#########################################################################################
# Analyze valence and arousal in disclosers' language using VADER
# Eleanor Collier
# 1/5/22
#########################################################################################

# Set up workspace
library(tidyverse)
library(vader)

#########################################################################################
## MOMENT TO MOMENT ----
# Load data
get_data_here  <- "/Volumes/GoogleDrive/My Drive/UCR/UCR SNL/Research Projects/SyncDisclosures/Pilot/Analysis/Data/processed/moment_to_moment/"
save_data_here <- "/Volumes/GoogleDrive/My Drive/UCR/UCR SNL/Research Projects/SyncDisclosures/Pilot/Analysis/Data/processed/moment_to_moment/"

transcripts_by_window <- read_csv(paste0(get_data_here, "transcripts_by_window.csv"))

# Clean up use of the word "like" as it throws off valence scores
transcripts_by_window$text <- gsub("like", "", transcripts_by_window$text, ignore.case=T)

# Get valence using vader's normalized, weighted compound score for valence
vader_scores <- transcripts_by_window$text %>%
  vader_df(text) %>%
  rename(vader_valence = compound) %>%
  # Get overall arousal (valence agnostic) by summing vader's valence score for each word (abs value)
  mutate(
    vader_arousal = sapply(strsplit(gsub("\\{|\\}", "", word_scores), ","), function(x) sum(abs(as.numeric(x))))
  ) %>%
  select(-c(pos, neu, neg, but_count, text))

# Bind with original data cols
transcripts_by_window_vader <- bind_cols(transcripts_by_window, vader_scores)

# Save data
transcripts_by_window_vader <- transcripts_by_window_vader %>% select(-word_scores)
write_csv(transcripts_by_window_vader, paste0(save_data_here, "transcripts_by_window_vader.csv"))

## MEAN BY DISCLOSURE ----
# Load data
get_data_here  <- "/Volumes/GoogleDrive/My Drive/UCR/UCR SNL/Research Projects/SyncDisclosures/Pilot/Analysis/Data/processed/mean_by_disclosure/"
save_data_here <- "/Volumes/GoogleDrive/My Drive/UCR/UCR SNL/Research Projects/SyncDisclosures/Pilot/Analysis/Data/processed/mean_by_disclosure/"

transcripts <- read_csv(paste0(get_data_here, "transcripts.csv"))

# Clean up use of the word "like" as it throws off valence scores
transcripts$text <- gsub("like", "", transcripts$text, ignore.case=T)

# Get valence using vader's normalized, weighted compound score for valence
vader_scores <- transcripts$text %>%
  vader_df(text) %>%
  rename(
    vader_valence = compound,
    vader_posemo = pos,
    vader_negemo = neg
    ) %>%
  # Get overall arousal (valence agnostic) by summing vader's valence score for each word (abs value)
  # and dividing by total number of words
  mutate(
    n_words = sapply(strsplit(gsub("\\{|\\}", "", word_scores), ","), function(x) length(x)),
    vader_arousal = sapply(strsplit(gsub("\\{|\\}", "", word_scores), ","), function(x) sum(abs(as.numeric(x))))/n_words
  ) %>%
  select(-c(neu, but_count, text))

# Bind with original data cols
transcripts_vader <- bind_cols(transcripts, vader_scores)

# Save data
transcripts_vader <- transcripts_vader %>% select(-word_scores)
write_csv(transcripts_vader, paste0(save_data_here, "transcripts_vader.csv"))


library("zoo")
library("xts")
library("ggplot2")

conversations <- read.csv("output/conversations/part-r-00000", header=F)

pdf(file="output/conversations/plot.pdf")

plot(conversations)


library(shiny)
library(magrittr)
library(dplyr)
library(tidyr)
library(ggplot2)
library(RColorBrewer)
library(cowplot)
library(igraph)
library(pals)
library(UpSetR)

#Nayla's WD
#setwd("/Users/naylaboorady/Desktop/MSK/scDNA_myeloid/shiny/scDNA_myeloid_shiny")
#Bobby's WD
#setwd("/Users/bowmanr/Projects/scDNA/scDNA_myeloid/shiny/scDNA_myeloid_shiny/")

source("functions.r")

# RELEVANT DATA ====
test<-read.csv("data/for_NB.csv")
test$Final_group<- factor(test$Final_group,levels=c("CH","MPN","Signaling","DTAI","DTAI-RAS","DTAI-FLT3","DTAI-FLT3-RAS"))
final_sample_summary<-readRDS(file="data/final_sample_summary.rds")
clone_mutations<-readRDS(file="data/clone_mutations.rds")
sample_mutations <-readRDS(file="data/sample_mutations_with_pheno.rds")

sample_list <-final_sample_summary

#SERVER ====
shinyServer(function(input,output,session) {

  plotCount_sample <- reactive({as.numeric(length(input$clonoInputSample))})
  plotHeight_sample <- reactive({ifelse(plotCount_sample()==1,400,400 * round(plotCount_sample()/2))})
  plotWidth_sample  <- reactive({ifelse(plotCount_sample()==1,500,1000)})

  plotCount_gene <- reactive({as.numeric(length(gene_sample_selection(input$clonoInputGene) ))})
  plotHeight_gene <- reactive({ifelse(plotCount_gene()==1,400,400 * round(plotCount_gene()/2))})
  plotWidth_gene  <- reactive({ifelse(plotCount_gene()==1,500,1000)})

  output$sampleClonPlotP <- renderPlot(switch(input$sc, oneC = gg_number_of_mutations(input$sampleClonGroups),
                                             oneE = gg_number_of_clones(input$sampleClonGroups),
                                             twoA = gg_shannon(input$sampleClonGroups),
                                             twoB = gg_Number_of_mutations_in_Dclone(input$sampleClonGroups),
                                             threeA = gg_dominant_clone_size_function(input$sampleClonGroups)
                             ))

  output$sampleClonPlotC <- renderPlot(switch(input$sc, oneC = gg_number_of_mutations(input$sampleClonGroups),
                                              oneE = gg_number_of_clones(input$sampleClonGroups),
                                              twoA = gg_shannon(input$sampleClonGroups),
                                              twoB = gg_Number_of_mutations_in_Dclone(input$sampleClonGroups),
                                              threeA = gg_dominant_clone_size_function(input$sampleClonGroups)
  ))

  output$clonalBarplot <- renderPlot(switch(input$selection_Feature,
                                            Sample= if(plotCount_sample()==1){
                                                          gg_clonograph(input$clonoInputSample)
                                                      }
                                                     else if(plotCount_sample()>1&plotCount_sample()<7){
                                                              gg_clonograph_multiplot(input$clonoInputSample)
                                                      } ,
                                            Gene =if(plotCount_gene()==1){
                                                        gg_clonograph(input$clonoInputGene)
                                                      }
                                                      else if(plotCount_gene()>1&plotCount_gene()<25){
                                                        gg_clonograph_multiplot(input$clonoInputGene)
                                                      })
  )

  output$plot.ui <- renderUI({switch(input$selection_Feature,
                                     Sample=plotOutput("clonalBarplot", height = plotHeight_sample(),
                                                       width = plotHeight_sample()),
                                     Gene =plotOutput("clonalBarplot", height = plotHeight_gene(),
                                                      width = plotHeight_gene())
                              )})

  output$networkPlot <- renderPlot(network_graph(input$networkInput,disease = "AML"))

})


require(RMySQL)

################################################################################
# define + for String concatenation
"+"=function(...) UseMethod("+")
"+.default"=.Primitive("+")
"+.character"=function(...) paste(...,sep="")
################################################################################

################################################################################
getIQRT = function(dbCon, runIndex=1, minRT=20, maxRT=100 )
{
  sql = "
    SELECT rt FROM `emrt4quant`
    WHERE (rt BETWEEN "+minRT+" AND "+maxRT+")
    ORDER BY rt ASC
  "
  dbRes = dbGetQuery(dbCon, sql)
  rt = dbRes$rt
  return(rt);
}
################################################################################

################################################################################
getPLGSRT = function(dbCon, runIndex=1, minRT=20, maxRT=100 )
{
  sql = "
    	SELECT
    		retention_time as rt
    	FROM
    		peptide as p
    		JOIN query_mass as q ON p.query_mass_index = q.`index`
    		JOIN low_energy as l ON q.low_energy_index = l.`index`
    	WHERE
    		p.type != ('IN_SOURCE')
    		AND length(p.sequence) >= 6
        AND (retention_time BETWEEN "+minRT+" AND "+maxRT+")
      GROUP BY l.`index`
    	ORDER BY retention_time ASC
	"
  dbRes = dbGetQuery(dbCon, sql)
  rt = dbRes$rt
  return(rt);
}
################################################################################

pdf(
  file="peptides_per_second.pdf",
  width=9, height=6
  #, units="cm", res=600,
  # compression="lzw"
)

dbNames = c(
  "Proj__13554790738200_199487011444631_100_28"
  ,"Proj__13554790738200_199487011444631_100_27"
  ,"Proj__13554790738200_199487011444631_100_21"
#  ,"Proj__13554790738200_199487011444631_100_23"
#  ,"Proj__13554790738200_199487011444631_100_25"
)

dbCols = c("blue", "green", "red")
dbTitles = c("MSE", "HDMSE", "UDMSE")
ppsDens = 1:3

dbDrv=dbDriver("MySQL")

mainSize=1.2
fontFamily="Helvetica"
par(mfrow=c(1,1))
par(mar=c(4.2,4,0.2,0.2))
par(las=1)

