ddplot <- function(drp, well = 1, channel = 1,...){
      drp1 <- if(channel == 1){na.omit(drp$Ch1[, well])}else{na.omit(drp$Ch2[, well])}
      temp <- sample(c(1:length(drp1)), size = length(drp1), replace = F)
      plot(drp1 ~ temp, col = rgb(123, 168, 194, maxColorValue = 255), bty = "L", pch = '.' , cex = 5, xlab = "observation", ylab = "FU", ...)}

tdplot <- function(drp, well = 1,...){
      drp1 <- na.omit(drp$Ch1[, well])
      drp2 <- na.omit(drp$Ch2[, well])
      plot(drp1 ~ drp2, col = rgb(123, 168, 194, maxColorValue = 255), bty = "L", pch = '.' , cex = 5, xlab = "FU_Ch2", ylab = "FU_Ch1", ...)}


# BiocManager::install(c("minfi","minfiData"))
library(minfi)
# specify directory
#minfi_baseDir = paste0("/Users/nrigby/Desktop/idats_standard/batch_1052641/")
baseDir = paste0("/Users/mmaxmeister/methylprep/docs/example_data/GSE69852/minfi/")
# read samplesheet
targets = read.metharray.sheet(baseDir)
# read IDAT's into RGChannelSet
rgSet <- read.metharray.exp(targets = targets, verbose = TRUE)
# preprocessRaw
mSet.raw = preprocessRaw(rgSet)
# make files
meth.raw = getMeth(mSet.raw)
write.csv(file=file.path(baseDir,'minfi_raw_meth.csv'),x=meth.raw,row.names=TRUE)
unmeth.raw = getUnmeth(mSet.raw)
write.csv(file=file.path(baseDir,'minfi_raw_unmeth.csv'),x=unmeth.raw,row.names=TRUE)
betas.raw = getBeta(mSet.raw)
write.csv(file=file.path(baseDir,'minfi_raw_betas.csv'),x=betas.raw,row.names=TRUE)
# preprocessNoob
mSet.noob = preprocessNoob(rgSet)
# make files
meth.noob = getMeth(mSet.noob)
write.csv(file='~/Desktop/idats_standard/minfi_noob_meth.csv',x=meth.noob,row.names=TRUE,col.names=TRUE)
unmeth.noob = getUnmeth(mSet.noob)
write.csv(file='~/Desktop/idats_standard/minfi_noob_unmeth.csv',x=unmeth.noob,row.names=TRUE,col.names=TRUE)
betas.noob = getBeta(mSet.noob)
write.csv(file='~/Desktop/idats_standard/minfi_noob_betas.csv',x=betas.noob,row.names=TRUE,col.names=TRUE)


#' Combine datasets from different source files.
#'
#' @param data - Normalized, imputed data. Data matrix with observations as rows, features as columns.
#' @param ref - Reference samples normalized, imputed data.
#' @return combined.data - Z-transformed data.
#' @export data.combineData
data.combineData = function(ref, data) {
  ref = as.matrix(ref)
  data = as.matrix(data)

  unionMets = unique(c(rownames(ref), rownames(data)))
  combined.data = matrix(0, nrow=length(unionMets), ncol=ncol(ref)+ncol(data))
  rownames(combined.data) = unionMets
  colnames(combined.data) = c(colnames(ref), colnames(data))
  for (r in 1:length(unionMets)) {
    if (unionMets[r] %in% rownames(ref)) {
      combined.data[r,colnames(ref)] = as.numeric(ref[unionMets[r], ])
    } else {
      combined.data[r,colnames(ref)] = rep(NA, ncol(ref))
    }

    if (unionMets[r] %in% rownames(data)) {
      combined.data[r,colnames(data)] = as.numeric(data[unionMets[r], ])
    } else {
      combined.data[r,colnames(data)] = rep(NA, ncol(data))
    }
  }

  return(combined.data)
}


# Generates VRTs for all the Proba-V imagery to use as a stack.
library(gdalUtils)
library(raster)
library(foreach)
library(doParallel)
source("pixel-based/utils/getProbaVInfo.r")
source("pixel-based/utils/load-sampling-data.r")
source("utils/GetProbaVQCMask.r")
source("pixel-based/utils/ProbaVDataDirs.r")

DataDir = "/data/MTDA/TIFFDERIVED/PROBAV_L3_S5_TOC_100M"
OutputDir = "../data/pixel-based/raster"

SamplePoints = LoadGlobalRasterPoints()

# Tiles to process
TileList = levels(SamplePoints$Tile)#GetTileList(SamplePoints)
TileList = TileList[!TileList %in% c("X00Y08", "X00Y09", "X00Y11", "X01Y05", "X02Y07", "X02Y08", "X02Y09", "X03Y08", "X03Y09", "X04Y08", "X06Y05", "X08Y07", "X10Y10", "X10Y13", "X11Y13", "X13Y01", "X14Y03", "X14Y09", "X14Y12", "X15Y13", "X23Y07", "X23Y08", "X23Y09", "X23Y12", "X24Y12", "X25Y12", "X29Y07", "X31Y06", "X32Y06", "X33Y06", "X34Y08", "X35Y07")] # Remove incomplete tiles

# Generate a list of directories to read from.
# This list is semi-static: we don't read in more files when they arrive. Else the lengths would differ.
DataDirsDates = LoadRawDataDirs(RequiredTiles = TileList)
DataDirs = DataDirsDates$dir

BuildProbaVTileVRT = function(TileFiles, VI, Tile, Band=1, OutputDir="../../userdata/master-classification/pixel-based/vrt/raster/")
{
    Dates = getProbaVinfo(TileFiles)$date
    if (!dir.exists(OutputDir))
        dir.create(OutputDir)
    VRTFile = file.path(OutputDir, paste0(Tile, "-", VI, "-", Band, ".vrt"))
    if (!file.exists(VRTFile))
    {
        gdalbuildvrt(TileFiles, VRTFile, separate=TRUE, b=Band)
        # Workaround for -b not working again
        if (Band != 1)
            system(paste0('sed -i "s|<SourceBand>1</SourceBand>|<SourceBand>', Band ,'</SourceBand>|" ', VRTFile))
    }
    Result = brick(VRTFile)
    Result = setZ(Result, Dates)
    return(Result)
}

# Extract time series data from the Proba-V tiles and mask them with the quality control layer.
# Returns a matrix of extracted, masked values.
# FilterQC values are based on GetProbaVQCMask(bluegood=TRUE, redgood=TRUE, nirgood=TRUE, swirgood=TRUE, ice=FALSE, cloud=FALSE, shadow=FALSE)
ExtractPixelData = function(ExtractLocations, DataDirs, VI, Tile, Band, QCMatrix, FilterQC=c(240, 248), OutputDir="../data/pixel-based")
{
    OutputCSVFile = file.path(OutputDir, paste0(paste(Tile, VI, Band, sep="-"), ".csv"))
    if (file.exists(OutputCSVFile))
        return(read.csv(OutputCSVFile))

    TileFiles = list.files(DataDirs, pattern=glob2rx(paste0("PROBAV_S5_TOC_", Tile, "*", VI, ".tif")), full.names=TRUE)
    BandStack = BuildProbaVTileVRT(TileFiles, VI, Tile, Band)
    BandValueMatrix = extract(BandStack, ExtractLocations)
    BandValueMatrix[!QCMatrix %in% FilterQC] = NA
    colnames(BandValueMatrix) = paste0(Band, "-", c(getZ(BandStack)))
    rownames(BandValueMatrix) = ExtractLocations$location_id
    if (!dir.exists(OutputDir))
        dir.create(OutputDir)
    write.csv(BandValueMatrix, OutputCSVFile)
    return(BandValueMatrix)
}

registerDoParallel(cores=4)
foreach(Tile=iter(TileList), .inorder=FALSE, .multicombine=TRUE, .verbose=TRUE) %dopar%
{
    PointsInTile = SamplePoints[SamplePoints$Tile == Tile,]
    TileFiles = list.files(DataDirs, pattern=glob2rx(paste0("PROBAV_S5_TOC_", Tile, "*", "SM", ".tif")), full.names=TRUE)
    if (nrow(PointsInTile) < 1) {
        print(paste("Skipping tile", Tile, "because there are no samples here"))
    } else if (length(TileFiles) == 0) {
        print(paste("Skipping tile", Tile, "because there are no files at", DataDirs))
    } else {
        print(paste("Processing tile", Tile))

        # Extract QC values
        QCStack = BuildProbaVTileVRT(TileFiles, "SM", Tile)
        print(any(duplicated(getZ(QCStack))))
        print(system.time(
            QCInTile <- extract(QCStack, PointsInTile)
            ))

        # Extract NDVI values
        ExtractPixelData(PointsInTile, DataDirs, "NDVI", Tile, 1, QCInTile, OutputDir=OutputDir)
        print("NDVI extraction complete, moving on to radiometry")

        # Radiometry: do it for 4 bands (Red, NIR, Blue, SWIR)
        for (Band in 1:4)
            ExtractPixelData(PointsInTile, DataDirs, "RADIOMETRY", Tile, Band, QCInTile, OutputDir=OutputDir)
    }
}

# Could merge into one if needed
#cbind(PointsInTile, NDVIInTile)


generateHeatMap <- function(closest_systems_candidates, executionStatus, folderName) {

  nSystems <- executionStatus$AmountOfRecomendedSystems

  if(as.integer(executionStatus$amountOfCandidatesRecomendation) < as.integer(executionStatus$AmountOfRecomendedSystems))
    nSystems <- executionStatus$amountOfCandidatesRecomendation

  # heatmaps
  closest_systems_candidates$coveragePercent <- NULL
  closest_systems_candidates$coverage <- NULL

  closest_systems_candidates[closest_systems_candidates == 2] <- 1

  # closest systems
  closest <- closest_systems_candidates[0:nSystems,-1] %>%
    rownames_to_column() %>%
    gather(colname, value, -rowname)

  closest$rowname <- factor(closest$rowname, levels = unique(closest$rowname), ordered=FALSE)

  my_plot_2 <- ggplot(closest, aes(x = rowname, y = colname, fill = value)) +
    geom_tile(aes(fill = value), colour = "red", size = 3) +
    scale_fill_gradient(low="white", high="black") +
    labs(x = "Sistemas", y = "Caracteristicas") +
    theme(axis.text.x=element_text(size=60, angle = 90, hjust = 1),
          axis.text.y=element_text(size=60),
          axis.title=element_text(size=80,face="bold"))

  ggsave(here("R/results", executionStatus$Tecnique, paste(folderName, "/heat_map.png", sep="")),
         my_plot_2, width = 80, height = 40, limitsize = FALSE)

}

generateCoverageMap <- function(coveredSystems, executionStatus, folderName, system_candidates) {

  nSystems <- executionStatus$AmountOfRecomendedSystems

  if(as.integer(executionStatus$amountOfCandidatesRecomendation) < as.integer(executionStatus$AmountOfRecomendedSystems))
    nSystems <- executionStatus$amountOfCandidatesRecomendation

  system_candidates <- tibble::rownames_to_column(system_candidates, "id")
  coveredSystems$SystemName <- paste("(", system_candidates$id, ") ", coveredSystems$SystemName, sep="")

  #ploting line graph of covered systems
  ggplot(data=coveredSystems, aes(x=NumberOfSystems, y=FeaturesCovered, label=SystemName))+
    geom_line()+
    geom_point() +
    geom_point(data=subset(coveredSystems, NewFeature > 0), aes(x=NumberOfSystems, y=FeaturesCovered), colour="red", size = 4)+
    scale_y_continuous(breaks=c(0:executionStatus$AmountOfFeatures))+
    scale_x_continuous(breaks=c(0:nSystems))+
    labs(x = "Quantidade de sistemas", y = "Quantidade de caracteristicas atendidas") +
    geom_text(aes(label=SystemName),hjust=1.2, angle = 90) +
    geom_text(data=subset(coveredSystems, NewFeature > 0),aes(label=SystemName),hjust=1.2, angle = 90, colour = "red") +
    geom_segment(aes(x=0,xend=tail(coveredSystems, n=1)$NumberOfSystems, y=executionStatus$AmountOfFeatures, yend=executionStatus$AmountOfFeatures))

  ggsave(here("R/results", executionStatus$Tecnique, paste(folderName, "/coverageGraph.png", sep="")),
         width = 20, height = 20, units = "cm")
}


library("openxlsx")
library("stringr")
library(ComplexHeatmap)
library(circlize)
library(colorspace)
library(GetoptLong)
library(ggplot2)
library(gplots)
# install.packages('OpasnetUtils')
library(reticulate)

memory.limit(22000) # be sure you have enough memory to conduct the enrichment analysis

#set the project path
project_path = "./project/"

# be sure geneframe_id.pkl file is accessible
genome_width_dataset_file = paste(project_path,"data/geneframe_id.pkl", sep="")

xlgene = py_load_object(genome_width_dataset_file, pickle = "pickle")

#specify which lncRNA you want to analysis
# you can specify one of the five lncRNAs: ENSG00000206567.8, ENSG00000187185.4, ENSG00000259641.4, ENSG00000218510.5， ENSG00000257989.1
selectedLncRNA = 'ENSG00000206567.8' # by default
# selectedLncRNA = 'ENSG00000218510.5'

index = grep(selectedLncRNA, rownames(xlgene)) # the index of specified lncRNA in genome-width dataset
index

clinical_entire_cohort = read.xlsx(paste(project_path, "data/tcga/clinical_entire_cohort.xlsx",sep=""), sheet = 1, colNames = TRUE)
# clinical_entire_cohort

#find correlated genes (co-expressed genes), it may takes 10 mins!
rows = length(rownames(xlgene))
x = xlgene[index,]
realY = t(xlgene[-index,])

cormat = round(cor(t(x),realY, method="spearman"),2) #make correlation matrix

length(colnames(cormat)) #total
length(which(cormat >= 0.4)) #number of positively related genes
length(which(cormat <= -0.3))#number of negatively related genes

library(scales)

#get positive related genes and negative related genes separately using cutoff 0.4 and -0.4
df_positive = realY[,which(cormat >= 0.4)]
df_negative = realY[,which(cormat <= -0.3)]

#filter genes by p-values, remove genes which have correlations but not statistic meaning
cols_positive = c()
for ( i in 1: length(colnames(df_positive)))
    {
     if (cor.test(df_positive[,i],t(x)[,1])$p.value < 0.05)
     {
        cols_positive <- c(cols_positive,i)
     }
}

length(cols_positive)

# we have a lncRNA that don't have negatively correlated genes, remember to ommit this part when dealing with that lncRNA
cols_negative = c()
for ( i in 1: length(colnames(df_negative)))
    {
     if (cor.test(df_negative[,i],t(x)[,1])$p.value < 0.05)
     {
        cols_negative <- c(cols_negative,i)
     }
}

length(cols_negative)

df_sel_positive = df_positive[,cols_positive] #get final selected positively related genes

#get final selected negatively related genes, one of the lncRNAs have no negatively correlated genes,
#remember ommit this sentence when dealing with it
df_sel_negative = df_negative[,cols_negative]

