# set number of genes for empirical control for removing unwanted variation
EC = 3000
# set working directory
setwd(".")
## install packages
# install.packages(c("BiocManager","readr","dplyr", "magrittr","ggplot2"),
# lib = "./libraries",
# repos = 'http://cran.us.r-project.org')

# BiocManager::install("tximport", lib = "./libraries")
# BiocManager::install("DESeq2", lib = "./libraries")
# BiocManager::install("RUVSeq", lib = "./libraries")
# BiocManager::install("EDASeq", lib = "./libraries")
# BiocManager::install("edgeR", lib = "./libraries")

#  load libraries

library(readr, lib.loc =  "./libraries")
library(dplyr, lib.loc =  "./libraries/")
library(magrittr,  lib.loc = "./libraries")
library(tximport, lib.loc = "./libraries")
library(DESeq2, lib.loc = "./libraries")
library(ggplot2, lib.loc =  "./libraries")
library(hexbin, lib.loc =  "./libraries")
library(EDASeq, lib.loc =  "./libraries")
library(RUVSeq, lib.loc =  "./libraries")
library(edgeR, lib.loc = "./libraries")

#library(readr)
#library(dplyr)
#library(magrittr)
#library(tximport)
#library(DESeq2)
#library(ggplot2)
#library(EDASeq)
#library(RUVSeq)
#library(edgeR)
#load metadata

sample_table <-read.table("metadata_complete.csv", sep = ",", header = T)
# delete_samples
#sample_table<-rows_delete(sample_table, tibble(Sample.Number = 37))
# load files paths
sample_files = paste0(pull(sample_table , "Sample_file"), "/quant.sf")
# name table columns
names(sample_files) = pull(sample_table, "Sample_file")
# relate genes to transcripts
tx2gene = read.table("txgen2.txt", sep = ",", col.names =c("genid","transid"))
# import count data to tximport
count_data = tximport( files = sample_files,
                       type = "salmon",
                       tx2gene =  tx2gene,
                       ignoreTxVersion = T)

sample_table$Condition <- as.factor((sample_table$Condition))
sample_table$Genotype <- as.factor((sample_table$Genotype))
sample_table$DevStage <- as.factor((sample_table$DevStage))
sample_table$Individual <- as.factor((sample_table$Individual))
sample_table$Group <- paste(sample_table$Genotype,'_',
                            sample_table$Condition,'_',
                            sample_table$DevStage, sep='')
sample_table$Group<-as.factor(sample_table$Group)
raw <- DESeqDataSetFromTximport(txi = count_data,
                                colData = sample_table,
                                design = ~ Group)
dim(raw)
keep<- rowSums(counts(raw))>0
table(keep)
raw <- raw[keep,]
dim(raw)

data <- estimateSizeFactors(raw)
vst <- varianceStabilizingTransformation(data)

## pca raw

raw_pca <- assay(data)

pca_raw <- prcomp(raw_pca,
                  center = TRUE,
                  scale. = TRUE)
pca_raw_data <- as.data.frame(pca_raw$rotation)

## plot raw by devstage

p <- ggplot(pca_raw_data, aes(x=PC1, y=PC2, colour=sample_table$Group, shape=sample_table$DevStage))
p <- p + geom_point(size=4.5)
p <- p + theme_bw()
p <- p + labs(title = "RAW DATA BY DEVSTAGE", col="Group", shape="DevStage")
p <- p + xlab((paste0("PC1 : ",round(100 * (pca_raw$sdev[1]/sum(pca_raw$sdev)),2),"%")))
p <- p + ylab((paste0("PC1 : ",round(100 * (pca_raw$sdev[2]/sum(pca_raw$sdev)),2),"%")))
p <- p + theme( text = element_text(size=22),
                panel.border = element_blank(),
                panel.grid.major = element_blank(),
                panel.grid.minor = element_blank(),
                axis.line = element_line(colour = "black"))
ggsave( p, filename = "./raw_by_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)
p
## plot raw Genotype

q <- ggplot(pca_raw_data, aes(x=PC1, y=PC2, colour=sample_table$Group, shape=sample_table$Genotype))
q <- q + geom_point(size=4.5)
q <- q + theme_bw()
q <- q + labs(title = "RAW DATA BY Genotype", col="Group", shape="Genotype")
q <- q + xlab((paste0("PC1 : ",round(100 * (pca_raw$sdev[1]/sum(pca_raw$sdev)),2),"%")))
q <- q + ylab((paste0("PC1 : ",round(100 * (pca_raw$sdev[2]/sum(pca_raw$sdev)),2),"%")))
q <- q + theme( text = element_text(size=22),
                panel.border = element_blank(),
                panel.grid.major = element_blank(),
                panel.grid.minor = element_blank(),
                axis.line = element_line(colour = "black"))
q
ggsave( q, filename = "./raw_by_genotype.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## plot raw condition

r <- ggplot(pca_raw_data, aes(x=PC1, y=PC2, colour=sample_table$Group, shape=sample_table$Condition))
r <- r + geom_point(size=4.5)
r <- r + theme_bw()
r <- r + labs(title = "RAW DATA BY CONDITION", col="Group", shape="Condition")
r <- r + xlab((paste0("PC1 : ",round(100 * (pca_raw$sdev[1]/sum(pca_raw$sdev)),2),"%")))
r <- r + ylab((paste0("PC1 : ",round(100 * (pca_raw$sdev[2]/sum(pca_raw$sdev)),2),"%")))
r <- r + theme( text = element_text(size=22),
                panel.border = element_blank(),
                panel.grid.major = element_blank(),
                panel.grid.minor = element_blank(),
                axis.line = element_line(colour = "black"))
r
ggsave( r, filename = "./raw_by_Condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

### pca vst Devstage

pca_vst_devstage <- plotPCA(vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = vst$DevStage))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "VST devstage", col="Group", shape="DevStage") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
pca_vst_devstage
ggsave( pca_vst_devstage, filename = "./vst/vst_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

### pca vst genotype

pca_vst_genotype <- plotPCA(vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = vst$Genotype))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "VST genotype", col="Group", shape="Genotype") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
pca_vst_genotype
ggsave( pca_vst_genotype, filename = "./vst/vst_genotype.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

### pca vst condition

pca_vst_condition <- plotPCA(vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = vst$Condition))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "VST genotype", col="Group", shape="Condition") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
pca_vst_condition
ggsave( pca_vst_genotype, filename = "./vst/vst_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

### sub plot vst R condition
vst_R_condition <- vst[ ,vst$Genotype ==  "R" ]
pca_vst_R_condition <- plotPCA(vst_R_condition, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = vst_R_condition$Condition))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "VST R CONDITION", col="Group", shape="Condition") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
pca_vst_R_condition
ggsave(pca_vst_R_condition, filename = "./vst/vst_R_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

### sub plot vst R devstage
VST_R <- vst[ ,vst$Genotype ==  "R" ]
pca_vst_R_devstage <- plotPCA(VST_R, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = VST_R$DevStage))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "VST R Devstage", col="Group", shape="Devstage") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
pca_vst_R_devstage
ggsave( pca_vst_R_devstage, filename = "./vst/vst_R_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

### subplot vst NR devstage

VST_NR <- vst[ ,vst$Genotype ==  "NR" ]
pca_vst_NR_devstage <- plotPCA(VST_NR, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = VST_NR$DevStage))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "VST NR DEVSTAGE", col="Group", shape="DevStage") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
pca_vst_NR_devstage
ggsave( pca_vst_NR_devstage, filename = "./vst/vst_devstage_NR.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

### subplot vst NR condition

pca_vst_NR_condition <- plotPCA(VST_NR, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = VST_NR$Condition))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "VST NR CONDITION", col="Group", shape="Condition") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
pca_vst_NR_condition
ggsave( pca_vst_NR_condition, filename = "./vst/vst_NR_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

differences <- makeGroups(sample_table$Group)
genes <- row.names(raw)
setRUVs <- RUVs(as.matrix(assay(raw)), genes, k=1, differences)
dataRUVs <- DESeqDataSetFromMatrix(countData = setRUVs$normalizedCounts,
                                   colData = sample_table,
                                   design = ~ Group)

dataRUVs <- estimateSizeFactors(dataRUVs)
ruvs_vst <- varianceStabilizingTransformation(dataRUVs)

## RUVs condition

pca_ruvs_condition <- plotPCA(ruvs_vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = ruvs_vst$Condition, color = ruvs_vst$Group))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVs VST condition", col="Group", shape="Condition")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )

pca_ruvs_condition
ggsave( pca_ruvs_condition, filename = "./RUVs/RUVs_vst_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVs genotype
pca_ruvs_genotype <- plotPCA(ruvs_vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = ruvs_vst$Genotype, color = ruvs_vst$Group))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVs VST genotype", col="Group", shape="Genotype")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )

pca_ruvs_genotype
ggsave( pca_ruvs_genotype, filename = "./RUVs/RUVs_vst_genotype.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVs Devstage

pca_ruvs_devstage <- plotPCA(ruvs_vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = ruvs_vst$DevStage, color = ruvs_vst$Group))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVs VST Devstage", col="Group", shape="Devstage")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )

pca_ruvs_devstage
ggsave( pca_ruvs_devstage, filename = "./RUVs/RUVs_vst_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVs NR condition

RUVs_NR <- ruvs_vst[ ,ruvs_vst$Genotype ==  "NR" ]
ruvs_NR_condition <- plotPCA(RUVs_NR, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = RUVs_NR$Condition))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "RUVs NR CONDITION", col="Group", shape="Condition") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvs_NR_condition
ggsave( ruvs_NR_condition, filename = "./RUVs/NR/RUVs_NR_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVs R devstage
RUVs_R <- ruvs_vst[ ,ruvs_vst$Genotype ==  "R" ]
ruvs_R_devstage <- plotPCA(RUVs_R, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = RUVs_R$DevStage))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "RUVs R Devstage", col="Group", shape="Devstage") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvs_R_devstage
ggsave( ruvs_R_devstage, filename = "./RUVs/R/RUVs_R_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVs R condition
RUVs_R <- ruvs_vst[ ,ruvs_vst$Genotype ==  "R" ]
ruvs_R_condition <- plotPCA(RUVs_R, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = RUVs_R$Condition))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "RUVs R CONDITION", col="Group", shape="Condition") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvs_R_condition
ggsave( ruvs_R_condition, filename = "./RUVs/R/RUVs_R_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVs NR devstage

RUVs_NR <- ruvs_vst[ ,ruvs_vst$Genotype ==  "NR" ]
ruvs_NR_devstage <- plotPCA(RUVs_R, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = RUVs_NR$DevStage))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "RUVs NR Devstage", col="Group", shape="Devstage") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvs_NR_devstage
ggsave( ruvs_NR_devstage, filename = "./RUVs/NR/RUVs_NR_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

dea <- DESeq(raw)
results_table <- as.data.frame(results(dea))
empirical_control <- rownames(tail(arrange(results_table, pvalue),EC))
RUVgSet <- RUVg(as.matrix(assay(raw)), empirical_control, k = 1)
dataRUVg<- DESeqDataSetFromMatrix(countData = RUVgSet$normalizedCounts,
                                  colData = sample_table,
                                  design = ~ Group)

dataRUVg <- estimateSizeFactors(dataRUVg)
ruvg_vst <- varianceStabilizingTransformation(dataRUVg)

## RUVg devstage

ruvg_devstage <- plotPCA(ruvg_vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = ruvg_vst$DevStage, color = ruvg_vst$Group))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVg Devstage", col="Group", shape="DevStage")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )

ruvg_devstage
ggsave( ruvg_devstage, filename = "./RUVg/ruvg_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVg genotype

ruvg_genotype <- plotPCA(ruvg_vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = ruvg_vst$Genotype, color = ruvg_vst$Group))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVg genotype", col="Group", shape="Genotype")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )

ruvg_genotype
ggsave( ruvg_genotype, filename = "./RUVg/ruvg_genotype.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVg Condition

ruvg_condition <- plotPCA(ruvg_vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = ruvg_vst$Condition, color = ruvg_vst$Group))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVg Condition", col="Group", shape="Condition")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )

ruvg_condition
ggsave( ruvg_condition, filename = "./RUVg/ruvg_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVg R condition

RUVg_R <- ruvg_vst[ ,ruvg_vst$Genotype ==  "R" ]
ruvg_R_condition <- plotPCA(RUVg_R, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = RUVg_R$Condition))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "RUVg R condition", col="Group", shape="Condition") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvg_R_condition
ggsave( ruvg_R_condition, filename = "./RUVg/R/ruvg_R_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVg R devstage

RUVg_R <- ruvg_vst[ ,ruvg_vst$Genotype ==  "R" ]
ruvg_R_devstage <- plotPCA(RUVg_R, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = RUVg_R$DevStage))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "RUVg R devstage", col="Group", shape="DevStage") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvg_R_devstage
ggsave( ruvg_R_devstage, filename = "./RUVg/R/ruvg_R_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVg NR condition
RUVg_NR <- ruvg_vst[ ,ruvg_vst$Genotype ==  "NR" ]
ruvg_NR_condition <- plotPCA(RUVg_NR, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = RUVg_NR$Condition))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "RUVg NR condition", col="Group", shape="Condition") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvg_NR_condition
ggsave( ruvg_NR_condition, filename = "./RUVg/NR/ruvg_NR_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVg NR devstage

RUVg_NR <- ruvg_vst[ ,ruvg_vst$Genotype ==  "NR" ]
ruvg_NR_devstage <- plotPCA(RUVg_NR, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes( shape = RUVg_NR$DevStage))+
  scale_shape_manual(values = seq(0,8)) +
  labs(title = "RUVg NR devstage", col="Group", shape="DevStage") +
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvg_NR_devstage
ggsave( ruvg_NR_devstage, filename = "./RUVg/NR/ruvg_NR_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)
##
design <- model.matrix(~sample_table$Group)
y <- DGEList(counts=counts(raw), group=sample_table$Group)
keep <- filterByExpr(y)
y <- y[keep, , keep.lib.sizes=FALSE]
y <- calcNormFactors(y, method="upperquartile")
y <- estimateGLMCommonDisp(y, design)
y <- estimateGLMTagwiseDisp(y, design)
fit <- glmFit(y, design)
res <- residuals(fit, type="deviance")

set_RUVr <- RUVr(y$counts,rownames(y), k=1, res)
dataRUVr <- DESeqDataSetFromMatrix(countData = set_RUVr$normalizedCounts,
                                   colData = sample_table,
                                   design = ~ Group)
RUVr_vst <- varianceStabilizingTransformation(dataRUVr)

## RUVr condition
ruvr_condition <- plotPCA(RUVr_vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = RUVr_vst$Condition))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVr Condition", col="Group", shape="Condition")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvr_condition
ggsave(ruvr_condition, filename = "./RUVr/RUVr_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)
## RUVr genotype
ruvr_genotype <- plotPCA(RUVr_vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = RUVr_vst$Genotype))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVr Genotype", col="Group", shape="Genotype")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvr_genotype
ggsave(ruvr_condition, filename = "./RUVr/RUVr_genotype.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVr Devstage
ruvr_devstage <- plotPCA(RUVr_vst, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = RUVr_vst$DevStage))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVr Devstage", col="Group", shape="Devstage")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvr_devstage
ggsave(ruvr_condition, filename = "./RUVr/RUVr_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVr R condition
RUVr_R <- RUVr_vst[ ,RUVr_vst$Genotype ==  "R" ]
ruvr_R_condition <- plotPCA(RUVr_R, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = RUVr_R$Condition))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVr R CONDITION", col="Group", shape="Condition")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvr_R_condition
ggsave(ruvr_R_condition, filename = "./RUVr/R/RUVr_R_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVr R devstage
RUVr_R <- RUVr_vst[ ,RUVr_vst$Genotype ==  "R" ]
ruvr_R_devstage <- plotPCA(RUVr_R, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = RUVr_R$DevStage))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVr R DEVSTAGE", col="Group", shape="Devstage")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvr_R_devstage
ggsave(ruvr_R_devstage, filename = "./RUVr/R/RUVr_R_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVr NR condition
RUVr_NR <- RUVr_vst[ ,RUVr_vst$Genotype ==  "NR" ]
ruvr_NR_condition <- plotPCA(RUVr_NR, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = RUVr_NR$Condition))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVr NR CONDITION", col="Group", shape="Condition")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvr_NR_condition
ggsave(ruvr_NR_condition, filename = "./RUVr/NR/RUVr_NR_condition.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)

## RUVr NR devstage

RUVr_NR <- RUVr_vst[ ,RUVr_vst$Genotype ==  "NR" ]
ruvr_NR_devstage <- plotPCA(RUVr_NR, intgroup ='Group') +
  theme_bw() +
  geom_point(size=4.5, aes(shape = RUVr_NR$DevStage))+
  scale_shape_manual(values=seq(0,8)) +
  labs(title = "RUVr NR DEVSTAGE", col="Group", shape="Devstage")+
  theme( text = element_text(size=22),
         panel.border = element_blank(),
         panel.grid.major = element_blank(),
         panel.grid.minor = element_blank(),
         plot.title = element_text(hjust = 0.5),
         axis.line = element_line(colour = "black") )
ruvr_NR_devstage
ggsave(ruvr_NR_devstage, filename = "./RUVr/NR/RUVr_NR_devstage.png",units = "cm",width = 15*1.3, height = 15,dpi = 320)


library(RODBC)
library(pROC)
library(caTools)
library(ROSE)
library(DMwR)

ch <- odbcConnect("DBM_SANDBOX", believeNRows=FALSE)
nzdata <- sqlQuery(ch, paste("SELECT *
FROM BA_PROD..BADB_MODELFILE
ORDER BY RANDOM()
LIMIT 100000"))

nzdata$TARGET_SALES <- NULL
nzdata$CONT_ID <- NULL

noMissingTarget <- nzdata[!is.na(nzdata$TARGET_Q4_PURCHASE), ]

#columnList <- as.list(colnames(noMissingTarget))

vars <- c('CUST_TYPE', 'BPS_OUTDOOR_REWARDS', 'BPS_PREFERRED_REWARDS', 'CAB_REWARDS', 'CAB_CLUB', 'NEW_CLUB', 'COMBINED_LOYALTY',
          'COMBINED_CLUB', 'CHANNEL_TYPE', 'CHANNEL_TYPE_24MO', 'TOTAL_VISITS', 'TOTAL_BPS_VISITS', 'TOTAL_CAB_VISITS', 'TOTAL_VISITS_24MO',
          'TIME_AS_CUSTOMER', 'AVG_DAYS_BTW_VISITS', 'DAYS_SINCE_LAST_PURCHASE', 'TOTAL_SALES', 'RETAIL_SALES', 'RETAIL_SALES_PROPORTION',
          'TOTAL_UNITS', 'TOTAL_SALES_24MO', 'RETAIL_SALES_24MO', 'RETAIL_SALES_PROPORTION_24MO', 'TOTAL_UNITS_24MO', 'BPS_SALES_24MO',
          'BPS_UNITS_24MO', 'CAB_SALES_24MO', 'CAB_UNITS_24MO', 'D100_SALES_24MO', 'D100_UNITS_24MO', 'D151_SALES_24MO', 'D151_UNITS_24MO',
          'D175_SALES_24MO', 'D175_UNITS_24MO', 'D200_SALES_24MO', 'D200_UNITS_24MO', 'D300_SALES_24MO', 'D300_UNITS_24MO', 'D350_SALES_24MO',
          'D350_UNITS_24MO', 'D400_SALES_24MO', 'D400_UNITS_24MO', 'D450_SALES_24MO', 'D450_UNITS_24MO', 'D475_SALES_24MO', 'D475_UNITS_24MO',
          'D500_SALES_24MO', 'D500_UNITS_24MO', 'D600_SALES_24MO', 'D600_UNITS_24MO', 'D650_SALES_24MO', 'D650_UNITS_24MO', 'D675_SALES_24MO',
          'D675_UNITS_24MO', 'D700_SALES_24MO', 'D700_UNITS_24MO', 'TOTAL_SALES_LYQTR', 'TOTAL_UNITS_LYQTR', 'BPS_SALES_LYQTR', 'BPS_UNITS_LYQTR',
          'CAB_SALES_LYQTR', 'CAB_UNITS_LYQTR', 'D100_24MO_PROPORTION', 'D151_24MO_PROPORTION', 'D175_24MO_PROPORTION', 'D200_24MO_PROPORTION',
          'D300_24MO_PROPORTION', 'D350_24MO_PROPORTION', 'D400_24MO_PROPORTION', 'D475_24MO_PROPORTION', 'D500_24MO_PROPORTION',
          'D600_24MO_PROPORTION', 'D650_24MO_PROPORTION', 'D675_24MO_PROPORTION', 'D700_24MO_PROPORTION','VISITS_BY_TIME_INTER',
          'VISITS_BY_AVG_DAYS_INTER', 'VISITS_BY_DAYS_SINCE_INTER', 'VISITS_BY_LYQTY_UNITS_INTER', 'TIME_BY_AVG_DAYS_INTER',
          'TIME_BY_DAYS_SINCE_LAST_INTER', 'TIME_BY_LYQTR_UNITS_INTER', 'TARGET_Q4_PURCHASE')

vars.x.num <- c('TOTAL_VISITS', 'TOTAL_BPS_VISITS', 'TOTAL_CAB_VISITS', 'TOTAL_VISITS_24MO',
                'TIME_AS_CUSTOMER', 'AVG_DAYS_BTW_VISITS', 'DAYS_SINCE_LAST_PURCHASE', 'TOTAL_SALES', 'RETAIL_SALES', 'RETAIL_SALES_PROPORTION',
                'TOTAL_UNITS', 'TOTAL_SALES_24MO', 'RETAIL_SALES_24MO', 'RETAIL_SALES_PROPORTION_24MO', 'TOTAL_UNITS_24MO', 'BPS_SALES_24MO',
                'BPS_UNITS_24MO', 'CAB_SALES_24MO', 'CAB_UNITS_24MO', 'D100_SALES_24MO', 'D100_UNITS_24MO', 'D151_SALES_24MO', 'D151_UNITS_24MO',
                'D175_SALES_24MO', 'D175_UNITS_24MO', 'D200_SALES_24MO', 'D200_UNITS_24MO', 'D300_SALES_24MO', 'D300_UNITS_24MO', 'D350_SALES_24MO',
                'D350_UNITS_24MO', 'D400_SALES_24MO', 'D400_UNITS_24MO', 'D450_SALES_24MO', 'D450_UNITS_24MO', 'D475_SALES_24MO', 'D475_UNITS_24MO',
                'D500_SALES_24MO', 'D500_UNITS_24MO', 'D600_SALES_24MO', 'D600_UNITS_24MO', 'D650_SALES_24MO', 'D650_UNITS_24MO', 'D675_SALES_24MO',
                'D675_UNITS_24MO', 'D700_SALES_24MO', 'D700_UNITS_24MO', 'TOTAL_SALES_LYQTR', 'TOTAL_UNITS_LYQTR', 'BPS_SALES_LYQTR', 'BPS_UNITS_LYQTR',
                'CAB_SALES_LYQTR', 'CAB_UNITS_LYQTR', 'D100_24MO_PROPORTION', 'D151_24MO_PROPORTION', 'D175_24MO_PROPORTION', 'D200_24MO_PROPORTION',
                'D300_24MO_PROPORTION', 'D350_24MO_PROPORTION', 'D400_24MO_PROPORTION', 'D475_24MO_PROPORTION', 'D500_24MO_PROPORTION',
                'D600_24MO_PROPORTION', 'D650_24MO_PROPORTION', 'D675_24MO_PROPORTION', 'D700_24MO_PROPORTION','VISITS_BY_TIME_INTER',
                'VISITS_BY_AVG_DAYS_INTER', 'VISITS_BY_DAYS_SINCE_INTER', 'VISITS_BY_LYQTY_UNITS_INTER', 'TIME_BY_AVG_DAYS_INTER',
                'TIME_BY_DAYS_SINCE_LAST_INTER', 'TIME_BY_LYQTR_UNITS_INTER')

vars.x.nonum <- c('CUST_TYPE', 'BPS_OUTDOOR_REWARDS', 'BPS_PREFERRED_REWARDS', 'CAB_REWARDS', 'CAB_CLUB', 'NEW_CLUB', 'COMBINED_LOYALTY',
                  'COMBINED_CLUB', 'CHANNEL_TYPE', 'CHANNEL_TYPE_24MO')

vars.y <- c('TARGET_Q4_PURCHASE')

modelData2 <- noMissingTarget[ , vars]

scaled = scale(modelData2[, vars.x.num], center = TRUE)

mahal <- mahalanobis(scaled[ , vars.x.num],
                     colMeans(scaled[ , vars.x.num], na.rm = TRUE),
                     cov(scaled[ , vars.x.num],
                         use = "pairwise.complete.obs"),
                     tol=1e-20)

cutoff <- qchisq(1-.01, length(vars.x.num))

summary(mahal < cutoff)

modelData3 <- cbind(as.data.frame(scaled),
                    as.data.frame(modelData2[, vars.x.nonum]))

modelData3$TARGET_Q4_PURCHASE <- modelData2[, vars.y]

nooutliers <- as.data.frame(subset(modelData3, mahal < cutoff))

prop.table(table(nooutliers$TARGET_Q4_PURCHASE))

set.seed(12345)
split = sample.split(nooutliers$TARGET_Q4_PURCHASE, SplitRatio = 0.5)

train <- subset(nooutliers, split==TRUE)
test <- subset(nooutliers, split==FALSE)

train_bal <- ovun.sample(TARGET_Q4_PURCHASE ~ ., data= train, method='over', p=0.5)$data

#form <- 'TARGET_Q4_PURCHASE ~ TOTAL_VISITS + TOTAL_BPS_VISITS + TOTAL_CAB_VISITS + TOTAL_VISITS_24MO +
#         TIME_AS_CUSTOMER + AVG_DAYS_BTW_VISITS + DAYS_SINCE_LAST_PURCHASE + TOTAL_UNITS + TOTAL_SALES_24MO +
#         TOTAL_UNITS_24MO + BPS_SALES_24MO + D100_UNITS_24MO + D151_UNITS_24MO + D200_UNITS_24MO +
#         D450_UNITS_24MO + D475_UNITS_24MO + D500_UNITS_24MO + D675_SALES_24MO + D700_SALES_24MO +
#         D700_UNITS_24MO + TOTAL_SALES_LYQTR + TOTAL_UNITS_LYQTR + D350_24MO_PROPORTION + D475_24MO_PROPORTION +
#         D600_24MO_PROPORTION + D650_24MO_PROPORTION + CUST_TYPE + NEW_CLUB + CHANNEL_TYPE'

form <- 'TARGET_Q4_PURCHASE ~ TOTAL_VISITS_24MO +
         TIME_AS_CUSTOMER + AVG_DAYS_BTW_VISITS + DAYS_SINCE_LAST_PURCHASE + TOTAL_UNITS + TOTAL_SALES_24MO +
         TOTAL_UNITS_24MO + BPS_SALES_24MO + D100_UNITS_24MO + D151_UNITS_24MO + D200_UNITS_24MO +
         D450_UNITS_24MO + D475_UNITS_24MO + D500_UNITS_24MO + D675_SALES_24MO + D700_SALES_24MO +
         D700_UNITS_24MO + TOTAL_SALES_LYQTR + TOTAL_UNITS_LYQTR + D350_24MO_PROPORTION + D475_24MO_PROPORTION +
         D600_24MO_PROPORTION + D650_24MO_PROPORTION + VISITS_BY_TIME_INTER + VISITS_BY_AVG_DAYS_INTER +
         VISITS_BY_DAYS_SINCE_INTER + VISITS_BY_LYQTY_UNITS_INTER + TIME_BY_AVG_DAYS_INTER +
         TIME_BY_DAYS_SINCE_LAST_INTER + TIME_BY_LYQTR_UNITS_INTER + CUST_TYPE + NEW_CLUB + CHANNEL_TYPE'
logmod <- glm(formula = form,
              family = binomial(link = 'logit'),
              data=train_bal)

#save(logmod, file = "C:\\Users\\pairwin\\Documents\\GitHub\\RAnalyses\\CHURN_LOGISTIC.rda")

summary(logmod)
anova(logmod, test='Chisq')
car::vif(logmod)

#plot(logmod)

prob=predict(logmod, test, type=c("response"))

test$prob=prob
hist(test$prob)

accuracy.meas(response = test$TARGET_Q4_PURCHASE, predicted= test$prob)
roc.curve(test$TARGET_Q4_PURCHASE, test$prob, plotit = TRUE)

g <- roc(TARGET_Q4_PURCHASE ~ prob, data = test, auc=TRUE)
plot(g)

auc(g)

coords(g, x="best", ret=c("threshold","auc"))

test$prediction=ifelse(prob>=0.4205224,1,0)

caret::confusionMatrix(factor(test$prediction), factor(test$TARGET_Q4_PURCHASE), positive='1')


news_sample <- dplyr::sample_n(news, 4000)
x <- news_sample$title

s <- shingle(x, function(x) tokenizers::tokenize_character_shingles(x, 5))
results <- lsh(s)

edges <- prune_results(results, s, 0.9)
groups <- group_edges_rcpp(edges$from, edges$to)
groups$text <- x[groups$node]
dplyr::arrange(tibble::as_tibble(groups), group)


#####################################################
#
# oat_plot_functions.r   16 FEB 2017
#
# Creates the one-at-a-time sensitivity plots
# for figure 5.
#
#####################################################

make.oatplot <- function(this.frame, make.legend=TRUE,
                         rho.center=0, gamma.center=1, eta.center=1, c0.center=500,
                         this.ylim=NULL, ...) {

  # Create a data frame that has the
  # parameter values normalized
  norm.frame <- this.frame[,c("rho","gamma","eta","c0")]
  norm.frame <- data.frame(apply(norm.frame, 2, .normalize))
  norm.frame <- data.frame(norm.frame, SCC=this.frame$SCC)

  # Normalize central values for parsing the norm.frame
  rho.c.norm <- .normalize(rho.center, range(this.frame$rho))
  gamma.c.norm <- .normalize(gamma.center, range(this.frame$gamma))
  eta.c.norm <- .normalize(eta.center, range(this.frame$eta))
  c0.c.norm <- .normalize(c0.center, range(this.frame$c0))

  # Get the appropriate SCC values
  rho.scc <- norm.frame[which(with(norm.frame, gamma==gamma.c.norm & eta==eta.c.norm & c0==c0.c.norm)),c("rho","SCC")]
  gamma.scc <- norm.frame[which(with(norm.frame, rho==rho.c.norm & eta==eta.c.norm & c0==c0.c.norm)),c("gamma","SCC")]
  eta.scc <- norm.frame[which(with(norm.frame, gamma==gamma.c.norm & rho==rho.c.norm & c0==c0.c.norm)),c("eta","SCC")]
  c0.scc <- norm.frame[which(with(norm.frame, gamma==gamma.c.norm & eta==eta.c.norm & rho==rho.c.norm)),c("c0","SCC")]

  # Make the plot
	my.ylim <- this.ylim
  par(...)
  plot.new()
  plot.window(xlim=c(0,1), ylim=my.ylim, log="")
  axis(1, at=c(0,1), labels=c("Min", "Max"))
  mtext("Parameter Range", 1, line=2)
  axis(2)
  mtext("SCC", 2, line=3.7, cex=0.9)
  mtext(expression(paste("[2015 USD per ton ", CO[2], "]", sep="")), 2, line=2.6, cex=0.9)
  box(bty="o")

  line.cols <- c("black", "#1b9e77", "#d95f02", "#7570b3")
  lines(gamma.scc[,1], gamma.scc[,2], col=line.cols[2])
  points(gamma.scc[,1], gamma.scc[,2], col=line.cols[2], pch=15, cex=0.85)
  lines(eta.scc[,1], eta.scc[,2], col=line.cols[3])
  points(eta.scc[,1], eta.scc[,2], col=line.cols[3], pch=16, cex=0.85)
  lines(c0.scc[,1], c0.scc[,2], col=line.cols[4])
  points(c0.scc[,1], c0.scc[,2], col=line.cols[4], pch=17, cex=0.85)

  if(make.legend){
    legend("top", horiz=F, legend=c("gamma", "eta", "c0"), lty=1, pch=15:17, col=line.cols[-1], bty="n", cex=0.8)
  }
}

# Normalize a vector
.normalize <- function(x, x.range=NULL, ...) {
  if(is.null(x.range)) {
    (x - min(x, ...)) / (max(x, ...) - min(x, ...))
  }
  else {
    (x-x.range[1]) / (x.range[2] - x.range[1])
  }
}


library(tidyverse)
library(janitor)
library(here)

path <- "rawdata/"

filenames <- dir(path = "rawdata",
                 pattern = "*.txt",
                 full.names = TRUE)

get_country_name <- function(x){
    read_lines(x, n_max = 1) %>%
        str_extract(".+?,") %>%
        str_remove(",")
}

shorten_name <- function(x){
    str_replace_all(x, " -- ", " ") %>%
        str_replace("The United States of America", "USA") %>%
        snakecase::to_any_case()
}

countries <- tibble(country = map_chr(filenames, get_country_name),
                        ccode = map_chr(country, shorten_name),
                        path = filenames)

mortality <- countries %>%
    mutate(data = map(path,
                      ~ read_table(., skip = 2, na = "."))) %>%
    unnest(cols = c(data)) %>%
    clean_names() %>%
    mutate(age = as.integer(recode(age, "110+" = "110"))) %>%
    select(-path) %>%
    group_by(country, ccode) %>%
    nest()

save(mortality, file = "data/mortality.rda", compress = "xz")

britain <- read_table(paste0(path, "GBRTENW.Mx_1x1.txt"), skip = 2, na = ".") %>% clean_names()
britain$age <- as.integer(recode(britain$age, "110+" = "110"))

## britain <- britain %>% mutate(ratio = male / female,
##                               deciles = cut(ratio, breaks = quantile(ratio, probs = seq(0, 1, 0.1), na.rm = TRUE)),
##                               pct_diff = ((male - female) / (male + female))*100,
##                               bin_ratio = ntile(ratio, 100))

save(britain, file = "data/britain.rda", compress = "xz")

france <- read_table(paste0(path, "FRATNP.Mx_1x1.txt"), skip = 2, na = ".") %>% clean_names()
france$age <- as.integer(recode(france$age, "110+" = "110"))

save(france, file = "data/france.rda", compress = "xz")

## france <- france %>% mutate(ratio = male / female,
##                             deciles = cut(ratio, breaks = quantile(ratio, probs = seq(0, 1, 0.1), na.rm = TRUE)),
##                               pct_diff = ((male - female) / (male + female))*100,
##                               bin_ratio = ntile(ratio, 100))

ireland <- read_table(paste0(path, "IRL.Mx_1x1.txt"), skip = 2, na = ".") %>% clean_names()
ireland$age <- as.integer(recode(ireland$age, "110+" = "110"))

save(ireland, file = "data/ireland.rda", compress = "xz")

tmp <- nzl %>% mutate(ratio = male / female,
                          deciles = cut(ratio,
                                        breaks = quantile(ratio, probs = seq(0, 1, 0.1), na.rm = TRUE)),
                          pct_diff = ((male - female) / (male + female))*100,
                          bin_ratio = ntile(ratio, 100))

tmp <- sweden %>% mutate(ratio = male / female,
                         deciles = cut(ratio,
                                       breaks = quantile(ratio, probs = seq(0, 1, 0.1), na.rm = TRUE)),
                         pct_diff = ((male - female) / (male + female))*100,
                         bin_ratio = ntile(ratio, 100))

library(colorspace)
tmp %>%
    filter(age < 101) %>%
    ggplot(aes(x = year, y = age, fill = deciles)) +
    geom_raster() +
    scale_fill_discrete_diverging("Green-Orange") +
    scale_x_continuous(breaks = seq(1750, 2015, by = 15)) +
    ylim(c(0, 100)) +
        guides(fill = guide_legend(nrow = 1, title.position = "top", label.position = "bottom")) +
    labs(x = "Year", y = "Age", fill = "M/F Mortality Ratio") +
    theme_minimal()  +
    theme(legend.position = "top",
          legend.title = element_text(size = 8))

nzl <- read_table(paste0(path, "NZL_NM.Mx_1x1.txt"), skip = 2, na = ".") %>% clean_names()
nzl$age <- as.integer(recode(nzl$age, "110+" = "110"))

## nzl <- nzl %>% mutate(ratio = male / female,
##                               deciles = cut(ratio, breaks = quantile(ratio, probs = seq(0, 1, 0.1), na.rm = TRUE)),
##                               pct_diff = ((male - female) / (male + female))*100,
##                               bin_ratio = ntile(ratio, 100))

save(nzl, file = "data/nzl.rda", compress = "xz")

japan <- read_table(paste0(path, "JPN.Mx_1x1.txt"), skip = 2, na = ".") %>%
    clean_names()
japan$age <- as.integer(recode(japan$age, "110+" = "110"))

save(japan, file = "data/japan.rda", compress = "xz")

sweden <- read_table(paste0(path, "SWE.Mx_1x1.txt"), skip = 2, na = ".") %>% clean_names()
sweden$age <- as.integer(recode(sweden$age, "110+" = "110"))

save(sweden, file = "data/sweden.rda", compress = "xz")

okboomer <- read_csv("rawdata/boom_births.csv")

save(okboomer, file = "data/okboomer.rda", compress = "xz")

start_date <- "1938-01-01"
end_date <- "1991-12-01"
by_unit = "year"

###--------------------------------------------------
### Time series
###--------------------------------------------------

## break_vec <- seq(from=as.Date(start_date), to=as.Date(end_date), by = "month")
## break_vec <- break_vec[seq(25, length(break_vec), 60)]
## title_txt <- "Monthly Birth Rates, 1938-1991"
## subtitle_txt <- "Average births per million people per day."


two_way_tanimoto_predict <- function(Kc, Kr, S0, S1, MW, similarity.consumer, similarity.resource, minimum_threshold) {
    # Two-way Tanimoto Algorithm
    # ===========================

    # Parameters:
    #   Kc  Integer, how many neighbors to select for consumers
    #   Kr  Integer, how many neighbors to select for resources
    #   S0  A large set of species and their preys, with column structure ['taxon', 'taxonomy', 'resource', 'non-resource']
    #   S1  The subset of S0 where we want to predict new preys, string vector with taxa name
    #   MW  Mimimum weight to accept a candidate as a prey
    #

    # // TODO: I think MW should be a function of Kc & Kr and perhaps of the number of candidate resources. For example, a similar consumer could have multiple prey, which would artificially inflate the weight added to each prey in the candidate list. For exemple, Atlantic cod has over 600 prey species listed in the interaction catalogue... Hence, the longer the candidate list, the more likely a very small similarity will be turned into a predicted interaction
    # // REVIEW: Multiply similar.consumer[similarity] * similar.resource[similarity]? It's a similarity of a similarity in a sense...

    # // TODO: Different similarity measurement for resources and consumers

    # // REVIEW: Remove cannibalism from empirical data, or allow for it, or add parameter that allows or prevents cannibalism in the predictions. There are lots of predicted cannibalism interations in the catalogue and empirical webs. Accuracy would increase if it was allowed.

    # Output
    #   A vector of sets (the preys for each species)

    # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    # List of things to adjust - make it
    # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    # Process steps:
      # A prior process to this is to get the similarity matrix between all combinations of catalogue taxa and species in S1
      # For each species in S1:
      # 1. Identify resources already known in interaction catalogue (S0) for S1 species
        # 1.1 If resoures are in S1, automatically add them to the predictions as empirically valid interactions
        # 1.2 If resources are not in S1, find Kr similar resources in S1 and add them to candidate list with weight equal to their similarity

      # 2. Identify Kc similar consumers to S1 in S0
        # 2.1 Extract set of candidate resources from each similar consumer, if any
        # 2.2 If candidate resource is in S1, add it to candidate list with weight 1
        # 2.3 If candidate resource not in S1, find Kr similar resources in S1 and add them to candidate list with weight equal to their similarity

      # 3. Make predictions:
        # 3.1 Remove taxa with weight < to minimum weight (MW) from prediction list
        # 3.2 Sort prediction list according to weight. Higher weights mean higher likelihood for resource being consumed

    # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    # !!! étendre predator et non predator pour resource... il faudrait aussi calculer la similarité des proies sur la base de leurs prédateurs partagés !!!
    # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    predictions <- matrix(nrow = length(S1), ncol = 3, data = "", dimnames = list(c(S1), c('consumer','resource_empirical','resource_predictions'))) # empty object for resource predictions
    predictions[, 'consumer'] <- S1

    # pb <- txtProgressBar(min = 0,max = length(S1), style = 3)
    for(i in 1:length(S1)) { # loop through each taxon in S1
        candidates <- matrix(nrow = 0, ncol = 2, dimnames = list(c(), c('resource', 'weight')), data = NA) # empty matrix for resource candidate list for S1[i], with taxon name and weight
        resources.S1 <- unlist(strsplit(S0[S1[i], 'resource'], " \\|\\ ")) # resources of S1[i]

        # Add resources that are already listed as resources for S1[i] in predictions[, 'resource_empirical'] or
        # Find similar resources to resources for S1[i] in S1
        if(length(resources.S1) > 0) {
            empirical <- character()
            for(j in 1:length(resources.S1)) { #loop through empirical resources for S1
                if(resources.S1[j] %in% S1) {
                    empirical <- c(empirical, resources.S1[j]) # observed resource found in S1 are automatically added to the column resource_empirical
                } else { # selecting Kr most similar resources in S1
                    # Let's assume for this part that we are not compiling a different similarity measure for predators and preys.
                    similar.resource <- matrix(nrow = length(S1)-1, ncol = 2, dimnames = list(c(), c('resource','similarity')), data = NA) # importing K nearest neighbors resources
                    similar.resource[, 'resource'] <- names(sort(similarity.resource[S1[-which(S1 == S1[i])], resources.S1[j]], decreasing = TRUE))
                    similar.resource[, 'similarity'] <- sort(similarity.resource[S1[-which(S1 == S1[i])], resources.S1[j]], decreasing = TRUE)

                    # If multiple taxa with same similarity, randomly select those that will be used as similar resources.
                    if(similar.resource[Kr+1, 'similarity'] == similar.resource[Kr, 'similarity']) {
                        same.similarity <- which(similar.resource[, 'similarity'] == similar.resource[Kr, 'similarity'])
                        similar.resource[same.similarity, ] <- similar.resource[sample(same.similarity), ]
                        similar.resource <- similar.resource[1:Kr, ]
                    } else {
                        similar.resource <- similar.resource[1:Kr, ]
                    }# if for random draw

                    for(l in 1:Kr) { # extracting resource candidates
                        if(all.equal(similar.resource[, 'similarity'], rep('0',Kr)) == TRUE) { # if similarities all == 0, break
                            break
                        } else if(similar.resource[l, 'similarity'] == '0') { # if similarity l == 0, no candidates provided
                            NULL
                            # minimum threshold try.. adding it as a Parameters.. might not make sense, have to discuss it. If we keep it, previous else ifs can be removed
                        } else if(similar.resource[l, 'similarity'] < minimum_threshold) {
                            NULL
                        } else if((similar.resource[l, 'resource'] %in% candidates[, 'resource']) == TRUE) { # if candidate is already in candidate list, add resource' with wt to its weight
                          candidates[which(candidates[, 'resource'] == similar.resource[l]), 'weight'] <- as.numeric(candidates[which(candidates[, 'resource'] == similar.resource[l]), 'weight']) + as.numeric(similar.resource[l, 'similarity'])
                        } else {
                              candidates <- rbind(candidates, similar.resource[l, ]) # if candidate is not in the list, add it resource' with wt to its weight
                        }#if3
                    }#l
                }#if
            }#j
            predictions[S1[i], 'resource_empirical'] <- paste(empirical, collapse = ' | ')
        }#if1

        # Identify similar consumers to S1[i]
        similar.consumer <- matrix(nrow = nrow(similarity.consumer)-1, ncol = 2, dimnames = list(c(), c('consumer','similarity')), data = NA) # emporting K nearest neighbors for consumers
        similar.consumer[, 'consumer'] <- names(sort(similarity.consumer[-which(colnames(similarity.consumer) == S1[i]), S1[i]], decreasing = TRUE))
        similar.consumer[, 'similarity'] <- sort(similarity.consumer[-which(colnames(similarity.consumer) == S1[i]), S1[i]], decreasing = TRUE)

        # If multiple taxa with same similarity, randomly select those that will be used as similar resources.
        if(similar.consumer[Kc+1, 'similarity'] == similar.consumer[Kc, 'similarity']) {
            same.similarity <- which(similar.consumer[, 'similarity'] == similar.consumer[Kc, 'similarity'])
            similar.consumer[same.similarity, ] <- similar.consumer[sample(same.similarity), ]
            similar.consumer <- similar.consumer[1:Kc, ]
        } else {
            similar.consumer <- similar.consumer[1:Kc, ]
        }# if for random draw

        # Est-ce que la valeur de similarité a de l'importance pour l'attribution des proies?
        # If yes, we could add an argument call wt_predator.
          # if(wt_predator == FALSE) {
          #   resources <- unique of all prey species of all similar predators
          # } else {}

        for(j in 1:Kc) { #loop through consumers

            if(all.equal(similar.consumer[, 'similarity'], rep('0',Kc)) == TRUE) { # if similarities all == 0, break
                break
            } else if(similar.consumer[j, 'similarity'] == '0') { # if similarity l == 0, no candidates provided
                NULL
            } else {

                # It's possible that consumers in the list have high taxonomic similarity, but no recorded resource
                candidate.resource <- unlist(strsplit(S0[similar.consumer[j, 'consumer'], 'resource'], " \\|\\ ")) # list of resources for consumer j
                # candidate.resource <- candidate.resource[(candidate.resource %in% resources.S1) == FALSE] # substracting candidate resources that are already listed as resources for S1[i] and hence considered in the preceding code segment

                for(k in 1:length(candidate.resource)) { # loop through resources of consumer j
                    if(length(candidate.resource) == 0) { # if candidate resource list is empty, break
                        break
                    } else if(candidate.resource[1] == "") { # if candidate list is an empty vector "", break
                        break
                    } else if(candidate.resource[k] == S1[i]) {
                    #   #// FIXME: if candidate resource is taxon for which predictions are being made, break (unless we want to allow CANIBALISM). Add argument for cannibalism allowed or not
                         NULL
                    } else if((candidate.resource[k] %in% S1) == TRUE) {
                        if((candidate.resource[k] %in% candidates[, 'resource']) == TRUE) {# if candidate is already in candidate list, add 1 to its weight
                            candidates[which(candidates[, 'resource'] == candidate.resource[k]), 'weight'] <- as.numeric(candidates[which(candidates[, 'resource'] == candidate.resource[k]), 'weight']) + 1
                        } else {
                            candidates <- rbind(candidates, c(candidate.resource[k], 1)) # if candidate is not in the list, add it with 1 to its weight
                        }#if2

                    } else {
                        # Let's assume for this part that we are not compiling a different similarity measure for predators and preys.
                        similar.resource <- matrix(nrow = length(S1)-1, ncol = 2, dimnames = list(c(), c('resource','similarity')), data = NA) # importing K nearest neighbors resources
                        similar.resource[, 'resource'] <- names(sort(similarity.resource[S1[-which(S1 == S1[i])], candidate.resource[k]], decreasing = TRUE))
                        similar.resource[, 'similarity'] <- sort(similarity.resource[S1[-which(S1 == S1[i])], candidate.resource[k]], decreasing = TRUE)

                        # If multiple taxa with same similarity, randomly select those that will be used as similar resources.
                        if(similar.resource[Kr+1, 'similarity'] == similar.resource[Kr, 'similarity']) {
                            same.similarity <- which(similar.resource[, 'similarity'] == similar.resource[Kr, 'similarity'])
                            similar.resource[same.similarity, ] <- similar.resource[sample(same.similarity), ]
                            similar.resource <- similar.resource[1:Kr, ]
                        } else {
                            similar.resource <- similar.resource[1:Kr, ]
                        }# if for random draw

                        for(l in 1:Kr) { # extracting resource candidates
                            if(all.equal(similar.resource[, 'similarity'], rep('0',Kr)) == TRUE) { # if similarities all == 0, break
                                break
                            } else if(similar.resource[l, 'similarity'] == '0') { # if similarity l == 0, no candidates provided
                                NULL
                                # minimum threshold try.. adding it as a Parameters.. might not make sense, have to discuss it. If we keep it, previous else ifs can be removed
                            } else if(similar.resource[l, 'similarity'] < minimum_threshold) {
                                NULL
                            } else if((similar.resource[l, 'resource'] %in% candidates[, 'resource']) == TRUE) { # if candidate is already in candidate list, add 1 to its weight
                              candidates[which(candidates[, 'resource'] == similar.resource[l]), 'weight'] <- as.numeric(candidates[which(candidates[, 'resource'] == similar.resource[l]), 'weight']) + as.numeric(similar.resource[l, 'similarity'])
                            } else {
                                  candidates <- rbind(candidates, similar.resource[l, ]) # if candidate is not in the list, add it with its weight = similarity
                            }#if3
                        }#l
                    } #if1
                }#k
            }#if
        }#j

        candidates <- candidates[which(candidates[, 'weight'] >= MW), ] # remove candidates with a weight below MW
        if(is.matrix(candidates) == TRUE) { #if it's a vector, there's only one predicted resource, no need to order
            candidates[order(candidates[, 'weight']), ] # sorts candidates according to their weight
            predictions[S1[i], 'resource_predictions'] <- paste(candidates[, 'resource'], collapse = ' | ')
        } else {
          predictions[S1[i], 'resource_predictions'] <- paste(candidates['resource'], collapse = ' | ')
        }#if
    # setTxtProgressBar(pb, i)
    }#i
    # close(pb)
    return(predictions)
}#two_way_tanimoto_predict function


bigres=matrix(NA,length(dir(pattern="*.rda"))+1,5)

k=1
Id=dir(pattern="*.rda")
for(I in Id) {
load(I)
for(i in 1:5) {
sa=sapply(1:1000,function(j) {
jnk=res[[j]][[i]]
ifelse(!inherits(jnk,"try-error"),
       sum(abs(jnk$k-res[[1]]$ktrue)),NA)})
its=sapply(1:1000,function(j) res[[j]][[i]]$iters)
bigres[k,i]=mean(sa==0,na.rm=TRUE)
}
k=k+1}

rm(res)
save.image(file="B.RData")


library(dplyr)
library(plotly)

# Helper functions
source("Shiny_app/get_solo_artist.r")

# Takes the main charts dataset. Returns a new dataset with the solo artist
# column attached.
add_solo_artists <- function(main_df) {
  solo_artists <- get_solo_artists(main_df)
  # adds column of the Solo Artist, no feature
  main_df <- mutate(main_df, solo_artist = unlist(solo_artists))
  return(main_df)
}

# Takes in the charts dataframe WITH solo artist column. Returns a new dataframe
#that contains artist and number of hits they had.
count_num_hits <- function(df) {
  df_new <- add_solo_artists(df)
  times_appeared <- df_new %>%
    group_by(solo_artist) %>%
    summarize(num_hits = n())
  return(times_appeared)
}

# Takes a number of hits, a filtered (artist + number of hits) dataframe, and
# the main charts dataframe. Returns a dataframe with the artist column,
# number of hits column matching given param, and their respective genre.
make_hits_table <- function(num, filtered, data) {
  # this is times
  top_num_hits <- filtered %>%
    filter(num_hits == num)

  if (as.integer(num) <= 5) {
    top_num_hits <- sample_n(top_num_hits, 15)
  }

  artists <- top_num_hits$solo_artist
  artist_genres <- list()
  for (i in seq(length(artists))) {
    genre <- data %>%
      filter(solo_artist == as.name(artists[[i]])) %>%
      head(1) %>%
      pull(genre)
    artist_genres[[i]] <- genre
  }
  top_num_hits <- mutate(top_num_hits, genre = unlist(artist_genres))
  names(top_num_hits)[1] <- "Artist"
  names(top_num_hits)[2] <- "Number of Hits"
  names(top_num_hits)[3] <- "Genre"
  return(top_num_hits)
}

# Takes in a number of hits table, and the number of hits. Returns a bar chart
# showing the frequency of each genre in the given table.
plot_genre_frequency <- function(table, num_hits) {
  plot_table <- table %>%
    group_by(Genre) %>%
    summarize(frequency = n())

  fig <- plot_ly(data = plot_table, x = ~Genre, y = ~frequency, type = "bar")
  fig <- fig %>%
    layout(title = paste0("Frequency of Genres for Artists with ",
                           num_hits, " Hits"),
           yaxis = list(title = "Frequency"),
           xaxis = list(tickangle = 45))
  return(fig)
}


#!/usr/bin/env Rscript

args=commandArgs(trailingOnly=TRUE)
if(length(args)<2) {
  stop("Must supply input and output\n",call.=FALSE)
}

# decide output type
filex = substr(args[2],nchar(args[2])-2,nchar(args[2]))
if(filex=="pdf") {
  pdf(args[2],bg="#FFFFFF",height=3.5,width=7)
} else if (filex=="png") {
  png(args[2],bg="#FFFFFF",width=480,height=240)
} else {
    stop("Unsupported type for output file.\n",call.=FALSE)
}

d<-read.csv(args[1],sep="\t",header=FALSE)
tot = length(d[,1])
biggest = max(d[,2])
par(mar=c(5,4.1,1,1))
plot(1,type="n",xlim=c(0,max(20,tot)+1),ylim=c(0,biggest),xlab="SMRT cell",ylab="Molecule count")
for(i in seq(1,tot,1)) {
  rect(-0.4+i,0,i+0.4,d[i,1],col="#777777")
  rect(-0.4+i,d[i,1],i+0.4,d[i,2],col="#FF0000")
}
dev.off()


#' Isler et al. (2008) dataset of primate brain and body mass.
#'
#' A dataset containing the brain and body mass of 74 primate species
#'
#'
#' @format A data frame with 74 rows and 2 variables:
#' \describe{
#'   \item{Brain}{brain mass, in grams}
#'   \item{Body}{body mass, in grams}
#'   ...
#' }
#' @source Isler K, Kirk EC, Miller JMA, Albrecht GA, Gelvin BR, Martin RD. 2008. Endocranial volumes of primate species: scaling analyses using a comprehensive and reliable data set. Journal of Human Evolution 55: 967-978.
"primateData"

#' Molecular consensus phylogeny of primate species from the 10k trees project
#'
#' An object of class "phylo"
#'
#'
#' @format A tree  146 primate species
#'   ...
#'
#' @source Arnold C, Matthews LJ, Nunn CL. 2010. The 10k Trees Website: A New Online Resource for Primate Phylogeny. Evolutionary Anthropology 19: 114-118.
"primateTree"


#' Load detection p-value matrix
#'
#' @param qc.objects A list of outputs from \code{\link{meffil.create.qc.object}()}.
#' @param verbose If \code{TRUE}, then detailed status messages are printed during execution (Default: \code{FALSE}).
#' @param ... Arguments passed to \code{\link[parallel]{mclapply}()}.
#' @return Matrix of probe detection p-values.
#'
#' @export
meffil.load.detection.pvalues <- function(qc.objects,
                                        max.bytes=2^30-1,
                                        verbose=F,
                                        ...) {
    stopifnot(all(sapply(qc.objects, is.qc.object)))

    featuresets <- sapply(qc.objects, function(qc.object) qc.object$featureset)
    featureset <- featuresets[1]

    if (is.list(featuresets)) ## backwards compatibility
        featureset <- featuresets <- "450k"

    if (any(featuresets != featureset))
        stop("Multiple feature sets were used to create these QC objects:",
             paste(unique(featuresets), collapse=", "))

    feature.names <- meffil.get.features(featureset)$name

    if (!all(sapply(qc.objects, function(qc.object) exists.rg(qc.object$basename))))
         stop("IDAT files are not accessible for all QC objects")

    ret <- mcsapply.safe(qc.objects, function(qc.object) {
        if (is.null(qc.object$featureset)) ## backwards compatibility
            qc.object$chip <- "450k"

        rg <- read.rg(qc.object$basename, verbose=verbose)
        probes <- meffil.probe.info(qc.object$chip)
        pvalues <- extract.detection.pvalues(rg, probes, verbose=verbose)
        unname(pvalues[feature.names])
    }, ..., max.bytes=max.bytes)

    dimnames(ret) <- list(feature.names, names(qc.objects))
    ret
}


#plotting yeast forecasts vs. validation data.
#clear environment, source paths, functions and packages.
rm(list=ls())
source('paths.r')

#set output path.----
output.path <- NEON_dmulti.ddirch_yeast_forecast_validation.path
output.path <- 'test.png'

#load data.----
d <- readRDS(NEON_dmulti.ddirch_fcast_yeast.path)
core.truth <- readRDS(NEON_ITS_fastq_yeast_taxa.path)
core.truth <- core.truth$rel.abundances
rownames(core.truth) <- gsub('-GEN','',rownames(core.truth))
plot.truth <- readRDS(NEON_plot.level_yeast_obs_fastq.path)
site.truth <- readRDS(NEON_site.level_yeast_obs_fastq.path)

#DEFINE OUTLIER SITES- DSNY in this case.----
out_sites <- c('')
out_spp   <- c('')

#setup output spec.----
png(filename=output.path,width=12,height=12,units='in',res=300)

#global plot settings.----
par(mfrow = c(2,3),
    mai = c(0.3,0.3,0.3,0.3),
    oma = c(4,6,3,1))
trans <- 0.3
limy <- c(0,1)
core.cex <- 0.7
plot.cex <- 1.0
site.cex <- 1.5
outer.cex <- 2
glob.pch <- 16
names <- colnames(d$core.fit$mean)
names <- names[c(2:(length(names)),1)]
names <- names[!(names %in% c('other'))]
out.color <- 'gray'
bf_col <- 'magenta1' #best-fit regression line color.

#loop over functional groups.----
for(i in 1:length(names)){
  #core.level.----
  #organize data.
  fcast <- d$core.fit
  obs <- core.truth
  obs <- obs[,colnames(obs) %in% colnames(fcast$mean)]
  obs <- obs[rownames(obs) %in% rownames(fcast$mean),]
  for(k in 1:length(fcast)){
    fcast[[k]] <- fcast[[k]][rownames(fcast[[k]]) %in% rownames(obs),]
  }
  obs <- as.matrix(obs)
  pos <- which(colnames(fcast$mean) == names[i]) #position that matches the fungal type we are plotting.
  mu <- fcast$mean[,pos][order(fcast$mean[,pos])]
  ci_0.975 <- fcast$ci_0.975[,pos][order(match(names(fcast$ci_0.975[,pos]),names(mu)))]
  ci_0.025 <- fcast$ci_0.025[,pos][order(match(names(fcast$ci_0.025[,pos]),names(mu)))]
  pi_0.975 <- fcast$pi_0.975[,pos][order(match(names(fcast$pi_0.975[,pos]),names(mu)))]
  pi_0.025 <- fcast$pi_0.025[,pos][order(match(names(fcast$pi_0.025[,pos]),names(mu)))]
  fungi_name <- colnames(fcast$mean)[pos]
  obs.pos <- which(colnames(obs) == names[i])
  obs.mu   <- obs[,obs.pos][order(match(names(obs[,c(fungi_name)]),names(mu)))]

  #make DSNY sites light gray for Ectos.
  obs.cols <- rep('black',length(obs))
  if(names[i] %in% out_spp){
    obs.cols <- ifelse(substring(names(obs.mu),1,4) %in% out_sites,out.color,'black')
  }

  #get y-limit.
  obs_limit <- max(obs.mu)
  if(max(pi_0.975) > as.numeric(obs_limit)){obs_limit <- max(pi_0.975)}
  y_max <- as.numeric(obs_limit)*1.05
  if(y_max > 0.95){y_max <- 1}
  if(names[i] == 'Arbuscular'){y_max = 0.1}

  #plot
  plot(obs.mu ~ mu, cex = core.cex, pch=glob.pch, ylim=c(0,y_max), ylab=NA, xlab = NA, col = obs.cols)
  mod_fit <- lm(obs.mu ~ mu)
  if(names[i] %in% out_spp){
    siteID <- substring(names(obs.mu),1,4)
    to_keep <- ifelse(siteID %in% out_sites, F, T)
    mod_fit <- lm(obs.mu[to_keep] ~mu[to_keep])
  }
  rsq <- round(summary(mod_fit)$r.squared,2)
  mtext(paste0('R2=',rsq), side = 3, line = -2.7, adj = 0.03)
  mtext(fungi_name, side = 2, line = 2.5, cex = 1.5)
  #add confidence interval.
  range <- mu
  polygon(c(range, rev(range)),c(pi_0.975, rev(pi_0.025)), col=adjustcolor('green', trans), lty=0)
  polygon(c(range, rev(range)),c(ci_0.975, rev(ci_0.025)), col=adjustcolor('blue' , trans), lty=0)
  #fraction within 95% predictive interval.
  in_it <- round(sum(as.numeric(obs.mu) < pi_0.975 & as.numeric(obs.mu) > pi_0.025) / length(obs.mu),2) * 100
  state <- paste0(in_it,'% of obs. within interval.')
  mtext(state,side = 3, line = -1.3, adj = 0.05)
  abline(0,1,lwd=2)
  abline(mod_fit, lwd =2, lty = 2, col = bf_col)

  #plot.level.----
  #organize data.
  fcast <- d$plot.fit
  obs <- plot.truth
  for(k in 1:length(obs)){
    rownames(obs[[k]]) <- gsub('.','_',rownames(obs[[k]]), fixed = T)
    obs[[k]] <- obs[[k]][rownames(obs[[k]]) %in% rownames(fcast$mean),]
  }
  for(k in 1:length(fcast)){
    fcast[[k]] <- fcast[[k]][rownames(fcast[[k]]) %in% rownames(obs$mean),]
  }
  pos <- which(colnames(fcast$mean) == names[i]) #position that matches the fungal type we are plotting.
  mu <- fcast$mean[,pos][order(fcast$mean[,pos])]
  ci_0.975 <- fcast$ci_0.975[,pos][order(match(names(fcast$ci_0.975[,pos]),names(mu)))]
  ci_0.025 <- fcast$ci_0.025[,pos][order(match(names(fcast$ci_0.025[,pos]),names(mu)))]
  pi_0.975 <- fcast$pi_0.975[,pos][order(match(names(fcast$pi_0.975[,pos]),names(mu)))]
  pi_0.025 <- fcast$pi_0.025[,pos][order(match(names(fcast$pi_0.025[,pos]),names(mu)))]
  fungi_name <- colnames(fcast$mean)[pos]
  obs.mu   <- obs$mean[,fungi_name][order(match(names(obs$mean[,fungi_name]),names(mu)))]
  obs.lo95 <- obs$lo95[,fungi_name][order(match(names(obs$lo95[,fungi_name]),names(mu)))]
  obs.hi95 <- obs$hi95[,fungi_name][order(match(names(obs$hi95[,fungi_name]),names(mu)))]

  #Make out_sites sites gray for out_spp.
  obs.cols <- rep('black',length(obs.mu))
  if(names[i] %in% out_spp){
    obs.cols <- ifelse(substring(names(obs.mu),1,4) %in% out_sites,out.color,'black')
  }

  #get y-limit.
  obs_limit <- max(obs.hi95)
  if(max(pi_0.975) > obs_limit){obs_limit <- max(pi_0.975)}
  y_max <- as.numeric(obs_limit)*1.05
  if(y_max > 0.95){y_max <- 1}
  if(names[i] == 'Arbuscular'){y_max = 0.1}

  #plot
  plot(obs.mu ~ mu, cex = plot.cex, pch=glob.pch, ylim=c(0,y_max), ylab=NA, xlab = NA, col = obs.cols)
  arrows(c(mu), obs.lo95, c(mu), obs.hi95, length=0.05, angle=90, code=3, col = obs.cols)
  mod_fit <- lm(obs.mu ~ mu)
  if(names[i] %in% out_spp){
    siteID <- substring(names(obs.mu),1,4)
    to_keep <- ifelse(siteID %in% out_sites, F, T)
    mod_fit <- lm(obs.mu[to_keep] ~mu[to_keep])
  }
  rsq <- round(summary(mod_fit)$r.squared,2)
  mtext(paste0('R2=',rsq), side = 3, line = -2.7, adj = 0.03)
  #1:1 line
  abline(0,1, lwd = 2)
  abline(mod_fit, lwd =2, lty = 2, col = bf_col)

  #add confidence interval.
  range <- mu
  polygon(c(range, rev(range)),c(pi_0.975, rev(pi_0.025)), col=adjustcolor('green', trans), lty=0)
  polygon(c(range, rev(range)),c(ci_0.975, rev(ci_0.025)), col=adjustcolor('blue' , trans), lty=0)
  #fraction within 95% predictive interval.
  in_it <- round(sum(obs.mu < pi_0.975 & obs.mu > pi_0.025) / length(obs.mu),2) *100
  state <- paste0(in_it,'% of obs. within interval.')
  mtext(state,side = 3, line = -1.3, adj = 0.05)

  #site.level.----
  #organize data.
  fcast <- d$site.fit
  obs <- site.truth
  for(k in 1:length(obs)){
    rownames(obs[[k]]) <- gsub('.','_',rownames(obs[[k]]), fixed = T)
    obs[[k]] <- obs[[k]][rownames(obs[[k]]) %in% rownames(fcast$mean),]
  }
  for(k in 1:length(fcast)){
    fcast[[k]] <- fcast[[k]][rownames(fcast[[k]]) %in% rownames(obs$mean),]
  }
  pos <- which(colnames(fcast$mean) == names[i]) #position that matches the fungal type we are plotting.
  mu <- fcast$mean[,pos][order(fcast$mean[,pos])]
  ci_0.975 <- fcast$ci_0.975[,pos][order(match(names(fcast$ci_0.975[,pos]),names(mu)))]
  ci_0.025 <- fcast$ci_0.025[,pos][order(match(names(fcast$ci_0.025[,pos]),names(mu)))]
  pi_0.975 <- fcast$pi_0.975[,pos][order(match(names(fcast$pi_0.975[,pos]),names(mu)))]
  pi_0.025 <- fcast$pi_0.025[,pos][order(match(names(fcast$pi_0.025[,pos]),names(mu)))]
  fungi_name <- colnames(fcast$mean)[pos]
  obs.mu   <- obs$mean[,fungi_name][order(match(names(obs$mean[,fungi_name]),names(mu)))]
  obs.lo95 <- obs$lo95[,fungi_name][order(match(names(obs$lo95[,fungi_name]),names(mu)))]
  obs.hi95 <- obs$hi95[,fungi_name][order(match(names(obs$hi95[,fungi_name]),names(mu)))]

  #Make out_sites sites gray for out_spp.
  obs.cols <- rep('black',length(obs.mu))
  if(names[i] %in% out_spp){
    obs.cols <- ifelse(substring(names(obs.mu),1,4) %in% out_sites,out.color,'black')
  }

  #get y-limit.
  obs_limit <- max(obs.hi95)
  if(max(pi_0.975) > obs_limit){obs_limit <- max(pi_0.975)}
  y_max <- as.numeric(obs_limit)*1.05
  if(y_max > 0.95){y_max <- 1}
  if(names[i] == 'Arbuscular'){y_max = 0.1}

  #plot
  plot(obs.mu ~ mu, cex = site.cex, pch=glob.pch, ylim=c(0,y_max), ylab=NA, xlab = NA, col = obs.cols)
  arrows(c(mu), obs.lo95, c(mu), obs.hi95, length=0.05, angle=90, code=3, col = obs.cols)
  mod_fit <- lm(obs.mu ~ mu)
  if(names[i] %in% out_spp){
    siteID <- substring(names(obs.mu),1,4)
    to_keep <- ifelse(siteID %in% out_sites, F, T)
    mod_fit <- lm(obs.mu[to_keep] ~mu[to_keep])
  }
  rsq <- round(summary(mod_fit)$r.squared,2)
  mtext(paste0('R2=',rsq), side = 3, line = -2.7, adj = 0.03)
  #1:1 line
  abline(0,1, lwd = 2)
  abline(mod_fit, lwd =2, lty = 2, col = bf_col)

  #add confidence interval.
  range <- mu
  polygon(c(range, rev(range)),c(pi_0.975, rev(pi_0.025)), col=adjustcolor('green', trans), lty=0)
  polygon(c(range, rev(range)),c(ci_0.975, rev(ci_0.025)), col=adjustcolor('blue' , trans), lty=0)
  #fraction within 95% predictive interval.
  in_it <- round(sum(obs.mu < pi_0.975 & obs.mu > pi_0.025) / length(obs.mu),2) *100
  state <- paste0(in_it,'% of obs. within interval.')
  mtext(state,side = 3, line = -1.3, adj = 0.05)
}

#outer labels.----
mtext('core-level', side = 3, line = -1.8, adj = 0.12, cex = outer.cex, outer = T)
mtext('plot-level', side = 3, line = -1.8, adj = 0.50, cex = outer.cex, outer = T)
mtext('site-level', side = 3, line = -1.8, adj = 0.88, cex = outer.cex, outer = T)
mtext( 'observed relative abundance', side = 2, line = 3, cex = outer.cex, outer = T)
mtext('predicted relative abundance', side = 1, line = 2, cex = outer.cex, outer = T)

#end plot.----
dev.off()


library(estimate)
library(DBI)
library(odbc)
library(ggplot2)
library(RColorBrewer)

rm(list=ls())

#Load and prepare gene expression matrix

filterCommonGenes("/projects/varnf/GLASS-III/GLASS-III/results/kallisto/kallisto/final/gene_tpm_matrix_all_samples.tsv", "/projects/varnf/GLASS-III/GLASS-III/data/sigs/gene_tpm_matrix_all_samples_estimate_filtered.tsv",id="GeneSymbol")
estimateScore("/projects/varnf/GLASS-III/GLASS-III/data/sigs/gene_tpm_matrix_all_samples_estimate_filtered.tsv","/projects/varnf/GLASS-III/GLASS-III/data/sigs/gene_tpm_matrix_all_samples_estimate_scores.txt","affymetrix")

estimate <- t(read.delim("/projects/varnf/GLASS-III/GLASS-III/data/sigs/gene_tpm_matrix_all_samples_estimate_scores.txt"))
colnames(estimate) <- estimate[2,]
estimate <- estimate[-c(1,2),]
aliquot_barcode <- gsub("\\.","-",estimate[,2])
estimate <- estimate[,3:5]
estimate <- apply(estimate,2,as.numeric)
est_purity <- cos(0.6049872018+0.0001467884 * estimate[,"ESTIMATEScore"])
estimate <- data.frame(aliquot_barcode,estimate,est_purity)

con <- DBI::dbConnect(odbc::odbc(), "GLASSv3")

#Gold set
q <- "SELECT al.sample_barcode, tumor_barcode, an.rna_barcode, tp.purity AS titan_purity, sp.cellularity AS seqz_cellularity, al.aliquot_batch
FROM variants.titan_params tp
JOIN variants.seqz_params sp ON sp.pair_barcode = tp.pair_barcode
JOIN analysis.pairs pa ON pa.pair_barcode = tp.pair_barcode
JOIN analysis.analyte_sets an ON pa.tumor_barcode = an.dna_barcode
JOIN analysis.gold_set gs ON gs.tumor_barcode_a = an.dna_barcode OR gs.tumor_barcode_b = an.dna_barcode
JOIN biospecimen.aliquots al ON an.rna_barcode = al.aliquot_barcode"

pur <- dbGetQuery(con,q)

all_purity <- merge(pur,estimate,by.x="rna_barcode",by.y="aliquot_barcode")

wxs_purity <- all_purity[grep("-WXS-",all_purity[,"tumor_barcode"]),]

mycors <- cor(wxs_purity[,c(4,5,10)],method="s")
mycorp <- cor(wxs_purity[,c(4,5,10)],method="p")
titan_cor <- round(mycorp[1,3],2)
seqz_cor <- round(mycorp[2,3],2)

titan_lm <- lm(wxs_purity[,"titan_purity"]~wxs_purity[,"est_purity"])
seqz_lm <- lm(wxs_purity[,"seqz_cellularity"]~wxs_purity[,"est_purity"])

pdf("/projects/varnf/GLASS-III/GLASS-III/figures/qc/purity_plots.pdf",width=7,height=7)
ggplot(data = wxs_purity, aes(x = est_purity, y = titan_purity,colour=aliquot_batch)) +
  geom_point() +
  ggtitle("ESTIMATE purity versus titan purity") +
  scale_colour_manual(values=brewer.pal(11,"Set3")) +
  annotate("text", x = 0.1, y = 0, label = paste("R = ",titan_cor,sep="")) +
  theme_classic()+
  geom_abline(intercept = titan_lm$coefficients[1], slope = titan_lm$coefficients[2]) +
  coord_cartesian(xlim=c(0,1),ylim=c(0,1))

ggplot(data = wxs_purity, aes(x = est_purity, y = seqz_cellularity,colour=aliquot_batch)) +
  geom_point() +
  ggtitle("ESTIMATE purity versus sequenza cellularity") +
  scale_colour_manual(values=brewer.pal(11,"Set3")) +
  annotate("text", x = 0.1, y = 0, label = paste("R = ",seqz_cor,sep="")) +
  theme_classic() +
  geom_abline(intercept = seqz_lm$coefficients[1], slope = seqz_lm$coefficients[2]) +
  coord_cartesian(xlim=c(0,1),ylim=c(0,1))

dev.off()

#All samples
q <- "SELECT al.sample_barcode, tumor_barcode, an.rna_barcode, tp.purity AS titan_purity, sp.cellularity AS seqz_cellularity, al.aliquot_batch
FROM variants.titan_params tp
JOIN variants.seqz_params sp ON sp.pair_barcode = tp.pair_barcode
JOIN analysis.pairs pa ON pa.pair_barcode = tp.pair_barcode
JOIN analysis.analyte_sets an ON pa.tumor_barcode = an.dna_barcode
JOIN biospecimen.aliquots al ON an.rna_barcode = al.aliquot_barcode
"

pur <- dbGetQuery(con,q)

all_purity <- merge(pur,estimate,by.x="rna_barcode",by.y="aliquot_barcode")

wxs_purity <- all_purity[grep("-WXS-",all_purity[,"tumor_barcode"]),]

cor(wxs_purity[,c(4,5,10)],method="s")

#---------------------------------

#Check TCGA purity with previous values

tcga_pur <- read.delim("/projects/varnf/Data/TCGA/TCGA_purity.txt")

glass_tcga <- all_purity[grep("TCGA-",all_purity[,"sample_barcode"]),]
glass_tcga[,"sample_barcode"] <- gsub("-TP$","-01A", glass_tcga[,"sample_barcode"])
glass_tcga[,"sample_barcode"] <- gsub("-R1$","-02A", glass_tcga[,"sample_barcode"])
glass_tcga[,"sample_barcode"] <- gsub("-R2$","-02B", glass_tcga[,"sample_barcode"])

#Manual change
glass_tcga[13,"sample_barcode"] <- "TCGA-14-1034-02B"
glass_tcga[32,"sample_barcode"] <- "TCGA-14-1034-01B"

tcga_all <- merge(glass_tcga,tcga_pur,by.x="sample_barcode",by.y="Sample.ID")
cor(tcga_all[,"est_purity"],tcga_all[,"ESTIMATE"],method="s",use="complete")

#---------------------------------
#Compare RPKM ESTIMATE purity with TPM ESTIMATE purity

expr <- read.delim("/projects/varnf/GLASS/data/CIBERSORT/synapse_final_RNAseq.txt",sep="\t",header=T,stringsAsFactor=F)
expr <- expr[,c(1,20:ncol(expr))]
rownames(expr) <- expr[,1]
expr <- expr[,-1]
expr <- t(expr)
gene_symbol <- rownames(expr)
expr <- data.frame(gene_symbol,expr)
write.table(expr,"/projects/varnf/GLASS/data/CIBERSORT/RPKM_matrix.txt",sep="\t",row.names=FALSE,quote=FALSE)

filterCommonGenes("/projects/varnf/GLASS/data/CIBERSORT/RPKM_matrix.txt", "/projects/varnf/GLASS/data/CIBERSORT/RPKM_matrix_filtered.txt",id="GeneSymbol")
estimateScore("/projects/varnf/GLASS/data/CIBERSORT/RPKM_matrix_filtered.txt","/projects/varnf/GLASS/data/CIBERSORT/RPKM_matrix_filtered_estimate.txt","affymetrix")

estimate <- t(read.delim("/projects/varnf/GLASS-III/GLASS-III/data/sigs/gene_tpm_matrix_all_samples_estimate_scores.txt"))
colnames(estimate) <- estimate[2,]
estimate <- estimate[-c(1,2),]
aliquot_barcode <- gsub("\\.","-",estimate[,2])
estimate <- estimate[,3:5]
estimate <- apply(estimate,2,as.numeric)
est_purity <- cos(0.6049872018+0.0001467884 * estimate[,"ESTIMATEScore"])
estimate <- data.frame(aliquot_barcode,estimate,est_purity)
tpm_estimate <- estimate

estimate <- t(read.delim("/projects/varnf/GLASS/data/CIBERSORT/RPKM_matrix_filtered_estimate.txt"))
colnames(estimate) <- estimate[2,]
estimate <- estimate[-c(1,2),]
aliquot_barcode <- gsub("\\.","-",estimate[,2])
estimate <- estimate[,3:5]
estimate <- apply(estimate,2,as.numeric)
est_purity <- cos(0.6049872018+0.0001467884 * estimate[,"ESTIMATEScore"])
estimate <- data.frame(aliquot_barcode,estimate,est_purity)
rpkm_estimate <- estimate

tpm_estimate[,"sample_barcode"] <- substr(tpm_estimate[,"aliquot_barcode"],1,15)

full_estimate <- merge(tpm_estimate,rpkm_estimate,by.x="sample_barcode",by.y="aliquot_barcode")

cor(full_estimate[,"est_purity.x"],full_estimate[,"est_purity.y"],method="s")


first.year.on.plot<-1975
last.year.on.plot<-2010

palette("default")                # good for clolorfull plots
#palette(gray(seq(0,.9,len=6)))  # gray scale for papers, use len =500 to get black only

  dirs<-c("NS_old-key","NS_74-13-Oct-2014")
 labels<-c("2011","2014")

 dirs<-c("NS-2015-ver01", "NS-2015-ver02","NS-2015-ver04", "NS-2015-ver04","NS-2015-ver05")
 labels<-c("NS-2015-ver01", "NS-2015-ver02","NS-2015-ver04", "NS-2015-ver04","NS-2015-ver05")

dirs<-c("NS_63-10-sep-2014", "v05-NS-2015")
labels<-c("2011-run", "2015-run")

for (dir in dirs) {
  if ( file.access(file.path(root,dir,"sms.dat"), mode = 0)!=0)  stop(paste('Directory',dir,'does not exist'))
}

Init.function() # get SMS.contol object  including sp.names

  for (dir in dirs) {
     a<-Read.summary.data(dir=file.path(root,dir),read.init.function=F)
     a<-subset(a,(Year>=first.year.on.plot & Year<=last.year.on.plot & Age==SMS.control@first.age & Quarter==SMS.control@rec.season & M>0),
    select=c(Species,Species.n, Year,N) ,drop=T)
      a$label<-labels[ which(dirs==dir)]
    a$N<-a$N/1000000
   if (dir==dirs[1]) all<-a else all<-rbind(all,a)
}

all<-subset(all,Species!='Saithe')

a<-aggregate(all$N,list(Species=all$Species),mean)
all<-merge(a,all,sort=F)
all$relRec<-all$N/all$x

all<-all[order(all$label,all$Species.n,all$Year),]

cleanup()
#trellis.device(device = "windows",   color = F, width=9, height=9,pointsize = 2, new = TRUE, retain = FALSE)

print(xyplot( N~Year|Species,groups=label, data=all,
  type='b',lwd=1 , layout=c(3,3), ylab='Recruitment (10^9)',
   strip = strip.custom( bg='white'),par.strip.text=list(cex=1, lines=1.7),
   auto.key = list(space = "bottom", points = T, lines = F,cex=1, columns = 2) ,

    scales = list(x = list( cex=0.8), y= list(cex=0.8),alternating = 1,relation='free')
))

print(xyplot( relRec~Year|Species,groups=label, data=all,
  type='b',lwd=1 , layout=c(4,3), ylab='Standardised recruitment',  lty=1,
   strip = strip.custom( bg='white'),par.strip.text=list(cex=1, lines=1.7),
   auto.key = list(space = "bottom", points = T, lines = F,cex=1, columns = 2) ,

    scales = list(x = list( cex=0.8), y= list(cex=0.8),alternating = 1,relation='same')
))


# Install the required packages
install.packages("e1071")
library(e1071)
install.packages("MESS")
library(MESS)

# Get the CSV files
openA <- read.csv('~/Downloads/OpenRevs/OpenReviewsPerQuarter.csv', header = T)
openAuthRec <- read.csv('~/Downloads/OpenRevs/OpenReviewsAuthRecPerQuarter.csv', header = T)
openOwnRec <- read.csv('~/Downloads/OpenRevs/OpenReviewsOwnRecPerQuarter.csv', header = T)
opencH <- read.csv('~/Downloads/OpenRevs/OpenReviewscHRevPerQuarter.csv', header = T)
openLearnRec <- read.csv('~/Downloads/OpenRevs/OpenReviewsLearnRecPerQuarter.csv', header = T)
openRet <- read.csv('~/Downloads/OpenRevs/OpenReviewsRetentionRecPerQuarter.csv', header = T)
openTurnRec <- read.csv('~/Downloads/OpenRevs/OpenReviewsTurnRecPerQuarter.csv', header = T)
openSV1 <- read.csv('~/Downloads/OpenRevs/OpenReviewsSofiaV1PerQuarter.csv', header = T)
openWhoDo <- read.csv('~/Downloads/OpenRevs/OpenReviewsWhoDoPerQuarter.csv', header = T)
openSV2 <- read.csv('~/Downloads/OpenRevs/OpenReviewsSofiaV2PerQuarter.csv', header = T)

#convience function
percentage_difference <- function(a, s) {
  ((s/a)-1) *100
}

#Calculate actual review concentration
#empirical result showing the tight concentration of top reviewers, ie 80-20 rule
plot_percentage_percentage(percentage_percentage_freq(openA$CoreFX))
plot_line_percentage_percentage(percentage_percentage_freq(openA$CoreCLR), lty = 2)
plot_line_percentage_percentage(percentage_percentage_freq(openA$Roslyn), lty = 3)
plot_line_percentage_percentage(percentage_percentage_freq(openA$Rust), lty = 4)
plot_line_percentage_percentage(percentage_percentage_freq(openA$Kubernetes), lty = 5)

percentage_difference_pp <- function(a, s, p) {
  (get_cumulative_at_df(percentage_percentage_freq(s), p)/get_cumulative_at_df(percentage_percentage_freq(a), p)-1) *100
}

percentage_difference_pp(openA$Kubernetes, openOwnRec$Kubernetes, 20)

#Simulation, how does the recommender change the 80-20 distribution?
percentage_difference_pp_all <- function(a, s, p) {
  r <- c(percentage_difference_pp(a$CoreFX, s$CoreFX, p),
    percentage_difference_pp(a$CoreCLR, s$CoreCLR, p),
    percentage_difference_pp(a$Roslyn, s$Roslyn, p),
    percentage_difference_pp(a$Rust, s$Rust, p),
    percentage_difference_pp(a$Kubernetes, s$Kubernetes, p)
  )
  print(mean(r))
  r
}

get_y_cumulative_at_percentage(na.omit(openA$CoreFX), 80)

percentage_difference(auc(percentage_percentage_freq(openA$Kubernetes)$percentage, seq(1:length(na.omit(openA$Kubernetes)))),
  auc(percentage_percentage_freq(openWhoDo$Kubernetes)$percentage, seq(1:length(na.omit(openWhoDo$Kubernetes))))
)

auc_difference_percentage <- function(a, s) {

  da <- percentage_percentage_freq(a);
  ds <- percentage_percentage_freq(s);

  #total area
  #percentage_difference(auc(da$percentage, da$cumulative, from = 1, to = 100), auc(ds$percentage, ds$cumulative, from = 1, to = 100))

  #relative getting rid of the area that is impossible to achieve based on cumulative distribution and rank (is a weighted avg)
  percentage_difference(auc(da$percentage, da$cumulative)-5000, auc(ds$percentage, ds$cumulative)-5000)

  #normal wrt actual and simulated
  #db <- percentage_percentage_freq(openA$Kubernetes)
  #percentage_difference(
  #                      auc(db$percentage, db$cumulative)-auc(ds$percentage, ds$cumulative),
  #                      auc(db$percentage, db$cumulative)- 5000
  #                      )

  #relative to the lowest one
  #db <- percentage_percentage_freq(openWhoDo$Kubernetes)
  #percentage_difference(auc(da$percentage, da$cumulative)-auc(db$percentage, db$cumulative),
  #  auc(ds$percentage, ds$cumulative)-auc(db$percentage, db$cumulative))

}

auc_total <- function(s) {

  ds <- percentage_percentage_freq(s);
  (auc(ds$percentage, ds$cumulative)-5000)/5000*100
}

auc_total(openOwnRec$Kubernetes) - auc_total(openA$Kubernetes)
auc_total(openWhoDo$Kubernetes) - auc_total(openA$Kubernetes)

auc_difference_percentage(openA$Kubernetes, openAuthRec$Kubernetes)
auc_difference_percentage(openA$Kubernetes, openOwnRec$Kubernetes)
auc_difference_percentage(openA$Kubernetes, opencH$Kubernetes)
auc_difference_percentage(openA$Kubernetes, openLearnRec$Kubernetes)
auc_difference_percentage(openA$Kubernetes, openRet$Kubernetes)
auc_difference_percentage(openA$Kubernetes, openTurnRec$Kubernetes)
auc_difference_percentage(openA$Kubernetes, openSV1$Kubernetes)
auc_difference_percentage(openA$Kubernetes, openWhoDo$Kubernetes)
auc_difference_percentage(openA$Kubernetes, openSV2$Kubernetes)

p = 20
percentage_difference_pp_all(openA, openAuthRec, p)
percentage_difference_pp_all(openA, openOwnRec, p)
percentage_difference_pp_all(openA, opencH, p)
percentage_difference_pp_all(openA, openLearnRec, p)
percentage_difference_pp_all(openA, openRet, p)
percentage_difference_pp_all(openA, openTurnRec, p)
percentage_difference_pp_all(openA, openSV1, p)
percentage_difference_pp_all(openA, openWhoDo, p)
percentage_difference_pp_all(openA, openSV2, p)

percentage_pp_all <- function(d, p) {
  r <- c(get_cumulative_at_df(percentage_percentage_freq(d$CoreFX), p),
    get_cumulative_at_df(percentage_percentage_freq(d$CoreCLR), p),
    get_cumulative_at_df(percentage_percentage_freq(d$Roslyn), p),
    get_cumulative_at_df(percentage_percentage_freq(d$Rust), p),
    get_cumulative_at_df(percentage_percentage_freq(d$Kubernetes), p)
  )
  print(mean(r))
  #print(100-mean(r))
  r
}

#raw value for pp
p = 20
percentage_pp_all(openA, p)
percentage_pp_all(openAuthRec, p)
percentage_pp_all(openOwnRec, p)
percentage_pp_all(opencH, p)
percentage_pp_all(openLearnRec, p)
percentage_pp_all(openRet, p)
percentage_pp_all(openTurnRec, p)
percentage_pp_all(openSV1, p)
percentage_pp_all(openWhoDo, p)
percentage_pp_all(openSV2, p)

#how does the percentile change?
percentile_difference_all <- function(a, s, p) {
  pd <- p/100
  r <- c(
    percentage_difference(quantile(a$CoreFX, pd, na.rm = T, names = F), quantile(s$CoreFX, pd, na.rm = T, names = F)),
    percentage_difference(quantile(a$CoreCLR, pd, na.rm = T, names = F), quantile(s$CoreCLR, pd, na.rm = T, names = F)),
    percentage_difference(quantile(a$Roslyn, pd, na.rm = T, names = F), quantile(s$Roslyn, pd, na.rm = T, names = F)),
    percentage_difference(quantile(a$Rust, pd, na.rm = T, names = F), quantile(s$Rust, pd, na.rm = T, names = F)),
    percentage_difference(quantile(a$Kubernetes, pd, na.rm = T, names = F), quantile(s$Kubernetes, pd, na.rm = T, names = F))
  )
  print(mean(r))
  r

}

pd = .5
percentage_difference(openA$Kubernetes, pd, na.rm = T, names = F)
quantile(openOwnRec$Kubernetes, pd, na.rm = T, names = F)

#percentile
p = 20
percentile_difference_all(openA, openAuthRec, p)
percentile_difference_all(openA, openOwnRec, p)
percentile_difference_all(openA, opencH, p)
percentile_difference_all(openA, openLearnRec, p)
percentile_difference_all(openA, openRet, p)
percentile_difference_all(openA, openTurnRec, p)
percentile_difference_all(openA, openSV1, p)
percentile_difference_all(openA, openWhoDo, p)
percentile_difference_all(openA, openSV2, p)

#What percentage of reviewers do 80% of the work?

#plots for individual projects
plot(seq(1:100), seq(1:100), type = 'l', lwd = 3, lty = 1, ylab = "Cumulative Percentage of Reviews", xlab = "Percentage of Reviewers")
plot_line_percentage_percentage(percentage_percentage_freq(openA$Kubernetes), lty = 2)
plot_line_percentage_percentage(percentage_percentage_freq(openAuthRec$Kubernetes), lty = 1)
plot_line_percentage_percentage(percentage_percentage_freq(openOwnRec$Kubernetes), lty = 3)
plot_line_percentage_percentage(percentage_percentage_freq(opencH$Kubernetes), lty = 4)
plot_line_percentage_percentage(percentage_percentage_freq(openLearnRec$Kubernetes), lty = 4)
plot_line_percentage_percentage(percentage_percentage_freq(openRet$Kubernetes), lty = 3)
plot_line_percentage_percentage(percentage_percentage_freq(openSV1$Kubernetes), lty = 6)
plot_line_percentage_percentage(percentage_percentage_freq(openWhoDo$Kubernetes), lty = "dotted")
plot_line_percentage_percentage(percentage_percentage_freq(openSV2$Kubernetes), lty = 4)

pdf("~/Downloads/WorkloadAUCExample.pdf")
plot(seq(1:100), seq(1:100), type = 'l', lwd = 3, lty = "twodash", ylab = "Cumulative Percentage of Reviews", xlab = "Percentage of Reviewers")
plot_line_percentage_percentage(percentage_percentage_freq(openA$Kubernetes), lty = "solid")
plot_line_percentage_percentage(percentage_percentage_freq(openOwnRec$Kubernetes), lty = "dotted", pch = 2)
plot_line_percentage_percentage(percentage_percentage_freq(openWhoDo$Kubernetes), lty = "dashed", pch = 6)
abline(v = 20)
legend(50, 20, legend=c("Past Reviewers Rec", "Actual Workload", "Workload Aware Rec", "Perfectly Equal Workload"), lty=c('dotted', 'solid', 'dashed', 'twodash'), lwd = 3, cex=1.2)
dev.off()

pdf("~/Downloads/WorkloadAUCDiscussion.pdf")
plot(seq(1:100), seq(1:100), type = 'l', lwd = 3, lty = "solid", ylab = "Cumulative Percentage of Reviews", xlab = "Percentage of Reviewers")
plot_line_percentage_percentage(percentage_percentage_freq(openA$Rust), lty = "solid")
plot_line_percentage_percentage(percentage_percentage_freq(openOwnRec$Rust), lty = "dotted", pch = 2)
plot_line_percentage_percentage(percentage_percentage_freq(openSV2$Rust), lty = "twodash", pch = 6)
plot_line_percentage_percentage(percentage_percentage_freq(openWhoDo$Rust), lty = "dashed", pch = 6)
#plot_line_percentage_percentage(percentage_percentage_freq(openLearnRec$Rust), lty = "dashed", pch = 6)
abline(v = 1.5)
abline(v = 10)
abline(v = 20)
abline(h = 80)
abline(h = 60)
abline(h = 20)
legend(50, 20, legend=c("RevOwnRec", "Actual Workload", "SofiaWL", "WhoDo", "x = y"), lty=c('dotted', 'solid', 'twodash', 'dashed', 'solid'), lwd = 3, cex=1.2)
dev.off()

#legend(50, 20, legend=c("RevOwnRec", "Actual Workload", "LearnRec", "x = y"), lty=c('dotted', 'solid', 'dashed', 'solid'), lwd = 3, cex=1.2)

#skewness
percentage_difference(skewness(openA$Kubernetes, na.rm = TRUE), skewness(openAuthRec$Kubernetes, na.rm = TRUE))
percentage_difference(skewness(openA$Kubernetes, na.rm = TRUE), skewness(openOwnRec$Kubernetes, na.rm = TRUE))
percentage_difference(skewness(openA$Kubernetes, na.rm = TRUE), skewness(opencH$Kubernetes, na.rm = TRUE))
percentage_difference(skewness(openA$Kubernetes, na.rm = TRUE), skewness(openLearnRec$Kubernetes, na.rm = TRUE))
percentage_difference(skewness(openA$Kubernetes, na.rm = TRUE), skewness(openRet$Kubernetes, na.rm = TRUE))
percentage_difference(skewness(openA$Kubernetes, na.rm = TRUE), skewness(openTurnRec$Kubernetes, na.rm = TRUE))
percentage_difference(skewness(openA$Kubernetes, na.rm = TRUE), skewness(openSV1$Kubernetes, na.rm = TRUE))
percentage_difference(skewness(openA$Kubernetes, na.rm = TRUE), skewness(openWhoDo$Kubernetes, na.rm = TRUE))
percentage_difference(skewness(openA$Kubernetes, na.rm = TRUE), skewness(openSV2$Kubernetes, na.rm = TRUE))


library(dplyr)

# A class for storing and manipulating data relating to one race/ethnicity
RaceData <- setRefClass(
  "RaceData",
  fields = c('sql_conn', 'town_data', 'county_data'),
  methods = list(
    initialize = function(sql_conn, counties, pop_col1, pop_col2) {
      # Arguments:
      #  * sql_conn:  A dplyr PostgreSQL connection
      #   * Should be a connection to the database with all Census tables
      #  * pop_col1:  Name of the column containing population data for a race (town)
      #  * pop_col2:  Same as above but for cunties
      #  * counties:  A GeoJSON with county boundary information

      sql_conn <<- sql_conn
      town_data <<- get_town_data(sql_conn, pop_col1)
      county_data <<- left_join(counties@data,
                                get_county_data(sql_conn, pop_col2),
                                by='geo_id')

    },

    # Get largest absolute populations of X race
    get_town_top_n = function(n=25) {
      return(collect(
        .self$town_data %>%
          arrange(desc(race_pop))) %>%
          slice(1:n)
        )
    }
))

# Get data for the race/ethnicity and join it with geographical information
get_town_data = function(sql_conn, pop_col) {
  # Arguments:
  #  * pop_col: Name of the column containing population data for a race

  sql_query = sprintf(
    "SELECT
          geo_display_label AS town,
          CAST(hd01_s001 AS INTEGER) AS total_pop,
          CAST(%s AS INTEGER) as race_pop,
          CAST(%s AS FLOAT8)/CAST(hd01_s001 AS FLOAT8) AS race_percent,
          CAST(intptlat AS FLOAT8) AS latitude,
          CAST(intptlong AS FLOAT8) AS longitude
         FROM population JOIN geography
          ON geography.geoid = population.geoid
         WHERE CAST(hd01_s001 AS INTEGER) > 0",
    pop_col, pop_col)

  return(tbl(sql_conn, sql(sql_query)))
}

# Get county data
get_county_data = function(sql_conn, pop_col) {
  sql_query = sprintf(
    "SELECT
      geo_id,
      geo_display_label AS county_name,
      CAST(hd01_vd01 AS INTEGER) AS total_pop,
      CAST(%s AS INTEGER) as race_pop,
      CAST(%s AS FLOAT8)/CAST(hd01_vd01 AS FLOAT8) as race_percent
     FROM acs15_race_county",
    pop_col, pop_col)

  data <- collect(tbl(sql_conn, sql(sql_query)))

  return(data)
}