for(i in 1:length(dbNames))
{
  cat("processing " + dbName + " . . . \n")

  dbHost="192.168.1.102"
  dbPort=3306
  dbUser="root"
  dbPass="ykv16"
  dbName = dbNames[i]

  dbCon=dbConnect(dbDrv,host=dbHost, port=dbPort, dbname=dbName, user=dbUser, pass=dbPass)

  dbRes = dbGetQuery(dbCon, "SELECT title FROM project")
  prjTitle = gsub("\\W", " ", dbRes$title[1] )

  fromRT = 20
  toRT = 100

  binSize = 1/6
  parts = seq(fromRT, toRT, binSize)

  iqHist = hist( getIQRT(dbCon, 1, fromRT, toRT), breaks=parts, plot=F )

  x = iqHist$mids
  y = iqHist$counts / binSize / 60 / 3 # 60 seconds, 3 runs

  # lxy = lowess(x,y,f=0.01)

  if(T)
  if(i<2)
  {
    plot(
      x, y
      , t="l"
      , lwd=2
      , col=dbCols[i]
      , ylim=c( 0, 14)
      , ylab="average( unique sequences / sec )"
      , xlab="retention time [min]"
      # , main=prjTitle
    )
  }
  else
  {
    points( x, y, t="l", lwd=2, col=dbCols[i] )
  }

  if(F)
  if(i<2)
    {
      plot(
        density(y)
        , t="l"
        , lwd=2
        , col=dbCols[i]
        , xlim=c( 0.5, 18)
        #, ylab="average( unique sequences / sec )"
        #, xlab="retention time"
        # , main=prjTitle
      )
    }
  else
  {
    points( density(y), t="l", lwd=2, col=dbCols[i] )
  }

  # hp = hist( getPLGSRT(dbCon, 1, fromRT, toRT), breaks=parts, plot=F)
  # plgsY = hp$counts / binSize / 60 / 3
  # points(hp$mids, plgsY, t="l", col="red")

  dbDisconnect(dbCon)
}
legend("topright", legend=dbTitles, col=dbCols, lty=1, lwd=5, inset=0.01)

dev.off()

dbUnloadDriver(dbDrv)

################################################################################
################################################################################
################################################################################


# Performs variable processing for categorical (single) fields, namely:
# 1) Reassigning values as specified in data coding information file
# 2) Reordering categories for ordered fields
# 3) Replacing missing codes - we assume values < 0 are missing for categorical (single) variables
# 4) Remove values with <10 cases
# 5) Determine correct test to perform, either binary, ordered or unordered.

testCategoricalSingle <- function(varName, varType, thisdata, varlogfile)
{
    visit_number <- strsplit(varName, split="_")[[1]][2]
    varName <- strsplit(varName, split="_")[[1]][1]

    cat("CAT-SINGLE || ", file=varlogfile, append=TRUE)
    pheno <- thisdata[,phenoStartIdx:ncol(thisdata)]

    # Assert variable has only one column
    if (!is.null(dim(pheno))) {
        print(head(pheno))
        stop(paste0("More than one column for categorical single, number of columns: ", dim(pheno)[2]))
    }

    pheno <- reassignValue(pheno, varName, varlogfile)

    # Get data code info - whether this data code is ordinal or not
    # and any reordering
    dataPheno <- vl$phenoInfo[which(vl$phenoInfo$FieldID==varName),]
    dataCode <- dataPheno$DATA_CODING

    # Get data coding information.
   	dataCodeRow <- which(vl$dataCodeInfo$dataCode==dataCode)

    if (length(dataCodeRow)==0) {
        cat("ERROR: No row in data coding info file || ",
            file=varlogfile, append=TRUE)
        return(NULL)
    }

    dataDataCode <- vl$dataCodeInfo[dataCodeRow,]
    ordered <- dataDataCode$ordinal
    order <- as.character(dataDataCode$ordering)

    # Reorder variable values into increasing order
    # (we do this now as this may convert variable to binary rather than ordered)
    pheno <- reorderOrderedCategory(pheno, order, varlogfile)

    # If data code has a default_value then recode NA's to this value
    # for participants with value in default_related_field
    # this is used where there is no zero option e.g. field 100200
    defaultValue <- dataDataCode$default_value
    defaultRelatedID <- dataDataCode$default_related_field
    pheno <- setDefaultValue(pheno, defaultValue, defaultRelatedID, visit_number, varlogfile)

    # All categories coded as < 0 we assume are `missing' values
    pheno <- replaceMissingCodes(pheno)

    # Remove categories if < opt$mincategorysize examples
    pheno <- testNumExamples(pheno, varlogfile)

    uniqVar <- unique(na.omit(pheno))
    uniqVar <- sort(uniqVar)

    if (length(uniqVar) <= 1) {
    	cat("SKIP (only one value) || ", file=varlogfile, append=TRUE)
    	incrementCounter("catSin.onevalue")
        return(NULL)
    } else if (length(uniqVar) == 2) {
        cat("CAT-SINGLE-BINARY || ", file=varlogfile, append=TRUE)
        incrementCounter("catSin.case3")

        # Binary so logistic regression
        phenoFactor <- factor(pheno)
        thisdatanew <- cbind.data.frame(thisdata[,1:numPreceedingCols], phenoFactor)
        data_to_add <- binaryLogisticRegression(varName, varType, thisdatanew, varlogfile)

        return(data_to_add)
    } else {
        # > 2 categories
        if(length(is.na(ordered)) > 1) {
            print("problem:")
            print(varName)
            print(length(is.na(ordered)))
            print(ordered)
        }
        if (is.na(ordered)) {
            cat(" ERROR: 'ordered' not found in data code info file")
            return(NULL)
        } else {
            # Unordered
            if (ordered == 0) {
                cat("CAT-SINGLE-UNORDERED || ", file=varlogfile, append=TRUE)
                incrementCounter("catSin.case2")

                thisdatanew <- cbind.data.frame(thisdata[,1:numPreceedingCols], pheno)
                data_to_add <- testCategoricalUnordered(varName, varType, thisdatanew,
                    varlogfile)
                return(data_to_add)
            } else if (ordered == 1) {
                # Ordered
                cat("ordered || ", file=varlogfile, append=TRUE)
                incrementCounter("catSin.case1")

                # Reorder variable values into increasing order
                thisdatanew <- cbind.data.frame(thisdata[,1:numPreceedingCols], pheno)
                data_to_add <- testCategoricalOrdered(varName, varType, thisdatanew,
                    varlogfile, order)
                return(data_to_add)
            } else if (ordered == -2) {
                cat(" EXCLUDED or BINARY variable: Should not get here in code. ")
                incrementCounter("catSin.binaryorexcluded")
                return(NULL)
            } else {
                print(paste("ERROR", varName, varType, dataCode))
                return(NULL)
            }
        }
    }
}

# Values are reordered and assigned values 1:N for N categories
reorderOrderedCategory <- function(pheno, order, varlogfile)
{
    # New pheno of NAs (all values not in order are assumed to be NA)
    if (!is.na(order) && nchar(order)>0) {
        # Make empty pheno
        pheno2 <- rep(NA,length(pheno))
        # Get ordering
        orderParts <- unlist(strsplit(order,"\\|"))

        # Go through values in correct order and set value
        # from 1 to the number of values
        count <- 1
        for (i in orderParts) {
            idx <- which(pheno==i)
            pheno2[idx] <- count
            count <- count+1
        }

        cat("reorder ",order," || ", sep="", file=varlogfile, append=TRUE)
        return(pheno2)

    } else {
        return(pheno)
    }
}

# Sets default value for people with no value in pheno, but with a value in the
# field specified in the default_value_related_field column in the data coding info file.
# the default value is specified in the default_value column in the data coding info file.
setDefaultValue <- function(pheno, defaultValue, defaultRelatedID, visit_number, varlogfile)
{
    if (!is.na(defaultValue) && nchar(defaultValue) > 0) {
        # Remove people who have no value for indicator variable
        # Altered this from initial PHESANT.
        # indName <- paste("x", defaultRelatedID, "_0_0", sep="")
        indName <- paste0("x", defaultRelatedID, "_", visit_number, "_0")
     	cat("Default related field:", indName, "|| ",
            file=varlogfile, append=TRUE)
    	indicatorVar <- data[,indName]
    	# Remove participants with NA value in this related field
    	indicatorVar <- replaceNaN(indicatorVar)
        # Check if there are already examples with default value and if so display warning
        numWithDefault <- length(which(pheno==defaultValue))

        if (numWithDefault > 0)
            cat("(WARNING: already", numWithDefault, "values with default value) ")

        # Set default value in people who have no value in the pheno but do
        # have a value in the default_value_related_field
    	defaultIdxs <- which(!is.na(indicatorVar) & is.na(pheno))
        pheno[defaultIdxs] <- defaultValue
       	cat("default value", defaultValue, "set, N=", length(defaultIdxs), "|| ",
            file=varlogfile, append=TRUE)
    }
    return(pheno)
}


include	defs

# stlu --- symbol table lookup primitive

   integer function stlu (symbol, node, pred, st)
   character symbol (ARB)
   pointer node, pred, st

   DS_DECL(Mem, MEMSIZE)

   integer hash, i, j, nodsiz

   nodsiz = Mem (st)

   hash = 0
   for (i = 1; symbol (i) != EOS; i = i + 1)
      hash = hash + symbol (i)
   hash = mod (hash, ST_HTABSIZE) + 1

   pred = st + hash
   node = Mem (pred)
   while (node != LAMBDA) {
      i = 1
      j = node + ST_DATA + nodsiz
      while (symbol (i) == Mem (j)) {
	 if (symbol (i) == EOS)
	    return (YES)
	 i = i + 1
	 j = j + 1
	 }
      pred = node
      node = Mem (pred + ST_LINK)
      }

   return (NO)
   end


# Test for gwloggeR detect_drift() with multiple KNMI series as reference.
# This analysis is based on 32 where only 1 reference is used.

logger.names <- tools::file_path_sans_ext(grep('barometer/', gwloggeR.data::enumerate(), value = TRUE))
ref.logger.names <- tools::file_path_sans_ext(grep('20201103', gwloggeR.data::enumerate(partner = 'knmi'), value = TRUE))

ref <- sapply(ref.logger.names, function(name) {
  df.ref <- gwloggeR.data::read(name)$df
  list('x' = df.ref[!is.na(PRESSURE_VALUE), PRESSURE_VALUE],
       'timestamps' = df.ref[!is.na(PRESSURE_VALUE), TIMESTAMP_UTC])
}, simplify = FALSE, USE.NAMES = TRUE)

ggplot2::ggplot(data = data.table::rbindlist(ref, use.names = TRUE, fill = TRUE, idcol = 'file'),
                mapping = ggplot2::aes(x = timestamps, y = x, col = file)) +
  ggplot2::geom_line(alpha = 0.5) +
  ggplot2::theme_light() +
  ggplot2::theme(legend.position='top',
                 axis.text.y = ggplot2::element_text(angle = 90, hjust = 0.5),
                 axis.title.y = ggplot2::element_blank(),
                 axis.title.x = ggplot2::element_blank())