#rotate to set cluster (positive 1, negative 2), after that we can combine them
frame_positive = data.frame(t(df_sel_positive))
frame_negative = data.frame(t(df_sel_negative))
frame_positive$cluster <- 1
frame_negative$cluster <- 2

frame_sel_all = rbind(frame_positive, frame_negative) #combine selected genes, we have cluster to identify them

df = frame_sel_all[,1:(length(colnames(frame_sel_all))-1)] #dataframe without cluster column

df = apply(df, 1, rescale, to=c(-10,10)) #apply scale

df = data.frame(t(df))
df$cluster = frame_sel_all$cluster #add cluster back to scaled dataset

dftemp = data.frame(t(df)) #a temp

dftemp$GeneA <- c(t(x)[,1],-100)#add GeneA expression, used for sorting

clinical_entire_cohort$tumor_stage[is.na(clinical_entire_cohort$tumor_stage)] = "unknown"

write.xlsx(frame_negative[,1:10], paste(project_path,"results/negative5.xlsx", sep=""),col.names=TRUE, row.names=TRUE)

empty <- list()
for (age in clinical_entire_cohort$age_at_diagnosis)
{
    if(!is.na(age))
    {
         if(age > 65*365)
        {
            empty <- c(empty, 2)
        }
       else if(age >45*365)
       {
         empty <- c(empty, 1)
       }
      else
      {
         empty <- c(empty, 0)
       }
    }
    else
        {
        empty <- c(empty, 3)
    }

}

library(OpasnetUtils)
#add patient info
dftemp$gender = c(sapply(clinical_entire_cohort$gender,switch,"male"=1,"female"=0, "unknown"=2),0)
dftemp$System = c(clinical_entire_cohort$System,0)

dftemp$age_at_diagnosis = c(empty,0)

dftemp$stage = c(sapply(clinical_entire_cohort$tumor_stage,switch ,"ivb"=2,"i/ii nos"=1,"ia"=1,"x"=2,"iiic"=2,"ii"=1,"iib"=1,"iia"=1,"iic"=1,"iii"=2,"iva"=2,"ib"=1,"iiib"=2,"i"=1,"iiia"=2,"ivc"=2,"iv"=2,"0"=1,"is"=1, "unknown"=0), 0)

#female cancer heatmap
dftemp$cancer_type = c(sapply(clinical_entire_cohort$project_id,switch,"OV"=0,"MESO"=5,"LAML"=5,"LUAD"=5,"LGG"=5,"UCEC"=1,"GBM"=5,"CHOL"=5,"READ"=5,"BLCA"=5,"TGCT"=5,"PRAD"=5,"THYM"=5,"UCS"=5,"CESC"=2,"KIRC"=5,"SKCM"=5,"DLBC"=5,"THCA"=5,"PAAD"=5,"COAD"=5,"HNSC"=5,"KIRP"=5,"ACC"=5,"LUSC"=5,"STAD"=5,"BRCA"=3,"SARC"=5,"UVM"=5,"KICH"=5,"PCPG"=5,"ESCA"=5,"LIHC"=5),0)

length(rownames(dftemp))

dftemp = dftemp[dftemp$gender!=2,]
length(rownames(dftemp)) # in total of 4231 studies, another one is cluster for enrichment analysis

length(colnames(dftemp))

dfsort = dftemp[order(dftemp$GeneA),] #sort gene expression, the patients are reordered
frame = data.frame(t(dfsort)) # rotated for heatmap plotting
patient_frame = frame[(length(rownames(frame))-5):(length(rownames(frame))),]

clear_frame = frame[1:(length(rownames(frame))-6),]
pt = data.frame(t(patient_frame[,2:length(colnames(frame))]))
pt <- data.frame(sapply(pt, function(x) as.numeric(as.character(x))))

pt

length(rownames(pt))

length(rownames(pt[pt$age_at_diagnosis==3,]))

clear_frame <- data.frame(sapply(clear_frame, function(x) as.numeric(as.character(x))))
median(pt$GeneA[pt$GeneA > median(pt$GeneA)])

ret = paste0(c("Gene Group"), clear_frame$cluster) # two parts of the heatmap

median(pt$GeneA)

min(pt$GeneA)

max(pt$GeneA)

length(colnames(clear_frame[,2:length(colnames(clear_frame))]))

#show the heatmapp, the first column is cluster (positive or negative related genes), which is useless when plotting heatmap
#but, we can use cluster to split the heatmap into two parts, the top part is positively related gene expression, the lower part is negatively related gene expression
#we set :cluster_rows = FALSE, cluster_columns = FALSE, we do not use any of clustering methods provided by Heatmap function, we just plot the sorted gene expressions
ha1 = HeatmapAnnotation(df = pt,
    col = list(
               gender = c("1"="black","0"="pink"),
               GeneA=colorRamp2(c(min(pt$GeneA),median(pt$GeneA), median(pt$GeneA[pt$GeneA > median(pt$GeneA)]), max(pt$GeneA)), c("blue","#ebebeb", "#FF5C5C", "red")),
               stage = c("1"="#1e90ff","2"="orange", "0"="grey"),
               age_at_diagnosis = c("0" = "#C0C0C0", "1" = "#778899","2"= "#696969" ,  "3"="#2F4F4F"),
        cancer_type = c("0"="#f24433","1"="#960c14","2"="#d82623","3"="#bc1419","5"="blue"),
        System = c("1"="#1764ab","2"="#bb1419","3"="#157e3a","4"="#404040","5"="#61409b","6"="#f3701b","7"="#4294c3","8"="#99017b","9"="#cccc00")

    ),

     annotation_legend_param = list(
      gender = list(title = "Gender", at = c("1", "0"), labels = c("Male", "Female")),
         cancer_type = list(title = "FRC VS. Others", at = c("0", "1", "2", "3", "5"), labels = c("OV", "UCEC", "CESC", "BRCA", "Other 29 Cancers")),
         System = list(title = "System", at = c("1", "2", "3", "4", "5","6","7","8","9"), labels = c("Respiratory system", "Reproductive system", "Digestive system", "Endocrine system"
                                                                                , "Urinary system","Central nervous system","Immune system","Skin","Others")),
         stage = list(title = "Tumor stage", at = c("2","1", "0"), labels = c("I&II","III&IV", "Not reported")),
        age_at_diagnosis = list(title = "Age at diagnosis", at = c("3","2","1", "0"), labels = c("Unknown","Age > 65", "45 < Age ≤65", "Age ≤ 45")),
         # replace median value with above analysis results
         GeneA = list(title = paste("\n\n\n\n\n\nExpression", sep=""))

      )
   )

ht = Heatmap(clear_frame[,2:length(colnames(clear_frame))], name = "Expression", split = sapply(ret,switch, "Gene Group2"="C2 - Negative", "Gene Group1"="C1 - Positive"),
        show_row_dend = FALSE,show_column_dend = FALSE, cluster_rows = FALSE,
        cluster_columns = FALSE, show_row_names = FALSE, show_column_names = FALSE,
        show_heatmap_legend = FALSE,
       ,top_annotation=ha1)