dir.create('./drifts/analysis_34', recursive = TRUE, showWarnings = FALSE)
ggplot2::ggsave('./drifts/analysis_34/knmi_all.png', width = 1280/96, height = 720/96, dpi = 96)

save.output <- function(f) {

  print(Sys.time())
  print(basename(f))

  ROOT.PATH <- './drifts/analysis_34/'

  df <- gwloggeR.data::read(f)$df
  df <- df[!is.na(TIMESTAMP_UTC),]
  df <- df[!is.na(PRESSURE_VALUE),]
  data.table::setkey(df, TIMESTAMP_UTC)

  if (nrow(df) == 0L) {
    print('Skipping...')
    return()
  }

  gwloggeR:::test.detect_function(
    fun = gwloggeR::detect_drift,
    x = df$PRESSURE_VALUE,
    timestamps = df$TIMESTAMP_UTC,
    reference = ref,
    apriori = gwloggeR::Apriori(data_type = 'air pressure', units = 'cmH2O'),
    verbose = TRUE,
    plot = TRUE,
    title = paste0(basename(f), ' - v0.02'),
    alpha = 1,
    RESULT.PATH = paste0(ROOT.PATH, basename(f), '.result'),
    ATTRIB.PATH = paste0(ROOT.PATH, basename(f), '.attribs'),
    IMG.PATH = paste0(ROOT.PATH, basename(f), '.png'),
    LOG.PATH = paste0(ROOT.PATH, basename(f), '.log')
  )

}

# parallel::setDefaultCluster(parallel::makeCluster(spec = 5L))
# parallel::clusterExport(varlist = c('ref'))
# results <- setNames(parallel::clusterApplyLB(x = logger.names, fun = save.output), logger.names)
# names(results) <- logger.names
# parallel::stopCluster(cl = parallel::getDefaultCluster())

results <- sapply(logger.names, save.output, USE.NAMES = TRUE, simplify = FALSE)

results.df <- data.table::rbindlist(lapply(names(results), function(ln) {
  c(list('name' = basename(ln)),
    attributes(results[[ln]])[c('mu', 'sigma', 'timestamp', 'rate', 'significance')])
}), use.names = TRUE, fill = TRUE)

write.csv(results.df, file = './drifts/analysis_34/results.csv', row.names = FALSE)

plot(x = results.df$significance, y = results.df$rate,
     ylim = quantile(results.df$rate, probs = c(0.025, 0.975), na.rm = TRUE))

plot(x = results.df$significance, y = results.df$rate,
     ylim = quantile(results.df$rate, probs = c(0.025, 0.975), na.rm = TRUE),
     xlim = c(0, 1/1000))

hist(results.df$significance, breaks = 100)
hist(results.df$significance[results.df$significance < 0.05], breaks = 100)
quantile(results.df$significance, probs = c(0.05, 0.1, 0.2, 0.5), na.rm = TRUE)
plot(ecdf(results.df$significance))


### class ######################################################################

validFLOP.MSFD.control <- function(object){
    if ( !(object@do.community.biomass.demersal %in% c(0,1))) return("option do.community.biomass.demersal must have the value 0 or 1")
    # Everything is fine
    return(TRUE)
}

setClass("FLOP.MSFD.control",
    representation(
    do.community.biomass.demersal  ="numeric",
    community.biomass.demersal.ages="matrix",
    do.community.biomass.small  ="numeric",
    community.biomass.small.ages="matrix",
    do.community.biomass.pelagic  ="numeric",
    community.biomass.pelagic.ages="matrix",
    do.community.biomass.forage  ="numeric",
    community.biomass.forage.ages="matrix",
    do.M2.bar                    ="numeric",
    M2.bar.ages                  ="matrix",
    do.mean.weight.at.age        ="numeric",
    mean.weight.at.age.sp        ="matrix",
    do.community.mean.weight     ="numeric",
    community.mean.weight.sp     ="matrix",
    do.mean.weight.C             ="numeric",
    mean.weight.C.sp             ="matrix",
    do.community.mean.weight.C   ="numeric",
    community.mean.weight.C.sp   ="matrix",
    do.community.F               ="numeric",
    community.F.sp               ="matrix",
    do.community.M               ="numeric",
    community.M.sp               ="matrix",
    do.life.expectancy           ="numeric",
    life.expectancy.first.age    ="matrix",
    do.community.life.expectancy ="numeric",
    community.life.expectancy.options="matrix",
    do.size.spectra              ="numeric",
    size.spectra.sp              ="matrix",
    do.LFI                       ="numeric",
    LFI.sp                       ="matrix",
    LFI.age                      ="matrix"
 )
  ,
  prototype=prototype(
    do.community.biomass.demersal  =0,
    community.biomass.demersal.ages =matrix(0,ncol=1,nrow=2,dimnames=list(c("first.age","last.age"),c("sp1"))),
    do.M2.bar                    =0,
    M2.bar.ages                  =matrix(0,ncol=1,nrow=2,dimnames=list(c("first.age","last.age"),c("sp1"))),
    do.mean.weight.at.age        =0,
    mean.weight.at.age.sp        =matrix(1,ncol=1,nrow=1,dimnames=list(c("include"),c("sp1"))),
    do.community.mean.weight     =0,
    community.mean.weight.sp     =matrix(1,ncol=1,nrow=1,dimnames=list(c("include"),c("sp1"))),
    do.mean.weight.C             =0,
    mean.weight.C.sp             =matrix(1,ncol=1,nrow=1,dimnames=list(c("include"),c("sp1"))),
    do.community.mean.weight.C   =0,
    community.mean.weight.C.sp   =matrix(1,ncol=1,nrow=1,dimnames=list(c("include"),c("sp1"))),
    do.community.F               =0,
    community.F.sp               =matrix(1,ncol=1,nrow=1,dimnames=list(c("include"),c("sp1"))),
    do.community.M               =0,
    community.M.sp               =matrix(1,ncol=1,nrow=1,dimnames=list(c("include"),c("sp1"))),
    do.life.expectancy           =0,
    life.expectancy.first.age    =matrix(1,ncol=1,nrow=1,dimnames=list(c("first.age"),c("sp1"))),
    do.community.life.expectancy =0,
    community.life.expectancy.options=matrix(1,ncol=1,nrow=2,dimnames=list(c("first.age","weighting"),c("sp1"))),
    do.size.spectra              =0,
    size.spectra.sp              =matrix(1,ncol=1,nrow=1,dimnames=list(c("include"),c("sp1"))),
    do.LFI                       =0,
    LFI.sp                       =matrix(1,ncol=1,nrow=1,dimnames=list(c("include"),c("sp1"))),
    LFI.age                      =matrix(1,ncol=1,nrow=1,dimnames=list(c("first.age"),c("sp1"))),
    do.community.biomass.small  =0,
    community.biomass.small.ages=matrix(0,ncol=1,nrow=2,dimnames=list(c("first.age","last.age"),c("sp1"))),
    do.community.biomass.pelagic  =0,
    community.biomass.pelagic.ages=matrix(0,ncol=1,nrow=2,dimnames=list(c("first.age","last.age"),c("sp1"))),
    do.community.biomass.forage  =0,
    community.biomass.forage.ages=matrix(0,ncol=1,nrow=2,dimnames=list(c("first.age","last.age"),c("sp1")))
    )
    ,
    validity=validFLOP.MSFD.control
)
setValidity("FLOP.MSFD.control", validFLOP.MSFD.control)

# in final version remove(validOP.control)  # We do not need this function any more
### End class ###########################################################

### Methods #############################################################

FLOP.MSFD.control <- function()
  {
    Init.function()
    VPA.species.names<-sp.names[first.VPA:nsp]
    all.species.names<-sp.names[1:nsp]
    no.species<-nsp-first.VPA+1

    fala<-matrix(c(rep(fa,no.species),SMS.control@species.info[first.VPA:nsp,'last-age']),byrow=T,ncol=no.species,nrow=2,dimnames=list(c("first.age","last.age"),VPA.species.names))
    fala2<-matrix(c(rep(fa,no.species),SMS.control@species.info[first.VPA:nsp,'last-age']),byrow=T,ncol=no.species,nrow=2,dimnames=list(c("first.age","weighting"),VPA.species.names))
    fala.all<-matrix(c(rep(fa,nsp),SMS.control@species.info[1:nsp,'last-age']),byrow=T,ncol=nsp,nrow=2,dimnames=list(c("first.age","last.age"),all.species.names))

    inclsp<-matrix(1,ncol=no.species,nrow=1,dimnames=list(c("include"),VPA.species.names))
    inclsp.all<-matrix(1,ncol=nsp,nrow=1,dimnames=list(c("include"),all.species.names))

   res <- new("FLOP.MSFD.control",
    do.community.biomass.demersal  =as.integer(0),
    community.biomass.demersal.ages =fala.all,
    do.M2.bar                    =as.integer(0),
    M2.bar.ages                  =fala,
    do.mean.weight.at.age        =as.integer(0),
    mean.weight.at.age.sp        =inclsp,
    do.community.mean.weight     =as.integer(0),
    community.mean.weight.sp     =inclsp,
    do.mean.weight.C             =as.integer(0),
    mean.weight.C.sp             =inclsp,
    do.community.mean.weight.C   =as.integer(0),
    community.mean.weight.C.sp   =inclsp,
    do.community.F               =as.integer(0),
    community.F.sp               =inclsp,
    do.community.M               =as.integer(0),
    community.M.sp               =inclsp,
    do.life.expectancy           =as.integer(0),
    life.expectancy.first.age    =inclsp,
    do.community.life.expectancy =as.integer(0),
    community.life.expectancy.options=fala2,
    do.size.spectra              =as.integer(0),
    size.spectra.sp              =inclsp.all,
    do.LFI                       =as.integer(0),
    LFI.sp                       =inclsp.all,
    LFI.age                       =inclsp.all,
    do.community.biomass.small   =as.integer(0),
    community.biomass.small.ages =fala.all,
    do.community.biomass.pelagic =as.integer(0),
    community.biomass.pelagic.ages=fala.all,
    do.community.biomass.forage  =as.integer(0),
    community.biomass.forage.ages =fala.all)
    return(res)
 }

###

###
write.FLOP.MSFD.control<-function(control,file="op_msfd.dat",path=NULL,nice=TRUE,writeSpNames=T) {

  wr.matrix<-function(m,text){
    cat("# ",text,"\n",file=file,append=TRUE)
    for (j in (1:dim(m)[1])) cat(m[j,],"\n",file=file,append=TRUE)
  }

  wr.matrix.nice<-function(m,sp){
   cat("#",formatC(sp,width=11),"\n",file=file,append=TRUE)
    for (j in (1:dim(m)[1])) cat(formatC(m[j,],width=11),"\n",file=file,append=TRUE)
  }

  if (!inherits(control, "FLOP.MSFD.control"))
        stop(paste("control" ,"must be an 'FLOP.MSFD.contol' object!"))

  old.path<-getwd()
  if (!is.null(path)) setwd(path)
  sepLine<-"########################################\n"

  sp.names<-dimnames(slot(control,"community.biomass.demersal.ages"))[[2]]
  VPA.sp.names<-sp.names[first.VPA:nsp]

  cat("# options for calculation of MSFD and other indicatores\n",file=file)
  cat('# the character "#" is used as comment character, such that all text and numbers after # are skipped\n#\n',file=file, append=TRUE)

  n.<-slotNames(control)
  for (x in n.) {
      switch(x,
      "do.community.biomass.demersal" ={if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate Biomass of demersal fish (option do.community.biomass.demersal)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "community.biomass.demersal.ages"  ={if (nice) {
                                 cat("# First and last ages to be used for calc of demersal fish biomass. Negative value excludes the species\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
      "do.M2.bar"                    ={if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate average M2 by species (option do.M2.bar)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "M2.bar.ages"                 ={if (nice) {
                                 cat("# First and last ages to be used for calc of mean M2, Negative value excludes the species\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
     "do.mean.weight.at.age" =   {if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate mean weight at age in the sea (option do.mean.weight.at.age)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "mean.weight.at.age.sp"     ={if (nice) {
                                 cat("# Include species 0=no, 1=yes\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
     "do.community.mean.weight" =   {if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate mean weight in the sea for the whole comunity (option do.community.mean.weight)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "community.mean.weight.sp"     ={if (nice) {
                                 cat("# Include species 0=no, 1=yes\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
      "do.mean.weight.C"     =   {if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate mean weight in the catch (option do.mean.weight.C)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "mean.weight.C.sp"     ={if (nice) {
                                 cat("# Include species 0=no, 1=yes\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
     "do.community.mean.weight.C" =   {if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate mean weight in the catch for the whole comunity (option do.community.mean.weight.C)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "community.mean.weight.C.sp"     ={if (nice) {
                                 cat("# Include species 0=no, 1=yes\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },

     "do.community.F" =   {if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate catch biomass/ stock biomass ratio (option do.community.F)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "community.F.sp"     ={if (nice) {
                                 cat("# Include species 0=no, 1=yes\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
      "do.community.M" =   {if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate dead (M) biomass/ stock biomass ratio (option do.community.M)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "community.M.sp"     ={if (nice) {
                                 cat("# Include species 0=no, 1=yes\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },

     "do.life.expectancy" =   {if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate life expectancy (option do.life.expectancy)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "life.expectancy.first.age"  ={if (nice) {
                                 cat("# First age used. Negative means not used\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
      "do.community.life.expectancy" =   {if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate community life expectancy (option do.community.life.expectancy)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "community.life.expectancy.options"  ={if (nice) {
                                 cat("# First age used. Negative means not used\n",file=file,append=T,sep="")
                                 cat("# Weighting factor, positve=input value, -1=recruitment  \n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),VPA.sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
      "do.size.spectra" =   {if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate Size spectrum slope and intercept (option do.size.spectra)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "size.spectra.sp"     ={if (nice) {
                                 cat("# Include species 0=no, 1=yes\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },

       "do.LFI"            =   {if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate Large Fish Indicator (option do.LFI)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "LFI.sp"            ={if (nice) {
                                 cat("# LFI, include species in LFI (0=no, 1=yes)\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
       "LFI.age"           ={if (nice) {
                                 cat("# LFI, first age considerd as a Large Fish\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },
     "do.community.biomass.small" ={if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate Biomass of small fish (option do.community.biomass.small)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "community.biomass.small.ages"  ={if (nice) {
                                 cat("# First and last ages to be used for calc of small fish biomass. Negative value excludes the species\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },

     "do.community.biomass.pelagic" ={if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate Biomass of pelagic fish (option do.community.biomass.pelagic)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "community.biomass.pelagic.ages" ={if (nice) {
                                 cat("# First and last ages to be used for calc of pelagic fish biomass. Negative value excludes the species\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                             },

     "do.community.biomass.forage" ={if (nice) {
                                       cat(sepLine,file=file,append=T)
                                       cat("## Calculate Biomass of forage fish (option do.community.biomass.forage)\n#  0=no, 1=yes\n",
                                          slot(control,x),"\n",file=file,append=T,sep="")
                                     } else  cat(slot(control,x),"\t#",x,"\n",file=file,append=TRUE)
                                    },
      "community.biomass.forage.ages" ={if (nice) {
                                 cat("# First and last ages to be used for calc of forage fish biomass. Negative value excludes the species\n",file=file,append=T,sep="")
                                    wr.matrix.nice(slot(control,x),sp.names)
                                } else wr.matrix(slot(control,x),x)
                             }

   )  #end switch
  }

 setwd(old.path)
}

#####

read.FLOP.MSFD.control<-function(file="op_msfd.dat",n.VPA,n.other.pred) {

  n.sp<-n.VPA+n.other.pred
  species.names<-readLines("species_names.in", n=n.sp)
  species.names<-species.names[(n.other.pred+1):n.sp]
  species.names<-gsub('_',' ',species.names)
  species.names<-sub('[[:space:]]+$', '', species.names)

  all.species.names<-readLines("species_names.in", n=n.sp)
  all.species.names<-all.species.names[1:n.sp]
  all.species.names<-gsub('_',' ',all.species.names)
  all.species.names<-sub('[[:space:]]+$', '', all.species.names)

  opt<-scan(file, comment.char = "#",quiet=TRUE)

  n<-1
  control<-new("FLOP.MSFD.control")
  n.<-slotNames(control)
  for (x in n.) {
    switch(x,
      "community.biomass.demersal.ages" = {slot(control,x)<-matrix(opt[n:(n-1+2*n.sp)],ncol=n.sp,nrow=2,dimnames=list(c("first.age","last.age"),all.species.names),byrow=TRUE); n<-n+2*n.sp},
      "M2.bar.ages"               = {slot(control,x)<-matrix(opt[n:(n-1+2*n.VPA)],ncol=n.VPA,nrow=2,dimnames=list(c("first.age","last.age"),species.names),byrow=TRUE); n<-n+2*n.VPA},
      "mean.weight.at.age.sp"   = {slot(control,x)<-matrix(opt[n:(n-1+1*n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(c("include"),species.names),byrow=TRUE); n<-n+1*n.VPA},
     "community.mean.weight.sp" = {slot(control,x)<-matrix(opt[n:(n-1+1*n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(c("include"),species.names),byrow=TRUE); n<-n+1*n.VPA},
     "mean.weight.C.sp"         ={slot(control,x)<-matrix(opt[n:(n-1+1*n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(c("include"),species.names),byrow=TRUE); n<-n+1*n.VPA},
     "community.mean.weight.C.sp" = {slot(control,x)<-matrix(opt[n:(n-1+1*n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(c("include"),species.names),byrow=TRUE); n<-n+1*n.VPA},
     "community.F.sp"           = {slot(control,x)<-matrix(opt[n:(n-1+1*n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(c("include"),species.names),byrow=TRUE); n<-n+1*n.VPA},
     "community.M.sp"           = {slot(control,x)<-matrix(opt[n:(n-1+1*n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(c("include"),species.names),byrow=TRUE); n<-n+1*n.VPA},
     "life.expectancy.first.age"  = {slot(control,x)<-matrix(opt[n:(n-1+1*n.VPA)],ncol=n.VPA,nrow=1,dimnames=list(c("first.age"),species.names),byrow=TRUE); n<-n+1*n.VPA},
     "community.life.expectancy.options"  = {slot(control,x)<-matrix(opt[n:(n-1+2*n.VPA)],ncol=n.VPA,nrow=2,dimnames=list(c("first.age","weighting"),species.names),byrow=TRUE); n<-n+2*n.VPA},
     "size.spectra.sp"           = {slot(control,x)<-matrix(opt[n:(n-1+1*n.sp)],ncol=n.sp,nrow=1,dimnames=list(c("include"),all.species.names),byrow=TRUE); n<-n+1*n.sp},
     "LFI.sp"                    = {slot(control,x)<-matrix(opt[n:(n-1+1*n.sp)],ncol=n.sp,nrow=1,dimnames=list(c("include"),all.species.names),byrow=TRUE); n<-n+1*n.sp},
     "LFI.age"                   = {slot(control,x)<-matrix(opt[n:(n-1+1*n.sp)],ncol=n.sp,nrow=1,dimnames=list(c("first.age"),all.species.names),byrow=TRUE); n<-n+1*n.sp},
     "community.biomass.small.ages"  = {slot(control,x)<-matrix(opt[n:(n-1+2*n.sp)],ncol=n.sp,nrow=2,dimnames=list(c("first.age","last.age"),all.species.names),byrow=TRUE); n<-n+2*n.sp},
     "community.biomass.pelagic.ages"  = {slot(control,x)<-matrix(opt[n:(n-1+2*n.sp)],ncol=n.sp,nrow=2,dimnames=list(c("first.age","last.age"),all.species.names),byrow=TRUE); n<-n+2*n.sp},
     "community.biomass.forage.ages"  = {slot(control,x)<-matrix(opt[n:(n-1+2*n.sp)],ncol=n.sp,nrow=2,dimnames=list(c("first.age","last.age"),all.species.names),byrow=TRUE); n<-n+2*n.sp},

         # otherwise
                              {slot(control,x)<-opt[n];n<-n+1}
      )
      #print(x)
  }
  control
}

###

## show (a replacement for print of S3 classes)
setMethod("show", signature(object="FLOP.MSFD.control"),
    function(object){
      n.<-slotNames(object)
       for (i in 1:length(n.)) {
         cat(n.[i])
         for (j in nchar(n.[i]):25) cat(" ")

         if (is.integer(slot(object,n.[i]))) cat(slot(object,n.[i]),"\n")

         else if (is.vector(slot(object,n.[i]))) {
           if (is.list(slot(object,n.[i]))) {
              for (k in 1:length(slot(object,n.[i]))) cat("\n\t",slot(object,n.[i])[[k]])
              cat("\n")
           }
           else cat(slot(object,n.[i]),"\n")
         }
         else if (is.matrix(slot(object,n.[i]))) {
           m<-slot(object,n.[i])
           cat("\n")
           print(m)
         }
       }
    }
)

if (F) {
  MSFD<-new("FLOP.MSFD.control")
  print(MSFD)

  MSFD<-FLOP.MSFD.control()

  print(MSFD)
  write.FLOP.MSFD.control(MSFD)
  a<-read.FLOP.MSFD.control(n.VPA=10,n.other.pred=16)
}


library('bsseq')
library('bumphunter')
library('doParallel')
library("bsseq")
library("GenomicFeatures")
library("MethylSeekR")
library("BSgenome")
library("BSgenome.Hsapiens.UCSC.hg19")

# load data

rm(list= ls()[!(ls() %in% c('CGlist','CGPrenlist'))])
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/UMRs_LMRs_annotated.rda")
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/dmvs_annotated.rda")
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/PMDs_annotated.rda")
load('/dcl01/lieber/ajaffe/lab/brain-epigenomics/bumphunting/BSobj_bsseqSmooth_Neuron_minCov_3.Rdata')

pd = pData(BSobj)
pd$Race[pd$Race== "CAUC "] <- 'CAUC'
pd$Sex[pd$Sex == " M"] <- 'M'
pd$RIN <- as.numeric(gsub(" ", "", pd$RIN))
pd$pg.DNA.nuclei.input <- as.numeric(pd$pg.DNA.nuclei.input)
pd$Reads <- as.numeric(pd$Reads)
pd$Percent.GreaterThan.Q30 <- as.numeric(pd$Percent.GreaterThan.Q30)

cov = getCoverage(BSobj, type = "Cov")
dim(cov)
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/bumphunting/BSobj_bsseqSmooth_Neuron_minCov_3_prenatal.Rdata")
covPren = getCoverage(BSobj, type = "Cov")
dim(covPren)
cov = cbind(cov, covPren)
cov = as.matrix(as.data.frame(cov))
gr = granges(BSobj)

## collate regions

all = list(LMR.All = Reduce(intersect, lapply(lDMR, makeGRangesFromDataFrame)),
           UMR.All = Reduce(intersect, lapply(uDMR, makeGRangesFromDataFrame)),
           DMV.All = Reduce(intersect, lapply(dmvDMR, makeGRangesFromDataFrame)),
           PMD.All = Reduce(intersect, lapply(pmdDMR, makeGRangesFromDataFrame)))
tab = list(LMR.Prenatal = lDMR[-which(names(lDMR) %in% postnatalpd$Data.ID)],
           LMR.Neuron = lDMR[which(names(lDMR) %in% postnatalpd[postnatalpd$Cell.Type=="Neuron","Data.ID"])],
           LMR.Glia = lDMR[which(names(lDMR) %in% postnatalpd[postnatalpd$Cell.Type=="Glia","Data.ID"])],
           UMR.Prenatal = uDMR[-which(names(uDMR) %in% postnatalpd$Data.ID)],
           UMR.Neuron = uDMR[which(names(uDMR) %in% postnatalpd[postnatalpd$Cell.Type=="Neuron","Data.ID"])],
           UMR.Glia = uDMR[which(names(uDMR) %in% postnatalpd[postnatalpd$Cell.Type=="Glia","Data.ID"])],
           DMV.Prenatal = dmvDMR[-which(names(dmvDMR) %in% postnatalpd$Data.ID)],
           DMV.Neuron = dmvDMR[which(names(dmvDMR) %in% postnatalpd[postnatalpd$Cell.Type=="Neuron","Data.ID"])],
           DMV.Glia = dmvDMR[which(names(dmvDMR) %in% postnatalpd[postnatalpd$Cell.Type=="Glia","Data.ID"])],
           PMD.Prenatal = pmdDMR[-which(names(pmdDMR) %in% postnatalpd$Data.ID)],
           PMD.Neuron = pmdDMR[which(names(pmdDMR) %in% postnatalpd[postnatalpd$Cell.Type=="Neuron","Data.ID"])],
           PMD.Glia = pmdDMR[which(names(pmdDMR) %in% postnatalpd[postnatalpd$Cell.Type=="Glia","Data.ID"])])
tab = lapply(tab, function(y) lapply(y, makeGRangesFromDataFrame, keep=TRUE))
red = lapply(tab, function(x) reduce(do.call(getMethod(c, "GenomicRanges"), GRangesList(x))))
tab = c(all, list(LMR.Prenatal = setdiff(red$LMR.Prenatal,all$LMR.All),
                  LMR.Neuron = setdiff(red$LMR.Neuron,all$LMR.All),
                  LMR.Glia = setdiff(red$LMR.Glia,all$LMR.All),
                  UMR.Prenatal = setdiff(red$UMR.Prenatal,all$UMR.All),
                  UMR.Neuron = setdiff(red$UMR.Neuron,all$UMR.All),
                  UMR.Glia = setdiff(red$UMR.Glia,all$UMR.All),
                  DMV.Prenatal = setdiff(red$DMV.Prenatal,all$DMV.All),
                  DMV.Neuron = setdiff(red$DMV.Neuron,all$DMV.All),
                  DMV.Glia = setdiff(red$DMV.Glia,all$DMV.All),
                  PMD.Prenatal = setdiff(red$PMD.Prenatal,all$PMD.All),
                  PMD.Neuron = setdiff(red$PMD.Neuron,all$PMD.All),
                  PMD.Glia = setdiff(red$PMD.Glia,all$PMD.All)))

## get mean coverage in regions

ov = lapply(tab, function(x) findOverlaps(gr, x))
ind = lapply(ov, function(x) split(queryHits(x), subjectHits(x)))

meanCov = lapply(ind, function(x) sapply(x, function(ii) colMeans(t(t(cov[ii,])))))
meanCov = lapply(meanCov, function(x) if (class(x)=="list") { do.call("rbind", x) } else { t(x) } )
meanCov = lapply(meanCov, function(x) as.data.frame(t(data.frame(x))))
meanCov = Map(cbind, lapply(meanCov, function(x) cbind(x, id = rownames(x))), Group = as.list(names(meanCov)))
for (i in 1:length(meanCov)) {
  meanCov[[i]][-which(meanCov[[i]][,"id"] %in% postnatalpd$Data.ID),"celltype"] = "Prenatal"
  meanCov[[i]][which(meanCov[[i]][,"id"] %in% postnatalpd[postnatalpd$Cell.Type=="Neuron","Data.ID"]),"celltype"] = "Neuron"
  meanCov[[i]][which(meanCov[[i]][,"id"] %in% postnatalpd[postnatalpd$Cell.Type=="Glia","Data.ID"]),"celltype"] = "Glia"
  meanCov[[i]][,"Age"] = postnatalpd[match(meanCov[[i]][,"id"], postnatalpd$Data.ID), "Age"]
}

corr = vector("list", length=length(meanCov))
for (i in 1:length(meanCov)) {
  for (j in 1:elementNROWS(ind)[i]) {
    corr[[i]][[j]] = cor.test(x = meanCov[[i]][which(meanCov[[i]][,"celltype"]!="Prenatal"),j],
                              y = meanCov[[i]][which(meanCov[[i]][,"celltype"]!="Prenatal"),"Age"])
  }
}
save(corr, file = "/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/coverage_check.r")

x = lapply(corr, function(x) do.call(rbind, lapply(x, function(y) data.frame(pval = y$p.value, estimate = y$estimate))))
x = do.call(rbind, Map(cbind, x, Regions = as.list(names(meanCov))))
x = data.table(x)
x[,list(max = max(estimate), min = min(estimate), mean = mean(estimate), median = median(estimate), sd = sd(estimate)),by="Regions"]
#        Regions       max        min        mean      median         sd
#1:      LMR.All 0.1381719 -0.4009710 -0.10216588 -0.10992318 0.14186114
#2:      UMR.All        NA         NA          NA          NA         NA
#3:      DMV.All 0.1177752 -0.3678718 -0.15409766 -0.15318706 0.07637643
#4:      PMD.All 0.4540102 -0.3966330  0.10347465  0.10911761 0.13486947
#5: LMR.Prenatal        NA         NA          NA          NA         NA
#6:   LMR.Neuron        NA         NA          NA          NA         NA
#7:     LMR.Glia        NA         NA          NA          NA         NA
#8: UMR.Prenatal        NA         NA          NA          NA         NA
#9:   UMR.Neuron        NA         NA          NA          NA         NA
#10:     UMR.Glia        NA         NA          NA          NA         NA
#11: DMV.Prenatal        NA         NA          NA          NA         NA
#12:   DMV.Neuron        NA         NA          NA          NA         NA
#13:     DMV.Glia        NA         NA          NA          NA         NA
#14: PMD.Prenatal 0.5455393 -0.2704574  0.22828721  0.25222361 0.10881298
#15:   PMD.Neuron 0.5455393 -0.2704574  0.09358677  0.09302474 0.11710940
#16:     PMD.Glia 0.5455393 -0.2704574  0.22695230  0.24657647 0.10687669

x[pval<=0.01, list(length()), by="Regions"]

tres = lapply(meanCov, function(x) t.test(x = rowMeans(x[which(x$celltype!="Prenatal"),c(1:(ncol(x)-4))]),
                                           y = rowMeans(x[which(x$celltype=="Prenatal"),c(1:(ncol(x)-4))])))
trespostnatal = lapply(meanCov, function(x) t.test(x = rowMeans(x[which(x$celltype=="Neuron"),c(1:(ncol(x)-4))]),
                                          y = rowMeans(x[which(x$celltype=="Glia"),c(1:(ncol(x)-4))])))
write.csv(data.frame(Regions = names(tres), Postnatal.Prenatal.Tstat = unlist(lapply(tres, function(x) x$statistic)),
                     Postnatal.Prenatal.pval = unlist(lapply(tres, function(x) x$p.value)),
                     Postnatal.mean = unlist(lapply(tres, function(x) x$estimate[1])),
                     Prenatal.mean = unlist(lapply(tres, function(x) x$estimate[2])),
                     Neuron.Glia.Tstat = unlist(lapply(trespostnatal, function(x) x$statistic)),
                     Neuron.Glia.pval = unlist(lapply(trespostnatal, function(x) x$p.value)),
                     Neuron.mean = unlist(lapply(trespostnatal, function(x) x$estimate[1])),
                     Glia.mean = unlist(lapply(trespostnatal, function(x) x$estimate[2]))), quote = F,
          file = "/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/cellType_CRE_coverage_tstats.csv")

df = do.call(rbind, Map(cbind, lapply(meanCov, function(x)
  rbind(data.frame(rowmeans = rowMeans(x[which(x$celltype=="Prenatal"),c(1:(ncol(x)-4))]), celltype = "Prenatal"),
  data.frame(rowmeans = rowMeans(x[which(x$celltype=="Neuron"),c(1:(ncol(x)-4))]), celltype = "Neuron"),
  data.frame(rowmeans = rowMeans(x[which(x$celltype=="Glia"),c(1:(ncol(x)-4))]), celltype = "Glia"))),
  Regions = as.list(names(meanCov))))

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/prenatal_postnatal_coverage_inCREs.pdf", width = 26)
ggplot(df, aes(x = celltype, y = rowmeans, colour = celltype)) +
  theme_classic() + geom_boxplot() +
  labs(fill="") + facet_grid(. ~ Regions) +
  ylab("Mean Coverage") +
  xlab("") + theme(axis.text.x = element_text(angle = 30, hjust = 1)) +
  ggtitle("Mean Coverage by Cell Type in CRE sequence") +
  theme(title = element_text(size = 20)) +
  theme(text = element_text(size = 20), legend.title=element_blank()) + theme(legend.position="bottom")
dev.off()

for (i in 1:length(meanCov)) {
  meanCov[[i]] = cbind(meanCov[[i]], Age.bin = postnatalpd[match(meanCov[[i]][,"id"], postnatalpd$Data.ID),"Age.Bin"])
  meanCov[[i]][,"Age.bin"] = as.character(meanCov[[i]][,"Age.bin"])
  meanCov[[i]][is.na(meanCov[[i]][,"Age.bin"]),"Age.bin"] = "Prenatal"
}

df = do.call(rbind, Map(cbind, lapply(meanCov, function(x)
  rbind(data.frame(rowmeans = rowMeans(x[which(x$Age.bin=="Prenatal"),c(1:(ncol(x)-5))]), Age.bin = "Prenatal"),
        data.frame(rowmeans = rowMeans(x[which(x$Age.bin=="Neonate"),c(1:(ncol(x)-5))]), Age.bin = "Neonate"),
        data.frame(rowmeans = rowMeans(x[which(x$Age.bin=="Toddler"),c(1:(ncol(x)-5))]), Age.bin = "Toddler"),
        data.frame(rowmeans = rowMeans(x[which(x$Age.bin=="Child"),c(1:(ncol(x)-5))]), Age.bin = "Child"),
        data.frame(rowmeans = rowMeans(x[which(x$Age.bin=="Early.Teen"),c(1:(ncol(x)-5))]), Age.bin = "Early.Teen"),
        data.frame(rowmeans = rowMeans(x[which(x$Age.bin=="Teen"),c(1:(ncol(x)-5))]), Age.bin = "Teen"),
        data.frame(rowmeans = rowMeans(x[which(x$Age.bin=="Young.Adult"),c(1:(ncol(x)-5))]), Age.bin = "Young.Adult"))),
  Regions = as.list(names(meanCov))))

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/acrossAge_coverage_inCREs.pdf", width = 52)
ggplot(df, aes(x = Age.bin, y = rowmeans, colour = Age.bin)) +
  theme_classic() + geom_boxplot() +
  labs(fill="") + facet_grid(. ~ Regions) +
  ylab("Mean Coverage") +
  xlab("") + theme(axis.text.x = element_text(angle = 30, hjust = 1)) +
  ggtitle("Mean Coverage by Age Bin in CRE sequence") +
  theme(title = element_text(size = 20)) +
  theme(text = element_text(size = 20), legend.title=element_blank()) + theme(legend.position="bottom")
dev.off()


library(tidyverse)
# Define function to get features for album, instead of playlist.
# Works up to 100 tracks (limitation of get_track_audio_features()).
# get_album_audio_features <- function(album_id) {
#   req = get_album_tracks(album_id)
#   album_info <- get_track_audio_features(req$id)
#   return(merge(req, album_info, by="id"))
# }
#
# get_base_linkin_park <- function() {
#   hybrid_theory <- get_album_audio_features("2pKw6GERJVAD61449B1EEM")
#   meteora <- get_album_audio_features("4Gfnly5CzMJQqkUFfoHaP3")
#   minutes_to_midnight <- get_album_audio_features("2tlTBLz2w52rpGCLBGyGw6")
#   a_thousand_suns <- get_album_audio_features("113yjuFZEqkkbuLi4sEBxo")
#   living_things <- get_album_audio_features("4XHIjbhjRmqWlosjj5rqSI")
#   the_hunting_party <- get_album_audio_features("3XB2yloP7l00tEUmaODtVi")
#   one_more_light <- get_album_audio_features("5Eevxp2BCbWq25ZdiXRwYd")
#
#   return(rbind(hybrid_theory, meteora, minutes_to_midnight,
#                        a_thousand_suns,living_things, the_hunting_party,
#                        one_more_light))
# }
#
# get_remix_linkin_park <- function(){
#   recharged <- get_album_audio_features("2FUsvD1bw53HGOjAg56vRD")
#   reanimation <- get_album_audio_features("2NbO8RRVTVEUjHaxUVdMDT")
#   return(rbind(recharged, reanimation))
# }

all_lp_tracks <- get_playlist_audio_features("", "1y9QYGfYFzSO7EF53wwLiB")
# Filter out songs that have been duplicated
# (republished under the 20th anniversary album), along with inbetween-tracks
# that are shorter than a minute as these are not songs.
unq_lp_tracks = distinct(all_lp_tracks, track.name, .keep_all = TRUE) %>%
  filter(track.duration_ms > 60000, track.album.album_type == "album")

unq_lp_tracks$year_album_published =
  as.Date(format(as.Date(unq_lp_tracks$track.album.release_date,
                         format="%Y-%m-%d"),"%Y"), "%Y")

ggplot(unq_lp_tracks, aes(x=year_album_published, y=track.popularity)) +
  labs(title="Linkin Park track popularity over time", x="Year", y="Popularity", color = "Album") +
  geom_point(aes(color=track.album.name)) +
  geom_smooth()

main_albums <- c("Hybrid Theory (Bonus Edition)","Meteora (Bonus Edition)", "Minutes to Midnight",  "A Thousand Suns", "LIVING THINGS","The Hunting Party", "One More Light")
main_album_tracks <- unq_lp_tracks %>% filter(track.album.name %in% main_albums)
a <- ggplot(main_album_tracks, aes(x=year_album_published, y=track.popularity)) +
  labs(title="Linkin Park track popularity over time", x="Year", y="Popularity", color = "Album") +
  geom_point(aes(color=track.album.name)) +
  geom_smooth()
ggplotly(a)


#!/usr/bin/env Rscript

library(DESeq2, quietly=TRUE)
library(stringr)
library(ashr)
library(EnhancedVolcano)
library(scales)

args = commandArgs(trailingOnly=TRUE)
cts = read.table(args[1], header=TRUE, row.names=1)
ssheet = read.table(args[2], header=TRUE, stringsAsFactors=TRUE)
results_dir = args[3]
# Assumes the results_dir has alreasy been created by python

####
coldata <- ssheet[, c("Status", "CT")]
rownames(coldata) <- ssheet[, "SampleName"]
print(coldata)

name.vec <- c("Chr", "Start", "End", "Strand", "Length")
for (i in 6:ncol(cts)) {
    name.vec <- append(name.vec, as.character(ssheet$SampleName[i-5]))
}
names(cts) <- name.vec

mat = cts[,6:ncol(cts)]
mat[is.na(mat)] <- 0

print(str(mat))
print(head(mat))

print(str(coldata))
print(head(coldata))

dds <- DESeqDataSetFromMatrix(countData = mat,
                              colData = coldata,
                              design= ~ Status)
dds <- DESeq(dds)
resultsNames(dds)
#########
for (control in unique(ssheet$Status)) {
    for (treatment in unique(ssheet$Status)) {
        if (control == treatment){
            next
        }
        print(paste("Contrast: ", control, " vs ", treatment))
        res <- results(dds, contrast=c("Status", control, treatment),
                       independentFiltering=TRUE, parallel=TRUE)
        res <- lfcShrink(dds, contrast=c("Status", control, treatment), res=res, type="ashr")
        print(paste0(results_dir, "/", control, "_vs_", treatment, ".csv"))
        write.csv(as.data.frame(res), paste0(results_dir, "/", control, "_vs_", treatment, ".csv"))

        print(paste0(results_dir, "/", control, "_vs_", treatment, ".pdf"))
        print(paste(control, "vs.", treatment))
        volcano <- EnhancedVolcano(res,
                        lab = rownames(res),
                        x = 'log2FoldChange',
                        y = 'pvalue',
                        title = paste(control, "vs.", treatment),
                        pCutoff = 0.05,
                        FCcutoff = 1.2
                        )
        ggsave(paste0(results_dir, "/", control, "_vs_", treatment, ".pdf"), volcano)

        # # Make pairwse peak/count plots for each sample
        control_samples <- as.character(ssheet[ssheet$Status == control,"SampleName"])
        treatment_samples <- as.character(ssheet[ssheet$Status == treatment,"SampleName"])
        # rowMeans behaes extremely stupidly and doesn't work on a dataframe with only one column
        # This is why R sucks...
        if (length(control_samples) > 1) {
            control_counts <- rowMeans(mat[, control_samples])
        } else {
            control_counts <- mat[, control_samples]
        }
        if (length(treatment_samples) > 1) {
            treatment_counts <- rowMeans(mat[, treatment_samples])
        } else {
            treatment_counts <- mat[, treatment_samples]
        }
        ppc_df <- as.data.frame(cbind(control_counts, treatment_counts))
        ppc <- ggplot(ppc_df, aes(x=control_counts,
                                  y=treatment_counts),
                      ) +
               geom_density_2d() +
               geom_abline(intercept=0, slope=1, color="Black") +
               scale_y_continuous(trans='log10',
                                  breaks = trans_breaks('log10', function(x) 10^x),
                                  labels = trans_format('log10', math_format(10^.x))
                                  ) +
               scale_x_continuous(trans='log10',
                                  breaks = trans_breaks('log10', function(x) 10^x),
                                  labels = trans_format('log10', math_format(10^.x))
                                  ) +
               theme_minimal() +
               xlab(paste0(control)) +
               ylab(paste0(treatment)) +
               ggtitle("ATAC-seq mean counts/peak")
        ###### These plots may also be used
        # ppc <- ggplot(ppc_df, aes(x=control_counts,
        #                           y=treatment_counts),
        #               ) +
        #        geom_hex() +
        #        geom_abline(intercept=0, slope=1, color="Black") +
        #        scale_fill_continuous(type = "viridis") +
        #        scale_y_continuous(trans='log10') +
        #        scale_x_continuous(trans='log10')
        # ppc <- ggplot(ppc_df, aes(x=control_counts,
        #                           y=treatment_counts),
        #               ) +
        #        geom_point(alpha=0.05) +
        #        geom_abline(intercept=0, slope=1, color="Black") +
        #        scale_y_continuous(trans='log10') +
        #        scale_x_continuous(trans='log10')
        #######
        ggsave(paste0(results_dir, "/", control, "_vs_", treatment, "_ppc",".pdf"), ppc)
    }
}

#########
main <- function(){
}


#!/usr/local/bin/rscript

require(ggplot2)
require(reshape2)

experiments = c('fis')
outDirectory = '../out/plots/'
timeSteps = 199

colSd <- function (x, na.rm = F) apply(X = x, MARGIN = 2, FUN = sd, na.rm = na.rm)

# http://stackoverflow.com/a/24241954/1185
fancy_scientific <- function(value) {
     value <- format(value, scientific = TRUE)
     value <- gsub("^(.*)e", "'\\1'e", value)
     value <- gsub("e", "%*%10^", value)
     parse(text = value)
}

analysis <- function (file, title, ylabel, fancy) {

	# Read the relevent data from disk
	data <- loadData(file)
	rows = nrow(data[['fis']])

	# Prepare the data farme with the mean of the data
	df <- data.frame(Year = 1:timeSteps,
					 'fis' = colMeans(data[['fis']]))

	df <- melt(df, id.vars = 'Year', variable.name = 'Series')
	df$Series <- as.character(df$Series)
	df$Series[df$Series == "fis"] <- "FIS"

	# Plot and save
	plot(df, rows, title, ylabel, fancy, file)
}

harvestAnalysis <- function(title, ylabel, fancy) {
	# Read the relevent data from disk
	stems <- loadData('harvestedStems')
	biomass <- loadData('harvestedBiomass')
	rows = nrow(stems[['fis']])

	# Prepare the data frame wtih the mean of the data
	df <- data.frame(Year = 1:timeSteps,
			'none.biomass' = colMeans(biomass[['fis']]),
			'none.stems' = colMeans(stems[['fis']]))

	# Melt and set the labels
	df <- melt(df, id.vars = 'Year', variable.name = 'Series')
	df$Series <- as.character(df$Series)
	df$Series[df$Series == "fis.biomass"] <- "Biomass"
	df$Series[df$Series == "fis.stems"] <- "Stems"

	# Plot and save
	plot(df, rows, title, ylabel, fancy, 'harvestedBiomass')
}

loadData <- function(file) {
	data <- list()
	for (experiment in experiments) {
		path = paste('../out/', experiment, '/', file, '.csv', sep="")
		working <- read.csv(path, header=F)
		data[[experiment]] <- working[, 0:timeSteps]
	}
	return(data)
}

plot <- function(df, rows, title, ylabel, fancy, file) {
	title = sprintf("%s (mean of %i runs)", title, rows)
	plotted <- ggplot(df, aes(Year, value), main = title) +
			geom_line(aes(colour = Series)) +
			labs(y = ylabel, title = title) +
			theme(legend.position = "none", legend.title = element_blank())

	if (fancy) {
		plotted <- plotted + scale_y_continuous(labels = fancy_scientific)
	}

	file = paste(outDirectory, file, '.png', sep="")
	ggsave(filename = file, plot = plotted)
}

main <- function() {
	dir.create(outDirectory, showWarnings = FALSE)

	analysis('carbonAgents', 'Carbon Sequestration by NIPFOs', expression('Metric Tons (MTCO'[2]*')'), F)
	analysis('carbonGlobal', 'Global Carbon Sequestration', expression('Metric Tons (MTCO'[2]*')'), F)

	harvestAnalysis('Harvested Biomass & Stems', 'Metric Tons (MT) Dry Weight', T)
	analysis('harvestDemand', 'Harvest Demand', 'Owners', F)
	analysis('harvestedParcels', 'Harvested Parcels', 'Owners', F)

	#analysis('harvestedBiomass', 'Harvested Biomass', 'Metric Tons (MT) Dry Weight', T)
	#analysis('harvestedStems', 'Harvested Stems', 'Metric Tons (MT) Dry Weight', T)
}
main()


#' Scales for area or radius
#'
#' `scale_size()` scales area, `scale_radius()` scales radius. The size
#' aesthetic is most commonly used for points and text, and humans perceive
#' the area of points (not their radius), so this provides for optimal
#' perception. `scale_size_area()` ensures that a value of 0 is mapped
#' to a size of 0. `scale_size_binned()` is a binned version of `scale_size()` that
#' scales by area (but does not ensure 0 equals an area of zero). For a binned
#' equivalent of `scale_size_area()` use `scale_size_binned_area()`.
#'
#' @name scale_size
#' @inheritParams continuous_scale
#' @inheritParams binned_scale
#' @param range a numeric vector of length 2 that specifies the minimum and
#'   maximum size of the plotting symbol after transformation.
#' @seealso [scale_size_area()] if you want 0 values to be mapped
#'   to points with size 0.
#' @examples
#' p <- ggplot(mpg, aes(displ, hwy, size = hwy)) +
#'    geom_point()
#' p
#' p + scale_size("Highway mpg")
#' p + scale_size(range = c(0, 10))
#'
#' # If you want zero value to have zero size, use scale_size_area:
#' p + scale_size_area()
#'
#' # Binning can sometimes make it easier to match the scaled data to the legend
#' p + scale_size_binned()
#'
#' # This is most useful when size is a count
#' ggplot(mpg, aes(class, cyl)) +
#'   geom_count() +
#'   scale_size_area()
#'
#' # If you want to map size to radius (usually bad idea), use scale_radius
#' p + scale_radius()
NULL

#' @rdname scale_size
#' @export
#' @usage NULL
scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = waiver(),
                                  limits = NULL, range = c(1, 6),
                                  trans = "identity", guide = "legend") {
  continuous_scale("size", "area", area_pal(range), name = name,
    breaks = breaks, labels = labels, limits = limits, trans = trans,
    guide = guide)
}

#' @rdname scale_size
#' @export
scale_size <- scale_size_continuous

#' @rdname scale_size
#' @export
scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(),
                         limits = NULL, range = c(1, 6),
                         trans = "identity", guide = "legend") {
  continuous_scale("size", "radius", rescale_pal(range), name = name,
    breaks = breaks, labels = labels, limits = limits, trans = trans,
    guide = guide)
}

#' @rdname scale_size
#' @export
scale_size_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(),
                              limits = NULL, range = c(1, 6), n.breaks = NULL,
                              nice.breaks = TRUE, trans = "identity", guide = "bins") {
  binned_scale("size", "area_b", area_pal(range), name = name,
               breaks = breaks, labels = labels, limits = limits, trans = trans,
               n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide)
}

#' @rdname scale_size
#' @export
#' @usage NULL
scale_size_discrete <- function(...) {
  warn("Using size for a discrete variable is not advised.")
  scale_size_ordinal(...)
}

#' @rdname scale_size
#' @export
#' @usage NULL
scale_size_ordinal <- function(..., range = c(2, 6)) {
  force(range)

  discrete_scale(
    "size",
    "size_d",
    function(n) {
      area <- seq(range[1] ^ 2, range[2] ^ 2, length.out = n)
      sqrt(area)
    },
    ...
  )
}

#' @inheritDotParams continuous_scale -aesthetics -scale_name -palette -rescaler
#' @param max_size Size of largest points.
#' @export
#' @rdname scale_size
scale_size_area <- function(..., max_size = 6) {
  continuous_scale("size", "area",
    palette = abs_area(max_size),
    rescaler = rescale_max, ...)
}

#' @export
#' @rdname scale_size
scale_size_binned_area <- function(..., max_size = 6) {
  binned_scale("size", "area_b",
               palette = abs_area(max_size),
               rescaler = rescale_max, ...)
}

#' @rdname scale_size
#' @export
#' @usage NULL
scale_size_datetime <- function(..., range = c(1, 6)) {
  datetime_scale("size", "time", palette = area_pal(range), ...)
}

#' @rdname scale_size
#' @export
#' @usage NULL
scale_size_date <- function(..., range = c(1, 6)) {
  datetime_scale("size", "date", palette = area_pal(range), ...)
}


library(shiny)
library(png)
library(jpeg)
library(digest)
library(rdrop2)

# TODO: Magnifying glass
# Dropbox authentication
token <- readRDS(paste0(getwd(),"/droptoken.rds"))
drop_acc(dtoken = token)
# Temporary directory
temp.dir=tempdir()

ui <- shinyUI(fluidPage(
  titlePanel("Upload plot - [ALPHA] PlotPinch v0.1"),
  sidebarLayout(
    sidebarPanel(
      fileInput(inputId = 'fileplot',
                label = 'Select an Image',
                multiple = F,
                accept=c('image/png', 'image/jpeg')),
      fluidRow(column(2,actionButton("origin","Origin"))),
      fluidRow(column(2),column(2,h5("From")),column(2,h5("To")),column(3,h5("Scale"))),
      fluidRow(column(2,actionButton("abscissa","X axis")),
               column(2,textInput(inputId = "abscissa.min",label = NA, value = "0")),
               column(2,textInput(inputId = "abscissa.max",label = NA, value = "1")),
               column(3,selectInput(inputId = "abscissa.scale",label=NA,c("Linear","Log")))),
      fluidRow(column(2),column(2,h5("From")),column(2,h5("To")),column(3,h5("Scale"))),
      fluidRow(column(2,actionButton("ordinate","Y axis")),
               column(2,textInput(inputId = "ordinate.min",label = NA, value = "0")),
               column(2,textInput(inputId = "ordinate.max",label = NA, value = "1")),
               column(3,selectInput(inputId = "ordinate.scale",label=NA,c("Linear","Log")))),
      fluidRow(column(2,h5(" "))),
      fluidRow(column(2,h5(" "))),
      fluidRow(column(2,actionButton("add.curve","Add")),
               column(3,selectInput(inputId = "select.curve",label=NA,c("Curve 1" = 1, "Curve 2" = 2, "Curve 3" = 3, "Curve 4" = 4)))),
      fluidRow(column(2,h5(" "))),
      fluidRow(column(2,h5(" "))),
      fluidRow(column(3,actionButton("delete","Delete points")),column(3,actionButton("confirm","Confirm deletion"))),
      fluidRow(column(2,h5(" "))),
      fluidRow(column(2,h5(" "))),
      fluidRow(column(2,downloadButton('downloadData', 'Download')))
    ),
    mainPanel(
      uiOutput("image.ui")
    )
  )
))

server <- shinyServer(function(input, output) {
  # File upload
  files <- reactive({
    files <- input$fileplot
    files$datapath <- gsub("\\\\", "/", files$datapath)
    files
  })
  # Reads PNG
  ima <- reactive({
    if (is.null(input$fileplot)) {
      ima <- readPNG("WelcomeTutorial.png")
    }
    else{
      if (files()$type == "image/png") {
        ima <- readPNG(files()$datapath, native = T)
      } else if (files()$type == "image/jpeg") {
        ima <- readJPEG(files()$datapath, native = T)
      }
    }
  })
  # Extracts width and height
  ima.x <- reactive(dim(ima())[2])
  ima.y <- reactive(dim(ima())[1])
  # Substitute for plotPutput on ShinyUI() in order to dinamically allocate width and heigth
  output$image.ui <- renderUI({
    plotOutput("image1", width = ima.x(), height = ima.y(), click = clickOpts(id = "plot_click"),brush = "plot_brush")
  })
  # Render a zero margin plot with image as background
  output$image1 <- renderPlot({
    par(mar=c(0,0,0,0))
    par(xaxs='i',yaxs='i')
    plot(0:1,0:1,cex=0)
    lim <- par()
    rasterImage(ima(), lim$usr[1], lim$usr[3], lim$usr[2], lim$usr[4])
    if (value$origin$x != 0 || value$origin$y != 0) {
      points(value$origin$x,value$origin$y,pch=3,cex=5, col="black",lwd=3)
    }
    if (value$abscissa$x != 1 || value$abscissa$y != 0) {
      points(value$abscissa$x,value$abscissa$y,pch=3,cex=5, col="blue",lwd=3)
    }
    if (value$ordinate$x != 0 || value$ordinate$y != 1) {
      points(value$ordinate$x,value$ordinate$y,pch=3,cex=5, col="green",lwd=3)
    }
    if (nrow(value$curve) != 1) {
      points(value$curve$x,value$curve$y,pch=10,cex=3, col=(value$curve$n+1),lwd=2)
    }
    input$confirm
  })
  # Axis handling
  # Set Default axis and save them to Value
  origin = data.frame(x=0 ,y=0)
  abscissa = data.frame(x=1, y=0)
  ordinate = data.frame(x=0, y=1)
  curve = data.frame(x=NA, y=NA, n=NA)
  delete = data.frame(x=c(-2,-2),y=c(-2,-2))
  value <- reactiveValues(origin.set=F, origin=origin, abscissa.set=F,
                          abscissa=abscissa, ordinate.set=F, ordinate=ordinate,
                          curve.set=F,curve=curve, delete.set=F,delete=delete)
  #Origin, X axis, Yaxis and add curve buttons as triggers
  observeEvent(input$origin,{ # Origin
    value$origin.set=T
    value$abscissa.set=F
    value$ordinate.set=F
    value$curve.set = F
    value$delete.set = F
  })
  observeEvent(input$abscissa,{ # X axis
    value$origin.set=F
    value$abscissa.set=T
    value$ordinate.set=F
    value$curve.set = F
    value$delete.set = F
  })
  observeEvent(input$ordinate,{ # Y axis
    value$origin.set=F
    value$abscissa.set=F
    value$ordinate.set=T
    value$curve.set = F
    value$delete.set = F
  })
  observeEvent(input$add.curve,{ # Add curve
    value$origin.set=F
    value$abscissa.set=F
    value$ordinate.set=F
    value$curve.set = T
    value$delete.set = F
  })
  observeEvent(input$delete,{ # Add curve
    value$origin.set=F
    value$abscissa.set=F
    value$ordinate.set=F
    value$curve.set = F
    value$delete.set = T
  })
  # Action button actions
  observeEvent(input$plot_click,{
    if (value$origin.set==T) { # Set Origin
      origin$x=input$plot_click[[1]]
      origin$y=input$plot_click[[2]]
      value$origin=origin
      value$origin.set=F
    } else if (value$abscissa.set==T) { # Set X axis
      abscissa$x=input$plot_click[[1]]
      abscissa$y=input$plot_click[[2]]
      value$abscissa=abscissa
      value$abscissa.set=F
    } else if (value$ordinate.set==T) { # Set Y axis
      ordinate$x=input$plot_click[[1]]
      ordinate$y=input$plot_click[[2]]
      value$ordinate=ordinate
      value$ordinate.set=F
    } else if (value$curve.set==T) { # Add points to a curve
      value$curve=rbind(value$curve,c(input$plot_click[[1]],input$plot_click[[2]],as.numeric(input$select.curve)))
    }
    else {
      return(NULL)
    }
  })
  observeEvent(input$confirm,{
    if (value$delete.set==T && !is.null(input$plot_brush)) {
      a=rep(F,nrow(value$curve))
      for (i in 2:nrow(value$curve)){
        if (value$curve$x[i]>=input$plot_brush$xmin && value$curve$y[i]>=input$plot_brush$ymin &&
            value$curve$x[i]<=input$plot_brush$xmax && value$curve$y[i]<=input$plot_brush$ymax) a[i]=T
      }
      value$curve=value$curve[which(a==F),]
    }
    value$delete.set = F
  })
  # Post Processing and download handler
  output$downloadData <- downloadHandler(
    filename = function() {
      paste('PlotPinch.csv', sep='')
    },
    content = function(con) {
      curve = value$curve[2:nrow(value$curve),]
      rownames(curve) = c(1:nrow(curve))
      colnames(curve) = c("X","Y","CURVE")
      xm = value$origin$x
      xM = value$abscissa$x
      ym = value$origin$y
      yM = value$ordinate$y
      Xmin=as.numeric(input$abscissa.min)
      Xmax=as.numeric(input$abscissa.max)
      Ymin=as.numeric(input$ordinate.min)
      Ymax=as.numeric(input$ordinate.max)
      x.offset = Xmin
      x.scale = Xmax-Xmin
      y.offset = Ymin
      y.scale = Ymax-Ymin
      if (input$abscissa.scale == "Log") {
        curve$X = (curve$X - xm)/(xM-xm)
        curve$X = Xmin*10.0^(curve$X*(log10(Xmax)-log10(Xmin)))
      }
      else {
        curve$X=(curve$X - xm)/(xM-xm)*x.scale+x.offset
      }
      if (input$ordinate.scale == "Log") {
        curve$Y=(curve$Y - ym)/(yM - ym)
        curve$Y = Ymin*10.0^(curve$Y*(log10(Ymax)-log10(Ymin)))
      }
      else {
        curve$Y=(curve$Y - ym)/(yM-ym)*y.scale+y.offset
      }
      curve=curve[order(curve$CURVE,curve$X,curve$Y),]
      curve$X=format(curve$X,digits = 4, scientific = T)
      curve$Y=format(curve$Y,digits = 4, scientific = T)
      essentials=data.frame(xmin=xm,xmax=xM,Xmin=Xmin,Xmax=Xmax,Xscale=input$abscissa.scale,
                            ymin=ym,ymax=yM,Ymin=Ymin,Ymax=Ymax,Yscale=input$ordinate.scale)
      values=value$curve[2:nrow(value$curve),]
      # Save Files
      file.name=sprintf("/%s_%s", as.integer(Sys.time()), digest::digest(curve))
      png(file=paste0(temp.dir,file.name,".png"),ima.x(),ima.y(),"px")
      par(mar=c(0,0,0,0))
      par(xaxs='i',yaxs='i')
      lim <- par()
      plot(0:1,0:1,cex=0)
      rasterImage(ima(), lim$usr[1], lim$usr[3], lim$usr[2], lim$usr[4])
      dev.off()
      # Dropbox Upload
      outputDir="PlotPinch"
      drop_upload(paste0(temp.dir,file.name,".png"), dest = outputDir)
      write.table(essentials,file=paste0(temp.dir,file.name,"_META.csv"),row.names = F)
      drop_upload(paste0(temp.dir,file.name,"_META.csv"), dest = outputDir)
      write.table(values,file=paste0(temp.dir,file.name,"_POINTS.csv"),row.names = F)
      drop_upload(paste0(temp.dir,file.name,"_POINTS.csv"), dest = outputDir)
      # Data Download
      write.table(curve, con, row.names = F,sep = ";")
    })

  # DEBUG: (todo: delete it for code lightness)
  observe({
    if (is.null(input$plot_click)) return(NULL)
    #print(as.numeric(c(input$plot_click[[1]],input$plot_click[[2]])))
  })
})

shinyApp(ui=ui,server=server)