p = draw(ht, heatmap_legend_side = "top")
decorate_annotation("GeneA", {grid.text("Expression", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left" , gp = gpar(fontsize = 10))})

decorate_annotation("gender", {grid.text("Gender", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left", gp = gpar(fontsize = 10))})
decorate_annotation("System", {grid.text("System", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left", gp = gpar(fontsize = 10))})
decorate_annotation("stage", {grid.text("Tumor Stage", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left", gp = gpar(fontsize = 10))})

decorate_annotation("cancer_type", {grid.text("FRC VS. Others", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left", gp = gpar(fontsize = 10))})
decorate_annotation("age_at_diagnosis", {grid.text("Age at diagnosis", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left", , gp = gpar(fontsize = 10) )})

# save results
title = paste(project_path, "results/", selectedLncRNA, "-Heatmap.tiff", sep="")
tiff(title, width=861*3, height=840*3, units="px", res=96*3, compression = "lzw")
p = draw(ht, heatmap_legend_side = "top")
decorate_annotation("GeneA", {grid.text("Expression", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left" , gp = gpar(fontsize = 10))})

decorate_annotation("gender", {grid.text("Gender", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left", gp = gpar(fontsize = 10))})
decorate_annotation("System", {grid.text("System", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left", gp = gpar(fontsize = 10))})
decorate_annotation("stage", {grid.text("Tumor Stage", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left", gp = gpar(fontsize = 10))})

decorate_annotation("cancer_type", {grid.text("FRC VS. Others", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left", gp = gpar(fontsize = 10))})
decorate_annotation("age_at_diagnosis", {grid.text("Age at diagnosis", unit(1, "npc") + unit(2, "mm"), 0.5, default.units = "npc", just = "left", , gp = gpar(fontsize = 10) )})

dev.off()


# For diff-in-diff data, first group by ID, then aggregate by
# period. Each period has the length of N rows
diffInDiffAggregate =
    function(data,
             idCol="id",  # Identifier of the group
             xCol="x",  # Data to aggregate
             timeCol="date",
             interval=7,  # 1 interval=N rows: Each period has N rows
             normalizeByPeriod=NULL, # Set N-th period (1, 2, 3...)
             diffByPeriod=NULL, # Set N-th period (1, 2, 3...)
             FUNC=sum) {
        require(dplyr)

        totalAggData <- NULL
        ids  <- unique(data[,idCol])
        for (i in 1:length(ids)){
            current <- data[data[, idCol] == ids[i],]
            current <- current[order(current[,timeCol]),]
            aggData <- NULL
            for (j in 1:(nrow(current) / interval)) {
                x <- FUNC(current[seq((j - 1) * interval + 1,
                                    min(nrow(current), j * interval),
                                    1),
                                xCol])
                time <- current[(j - 1) * interval + 1, timeCol]
                agg <- data.frame(id=ids[i], time=time, x=x)
                names(agg) <- c(idCol, timeCol, xCol)

                if (is.null(aggData)) {
                    aggData <- agg
                } else {
                    aggData <- rbind(aggData, agg)
                }
            }

            if (!is.null(normalizeByPeriod)) {
                base <- aggData[normalizeByPeriod, xCol]
                if (is.null(base) | is.na(base) | base == 0) {
                    message(paste("Skipped", aggData[1, idCol], "because of normalization by zero"))
                    next()
                }
                aggData[, xCol] <- aggData[, xCol] / base
            } else if (!is.null(diffByPeriod)) {
                base <- aggData[diffByPeriod, xCol]
                aggData[, xCol] <- aggData[, xCol] - base
            }

            if (is.null(totalAggData)) {
                totalAggData <- aggData
            } else {
                totalAggData <- rbind(totalAggData, aggData)
            }
        }
        return (totalAggData)
}


# Class: RCTtoolbox.ttest
#'
#' @importFrom dplyr mutate
#' @importFrom dplyr case_when
#' @importFrom dplyr case_when
#' @importFrom glue glue
#' @importFrom rlang enquos
#' @importFrom ggplot2 ggplot
#' @importFrom ggplot2 aes
#' @importFrom ggplot2 geom_bar
#' @importFrom ggplot2 geom_errorbar
#' @importFrom ggplot2 geom_hline
#' @importFrom ggplot2 geom_text
#' @importFrom ggplot2 ylim
#' @importFrom ggplot2 labs
#' @importFrom ggplot2 coord_flip
#' @importFrom ggplot2 theme
#' @importFrom patchwork wrap_plots
#' @importFrom patchwork plot_layout
#' @importFrom forcats fct_rev
#'
rctplot.RCTtoolbox.ttest <- function(obj,
                                     zval = 1,
                                     xlab = "Experimental Arms",
                                     ylab = "Average (+/- Std.Err.)",
                                     title = NULL,
                                     caption = NULL,
                                     inplot_lab_format =
                                       "{round(mean1, 3)}{pstar}",
                                     inplot_lab_size = 5,
                                     inplot_lab_adjust = 0,
                                     ylim = NULL,
                                     flip = FALSE,
                                     patchwork = TRUE,
                                     ncol = NULL,
                                     nrow = NULL,
                                     family = getOption("RCTtoolbox.plot_family"),
                                     ...) {
  mean1 <- se1 <- arms <- ymin <- ymax <- label <- NULL
  # plot data
  pdt <- obj$result %>%
    mutate(pstar = case_when(
      pval <= .01 ~ "***",
      pval <= .05 ~ "**",
      pval <= .1 ~ "*",
      TRUE ~ ""
    ))

  method <- unique(pdt$method)
  if (method == "Welch t-test") {
    pdt <- pdt %>%
      mutate(
        ymin = mean1 - se1 * zval,
        ymax = mean1 + se1 * zval
      )
  }

  if (!is.null(inplot_lab_format)) {
    pdt <- pdt %>% mutate(label = glue(inplot_lab_format))
  }

  # plot arguments
  args <- enquos(
    xlab = xlab,
    ylab = ylab,
    title = title,
    caption = caption,
    inplot_lab_adjust = inplot_lab_adjust,
    ylim = ylim
  )

  # plot list
  outcome <- unique(pdt$outcome)
  plist <- lapply(outcome, function(z) {
    input <- subset(pdt, outcome == z)
    args <- lapply(args, eval_tidy, list(outcome = z))
    inplot_lab_pos <- if (method == "Welch t-test") {
      max(input$ymax) + inplot_lab_adjust
    } else {
      max(input$mean1) + inplot_lab_adjust
    }

    if (flip) {
      p <- ggplot(input, aes(x = fct_rev(arms), y = mean1))
    } else {
      p <- ggplot(input, aes(x = arms, y = mean1))
    }

    p <- p +
      geom_bar(stat = "identity", fill = "grey80", color = "black") +
      geom_hline(aes(yintercept = 0))

    if (method == "Welch t-test") {
      p <- p +
        geom_errorbar(aes(ymin = ymin, ymax = ymax), width = 0.5)
    }

    if (!is.null(input$label)) {
      p <- p +
        geom_text(
          aes(y = inplot_lab_pos, label = label),
          size = inplot_lab_size, family = family
        )
    }

    if (!is.null(ylim)) p <- p + ylim(args$ylim)

    p <- p +
      labs(
        x = args$xlab,
        y = args$ylab,
        title = args$title,
        caption = args$caption
      )

    if (flip) p <- p + coord_flip()

    p + simplegg(flip = flip, font_family = family, ...)
  })

  # patchwork
  if (patchwork) {
    wrap_plots(plist, ncol = ncol, nrow = nrow) +
      plot_layout(guides = "collect") &
      theme(legend.position = "bottom")
  } else {
    plist
  }
}


#!/usr/bin/env Rscript --vanilla
if (!library("getopt", character.only = TRUE, logical.return = TRUE)) {
  install.packages("getopt", repos = "http://lib.stat.cmu.edu/R/CRAN")
}
require("getopt")

# Setup parameters for the script
params = matrix(c(
  'help',    'h', 0, "logical",
  'input',   'i', 2, "character"
  ), ncol=4, byrow=TRUE)

# Parse the parameters
opt = getopt(params)

data <- read.csv(file=opt$input,head=TRUE,sep=",")
plot(data$t, data$exponential.mean, "l", xlab="Time", ylab="Mean", col="tomato")
lines(data$expected.exponential.mean, col="tomato4")
lines(data$uniform.mean, col="violetred")
lines(data$expected.uniform.mean, col="violetred4")


##############################################################################
# Interpolate GC effects for Jun
##############################################################################
plotdat_gc <- plotdat %>%
  filter(Cov=="GC" & Category=="A>G") %>%
  mutate(Odds=exp(Est), subtype=paste0(Category, "_", Sequence)) %>%
  dplyr::select(Category, Sequence, subtype, Odds) %>%
  filter(Odds<2)

plotdat_exp <- plotdat_gc %>%
  tidyr::expand(subtype, ind=seq(0:10)-1)

plotdat_gc <- merge(plotdat_exp, plotdat_gc, by="subtype") %>%
  mutate(Odds=Odds^ind, pctGC=ind*10, seq3=substr(Sequence, 3, 5))

# Get top 6 positive/negative effects
top <- plotdat_gc %>%
  ungroup() %>%
  filter(pctGC==100) %>%
  top_n(6, Odds) %>%
  dplyr::select(subtype)

bottom <- plotdat_gc %>%
  ungroup() %>%
  filter(pctGC==100) %>%
  top_n(-6, Odds) %>%
  dplyr::select(Sequence)

tb <- rbind(top, bottom)

plotdat_gc <- plotdat_gc %>%
  filter(subtype %in% tb$subtype)

ggplot(plotdat_gc, aes(x=pctGC, y=log(Odds), colour=subtype, group=subtype))+
  geom_point()+
  geom_line()+
  geom_hline(yintercept=0)+
  scale_x_continuous(expand=c(0,0.4),
    breaks=seq(0, 100, 10),
    labels=seq(0, 100, 10))+
  scale_colour_manual(values=iwhPalette[1:12])+
  ylab("log-odds of mutability")+
  xlab("%GC")+
  theme_bw()+
  theme(legend.position="bottom")

ggsave(paste0(parentdir, "/images/gc_effect.png"))

sitefile1 <- paste0(parentdir, "/output/logmod_data/motifs3/CGTAATT.txt")
sitefile2 <- paste0(parentdir, "/output/logmod_data/motifs3/TCGATTG.txt")

sites1 <- read.table(sitefile1, header=F, stringsAsFactors=F)
names(sites1) <- c("CHR", "POS", "Sequence", mut_cats, "DP")

sites1$GC <- gcCol(sites1,
  paste0(parentdir, "/reference_data/gc10kb.bed"))

sites2 <- read.table(sitefile2, header=F, stringsAsFactors=F)
names(sites2) <- c("CHR", "POS", "Sequence", mut_cats, "DP")

sites2$GC <- gcCol(sites2,
  paste0(parentdir, "/reference_data/gc10kb.bed"))

sites1$GP <- "CGT[A>G]ATT (+)"
sites2$GP <- "TCG[A>G]TTG (-)"

mround <- function(x,base){
  base*round(x/base)
}

# sites2 <- sites2 %>%
rbind(sites1, sites2) %>%
mutate(GC=mround(GC*100, 0.5)) %>%
group_by(GP, GC, AT_GC) %>%
tally() %>%
spread(AT_GC, n) %>%
setNames(c("GP", "GC", "nonmut", "nERVs")) %>%
na.omit() %>%
mutate(tot=nERVs+nonmut, pctmut=nERVs/tot) %>% #data.frame
filter(nERVs>2) %>%
ggplot(aes(x=GC, y=pctmut, colour=GP))+
  geom_point(aes(group=GP, size=nERVs))+
  geom_smooth(method="lm", aes(weight=tot))+
  facet_wrap(~GP)+
  # geom_line()+
  scale_colour_manual(values=iwhPalette[c(6,10)])+
  xlab("%GC")+
  ylab("ERV fraction")+
  theme_bw()
ggsave(paste0(parentdir, "/images/gc_effect_raw.png"))

# rbind(sites1, sites2) %>%
# # mutate(GC=mround(GC*100, 2)) %>%
# group_by(GP, GC, AT_GC) %>%
# filter(GC>0.3 & GC<0.6) %>%
# # tally() %>%
# # spread(AT_GC, n) %>%
# # setNames(c("GP", "GC", "nonmut", "mut")) %>%
# # na.omit() %>%
# # mutate(tot=mut+nonmut, pctmut=mut/tot) %>% #data.frame
# # filter(mut>3) %>%
# ggplot(aes(x=AT_GC, y=GC, fill=GP, group=AT_GC))+
#   # geom_point(alpha=0.3, shape=21)+
#   geom_violin()+
#   facet_wrap(~GP)+
#   # geom_line()+
#   scale_colour_manual(values=iwhPalette[c(6,10)])+
#   xlab("%GC")+
#   ylab("mutated")+
#   theme_bw()
# ggsave(paste0(parentdir, "/images/gc_effect_raw2.png"), width=8, height=6)


#!/usr/bin/env Rscript

load(file = "/home/stlk/Desktop/DigEc_scripts/df_with_creators.RData")

dfc$exp = unlist(by(dfc, dfc$creator_id,
                    function(x) rank(dfc$state_changed_at, ties.method = "first")))

save(file = "~/DigEc/df_with_creators.RData", list = c("df_with_creators"))


#################################################################################
## File Name: v3_Analysis0_CodingValidity.R                                    ##
## Creation Date: 4 Nov 2017                                                   ##
## Author: Gento Kato                                                          ##
## Project: Foreign Image News Project                                         ##
## Purpose: Check the Validity of Machine-Coding                               ##
#################################################################################

## For Jupyter Notebook (Ignore if Using Other Software) ##
library(IRdisplay)

display_html(
'<script>
code_show=true;
function code_toggle() {
  if (code_show){
    $(\'div.input\').hide();
  } else {
    $(\'div.input\').show();
  }
  code_show = !code_show
}
$( document ).ready(code_toggle);
</script>
  <form action="javascript:code_toggle()">
    <input type="submit" value="Click here to toggle on/off the raw code.">
 </form>'
)

## Suppress Warning
options(warn=-1)
#options(warn=0) # put it back

#################
## Preparation ##
#################

## Clear Workspace
rm(list=ls())

## Library Required Packages
library(rprojroot); library(xtable);library(repr)

## Set Working Directory (Automatically or Manually) ##
#setwd(dirname(rstudioapi::getActiveDocumentContext()$path)); setwd("../") #In RStudio
projdir <- find_root(has_file("README.md")); projdir; setwd(projdir) #In Atom
#setwd("C:/GoogleDrive/Projects/Agenda-Setting Persuasion Framing/Foreign_Image_News_Project")

uspred<- read.csv("data/uspred_test.csv")
chnpred<- read.csv("data/chnpred_test.csv")
skopred<- read.csv("data/skopred_test.csv")
nkopred<- read.csv("data/nkopred_test.csv")

###########################################################
## Function to Assess Aggregate Level RF Coding Validity ##
###########################################################

simubysampleRF <- function(dtpred,N,seedset=5689){
dtpred_simu <- data.frame(by10true_neg=rep(NA,N),by10rfp_neg=NA,by10difp_neg=NA,by10rfd_neg=NA,by10difd_neg=NA,
                          by50true_neg=NA,by50rfp_neg=NA,by50difp_neg=NA,by50rfd_neg=NA,by50difd_neg=NA,
                          by100true_neg=NA,by100rfp_neg=NA,by100difp_neg=NA,by100rfd_neg=NA,by100difd_neg=NA,
                          by10true_pos=rep(NA,N),by10rfp_pos=NA,by10difp_pos=NA,by10rfd_pos=NA,by10difd_pos=NA,
                          by50true_pos=NA,by50rfp_pos=NA,by50difp_pos=NA,by50rfd_pos=NA,by50difd_pos=NA,
                          by100true_pos=NA,by100rfp_pos=NA,by100difp_pos=NA,by100rfd_pos=NA,by100difd_pos=NA)
for (i in 1:N){
set.seed(i+seedset)
nrs10 <- sample(seq(1,nrow(dtpred),by=1),10)
nrs50 <- sample(seq(1,nrow(dtpred),by=1),50)
nrs100 <- sample(seq(1,nrow(dtpred),by=1),100)
dtpred_simu$by10true_neg[i] <- mean(dtpred[nrs10,]$y_test_neg)
dtpred_simu$by10rfp_neg[i] <- mean(dtpred[nrs10,]$proby_test_rf_neg)
dtpred_simu$by10rfd_neg[i] <- mean((dtpred[nrs10,]$proby_test_rf_neg>=0.5)*1)
dtpred_simu$by50true_neg[i] <- mean(dtpred[nrs50,]$y_test_neg)
dtpred_simu$by50rfp_neg[i] <- mean(dtpred[nrs50,]$proby_test_rf_neg)
dtpred_simu$by50rfd_neg[i] <- mean((dtpred[nrs50,]$proby_test_rf_neg>=0.5)*1)
dtpred_simu$by100true_neg[i] <- mean(dtpred[nrs100,]$y_test_neg)
dtpred_simu$by100rfp_neg[i] <- mean(dtpred[nrs100,]$proby_test_rf_neg)
dtpred_simu$by100rfd_neg[i] <- mean((dtpred[nrs100,]$proby_test_rf_neg>=0.5)*1)
dtpred_simu$by10true_pos[i] <- mean(dtpred[nrs10,]$y_test_pos)
dtpred_simu$by10rfp_pos[i] <- mean(dtpred[nrs10,]$proby_test_rf_pos)
dtpred_simu$by10rfd_pos[i] <- mean((dtpred[nrs10,]$proby_test_rf_pos>=0.5)*1)
dtpred_simu$by50true_pos[i] <- mean(dtpred[nrs50,]$y_test_pos)
dtpred_simu$by50rfp_pos[i] <- mean(dtpred[nrs50,]$proby_test_rf_pos)
dtpred_simu$by50rfd_pos[i] <- mean((dtpred[nrs50,]$proby_test_rf_pos>=0.5)*1)
dtpred_simu$by100true_pos[i] <- mean(dtpred[nrs100,]$y_test_pos)
dtpred_simu$by100rfp_pos[i] <- mean(dtpred[nrs100,]$proby_test_rf_pos)
dtpred_simu$by100rfd_pos[i] <- mean((dtpred[nrs100,]$proby_test_rf_pos>=0.5)*1)
}

dtpred_simu$by10difp_neg <- dtpred_simu$by10rfp_neg - dtpred_simu$by10true_neg
dtpred_simu$by50difp_neg <- dtpred_simu$by50rfp_neg - dtpred_simu$by50true_neg
dtpred_simu$by100difp_neg <- dtpred_simu$by100rfp_neg - dtpred_simu$by100true_neg
dtpred_simu$by10difp_pos <- dtpred_simu$by10rfp_pos - dtpred_simu$by10true_pos
dtpred_simu$by50difp_pos <- dtpred_simu$by50rfp_pos - dtpred_simu$by50true_pos
dtpred_simu$by100difp_pos <- dtpred_simu$by100rfp_pos - dtpred_simu$by100true_pos

dtpred_simu$by10difd_neg <- dtpred_simu$by10rfd_neg - dtpred_simu$by10true_neg
dtpred_simu$by50difd_neg <- dtpred_simu$by50rfd_neg - dtpred_simu$by50true_neg
dtpred_simu$by100difd_neg <- dtpred_simu$by100rfd_neg - dtpred_simu$by100true_neg
dtpred_simu$by10difd_pos <- dtpred_simu$by10rfd_pos - dtpred_simu$by10true_pos
dtpred_simu$by50difd_pos <- dtpred_simu$by50rfd_pos - dtpred_simu$by50true_pos
dtpred_simu$by100difd_pos <- dtpred_simu$by100rfd_pos - dtpred_simu$by100true_pos

return(dtpred_simu)
}

###############################
## Assess RF Coding Validity ##
###############################

uspred_simuRF <- simubysampleRF(uspred,1000)
chnpred_simuRF <- simubysampleRF(chnpred,1000)
skopred_simuRF <- simubysampleRF(skopred,1000)
nkopred_simuRF <- simubysampleRF(nkopred,1000)

codesimutab <- data.frame(
  "Metric" = NA,
  "Tone" = NA,
  "Country" = NA,
  "by10p" = rep(NA,24),
  "by10d" = NA,
  "by50p" = NA,
  "by50d" = NA,
  "by100p" = NA,
  "by100d" = NA)

codesimutab$Metric <- c("Correlation",rep(NA,7),
                        "Av. Distance",rep(NA,7),
                        "Distance SD",rep(NA,7))
codesimutab$Tone <- c("Negative",rep(NA,3),
                      "Positive",rep(NA,3),
                      "Negative",rep(NA,3),
                      "Positive",rep(NA,3),
                      "Negative",rep(NA,3),
                      "Positive",rep(NA,3))
codesimutab$Country <- c(rep(c("US","China","S.Korea","N.Korea"),6))

## Correlation (Negative)
codesimutab[1,-c(1,2,3)] <-
c(cor(uspred_simuRF$by10true_neg,uspred_simuRF$by10rfp_neg),
  cor(uspred_simuRF$by10true_neg,uspred_simuRF$by10rfd_neg),
  cor(uspred_simuRF$by50true_neg,uspred_simuRF$by50rfp_neg),
  cor(uspred_simuRF$by50true_neg,uspred_simuRF$by50rfd_neg),
  cor(uspred_simuRF$by100true_neg,uspred_simuRF$by100rfp_neg),
  cor(uspred_simuRF$by100true_neg,uspred_simuRF$by100rfd_neg))
codesimutab[2,-c(1,2,3)] <-
  c(cor(chnpred_simuRF$by10true_neg,chnpred_simuRF$by10rfp_neg),
    cor(chnpred_simuRF$by10true_neg,chnpred_simuRF$by10rfd_neg),
    cor(chnpred_simuRF$by50true_neg,chnpred_simuRF$by50rfp_neg),
    cor(chnpred_simuRF$by50true_neg,chnpred_simuRF$by50rfd_neg),
    cor(chnpred_simuRF$by100true_neg,chnpred_simuRF$by100rfp_neg),
    cor(chnpred_simuRF$by100true_neg,chnpred_simuRF$by100rfd_neg))
codesimutab[3,-c(1,2,3)] <-
  c(cor(skopred_simuRF$by10true_neg,skopred_simuRF$by10rfp_neg),
    cor(skopred_simuRF$by10true_neg,skopred_simuRF$by10rfd_neg),
    cor(skopred_simuRF$by50true_neg,skopred_simuRF$by50rfp_neg),
    cor(skopred_simuRF$by50true_neg,skopred_simuRF$by50rfd_neg),
    cor(skopred_simuRF$by100true_neg,skopred_simuRF$by100rfp_neg),
    cor(skopred_simuRF$by100true_neg,skopred_simuRF$by100rfd_neg))
codesimutab[4,-c(1,2,3)] <-
  c(cor(nkopred_simuRF$by10true_neg,nkopred_simuRF$by10rfp_neg),
    cor(nkopred_simuRF$by10true_neg,nkopred_simuRF$by10rfd_neg),
    cor(nkopred_simuRF$by50true_neg,nkopred_simuRF$by50rfp_neg),
    cor(nkopred_simuRF$by50true_neg,nkopred_simuRF$by50rfd_neg),
    cor(nkopred_simuRF$by100true_neg,nkopred_simuRF$by100rfp_neg),
    cor(nkopred_simuRF$by100true_neg,nkopred_simuRF$by100rfd_neg))
## Correlation (Positive)
codesimutab[5,-c(1,2,3)] <-
  c(cor(uspred_simuRF$by10true_pos,uspred_simuRF$by10rfp_pos),
    cor(uspred_simuRF$by10true_pos,uspred_simuRF$by10rfd_pos),
    cor(uspred_simuRF$by50true_pos,uspred_simuRF$by50rfp_pos),
    cor(uspred_simuRF$by50true_pos,uspred_simuRF$by50rfd_pos),
    cor(uspred_simuRF$by100true_pos,uspred_simuRF$by100rfp_pos),
    cor(uspred_simuRF$by100true_pos,uspred_simuRF$by100rfd_pos))
codesimutab[6,-c(1,2,3)] <-
  c(cor(chnpred_simuRF$by10true_pos,chnpred_simuRF$by10rfp_pos),
    cor(chnpred_simuRF$by10true_pos,chnpred_simuRF$by10rfd_pos),
    cor(chnpred_simuRF$by50true_pos,chnpred_simuRF$by50rfp_pos),
    cor(chnpred_simuRF$by50true_pos,chnpred_simuRF$by50rfd_pos),
    cor(chnpred_simuRF$by100true_pos,chnpred_simuRF$by100rfp_pos),
    cor(chnpred_simuRF$by100true_pos,chnpred_simuRF$by100rfd_pos))
codesimutab[7,-c(1,2,3)] <-
  c(cor(skopred_simuRF$by10true_pos,skopred_simuRF$by10rfp_pos),
    cor(skopred_simuRF$by10true_pos,skopred_simuRF$by10rfd_pos),
    cor(skopred_simuRF$by50true_pos,skopred_simuRF$by50rfp_pos),
    cor(skopred_simuRF$by50true_pos,skopred_simuRF$by50rfd_pos),
    cor(skopred_simuRF$by100true_pos,skopred_simuRF$by100rfp_pos),
    cor(skopred_simuRF$by100true_pos,skopred_simuRF$by100rfd_pos))
codesimutab[8,-c(1,2,3)] <-
  c(cor(nkopred_simuRF$by10true_pos,nkopred_simuRF$by10rfp_pos),
    cor(nkopred_simuRF$by10true_pos,nkopred_simuRF$by10rfd_pos),
    cor(nkopred_simuRF$by50true_pos,nkopred_simuRF$by50rfp_pos),
    cor(nkopred_simuRF$by50true_pos,nkopred_simuRF$by50rfd_pos),
    cor(nkopred_simuRF$by100true_pos,nkopred_simuRF$by100rfp_pos),
    cor(nkopred_simuRF$by100true_pos,nkopred_simuRF$by100rfd_pos))
## Average Distance (Negative)
codesimutab[9,-c(1,2,3)] <-
  c(mean(abs(uspred_simuRF$by10difp_neg)),
    mean(abs(uspred_simuRF$by10difd_neg)),
    mean(abs(uspred_simuRF$by50difp_neg)),
    mean(abs(uspred_simuRF$by50difd_neg)),
    mean(abs(uspred_simuRF$by100difp_neg)),
    mean(abs(uspred_simuRF$by100difd_neg)))
codesimutab[10,-c(1,2,3)] <-
  c(mean(abs(chnpred_simuRF$by10difp_neg)),
    mean(abs(chnpred_simuRF$by10difd_neg)),
    mean(abs(chnpred_simuRF$by50difp_neg)),
    mean(abs(chnpred_simuRF$by50difd_neg)),
    mean(abs(chnpred_simuRF$by100difp_neg)),
    mean(abs(chnpred_simuRF$by100difd_neg)))
codesimutab[11,-c(1,2,3)] <-
  c(mean(abs(skopred_simuRF$by10difp_neg)),
    mean(abs(skopred_simuRF$by10difd_neg)),
    mean(abs(skopred_simuRF$by50difp_neg)),
    mean(abs(skopred_simuRF$by50difd_neg)),
    mean(abs(skopred_simuRF$by100difp_neg)),
    mean(abs(skopred_simuRF$by100difd_neg)))
codesimutab[12,-c(1,2,3)] <-
  c(mean(abs(nkopred_simuRF$by10difp_neg)),
    mean(abs(nkopred_simuRF$by10difd_neg)),
    mean(abs(nkopred_simuRF$by50difp_neg)),
    mean(abs(nkopred_simuRF$by50difd_neg)),
    mean(abs(nkopred_simuRF$by100difp_neg)),
    mean(abs(nkopred_simuRF$by100difd_neg)))
## Average Distance (Positive)
codesimutab[13,-c(1,2,3)] <-
  c(mean(abs(uspred_simuRF$by10difp_pos)),
    mean(abs(uspred_simuRF$by10difd_pos)),
    mean(abs(uspred_simuRF$by50difp_pos)),
    mean(abs(uspred_simuRF$by50difd_pos)),
    mean(abs(uspred_simuRF$by100difp_pos)),
    mean(abs(uspred_simuRF$by100difd_pos)))
codesimutab[14,-c(1,2,3)] <-
  c(mean(abs(chnpred_simuRF$by10difp_pos)),
    mean(abs(chnpred_simuRF$by10difd_pos)),
    mean(abs(chnpred_simuRF$by50difp_pos)),
    mean(abs(chnpred_simuRF$by50difd_pos)),
    mean(abs(chnpred_simuRF$by100difp_pos)),
    mean(abs(chnpred_simuRF$by100difd_pos)))
codesimutab[15,-c(1,2,3)] <-
  c(mean(abs(skopred_simuRF$by10difp_pos)),
    mean(abs(skopred_simuRF$by10difd_pos)),
    mean(abs(skopred_simuRF$by50difp_pos)),
    mean(abs(skopred_simuRF$by50difd_pos)),
    mean(abs(skopred_simuRF$by100difp_pos)),
    mean(abs(skopred_simuRF$by100difd_pos)))
codesimutab[16,-c(1,2,3)] <-
  c(mean(abs(nkopred_simuRF$by10difp_pos)),
    mean(abs(nkopred_simuRF$by10difd_pos)),
    mean(abs(nkopred_simuRF$by50difp_pos)),
    mean(abs(nkopred_simuRF$by50difd_pos)),
    mean(abs(nkopred_simuRF$by100difp_pos)),
    mean(abs(nkopred_simuRF$by100difd_pos)))
## Distance SD (Negative)
codesimutab[17,-c(1,2,3)] <-
  c(sd(abs(uspred_simuRF$by10difp_neg)),
    sd(abs(uspred_simuRF$by10difd_neg)),
    sd(abs(uspred_simuRF$by50difp_neg)),
    sd(abs(uspred_simuRF$by50difd_neg)),
    sd(abs(uspred_simuRF$by100difp_neg)),
    sd(abs(uspred_simuRF$by100difd_neg)))
codesimutab[18,-c(1,2,3)] <-
  c(sd(abs(chnpred_simuRF$by10difp_neg)),
    sd(abs(chnpred_simuRF$by10difd_neg)),
    sd(abs(chnpred_simuRF$by50difp_neg)),
    sd(abs(chnpred_simuRF$by50difd_neg)),
    sd(abs(chnpred_simuRF$by100difp_neg)),
    sd(abs(chnpred_simuRF$by100difd_neg)))
codesimutab[19,-c(1,2,3)] <-
  c(sd(abs(skopred_simuRF$by10difp_neg)),
    sd(abs(skopred_simuRF$by10difd_neg)),
    sd(abs(skopred_simuRF$by50difp_neg)),
    sd(abs(skopred_simuRF$by50difd_neg)),
    sd(abs(skopred_simuRF$by100difp_neg)),
    sd(abs(skopred_simuRF$by100difd_neg)))
codesimutab[20,-c(1,2,3)] <-
  c(sd(abs(nkopred_simuRF$by10difp_neg)),
    sd(abs(nkopred_simuRF$by10difd_neg)),
    sd(abs(nkopred_simuRF$by50difp_neg)),
    sd(abs(nkopred_simuRF$by50difd_neg)),
    sd(abs(nkopred_simuRF$by100difp_neg)),
    sd(abs(nkopred_simuRF$by100difd_neg)))
## Distance SD (Positive)
codesimutab[21,-c(1,2,3)] <-
  c(sd(abs(uspred_simuRF$by10difp_pos)),
    sd(abs(uspred_simuRF$by10difd_pos)),
    sd(abs(uspred_simuRF$by50difp_pos)),
    sd(abs(uspred_simuRF$by50difd_pos)),
    sd(abs(uspred_simuRF$by100difp_pos)),
    sd(abs(uspred_simuRF$by100difd_pos)))
codesimutab[22,-c(1,2,3)] <-
  c(sd(abs(chnpred_simuRF$by10difp_pos)),
    sd(abs(chnpred_simuRF$by10difd_pos)),
    sd(abs(chnpred_simuRF$by50difp_pos)),
    sd(abs(chnpred_simuRF$by50difd_pos)),
    sd(abs(chnpred_simuRF$by100difp_pos)),
    sd(abs(chnpred_simuRF$by100difd_pos)))
codesimutab[23,-c(1,2,3)] <-
  c(sd(abs(skopred_simuRF$by10difp_pos)),
    sd(abs(skopred_simuRF$by10difd_pos)),
    sd(abs(skopred_simuRF$by50difp_pos)),
    sd(abs(skopred_simuRF$by50difd_pos)),
    sd(abs(skopred_simuRF$by100difp_pos)),
    sd(abs(skopred_simuRF$by100difd_pos)))
codesimutab[24,-c(1,2,3)] <-
  c(sd(abs(nkopred_simuRF$by10difp_pos)),
    sd(abs(nkopred_simuRF$by10difd_pos)),
    sd(abs(nkopred_simuRF$by50difp_pos)),
    sd(abs(nkopred_simuRF$by50difd_pos)),
    sd(abs(nkopred_simuRF$by100difp_pos)),
    sd(abs(nkopred_simuRF$by100difd_pos)))

codesimutab <- as.matrix(cbind(codesimutab[,1:3],round(codesimutab[,-c(1,2,3)],3)))
colnames(codesimutab)[-c(1,2,3)] <- c("$\\overline{p(c|x)}$ by 10","$d(c|x)$ by 10",
                                     "$\\overline{p(c|x)}$ by 50","$d(c|x)$ by 50",
                                     "$\\overline{p(c|x)}$ by 100","$d(c|x)$ by 100")
# display value
xtable(codesimutab)
cat('No cases for US-positive have predicted probability larger than 0.5.')

## For the Paper ##
colnames(codesimutab)[-c(1,2,3)] <- rep(c("$\\overline{p(c|x)}$","$d(c|x)$"),3)

addtorow_cst <- list()
addtorow_cst$pos <- list(-1,nrow(codesimutab[1:8,]))
addtorow_cst$command <-
  c("\\toprule \n \\multicolumn{3}{l}{\\it Aggregation Size:} & \\multicolumn{2}{c}{By 10} & \\multicolumn{2}{c}{By 50}  & \\multicolumn{2}{c}{By 100} \\\\ \n",
"\\bottomrule \n \\multicolumn{9}{r}{\\scriptsize No cases for US-positive have predicted probability larger than 0.5.}")

# print(xtable(codesimutab[1:8,]),add.to.row=addtorow_cst,
#       hline.after = c(0),sanitize.colnames.function = identity,
#       floating=FALSE,booktabs=TRUE,include.rownames=F)

##############################################################
## Function to Assess Aggregate Level Logit Coding Validity ##
##############################################################

simubysamplelogit <- function(dtpred,N,seedset=5689){
dtpred_simu <- data.frame(by10true_neg=rep(NA,N),by10logitp_neg=NA,by10difp_neg=NA,by10logitd_neg=NA,by10difd_neg=NA,
                          by50true_neg=NA,by50logitp_neg=NA,by50difp_neg=NA,by50logitd_neg=NA,by50difd_neg=NA,
                          by100true_neg=NA,by100logitp_neg=NA,by100difp_neg=NA,by100logitd_neg=NA,by100difd_neg=NA,
                          by10true_pos=rep(NA,N),by10logitp_pos=NA,by10difp_pos=NA,by10logitd_pos=NA,by10difd_pos=NA,
                          by50true_pos=NA,by50logitp_pos=NA,by50difp_pos=NA,by50logitd_pos=NA,by50difd_pos=NA,
                          by100true_pos=NA,by100logitp_pos=NA,by100difp_pos=NA,by100logitd_pos=NA,by100difd_pos=NA)
for (i in 1:N){
set.seed(i+seedset)
nrs10 <- sample(seq(1,nrow(dtpred),by=1),10)
nrs50 <- sample(seq(1,nrow(dtpred),by=1),50)
nrs100 <- sample(seq(1,nrow(dtpred),by=1),100)
dtpred_simu$by10true_neg[i] <- mean(dtpred[nrs10,]$y_test_neg)
dtpred_simu$by10logitp_neg[i] <- mean(dtpred[nrs10,]$proby_test_logit_neg)
dtpred_simu$by10logitd_neg[i] <- mean((dtpred[nrs10,]$proby_test_logit_neg>=0.5)*1)
dtpred_simu$by50true_neg[i] <- mean(dtpred[nrs50,]$y_test_neg)
dtpred_simu$by50logitp_neg[i] <- mean(dtpred[nrs50,]$proby_test_logit_neg)
dtpred_simu$by50logitd_neg[i] <- mean((dtpred[nrs50,]$proby_test_logit_neg>=0.5)*1)
dtpred_simu$by100true_neg[i] <- mean(dtpred[nrs100,]$y_test_neg)
dtpred_simu$by100logitp_neg[i] <- mean(dtpred[nrs100,]$proby_test_logit_neg)
dtpred_simu$by100logitd_neg[i] <- mean((dtpred[nrs100,]$proby_test_logit_neg>=0.5)*1)
dtpred_simu$by10true_pos[i] <- mean(dtpred[nrs10,]$y_test_pos)
dtpred_simu$by10logitp_pos[i] <- mean(dtpred[nrs10,]$proby_test_logit_pos)
dtpred_simu$by10logitd_pos[i] <- mean((dtpred[nrs10,]$proby_test_logit_pos>=0.5)*1)
dtpred_simu$by50true_pos[i] <- mean(dtpred[nrs50,]$y_test_pos)
dtpred_simu$by50logitp_pos[i] <- mean(dtpred[nrs50,]$proby_test_logit_pos)
dtpred_simu$by50logitd_pos[i] <- mean((dtpred[nrs50,]$proby_test_logit_pos>=0.5)*1)
dtpred_simu$by100true_pos[i] <- mean(dtpred[nrs100,]$y_test_pos)
dtpred_simu$by100logitp_pos[i] <- mean(dtpred[nrs100,]$proby_test_logit_pos)
dtpred_simu$by100logitd_pos[i] <- mean((dtpred[nrs100,]$proby_test_logit_pos>=0.5)*1)
}

dtpred_simu$by10difp_neg <- dtpred_simu$by10logitp_neg - dtpred_simu$by10true_neg
dtpred_simu$by50difp_neg <- dtpred_simu$by50logitp_neg - dtpred_simu$by50true_neg
dtpred_simu$by100difp_neg <- dtpred_simu$by100logitp_neg - dtpred_simu$by100true_neg
dtpred_simu$by10difp_pos <- dtpred_simu$by10logitp_pos - dtpred_simu$by10true_pos
dtpred_simu$by50difp_pos <- dtpred_simu$by50logitp_pos - dtpred_simu$by50true_pos
dtpred_simu$by100difp_pos <- dtpred_simu$by100logitp_pos - dtpred_simu$by100true_pos

dtpred_simu$by10difd_neg <- dtpred_simu$by10logitd_neg - dtpred_simu$by10true_neg
dtpred_simu$by50difd_neg <- dtpred_simu$by50logitd_neg - dtpred_simu$by50true_neg
dtpred_simu$by100difd_neg <- dtpred_simu$by100logitd_neg - dtpred_simu$by100true_neg
dtpred_simu$by10difd_pos <- dtpred_simu$by10logitd_pos - dtpred_simu$by10true_pos
dtpred_simu$by50difd_pos <- dtpred_simu$by50logitd_pos - dtpred_simu$by50true_pos
dtpred_simu$by100difd_pos <- dtpred_simu$by100logitd_pos - dtpred_simu$by100true_pos

return(dtpred_simu)
}

##################################
## Assess Logit Coding Validity ##
##################################

uspred_simulogit <- simubysamplelogit(uspred,1000)
chnpred_simulogit <- simubysamplelogit(chnpred,1000)
skopred_simulogit <- simubysamplelogit(skopred,1000)
nkopred_simulogit <- simubysamplelogit(nkopred,1000)

codesimutabLT <- data.frame(
  "Metric" = NA,
  "Tone" = NA,
  "Country" = NA,
  "by10p" = rep(NA,24),
  "by10d" = NA,
  "by50p" = NA,
  "by50d" = NA,
  "by100p" = NA,
  "by100d" = NA)

codesimutabLT$Metric <- c("Correlation",rep(NA,7),
                        "Av. Distance",rep(NA,7),
                        "Distance SD",rep(NA,7))
codesimutabLT$Tone <- c("Negative",rep(NA,3),
                      "Positive",rep(NA,3),
                      "Negative",rep(NA,3),
                      "Positive",rep(NA,3),
                      "Negative",rep(NA,3),
                      "Positive",rep(NA,3))
codesimutabLT$Country <- c(rep(c("US","China","S.Korea","N.Korea"),6))

## Correlation (Negative)
codesimutabLT[1,-c(1,2,3)] <-
c(cor(uspred_simulogit$by10true_neg,uspred_simulogit$by10logitp_neg),
  cor(uspred_simulogit$by10true_neg,uspred_simulogit$by10logitd_neg),
  cor(uspred_simulogit$by50true_neg,uspred_simulogit$by50logitp_neg),
  cor(uspred_simulogit$by50true_neg,uspred_simulogit$by50logitd_neg),
  cor(uspred_simulogit$by100true_neg,uspred_simulogit$by100logitp_neg),
  cor(uspred_simulogit$by100true_neg,uspred_simulogit$by100logitd_neg))
codesimutabLT[2,-c(1,2,3)] <-
  c(cor(chnpred_simulogit$by10true_neg,chnpred_simulogit$by10logitp_neg),
    cor(chnpred_simulogit$by10true_neg,chnpred_simulogit$by10logitd_neg),
    cor(chnpred_simulogit$by50true_neg,chnpred_simulogit$by50logitp_neg),
    cor(chnpred_simulogit$by50true_neg,chnpred_simulogit$by50logitd_neg),
    cor(chnpred_simulogit$by100true_neg,chnpred_simulogit$by100logitp_neg),
    cor(chnpred_simulogit$by100true_neg,chnpred_simulogit$by100logitd_neg))
codesimutabLT[3,-c(1,2,3)] <-
  c(cor(skopred_simulogit$by10true_neg,skopred_simulogit$by10logitp_neg),
    cor(skopred_simulogit$by10true_neg,skopred_simulogit$by10logitd_neg),
    cor(skopred_simulogit$by50true_neg,skopred_simulogit$by50logitp_neg),
    cor(skopred_simulogit$by50true_neg,skopred_simulogit$by50logitd_neg),
    cor(skopred_simulogit$by100true_neg,skopred_simulogit$by100logitp_neg),
    cor(skopred_simulogit$by100true_neg,skopred_simulogit$by100logitd_neg))
codesimutabLT[4,-c(1,2,3)] <-
  c(cor(nkopred_simulogit$by10true_neg,nkopred_simulogit$by10logitp_neg),
    cor(nkopred_simulogit$by10true_neg,nkopred_simulogit$by10logitd_neg),
    cor(nkopred_simulogit$by50true_neg,nkopred_simulogit$by50logitp_neg),
    cor(nkopred_simulogit$by50true_neg,nkopred_simulogit$by50logitd_neg),
    cor(nkopred_simulogit$by100true_neg,nkopred_simulogit$by100logitp_neg),
    cor(nkopred_simulogit$by100true_neg,nkopred_simulogit$by100logitd_neg))
## Correlation (Positive)
codesimutabLT[5,-c(1,2,3)] <-
  c(cor(uspred_simulogit$by10true_pos,uspred_simulogit$by10logitp_pos),
    cor(uspred_simulogit$by10true_pos,uspred_simulogit$by10logitd_pos),
    cor(uspred_simulogit$by50true_pos,uspred_simulogit$by50logitp_pos),
    cor(uspred_simulogit$by50true_pos,uspred_simulogit$by50logitd_pos),
    cor(uspred_simulogit$by100true_pos,uspred_simulogit$by100logitp_pos),
    cor(uspred_simulogit$by100true_pos,uspred_simulogit$by100logitd_pos))
codesimutabLT[6,-c(1,2,3)] <-
  c(cor(chnpred_simulogit$by10true_pos,chnpred_simulogit$by10logitp_pos),
    cor(chnpred_simulogit$by10true_pos,chnpred_simulogit$by10logitd_pos),
    cor(chnpred_simulogit$by50true_pos,chnpred_simulogit$by50logitp_pos),
    cor(chnpred_simulogit$by50true_pos,chnpred_simulogit$by50logitd_pos),
    cor(chnpred_simulogit$by100true_pos,chnpred_simulogit$by100logitp_pos),
    cor(chnpred_simulogit$by100true_pos,chnpred_simulogit$by100logitd_pos))
codesimutabLT[7,-c(1,2,3)] <-
  c(cor(skopred_simulogit$by10true_pos,skopred_simulogit$by10logitp_pos),
    cor(skopred_simulogit$by10true_pos,skopred_simulogit$by10logitd_pos),
    cor(skopred_simulogit$by50true_pos,skopred_simulogit$by50logitp_pos),
    cor(skopred_simulogit$by50true_pos,skopred_simulogit$by50logitd_pos),
    cor(skopred_simulogit$by100true_pos,skopred_simulogit$by100logitp_pos),
    cor(skopred_simulogit$by100true_pos,skopred_simulogit$by100logitd_pos))
codesimutabLT[8,-c(1,2,3)] <-
  c(cor(nkopred_simulogit$by10true_pos,nkopred_simulogit$by10logitp_pos),
    cor(nkopred_simulogit$by10true_pos,nkopred_simulogit$by10logitd_pos),
    cor(nkopred_simulogit$by50true_pos,nkopred_simulogit$by50logitp_pos),
    cor(nkopred_simulogit$by50true_pos,nkopred_simulogit$by50logitd_pos),
    cor(nkopred_simulogit$by100true_pos,nkopred_simulogit$by100logitp_pos),
    cor(nkopred_simulogit$by100true_pos,nkopred_simulogit$by100logitd_pos))
## Average Distance (Negative)
codesimutabLT[9,-c(1,2,3)] <-
  c(mean(abs(uspred_simulogit$by10difp_neg)),
    mean(abs(uspred_simulogit$by10difd_neg)),
    mean(abs(uspred_simulogit$by50difp_neg)),
    mean(abs(uspred_simulogit$by50difd_neg)),
    mean(abs(uspred_simulogit$by100difp_neg)),
    mean(abs(uspred_simulogit$by100difd_neg)))
codesimutabLT[10,-c(1,2,3)] <-
  c(mean(abs(chnpred_simulogit$by10difp_neg)),
    mean(abs(chnpred_simulogit$by10difd_neg)),
    mean(abs(chnpred_simulogit$by50difp_neg)),
    mean(abs(chnpred_simulogit$by50difd_neg)),
    mean(abs(chnpred_simulogit$by100difp_neg)),
    mean(abs(chnpred_simulogit$by100difd_neg)))
codesimutabLT[11,-c(1,2,3)] <-
  c(mean(abs(skopred_simulogit$by10difp_neg)),
    mean(abs(skopred_simulogit$by10difd_neg)),
    mean(abs(skopred_simulogit$by50difp_neg)),
    mean(abs(skopred_simulogit$by50difd_neg)),
    mean(abs(skopred_simulogit$by100difp_neg)),
    mean(abs(skopred_simulogit$by100difd_neg)))
codesimutabLT[12,-c(1,2,3)] <-
  c(mean(abs(nkopred_simulogit$by10difp_neg)),
    mean(abs(nkopred_simulogit$by10difd_neg)),
    mean(abs(nkopred_simulogit$by50difp_neg)),
    mean(abs(nkopred_simulogit$by50difd_neg)),
    mean(abs(nkopred_simulogit$by100difp_neg)),
    mean(abs(nkopred_simulogit$by100difd_neg)))
## Average Distance (Positive)
codesimutabLT[13,-c(1,2,3)] <-
  c(mean(abs(uspred_simulogit$by10difp_pos)),
    mean(abs(uspred_simulogit$by10difd_pos)),
    mean(abs(uspred_simulogit$by50difp_pos)),
    mean(abs(uspred_simulogit$by50difd_pos)),
    mean(abs(uspred_simulogit$by100difp_pos)),
    mean(abs(uspred_simulogit$by100difd_pos)))
codesimutabLT[14,-c(1,2,3)] <-
  c(mean(abs(chnpred_simulogit$by10difp_pos)),
    mean(abs(chnpred_simulogit$by10difd_pos)),
    mean(abs(chnpred_simulogit$by50difp_pos)),
    mean(abs(chnpred_simulogit$by50difd_pos)),
    mean(abs(chnpred_simulogit$by100difp_pos)),
    mean(abs(chnpred_simulogit$by100difd_pos)))
codesimutabLT[15,-c(1,2,3)] <-
  c(mean(abs(skopred_simulogit$by10difp_pos)),
    mean(abs(skopred_simulogit$by10difd_pos)),
    mean(abs(skopred_simulogit$by50difp_pos)),
    mean(abs(skopred_simulogit$by50difd_pos)),
    mean(abs(skopred_simulogit$by100difp_pos)),
    mean(abs(skopred_simulogit$by100difd_pos)))
codesimutabLT[16,-c(1,2,3)] <-
  c(mean(abs(nkopred_simulogit$by10difp_pos)),
    mean(abs(nkopred_simulogit$by10difd_pos)),
    mean(abs(nkopred_simulogit$by50difp_pos)),
    mean(abs(nkopred_simulogit$by50difd_pos)),
    mean(abs(nkopred_simulogit$by100difp_pos)),
    mean(abs(nkopred_simulogit$by100difd_pos)))
## Distance SD (Negative)
codesimutabLT[17,-c(1,2,3)] <-
  c(sd(abs(uspred_simulogit$by10difp_neg)),
    sd(abs(uspred_simulogit$by10difd_neg)),
    sd(abs(uspred_simulogit$by50difp_neg)),
    sd(abs(uspred_simulogit$by50difd_neg)),
    sd(abs(uspred_simulogit$by100difp_neg)),
    sd(abs(uspred_simulogit$by100difd_neg)))
codesimutabLT[18,-c(1,2,3)] <-
  c(sd(abs(chnpred_simulogit$by10difp_neg)),
    sd(abs(chnpred_simulogit$by10difd_neg)),
    sd(abs(chnpred_simulogit$by50difp_neg)),
    sd(abs(chnpred_simulogit$by50difd_neg)),
    sd(abs(chnpred_simulogit$by100difp_neg)),
    sd(abs(chnpred_simulogit$by100difd_neg)))
codesimutabLT[19,-c(1,2,3)] <-
  c(sd(abs(skopred_simulogit$by10difp_neg)),
    sd(abs(skopred_simulogit$by10difd_neg)),
    sd(abs(skopred_simulogit$by50difp_neg)),
    sd(abs(skopred_simulogit$by50difd_neg)),
    sd(abs(skopred_simulogit$by100difp_neg)),
    sd(abs(skopred_simulogit$by100difd_neg)))
codesimutabLT[20,-c(1,2,3)] <-
  c(sd(abs(nkopred_simulogit$by10difp_neg)),
    sd(abs(nkopred_simulogit$by10difd_neg)),
    sd(abs(nkopred_simulogit$by50difp_neg)),
    sd(abs(nkopred_simulogit$by50difd_neg)),
    sd(abs(nkopred_simulogit$by100difp_neg)),
    sd(abs(nkopred_simulogit$by100difd_neg)))
## Distance SD (Positive)
codesimutabLT[21,-c(1,2,3)] <-
  c(sd(abs(uspred_simulogit$by10difp_pos)),
    sd(abs(uspred_simulogit$by10difd_pos)),
    sd(abs(uspred_simulogit$by50difp_pos)),
    sd(abs(uspred_simulogit$by50difd_pos)),
    sd(abs(uspred_simulogit$by100difp_pos)),
    sd(abs(uspred_simulogit$by100difd_pos)))
codesimutabLT[22,-c(1,2,3)] <-
  c(sd(abs(chnpred_simulogit$by10difp_pos)),
    sd(abs(chnpred_simulogit$by10difd_pos)),
    sd(abs(chnpred_simulogit$by50difp_pos)),
    sd(abs(chnpred_simulogit$by50difd_pos)),
    sd(abs(chnpred_simulogit$by100difp_pos)),
    sd(abs(chnpred_simulogit$by100difd_pos)))
codesimutabLT[23,-c(1,2,3)] <-
  c(sd(abs(skopred_simulogit$by10difp_pos)),
    sd(abs(skopred_simulogit$by10difd_pos)),
    sd(abs(skopred_simulogit$by50difp_pos)),
    sd(abs(skopred_simulogit$by50difd_pos)),
    sd(abs(skopred_simulogit$by100difp_pos)),
    sd(abs(skopred_simulogit$by100difd_pos)))
codesimutabLT[24,-c(1,2,3)] <-
  c(sd(abs(nkopred_simulogit$by10difp_pos)),
    sd(abs(nkopred_simulogit$by10difd_pos)),
    sd(abs(nkopred_simulogit$by50difp_pos)),
    sd(abs(nkopred_simulogit$by50difd_pos)),
    sd(abs(nkopred_simulogit$by100difp_pos)),
    sd(abs(nkopred_simulogit$by100difd_pos)))

codesimutabLT <- as.matrix(cbind(codesimutabLT[,1:3],round(codesimutabLT[,-c(1,2,3)],3)))
colnames(codesimutabLT)[-c(1,2,3)] <- c("$\\overline{p(c|x)}$ by 10","$d(c|x)$ by 10",
                                     "$\\overline{p(c|x)}$ by 50","$d(c|x)$ by 50",
                                     "$\\overline{p(c|x)}$ by 100","$d(c|x)$ by 100")
# display value
xtable(codesimutabLT)
cat('No cases for US-positive have predicted probability larger than 0.5.')

## For the Paper
colnames(codesimutabLT)[-c(1,2,3)] <- rep(c("$\\overline{p(c|x)}$","$d(c|x)$"),3)

addtorow_cst <- list()
addtorow_cst$pos <- list(-1,nrow(codesimutabLT[1:8,]))
addtorow_cst$command <-
  c("\\toprule \n \\multicolumn{3}{l}{\\it Aggregation Size:} & \\multicolumn{2}{c}{By 10} & \\multicolumn{2}{c}{By 50}  & \\multicolumn{2}{c}{By 100} \\\\ \n",
"\\bottomrule \n \\multicolumn{9}{r}{\\scriptsize No cases for US-positive have predicted probability larger than 0.5.}")

# print(xtable(codesimutabLT[1:8,]),add.to.row=addtorow_cst,
#       hline.after = c(0),sanitize.colnames.function = identity,
#       floating=FALSE,booktabs=TRUE,include.rownames=F)

####################
## Save the Table ##
####################

save(codesimutab,addtorow_cst,file="./outputs/codesimutab.RData")
save(codesimutabLT,addtorow_cst,file="./outputs/codesimutabLT.RData")


library(ggplot2)
library(reshape2)
library(scales)
#library(devtools)

#devtools::install_github('cttobin/ggthemr')

history.data <- read.csv(file = "history.csv", sep = ";")
history.data <- head(history.data, 30)

data <- melt(history.data, id="Iteration")
p <- ggplot(data=data, aes(x=Iteration, y=value, colour=variable))
p <- p + labs(colour = "Users")
p <- p + geom_line()
p <- p + geom_point()
p <- p + scale_x_continuous(breaks = pretty_breaks())
p <- p + labs(title="PageRank growth over time", x = "Iteration", y = "PageRank")
p <- p + theme_light()

p


suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(svglite))
suppressPackageStartupMessages(library(RColorBrewer))
suppressPackageStartupMessages(library(cowplot))

fig_extensions <- c('.png', '.pdf', '.svg')

# Define the dataset to compile results for
svcca_file <- file.path("results", "svcca_within_mean_correlation_weights.tsv.gz")
svcca_df <- readr::read_tsv(svcca_file,
                            col_types = readr::cols(
                                .default = readr::col_character(),
                                svcca_mean_similarity = readr::col_double()))
print(dim(svcca_df))
head(svcca_df, 2)

table(svcca_df$shuffled)

 # Make sure factors are in order
svcca_df$z_dim <- factor(
    svcca_df$z_dim,
    levels = sort(as.numeric(paste(unique(svcca_df$z_dim))))
)

algorithms <- c("pca", "ica", "nmf", "dae", "vae")

svcca_df$algorithm_1 <- factor(
    svcca_df$algorithm_1,
    levels = algorithms
)

svcca_df$algorithm_2 <- factor(
    svcca_df$algorithm_2,
    levels = algorithms
)

recoded <- list("pca" = "PCA",
                "ica" = "ICA",
                "nmf" = "NMF",
                "dae" = "DAE",
                "vae" = "VAE")

svcca_df$algorithm_1 <- svcca_df$algorithm_1 %>%
    dplyr::recode(!!!recoded)

svcca_df$algorithm_2 <- svcca_df$algorithm_2 %>%
    dplyr::recode(!!!recoded)

# Switch the order of the algorithms in the shuffled dataset to
# enable plotting in the lower triangle on the same figure
shuffled_df <- svcca_df %>% dplyr::filter(shuffled == 'shuffled')
signal_df <- svcca_df %>% dplyr::filter(shuffled != 'shuffled')

alg1_shuff <- shuffled_df$algorithm_1
alg2_shuff <- shuffled_df$algorithm_2

shuffled_df$algorithm_1 <- alg2_shuff
shuffled_df$algorithm_2 <- alg1_shuff

svcca_switched_df <- dplyr::bind_rows(signal_df, shuffled_df)

box_theme <- theme(panel.grid.minor = element_line(size = 0.1),
                   panel.grid.major = element_line(size = 0.3),
                   strip.text = element_text(size = 7),
                   strip.background = element_rect(colour = "black",
                                                   fill = "#fdfff4"),
                   axis.text.x = element_text(angle = 90,
                                              size = 3.2),
                   axis.text.y = element_text(size = 6),
                   axis.title = element_text(size = 7),
                   plot.title = element_text(hjust = 0.5,
                                             size = 9))

# Visualize across algorithm similarity
options(repr.plot.width = 15, repr.plot.height = 9)

across_algorithm_plots = list()
for(dataset in c("TARGET", "TCGA", "GTEX")) {

    svcca_subset_df <- svcca_switched_df %>%
        dplyr::filter(dataset == !!dataset)

    out_figure <- file.path("figures", paste0("stability_within_z_", dataset))
    plot_title <- paste0("SVCCA Mean Correlations\n", dataset)

    g <- ggplot(svcca_subset_df,
                aes(x = z_dim,
                    y = svcca_mean_similarity,
                    linetype = shuffled)) +
            geom_boxplot(outlier.size = 0.04,
                         lwd = 0.2,
                         fill = 'grey75') +
            facet_grid(algorithm_1 ~ algorithm_2) +
            xlab("k Dimension") +
            ylab("SVCCA Mean Similarity") +
            scale_linetype_manual(name = "Signal:",
                                  values = c("dotted", "solid"),
                                  labels = c("signal" = "Real",
                                             "shuffled" = "Permuted")) +
            ylim(c(0, 1)) +
            ggtitle(plot_title) +
            theme_bw() +
            box_theme +
            guides(linetype = guide_legend("none"))

    across_algorithm_plots[[dataset]] <- g

    for(extension in fig_extensions) {
        gg_file <- paste0(out_figure, extension)
        ggsave(plot = g,
               filename = gg_file,
               height = 120,
               width = 170,
               units = "mm",
               dpi = 500)
    }

    print(g)

}

svcca_subset_df <- svcca_df %>%
    dplyr::group_by(algorithm_1, algorithm_2, dataset, z_dim, shuffled) %>%
    dplyr::summarize_at('svcca_mean_similarity', mean)

signal_data = svcca_subset_df %>%
    dplyr::filter(shuffled == 'signal')
shuffled_data = svcca_subset_df %>%
    dplyr::filter(shuffled == 'shuffled')

full_svcca_data = signal_data %>%
    dplyr::full_join(shuffled_data,
                     by = c('algorithm_1', 'algorithm_2', 'dataset', 'z_dim'),
                     suffix = c('_signal', '_shuffled'))

full_svcca_data <- full_svcca_data %>%
    dplyr::mutate(
        svcca_diff = svcca_mean_similarity_signal - svcca_mean_similarity_shuffled
    )

g <- ggplot(full_svcca_data,
            aes(x = z_dim,
                y = svcca_diff,
                color = dataset)) +
    geom_point(alpha = 0.6,
               size = 0.25) +
    facet_grid(algorithm_1 ~ algorithm_2) +
    xlab("k Dimension") +
    ylab("SVCCA Mean Similarity") +
    scale_color_manual(name = "Dataset",
                       values = c("#66c2a5",
                                  "#fc8d62",
                                  "#8da0cb"),
                      labels = c("GTEX" = "GTEX",
                                 "TCGA" = "TCGA",
                                 "TARGET" = "TARGET")) +
    ylim(c(0, 1)) +
    ggtitle(paste0('SVCCA Mean Similarity\nSignal Difference')) +
    theme_bw() +
    box_theme +
    theme(legend.title = element_text(size = 8),
          legend.text = element_text(size = 7)) +
    guides(color = guide_legend(override.aes = list("size" = 1,
                                                    "alpha" = 1)))

across_algorithm_plots[['signal_difference']] <- g

out_figure = file.path("figures", "within_z_signal_difference")

for(extension in fig_extensions) {
    gg_file <- paste0(out_figure, extension)
    ggsave(plot = g,
           filename = gg_file,
           height = 120,
           width = 170,
           units = "mm",
           dpi = 500)
}

print(g)

myPalette <- colorRampPalette(rev(brewer.pal(9, "YlOrRd")))

heat_theme <- theme(panel.grid.minor = element_line(size = 0.1),
                    panel.grid.major = element_line(size = 0.3),
                    axis.text.x = element_text(angle = 90,
                                               size = 3.5),
                    axis.text.y = element_text(size = 3.5),
                    plot.title = element_text(hjust = 0.5,
                                              size = 9),
                    legend.title = element_text(size = 8),
                    legend.text = element_text(size = 7),
                    legend.key.size = unit(1, "lines"),
                    strip.text = element_text(size = 7),
                    strip.background = element_rect(colour = "black",
                                                    fill = "#fdfff4"))

across_dimension_plots = list()
for (dataset in c("TARGET", "TCGA", "GTEX")) {

    # Setup filename
    data_file <- paste0("svcca_across_z_", dataset, "_mean_correlation.tsv.gz")
    data_file <- file.path('results', data_file)

    # Load file
    svcca_df <- readr::read_tsv(data_file,
                                col_types = readr::cols(
                                .default = readr::col_character(),
                                svcca_mean_similarity = readr::col_double(),
                                z_dim_a = readr::col_integer(),
                                z_dim_b = readr::col_integer()))

    # Setup title and output file name
    plot_title <- paste0("SVCCA Across Z\nMean Correlations - ", dataset)
    out_figure <- paste0("stability_across_z_", dataset)
    out_figure <- file.path("figures", out_figure)

    # Make sure factors are in order
    svcca_df$z_dim_a <-
        factor(svcca_df$z_dim_a,
               levels =
                 sort(as.numeric(paste(unique(svcca_df$z_dim_a))))
               )

    svcca_df$z_dim_b <-
        factor(svcca_df$z_dim_b,
               levels =
                 sort(as.numeric(paste(unique(svcca_df$z_dim_b))))
               )

    svcca_df$algorithm <- factor(svcca_df$algorithm, levels = algorithms)
    svcca_df$algorithm <- svcca_df$algorithm %>% dplyr::recode(!!!recoded)

    svcca_df$svcca_mean_similarity <- as.numeric(paste(svcca_df$svcca_mean_similarity))

    # Aggregate over each seed
    svcca_df <- svcca_df %>%
        dplyr::group_by(dataset, algorithm, z_dim_a, z_dim_b) %>%
        dplyr::summarize(svcca_mean = mean(svcca_mean_similarity))

    # Plot and save results
    g <- ggplot(svcca_df, aes(z_dim_a, z_dim_b)) +
            geom_tile(aes(fill = svcca_mean), colour = "white") +
            scale_fill_gradientn(name = "SVCCA Mean Similarity",
                                 colours = myPalette(100),
                                 values = scales::rescale(c(1, 0.99, 0.9)),
                                 limits = c(0, 1)) +
            facet_wrap(~ algorithm, scales = "free") +
            ggtitle(plot_title) +
            theme_bw(base_size = 9) +
            heat_theme +
            xlab("k Dimension") +
            ylab("k Dimension") +
            scale_x_discrete(expand = c(0, 0)) +
            scale_y_discrete(expand = c(0, 0))

    across_dimension_plots[[dataset]] <- g

    for(extension in fig_extensions) {
        gg_file <- paste0(out_figure, extension)
        ggsave(plot = g,
               filename = gg_file,
               height = 100,
               width = 170,
               units = "mm",
               dpi = 500)
    }

    print(g)
}

xmin <- 0.81
xmax <- 0.91
ymin <- 0.1
ymax <- 0.2

# TCGA is the Main Figure
across_z_legend <- cowplot::get_legend(across_dimension_plots[['TCGA']])

plot_a <- across_algorithm_plots[["TCGA"]] +
            theme(legend.position = 'none') +
            ggtitle(paste0("SVCCA Across Algorithm (TCGA)"))

plot_b <- across_dimension_plots[["TCGA"]] +
            theme(legend.position = 'none') +
            ggtitle(paste0("SVCCA Across Dimension (TCGA)"))

main_plot <- (
    cowplot::plot_grid(
        plot_a,
        plot_b,
        labels = c("a", "b"),
        ncol = 1,
        nrow = 2
    )
)

main_plot <- main_plot + annotation_custom(grob = across_z_legend,
                                           xmin = xmin,
                                           xmax = xmax,
                                           ymin = ymin,
                                           ymax = ymax)

main_plot

for(extension in fig_extensions) {
    fig_file <- paste0("stability_summary_TCGA", extension)
    fig_file <- file.path("figures", fig_file)
    cowplot::save_plot(filename = fig_file,
                       plot = main_plot,
                       base_height = 200,
                       base_width = 170,
                       units = "mm",
                       dpi = 500)
}

gtex_across_gg <- across_algorithm_plots[["GTEX"]] +
                    theme(legend.position = 'none') +
                    ggtitle(paste0("SVCCA Across Algorithm (GTEX)"))

target_across_gg <- across_algorithm_plots[["TARGET"]] +
                        theme(legend.position = 'none') +
                        ggtitle(paste0("SVCCA Across Algorithm (TARGET)"))

main_plot <- (
    cowplot::plot_grid(
        gtex_across_gg,
        target_across_gg,
        labels = c("a", "b"),
        ncol = 1,
        nrow = 2
    )
)

main_plot

for(extension in fig_extensions) {
    fig_file <- paste0("supplementary_stability_across_algorithm_GTEX_TARGET",
                       extension)
    fig_file <- file.path("figures", fig_file)
    cowplot::save_plot(filename = fig_file,
                       plot = main_plot,
                       base_height = 200,
                       base_width = 170,
                       units = "mm",
                       dpi = 500)
}

gtex_z_gg <- across_dimension_plots[["GTEX"]] +
                theme(legend.position = 'none') +
                ggtitle(paste0("SVCCA Across Dimension (GTEX)"))

target_z_gg <- across_dimension_plots[["TARGET"]] +
                    theme(legend.position = 'none') +
                    ggtitle(paste0("SVCCA Across Dimension (TARGET)"))

main_plot <- (
    cowplot::plot_grid(
        gtex_z_gg,
        target_z_gg,
        labels = c("a", "b"),
        ncol = 1,
        nrow = 2
    )
)

main_plot <- main_plot + annotation_custom(grob = across_z_legend,
                                           xmin = xmin,
                                           xmax = xmax,
                                           ymin = ymin,
                                           ymax = ymax)

main_plot

for(extension in fig_extensions) {
    fig_file <- paste0("supplementary_stability_across_dimension_GTEX_TARGET",
                       extension)
    fig_file <- file.path("figures", fig_file)
    cowplot::save_plot(filename = fig_file,
                       plot = main_plot,
                       base_height = 200,
                       base_width = 170,
                       units = "mm",
                       dpi = 500)
}


code 'cf_reprice_gap'
name '重定价缺口'
dimensions {
	accbook fetchParents:true
	repriceGap null
}
dataRequest {
	table 'repriceGap',{
		allDimensions (['organ','accbook','currency','repriceGap'])
	}
	fields 'sum(endingBalance) endingBalance'
	groupFields 'accbook,repriceGap'
	contextParams (['date','organ','currency','staticModel'])
}
heads {
	accbook {
		params {
			reprice true
		}
	}
}
dataRequest StaticModelRgaplimitDataRequest

derivedHeads{
    accbook ([
        new Head(name:'重定价缺口',aggregate:true,
            formula:{
                def grids=thisColGrids({parent==null})
                def a=grids.find{it.rowHeadGrid.model?.alType=='A'}
                def l=grids.find{it.rowHeadGrid.model?.alType=='L'}
                if(a && l){
                    a-l
                }
            },
            evaluatedCallback:{
                    //下限额
                    def llimit=v0([riquidGap:params['riquidGap'],bal:'lvalue',dataRequest:'rgaplimit'])
                    //上限额
                    def ulimit=v0([riquidGap:params['riquidGap'],bal:'hvalue',dataRequest:'rgaplimit'])
                    if((llimit!=null && value<llimit) || (ulimit!=null && value>ulimit)){
                        if(properties==null){properties=[:]}
                        properties['cssClass']='rgap_out_of_limit'
                    }
            }
        ),
        new Head(name:'缺口累计',aggregate:true,
            formula:{
                (col==0)? higher:(left+higher)
            },
            evaluatedCallback:{
                    //下限额
                    def llimit=v0([riquidGap:params['riquidGap'],bal:'accumLvalue',dataRequest:'rgaplimit'])
                    //上限额
                    def ulimit=v0([riquidGap:params['riquidGap'],bal:'accumHvalue',dataRequest:'rgaplimit'])
                    if((llimit!=null && value<llimit) || (ulimit!=null && value>ulimit)){
                        if(properties==null){properties=[:]}
                        properties['cssClass']='rgap_out_of_limit'
                    }
            }
        )
    ])
}

dataGrids {
    apply selectRows({children!=null}),{
		formula {sumChildren()}
	}
}


#LOAD PACKAGES####
library(Hmisc)
library(excel.link)
library(tidyverse)
library(glue)
library(uuid)
library(ggplot2)

#define folder to be read from
datafolder = './result'
filename = '2021-03-13_linked_data.csv'

#read linked datasets and remove missing rows by first dataset MRN column
df = read.csv(paste0(datafolder, '/', filename))

new_df = df %>% drop_na(MRN__1)

for (i in c('MRN__1', 'ZIP__1')){
  cond = new_df[i] != ''
  new_df = new_df[cond,]
}

#census tract conversion (input)
#in order to convert physical address into census tract number on census website,
#dataframe is clean to meet the format required by the API
#https://geocoding.geo.census.gov/geocoder/geographies/addressbatch?form
#index | address | city | state | zip code
col = c('ADDR__1', 'CITY__1', 'ZIP__1') #note that state information is missing
CT_df = new_df[,col] %>% add_column(STATE__1 = '', .after='CITY__1')
write.table(CT_df, paste0(datafolder, '/', 'census_input.csv'), sep=',', col.names=FALSE)

#clean census tract import
#reading converted csv file
fname = paste0(datafolder, '/', 'GeocodeResults.csv')
ct_import = read.csv(fname, header=FALSE)# %>% order('V1')
ct_sorted = ct_import[order(ct_import$V1),]

#get tie (there are several matching states [match, tie, no_match])
#while enough address information is provided for entries marked as tie
#the conversion has not happened, thus the dataframe with only the
#tied results are submitted again for re-evaluation (work in progress)
tie_idx = ct_sorted[ct_sorted$V3 == 'Tie',]$V1
ct_tie = CT_df[match(tie_idx, rownames(CT_df)),]
write.table(ct_tie, paste0(datafolder, '/', 'census_tiebreaker.csv'), sep=',', col.names=FALSE)

#select match (V11: census tract number, V12: census block number)
#removes unsuccessful match by V12 column
ct_select = ct_sorted[ct_sorted$V12 != '',] %>% drop_na()
df_ct_select = new_df[match(ct_select$V1, rownames(new_df)),]

#evaluate positivity rate by date
cols = c('UUID__1','LAB_DATE__1', 'LAB_RESULT__1','AGE__1')
df_result = df_ct_select[,cols]
df_result$census = ct_select$V11

result_table = df_result %>% group_by(LAB_DATE__1) %>%
                            summarise(age = mean(AGE__1),
                                      pos_rate = sum(LAB_RESULT__1) / length(LAB_RESULT__1))

result_table = result_table[order(as.Date(result_table$LAB_DATE__1, format='%m/%d/%Y')),]
result_table$LAB_DATE__1 = factor(result_table$LAB_DATE__1, levels=result_table$LAB_DATE__1)

#generate figure for positivity rate over time
ggplot(data=result_table, aes(x=LAB_DATE__1, y=pos_rate, group=1)) +
  geom_line() + geom_point() + labs(y='Positivity Rate (positive cases over total number)',title='Positivity Rate over time') +
  theme(axis.text.x = element_text(angle = 45,size=8, hjust = 1),
        axis.title.x = element_blank(), axis.title.y=element_text(size=10),
        plot.title = element_text(hjust=0.5))

plotfolder = './figs/'
ggsave(paste0(plotfolder, 'pos_time.png'), device=png(), width=10, height=4)

#evaluate positivity rate by census tract number
result_table = df_result %>% group_by(census) %>%
  summarise(age = mean(AGE__1),
            pos_rate = sum(LAB_RESULT__1) / length(LAB_RESULT__1))

result_table = result_table[order(as.character(result_table$census)),]

#generate figure for positivity rate by census number
ggplot(data=result_table, aes(x=census, y=pos_rate, group=1)) +
  geom_point() + labs(x='Census Block Number', y='Positivity Rate (positive cases over total number)', title='Positivity Rate by Census Block Number') +
  theme(axis.text.x = element_blank(),
        axis.title.x = element_text(size=9), axis.title.y=element_text(size=9),
        plot.title = element_text(hjust=0.5))

plotfolder = './figs/'
ggsave(paste0(plotfolder, 'pos_census.png'), device=png(), width=10, height=4)


context("Facetting")

df <- data.frame(x = 1:3, y = 3:1, z = letters[1:3])

test_that("facets split up the data", {
  l1 <- ggplot(df, aes(x, y)) + geom_point() + facet_wrap(~ z)
  d1 <- pdata(l1)[[1]]

  expect_that(d1$PANEL, equals(factor(1:3)))

  l2 <- ggplot(df, aes(x, y)) + geom_point() + facet_grid(. ~ z)
  l3 <- ggplot(df, aes(x, y)) + geom_point() + facet_grid(z ~ .)

  d2 <- pdata(l2)[[1]]
  d3 <- pdata(l3)[[1]]

  expect_that(d2, equals(d3))
  expect_that(sort(names(d2)), equals(sort(c("x", "y", "group", "PANEL"))))
  expect_that(d2$PANEL, equals(factor(1:3)))
})

test_that("facets with free scales scale independently", {
  l1 <- ggplot(df, aes(x, y)) + geom_point() +
    facet_wrap(~ z, scales = "free")
  d1 <- cdata(l1)[[1]]
  expect_that(length(unique(d1$x)), equals(1))
  expect_that(length(unique(d1$y)), equals(1))

  l2 <- ggplot(df, aes(x, y)) + geom_point() +
    facet_grid(. ~ z, scales = "free")
  d2 <- cdata(l2)[[1]]
  expect_that(length(unique(d2$x)), equals(1))
  expect_that(length(unique(d2$y)), equals(3))

  l3 <- ggplot(df, aes(x, y)) + geom_point() +
    facet_grid(z ~ ., scales = "free")
  d3 <- cdata(l3)[[1]]
  expect_that(length(unique(d3$x)), equals(3))
  expect_that(length(unique(d3$y)), equals(1))
})

test_that("shrink parameter affects scaling", {
  l1 <- ggplot(df, aes(1, y)) + geom_point()
  r1 <- pranges(l1)

  expect_that(r1$x[[1]], equals(c(1, 1)))
  expect_that(r1$y[[1]], equals(c(1, 3)))

  l2 <- ggplot(df, aes(1, y)) + stat_summary(fun.y = "mean")
  r2 <- pranges(l2)
  expect_that(r2$y[[1]], equals(c(2, 2)))

  l3 <- ggplot(df, aes(1, y)) + stat_summary(fun.y = "mean") +
    facet_null(shrink = FALSE)
  r3 <- pranges(l3)
  expect_that(r3$y[[1]], equals(c(1, 3)))
})


library(ggplot2)
library(data.table)
library(ggsci)
library(ftplottools)
library(here)

pillar2 = fread(here("data", "pillar2.csv"))
cog =  fread(here("data", "cog.csv"))
ons =  fread(here("data", "ons.csv"))
samples =  fread(here("data", "samples.csv"))
ct =  fread(here("data", "ct_data.csv"))

## Figure 1A
g = ggplot(pillar2[date >= as.Date("2021-01-31") & Region_name == "London"])
g = g + geom_line(data=ons[area == "LONDON"], aes(x=date,y=pos_me * population,colour="S+ Infections (ONS)"))
g = g + geom_ribbon(data=ons[area == "LONDON"], aes(x=date,y=pos_me*population, ymin = pos_li*population, ymax = pos_ui*population), alpha = 0.1,fill="blue")
g = g + geom_line(aes(y=spos,x=date,colour="S+ Cases (Pillar 2)"))
g = g + geom_line(data=cog[Region_name == "London"],aes(y=pos,x=date,colour="Non-B.1.1.7 Sequences (COG-UK)"))
g = g + geom_ribbon(data=samples[date >= as.Date("2021-01-31") & Region_name == "London"],aes(x=date,y=spos, ymin = spos_li, ymax = spos_ui), alpha = 0.1,fill="red")
g = g + scale_y_log10("Number of people", breaks=c(10,20,50,100,200,500,1000,2000,5000,10000))
g = g + xlab("")
g = g + scale_x_date(date_labels = "%-d %b", date_breaks = "2 week")
g = g + scale_color_lancet(limits=c("S+ Infections (ONS)","S+ Cases (Pillar 2)","Non-B.1.1.7 Sequences (COG-UK)"))
g = g +  scale_fill_lancet() + ft_theme()
g = g + theme(legend.title = element_blank())
g

## Figure 1B
g = ggplot(pillar2[date >= as.Date("2021-01-31")])
g = g + geom_line(data=ons[date >= as.Date("2021-01-31")], aes(x=date,y=pos_me * population,colour="S+ Infections (ONS)"))
g = g + geom_ribbon(data=ons[date >= as.Date("2021-01-31")], aes(x=date,y=pos_me*population, ymin = pos_li*population,
                                                                 ymax = pos_ui*population), alpha = 0.1,fill="blue")
g = g + geom_line(aes(y=spos,x=date,colour="S+ Cases (Pillar 2)"))
g = g + geom_line(data=cog,aes(y=pos,x=date,colour="Non-B.1.1.7 Sequences (COG-UK)"))
g = g + geom_ribbon(data=samples[date >= as.Date("2021-01-31")],aes(x=date,y=spos, ymin = spos_li, ymax = spos_ui), alpha = 0.1,
                    fill="red")
g = g + scale_y_log10("Number of people") #, breaks=c(10,20,50,100,200,500,1000,2000,5000,10000))
g = g + xlab("")
g = g + scale_color_lancet(limits=c("S+ Infections (ONS)","S+ Cases (Pillar 2)","Non-B.1.1.7 Sequences (COG-UK)")) +  scale_fill_lancet() + ft_theme()
g = g + theme(legend.title = element_blank())
g = g + facet_wrap(~ Region_name) #, scales="free")
g = g + scale_x_date(date_labels = "%b", date_breaks = "1 month")
g

## Appendix Figure A
g = ggplot(pillar2[date >= as.Date("2021-01-31") & Region_name == "London"])
g = g + geom_line(aes(y=frac,x=date,colour="Pillar 2"))
g = g + geom_ribbon(data=samples[date >= as.Date("2021-01-31") & Region_name == "London"],aes(x=date,y=frac, ymin =
                                                                                lower_ci, ymax = upper_ci), alpha = 0.1,fill="red")
g = g + scale_y_continuous("Fraction S+\n",labels = scales::label_percent(accuracy = 1L),expand=c(0,0)) + expand_limits(y=0)
g = g + xlab("")
g = g + geom_line(data=ons[area == "LONDON"],aes(x=date,y=pos_me / (pos_me + neg_me),colour="ONS"))
g = g + geom_line(data=cog[Region_name == "London"],aes(x=date,y=frac,colour="COG-UK"))
g = g + geom_ribbon(data=cog[Region_name == "London"],aes(x=date,y=frac, ymin = lower_ci, ymax = upper_ci), alpha = 0.25,fill="green")
g = g + scale_color_lancet(limits=c("ONS","Pillar 2","COG-UK"))
g = g + scale_fill_lancet() + ft_theme()
g = g + theme(legend.title = element_blank())
g = g + scale_x_date(date_labels = "%-d %b", date_breaks = "2 week")
g = g + geom_ribbon(data=ons[area == "LONDON"],aes(x=date,y=pos_me / (pos_me + neg_me), ymin = fraction.lo, ymax = fraction.hi), alpha = 0.1,fill="blue")
g

## Appendix Figure B
g = ggplot(pillar2[date >= as.Date("2021-01-31")])
g = g + geom_line(aes(y=frac,x=date,colour="Pillar 2"))
g = g + geom_ribbon(data=samples[date >= as.Date("2021-01-31") ],aes(x=date,y=frac, ymin = lower_ci, ymax = upper_ci), alpha = 0.2,fill="red")
g = g + scale_y_continuous("Fraction S+\n",labels = scales::label_percent(accuracy = 1L),expand=c(0,0)) + expand_limits(y=0)
g = g + xlab("")
g = g + geom_line(data=ons[date >= as.Date("2021-01-31")],aes(x=date,y=pos_me / (pos_me + neg_me),colour="ONS"))
g = g + geom_line(data=cog,aes(x=date,y=frac,colour="COG-UK"))
g = g + geom_ribbon(data=cog,aes(x=date,y=frac, ymin = lower_ci, ymax = upper_ci), alpha = 0.2,fill="green")
g = g + scale_color_lancet(limits=c("ONS","Pillar 2","COG-UK"))
g = g +scale_fill_lancet() + ft_theme()
g = g + theme(legend.title = element_blank())
g = g + geom_ribbon(data=ons,aes(x=date,y=pos_me / (pos_me + neg_me), ymin = fraction.lo, ymax = fraction.hi), alpha = 0.1,fill="blue")
g = g + scale_x_date(date_labels = "%b", date_breaks = "1 month")
g = g + facet_wrap(~ Region_name) #, scales="free")
g

## Figure 2 and Appendix Figure 3
ct <- ct[,gene := factor(gene, levels = c("ORF1ab  (Ct<=30)","N  (Ct<=30)","MS2 control" ))]
for(i in unique(ct$phec_name)){
    p <- ggplot(ct[ct$phec_name==i,],aes(x=Date,y=ct_mean,colour=sneg_g)) +
      # labs(colour="SGTF") +
      geom_ribbon(aes(ymin=ct_mean-1.96*se,ymax=ct_mean+1.96*se, linetype=NA,fill=sneg_g),alpha=0.3,show.legend = FALSE) +
      geom_line(aes(y=ct_mean),size=1) +
      facet_wrap(~gene) +
      theme_classic() +
      scale_x_date(date_labels = "%d %b", date_breaks = "3 week") +
      ylab("Mean Ct value") +
      theme(panel.grid.major = element_line(colour="lightgrey",linetype="dashed", size = 0.1),
            strip.background = element_blank(),strip.text.x = element_text(size = 12)) +
      scale_fill_lancet() +
      scale_color_lancet() +
      ft_theme() +
      theme(axis.text.x = element_text( angle = 45,hjust = 1)) +
      theme(legend.title=element_blank()) +
      ggtitle(i)
    # if (i=="London"){
    #   p <- p + scale_x_date(date_labels = "%b %d", date_breaks = "3 week")
    # }
    ggsave(paste0(here(),"/figures/",i,"_ct.pdf"),p, width=8, height = 5)
}


context("%>%: multi-argument functions on right-hand side")

test_that("placement of lhs is correct in different situations", {

  # When not to be placed in first position and in the presence of
  # non-placeholder dots, e.g. in formulas.
  case0a <-
    lm(Sepal.Length ~ ., data = iris) %>% coef

  case1a <-
    iris %>% lm(Sepal.Length ~ ., .) %>% coef

  case2a <-
    iris %>% lm(Sepal.Length ~ ., data = .) %>% coef

  expect_that(case1a, is_equivalent_to(case0a))
  expect_that(case2a, is_equivalent_to(case0a))

  # In first position and used in arguments
  case0b <-
    transform(iris, Species = substring(Species, 1, 1))

  case1b <-
    iris %>% transform(Species = Species %>% substr(1, 1))

  case2b <-
    iris %>% transform(., Species = Species %>% substr(., 1, 1))

  expect_that(case1b, is_equivalent_to(case0b))
  expect_that(case2b, is_equivalent_to(case0b))

  # LHS function values
  case0c <-
    aggregate(. ~ Species, iris, function(x) mean(x >= 5))

  case1c <-
    (function(x) mean(x >= 5)) %>%
    aggregate(. ~ Species, iris, .)

  expect_that(case1c, is_equivalent_to(case0c))

  # several placeholder dots
  expect_true(iris %>% identical(., .))

  # "indirect" function expressions
  expect_that(1:100 %>% iris[., ], is_identical_to(iris[1:100, ]))

})


# Copyright 2020 The MuLT Authors. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# ==============================================================================

library(ggplot2)

df <- read.csv('../output/fill/accuracy_fish_aucs.csv', sep=',')
df$category <- c(rep('Copy Number Deletions', 3), c('Copy Number Gains'), rep('Hyperdiploid Copy Number Gains', 9), rep('Translocations', 8), c('Flag'))

fish.levels <- c("Copy Number Deletions", "Copy Number Gains", "Hyperdiploid Copy Number Gains", "Translocations", "Flag")
df$category <- factor(df$category, levels = fish.levels)
#df$category <- fish.levels
df <- df[order(df$category),]
# df$category <- factor(df$category, levels = fish.levels)

df$var <- factor(df$var, levels = df$var[rev(order(df$category))])

graph <- ggplot(df,
                aes(x = var,
                    y = auc,
                    colour = category,
                    fill = category)) +
  geom_bar(stat = "identity", alpha = .6, size = 0.3) +
  ylim(0,1) +
  scale_fill_hue(name    = "FISH Legend",
                 labels  = fish.levels) +
  scale_colour_hue(guide = "none") +
  scale_y_continuous(labels = scales::percent) +
  xlab(NULL) + ylab("AUC") +
  theme(legend.background  = element_rect(colour = "black", size = .2),
        panel.grid.major.y = element_line(size = .15),
        text               = element_text(size = 7),
        legend.key.size    = unit(8, "pt"),
        legend.position    = 'right',
        axis.text.x        = element_text(size = 6, angle = 45),
        axis.title.x       = element_text(vjust = 1)) +
  coord_flip()


library(testthat)

source("../src/data_structures.r")

test_that("TreatmentDictionary",{
  expect_error(TreatmentDictionary(TRUE,2),
               "Elements 1 of class(elements_true) == class(elements_false) are not true",fixed=TRUE)
  expect_error(TreatmentDictionary(rep(0.5,times=99),rep(1,times=100)),
               "length(elements_true) not equal to length(elements_false)",fixed=TRUE)
  treated = TreatmentDictionary(rep(0.5,times=100),rep(1,times=100))

})

test_that("NumericTreatmentDictionary",{
  expect_error(NumericTreatmentDictionary(TRUE,2),
               "Elements 1 of class(elements_true) == class(elements_false) are not true",fixed=TRUE)
  expect_error(NumericTreatmentDictionary(3,"string"),
               "Elements 1 of class(elements_true) == class(elements_false) are not true",fixed=TRUE)
  expect_error(NumericTreatmentDictionary(rep(TRUE,times=100),rep(1,times=100)),
               "Elements 1 of class(elements_true) == class(elements_false) are not true",fixed=TRUE)
  expect_error(NumericTreatmentDictionary(rep(0.5,times=100),rep(FALSE,times=100)),
               "Elements 1 of class(elements_true) == class(elements_false) are not true",fixed=TRUE)
  expect_error(NumericTreatmentDictionary(rep(0.5,times=99),rep(1,times=100)),
               "length(elements_true) not equal to length(elements_false)",fixed=TRUE)
  expect_error(NumericTreatmentDictionary("string","string"),
               "elements_true is not a numeric or integer vector")

  treated = NumericTreatmentDictionary(rep(0.5,times=100),rep(1,times=100))

})

test_that("init_observed",{
  W=rep(c(TRUE,FALSE),times=50)
  treated = NumericTreatmentDictionary(rep(0.5,times=100),rep(1,times=100))
  expect_error(init_observed(4,W),"is(object = treated, class2 = \"numeric_treatment_dictionary\") is not TRUE",fixed = TRUE)
  expect_error(init_observed(treated,"value"),"is.logical(W) is not TRUE",fixed = TRUE)
  expect_error(init_observed(treated,c(TRUE,FALSE)),"length(W) not equal to length(treated$`TRUE`)",fixed = TRUE)

  observed=init_observed(treated,W)

  expect_equal(observed$'TRUE'[W], (rep(0.5,times=50)))
  expect_equal(observed$'TRUE'[!W], (rep(1,times=50)))
  expect_equal(observed$'FALSE'[W], (rep(1,times=50)))
  expect_equal(observed$'FALSE'[!W], (rep(0.5,times=50)))

})

test_that("getN_treated",{
  expect_error(getN_treated("rr"),"W is not a numeric or integer vector")

  W=c(rep(c(1,0),times=20),1,1)
  N_treated = getN_treated(W)

  expect_equal(N_treated$`TRUE`,(22))
  expect_equal(N_treated$`FALSE`,(20))

})

test_that("Counterfactuals",{
  treated <-NumericTreatmentDictionary(c(1,1,1),c(2,2,2))
  W <- c(TRUE,TRUE,FALSE)
  counterfactuals <- Counterfactuals(treated,W)
  expect_equal(get_index(counterfactuals,3)$treated$`TRUE`,1)
  expect_equal(get_index(counterfactuals,3)$treated$`FALSE`,2)
  expect_equal(get_index(counterfactuals,3)$observed$`TRUE`,2)
  expect_equal(get_index(counterfactuals,3)$observed$`FALSE`,1)

  expect_equal(get_elements_by_treatment(counterfactuals,W,TRUE,TRUE),c(1,1))
  expect_equal(get_elements_by_treatment(counterfactuals,W,FALSE,FALSE),1)
  expect_equal(get_elements_by_treatment(counterfactuals,W,FALSE,TRUE),2)
  expect_equal(get_elements_by_treatment(counterfactuals,W,TRUE,FALSE),c(2,2))

  treated <-NumericTreatmentDictionary(c(1,2,3),c(4,5,6))
  W <- c(TRUE,FALSE,FALSE)
  counterfactuals <- Counterfactuals(treated,W)

  expect_equal(get_index(counterfactuals,c(2,1,1))$treated$`TRUE`,c(2,1,1))
  expect_equal(get_index(counterfactuals,c(2,1,1))$treated$`FALSE`,c(5,4,4))
})

test_that("get_elements_by_treatment.vector",{

  expect_equal(get_elements_by_treatment(1,TRUE,TRUE),1)
  expect_equal(get_elements_by_treatment(1,TRUE,FALSE),numeric(0))

  Y<-c(1,2,3,4,5)
  W<-c(TRUE,FALSE,TRUE,TRUE,TRUE)
  exp<-c(1,3,4,5)
  expect_equal(get_elements_by_treatment(Y,W,TRUE),exp)
  expect_equal(get_elements_by_treatment(Y,W,FALSE),2)
})

test_that("get_elements_by_treatment.matrix",{
  m<-rbind(c(1,2),c(3,4),c(5,6))
  W <- c(TRUE,FALSE,TRUE)
  exp <-rbind(c(1,2),c(5,6))
  expect_equal(get_elements_by_treatment(m,W,TRUE),exp)
  expect_equal(get_elements_by_treatment(m,W,FALSE),c(3,4))
})

test_that("add_counterfactuals",{
  treated <-NumericTreatmentDictionary(c(1,1,1),c(2,2,2))
  W <- c(TRUE,FALSE,TRUE)
  c1 <- Counterfactuals(treated,W)
  c2 <- Counterfactuals(treated,W)

  sum<-add_counterfactuals(c1,c2)
  expect_equal(sum$treated$`TRUE`,c(2,2,2))
  expect_equal(sum$treated$`FALSE`,c(4,4,4))

  treated <-NumericTreatmentDictionary(c(1,1,1)*2,c(2,2,2)*2)
  c3<-Counterfactuals(treated,W)

  expect_equal(sum$treated$`TRUE`,c3$treated$`TRUE`)
  expect_equal(sum$treated$`FALSE`,c3$treated$`FALSE`)
  expect_equal(sum$observed$`TRUE`,c3$observed$`TRUE`)
  expect_equal(sum$observed$`FALSE`,c3$observed$`FALSE`)
})


library( "rmacrolite" )

# # Setup MACRO directory (if needed)
# rmacroliteSetModelVar( "C:/swash/macro" )

#   Path to an example par-file
par_file_path <- system.file( "par-files",
    "chat_winCer_GW-X_900gHa_d182.par",
    package = "rmacrolite" )

#   Import the example par-file
par_file <- rmacroliteImportParFile(
    file = par_file_path )

#   Fetch the current parametrization
rmacroliteDiffCoef( x = par_file )
    # [1] 5.2e-10

#   Modify the parameter
par_file2 <- par_file
rmacroliteDiffCoef( x = par_file2 ) <- 5.00E-10

#   Check the result
dc <- rmacroliteDiffCoef( x = par_file2 )
dc
    # [1] 5e-10

#   Internal control
if(dc != 5.00E-10 ){
    stop( "Test of rmacroliteDiffCoef() failed" ) }

#   Clean-up
rm( par_file_path, par_file, par_file2, dc  )


#' Proportion size in MSDem
#'
#' This function allows you to calculate population size by sex or by regions using the MSDem output
#' @param res1 data
#' @param agel lower limit - default is 0
#' @param ageu upper limit - default it 'max'
#' @param period specific periods - default is NULL
#' @param sex specific sex - default is NULL
#' @param bysex group by sex - default is FALSE
#' @param reg specific region(s)
#' @param byreg group by regions - default is FALSE
#' @param resi specific residence(s)
#' @param byresi group by residences - default is FALSE
#' @return R list with five data.table 1) var_def 2) state_space 3) mig_dom 4) mig_int 5) results
#' @keywords read
#' @export
#' @examples

propkc <- function(resX=res,
                  period = NULL,
                  agel=0,ageu="max",byage=FALSE,
                  sex=NULL, bysex=FALSE,
                  reg=NULL, byreg=FALSE,
                  resi=NULL,byresi=FALSE) {
          #Try this for with residence
          #need to try all possible combinations

            # #need res data
            # if(length(grep("res",ls()))==0) print("Run fread_all() first")

            var_def <- resX$var_def
            names(var_def)[1] <-c("varname")
            # head(var_def)
            # unique(var_def$varname)
            ages = var_def[varname=="age"][,values:=as.numeric(values)]
            if(ageu == "max") ageu = max(ages$values)

            periods = var_def[varname=="period"][,values:=as.numeric(values)]$values
            periods = c(periods,max(periods)+unique(diff(periods)))
            if(!is.null(period)) periods = period

            sexes = var_def[varname=="sex"]$values
            if(!is.null(sex)) sexes = sex

            regions = var_def[varname=="region"]$values
            if(!is.null(reg)) regions = reg

            group.var = c("age","period")
            if(bysex) group.var = c(group.var,"sex")
            if(byreg) group.var = c(group.var,"region")

            group.var.minus.age = setdiff(group.var,"age")
            resX <- resX$results

            if(any(grep("resi",unique(var_def$varname)))) {
              residences = var_def[varname=="resi"]$values
              if(!is.null(resi)) residences = resi
              if(byres) key.cols = c(group.var,"residence")
              res.pop = resX[period%in%periods&age%in%seq(agel,ageu)&sex%in%sexes&reg%in%regions&resi%in%residences
                                  ,.(pop=sum(pop)),by=group.var]
            } else {
              res.prop <- resX[period%in%periods & sex%in%sexes & region%in%regions,.(pop=sum(pop)),by=group.var][,.(age=age,prop=prop.table(pop)),by=group.var.minus.age]
              if(!byage) res.prop <- res.prop[age%in%seq(agel,ageu),.(age=paste(agel,ageu+4,sep="to"),prop=sum(prop)),group.var.minus.age]
            }
        return(res.prop)
  }