library(Seurat)
library(ggplot2)
library(cowplot)
library(data.table)
library(DoubletFinder)
library(pheatmap)

rm(list=ls())
gc()

scale_colour_discrete=function(...) {scale_colour_brewer(..., palette="Set2")}
scale_fill_discrete=function(...) {scale_fill_brewer(...,palette="Set2")}
color=c(RColorBrewer::brewer.pal(8,"Set2"),RColorBrewer::brewer.pal(9,"Set1"),RColorBrewer::brewer.pal(6,"Set3"),RColorBrewer::brewer.pal(10,"RdYlGn"),RColorBrewer::brewer.pal(10,"BrBG"),RColorBrewer::brewer.pal(10,"PiYG"),RColorBrewer::brewer.pal(10,"PuOr"),RColorBrewer::brewer.pal(10,"RdBu"),RColorBrewer::brewer.pal(10,"PRGn"))

write_csv = function(vec, fn){write.table(vec, file = fn, append = FALSE, quote = FALSE, sep = ",",
            eol = "\n", na = "NA", dec = ".", row.names = TRUE,
            col.names = TRUE, qmethod = c("escape", "double"),
            fileEncoding = "")}

input='./'
setwd(input)
exprs=read.csv(paste0(input,'data/gene_expression.csv'), row.names=1, header=T , check.names = F)
exprs=t(exprs)
meta=read.csv(paste0(input,'data/metadata.csv'), row.names=1, header=T, check.names = F)
meta=meta[colnames(exprs),]
subject=read.csv(paste0(input,'data/subject_info.csv'), header=T, check.names = F)
group=as.character(subject$)

# remove doublet
# here doubled are similated within each subject, consider whether need to be changed based on the sequencing library
output = '[PATH]/Seurat_analysis/'
output1=paste0(output,'1.doublets/')
dir.create(output1,showWarning=F)

per = 0.01  # percentage of doublets which need to be removed, may need to be changed
usample=unique(as.character(meta$subject_id))

for (i in 1:length(usample)) {

  toutput=paste0(output1,usample[i],'/')
    dir.create(toutput,showWarning=F)
    setwd(toutput)
    sdata=exprs[,which(as.character(meta$subject_id) %in% usample[i])]

  brain = CreateSeuratObject(sdata)
  brain = NormalizeData(brain, normalization.method = "LogNormalize", scale.factor = 10000)
  brain = ScaleData(brain)
  brain = FindVariableFeatures(brain, selection.method = "vst", nfeatures = 2000)
  brain = RunPCA(brain, features = VariableFeatures(object = brain), npcs = 50)
  brain = RunUMAP(brain, dims = 1:30)
  sweep.res.list = paramSweep_v3(brain, PCs=1:30, sct = FALSE)
  sweep.stats = summarizeSweep(sweep.res.list, GT = FALSE)
  pdf(paste0("1.find.pK.pdf"))
  bcmvn = find.pK(sweep.stats)
  dev.off()
  pk = as.numeric(as.character(bcmvn$pK[which.max(bcmvn$BCmetric)]))

  nExp_poi = round(per*ncol(brain))

  brain = doubletFinder_v3(brain, PCs=1:30, pN = 0.25, pK = pk, nExp = nExp_poi, reuse.pANN = FALSE, sct = FALSE)

  brain@meta.data[,paste0("DF_hi.lo_",per)] = brain@meta.data[,paste0('DF.classifications_0.25_',pk,'_',nExp_poi)]
  brain@meta.data[,paste0("pANN_",per)] = brain@meta.data[,paste0('pANN_0.25_',pk,'_',nExp_poi)]

  pdf(paste0("0.doublet.",per,".pdf"), width = 5, height = 5)
  print(DimPlot(object = brain, reduction = "umap", group.by=paste0("DF_hi.lo_",per), order=c("Doublet","Singlet"), cols=c("black","red")))
  print(FeaturePlot(object = brain, reduction = "umap", features = c("nCount_RNA"), cols = c("grey", "blue")))
  print(FeaturePlot(object = brain, reduction = "umap", features = c("nFeature_RNA"), cols = c("grey", "blue")))
  dev.off()
  singletname=rownames(brain@meta.data[which(brain@meta.data[,paste0("DF_hi.lo_",per)] %in% 'Singlet'),])
  cbrain.data=sdata[,singletname]
  #smeta=FetchData(object = brain, vars = c("nCount_RNA", "nFeature_RNA", "percent.mito", "pANN_0.075", "DF_hi.lo_0.075"))
  smeta=FetchData(object = brain, vars = c("nCount_RNA", "nFeature_RNA", paste0("pANN", per), paste0("DF_hi.lo_",per)))

  if (i==1) {
        abrain.data=cbrain.data
    } else {
        abrain.data=cbind(abrain.data,cbrain.data)
    }

    if (i==1) {
        abrain.meta=smeta
    } else {
        abrain.meta=rbind(abrain.meta,smeta)
    }
}

setwd(output1)
saveRDS(abrain.data, file=paste0('0.exprs.matrix.rm.mit.doublets',per,'.all.rds'))
write_csv(abrain.meta, 'doublets.csv')

# build the Seurat object
soutput=paste0(output,'2.seurat.analysis/')
dir.create(soutput,showWarning=F)
setwd(soutput)

usample=c("NPBB113","NPBB052","NPBB098","NPBB105","NPBB135","NPBB138","NPBB139","NPBB137","NPBB131")
group1=c('Ctrl','Ctrl','Ctrl','Ctrl','COVID','COVID','COVID','COVID','COVID_HIV')
group2=c('Ctrl','Ctrl','Ctrl','Ctrl','COVID','COVID','COVID','COVID','COVID')
names(group1)=usample
names(group2)=usample

abrain.meta.data=meta[colnames(abrain.data),]
abrain.meta.data$group1=group1[as.character(abrain.meta.data$subject_id)]
abrain.meta.data$group2=group2[as.character(abrain.meta.data$subject_id)]

abrain=CreateSeuratObject(counts = abrain.data, meta.data=abrain.meta.data)
abrain[["percent.mito"]] = PercentageFeatureSet(object = abrain, pattern = "^MT-")
abrain=NormalizeData(object = abrain, normalization.method = "LogNormalize", scale.factor = 10000)
abrain=FindVariableFeatures(object = abrain, selection.method = "vst", nfeatures = 2000)

abrain=ScaleData(object = abrain, vars.to.regress = c("percent.mito"))
abrain=RunPCA(object = abrain, features = VariableFeatures(object = abrain), npcs = 100, verbose = FALSE)
abrain=ProjectDim(object = abrain, verbose = FALSE)

npc=20
abrain=FindNeighbors(object = abrain, dims = 1:npc, k.param = 100)
abrain=FindClusters(object = abrain, resolution = 0.2, graph.name = 'RNA_snn')
abrain=RunUMAP(object = abrain, min.dist = 1.5, graph = 'RNA_snn')

pdf(paste0("2.seurat.analysis.pdf"))
DimPlot(object = abrain, reduction='pca', cols=color, group.by = 'group2')
ElbowPlot(object = abrain, ndims = 100)
DimPlot(abrain, cols=color)
DimPlot(abrain, cols=color, label=T)
DimPlot(abrain, cols=color, group.by = 'subject_id')
DimPlot(abrain, cols=color, group.by = 'group1')
DimPlot(abrain, cols=color, group.by = 'group2')
DimPlot(abrain, cols=color, group.by = 'tissue')
FeaturePlot(object = abrain, reduction='umap', features = c('nCount_RNA'))
FeaturePlot(object = abrain, reduction='umap', features = c('nFeature_RNA'))
dev.off()

meta.data=abrain@meta.data
saveRDS(abrain, file = "seurat.object.rds")


library(stringr)
library(reshape2)
library(ggplot2)
library(scales)

filenames_all <- list.files(path = "datasets/AllAttributes/",pattern = ".csv",full.names = TRUE)
ldf <- lapply(filenames_all, read.csv, skip=0, header=TRUE, sep=";",blank.lines.skip = TRUE,strip.white = TRUE, colClasses = rep("character",7))
for(i in seq(from=1,to=length(filenames_all),by = 1)){
  ldf[[i]]$Dataset <- sapply(str_split(filenames_all, '/'), '[', 4)[i]
  ldf[[i]]$Attributes <- "All"
}

filenames_sel <- list.files(path = "datasets/ReliefFAttributeEval-FS//",pattern = ".csv",full.names = TRUE)
ldf_s <- lapply(filenames_sel, read.csv, skip=0, header=TRUE, sep=";",blank.lines.skip = TRUE,strip.white = TRUE, colClasses = rep("character",7))
for(i in seq(from=1,to=length(filenames_sel),by = 1)){
  ldf_s[[i]]$Dataset <- sapply(str_split(filenames_sel, '/'), '[', 5)[i]
  ldf_s[[i]]$Attributes <- "ReliefFAttributeEval-FS"
}

filenames_som <- list.files(path = "datasets/SOM-FS//",pattern = ".csv",full.names = TRUE)
ldf_som <- lapply(filenames_som, read.csv, skip=0, header=TRUE, sep=";",blank.lines.skip = TRUE,strip.white = TRUE, colClasses = rep("character",7))
for(i in seq(from=1,to=length(filenames_som),by = 1)){
  ldf_som[[i]]$Dataset <- sapply(str_split(filenames_som, '/'), '[', 5)[i]
  ldf_som[[i]]$Attributes <- "SOM-FS"
}

filenames_cfs <- list.files(path = "datasets/CfsSubsetEval-FS//",pattern = ".csv",full.names = TRUE)
ldf_cfs <- lapply(filenames_cfs, read.csv, skip=0, header=TRUE, sep=";",blank.lines.skip = TRUE,strip.white = TRUE, colClasses = rep("character",7))
for(i in seq(from=1,to=length(filenames_cfs),by = 1)){
  ldf_cfs[[i]]$Dataset <- sapply(str_split(filenames_cfs, '/'), '[', 5)[i]
  ldf_cfs[[i]]$Attributes <- "CfsSubsetEval-FS"
}

m_all <- do.call(rbind,ldf)
m_sel <- do.call(rbind,ldf_s)
m_som <- do.call(rbind,ldf_som)
m_cfs <- do.call(rbind,ldf_cfs)

m <- rbind(m_all,m_sel)
m <- rbind(m,m_som)
m <- rbind(m,m_cfs)

rm(m_all,m_sel,m_som,m_cfs,ldf,ldf_s,ldf_som,ldf_cfs,filenames_sel,filenames_all,filenames_som,filenames_cfs,i)

datos <- melt(data = m,id.vars = c("Method","Dataset","Attributes"),measure.vars = c("R.","MAE","RMSE","RAE","RRSE","TIME"),)

datos$Dataset <- str_replace(datos$Dataset,".csv","")

datos$error <- as.numeric(sapply(str_split(datos$value, '_'), '[', 2))
datos$value <- as.numeric(sapply(str_split(datos$value, '_'), '[', 1))

datos$variable <- as.character(datos$variable)
datos[datos$variable=="R.","variable"] <- "R"
dataset = unique(datos$Dataset)

datos$Dataset <- factor(datos$Dataset,c("PublishingCo-UDL929","PublishingCo-UDLW12","PublishingCo-UDL704","PublishingCo-UDLU11"))
datos$variable <- factor(datos$variable, c("R","MAE","RMSE","RAE","RRSE","TIME"))

#ggplot(data = subset(datos,Dataset==dataset[1]), aes(x=Attributes,y=value,color=Attributes,shape=Attributes)) + geom_point(stat="identity",size=3) +
#  facet_grid(variable ~ Method,scales = "free_y",labeller = as_labeller(expression()) +
#  scale_color_grey(start=0.0,end=0.2) + labs(title=dataset[1],x="",y="") +
#  geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.2,size=0.25) + theme_bw()  + theme(legend.position="bottom", axis.title.x=element_blank(),
#                                                                                axis.text.x=element_blank(),
#                                                                                axis.ticks.x=element_blank())

#ggplot(data = subset(datos,Dataset==dataset[1]), aes(x=Attributes,y=value,fill=Attributes,shape=Attributes)) + geom_bar(stat="identity") +
#  facet_grid(variable ~ Method,scales = "free_y",) +
#  scale_fill_grey(start=0.2,end=0.6) + labs(title=dataset[1],x="",y="") +
#  geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.5,size=0.5) + theme_bw()  + theme(legend.position="bottom", axis.title.x=element_blank(),
#                                                                                axis.text.x=element_blank(),
#                                                                                axis.ticks.x=element_blank())

# Publisher > Method > Metric > Attribute Selection

dataset = unique(datos$Dataset)

for(i in dataset){
  print(ggplot(data = subset(datos,Dataset==i), aes(x=Attributes,y=value,fill=Attributes,shape=Attributes)) + geom_point(size=2) + geom_bar(stat="identity") +
    facet_grid(variable ~ Method,scales = "free_y") +
    scale_fill_grey(start=0.6,end=0.8) + labs(title=i,x="",y="") +
    geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.5,size=0.5) + theme_bw()  +
    theme(legend.position="bottom", axis.title.x=element_blank(),axis.ticks.x=element_blank(), axis.text.x = element_text(angle = 90, hjust = 1)) +
    scale_y_continuous(limits = c(0, NA),oob=squish))

  ggsave(file=paste0("../imgs/datasets_",i,".eps"),scale=2,units = "cm", width = 16, height = 8,dpi = 800)
  ggsave(file=paste0("../imgs/datasets_",i,".png"),scale=2,units = "cm", width = 16, height = 8,dpi = 800)
}

# Attribute Selection > Publisher > Method > Metric

att = unique(datos$Attributes)

#for(i in dataset){
  for(j in att){

print(ggplot(data = subset(datos,Attributes==j), aes(x=Method,y=value,fill=Method)) +
  geom_point(stat="identity",size=2)  + geom_bar(stat="identity") +
  facet_grid(variable ~ Dataset,scales = "free_y") +
  scale_fill_grey(start=0.2,end=0.6) + labs(title=j,x="",y="") +
  geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.2,size=0.25) + theme_bw()  + theme(legend.position="right") +
    scale_y_continuous(limits = c(0, NA),oob=squish)
  )

  ggsave(file=paste0("../imgs/attribute_",j,".png"),scale=2,units = "cm", width = 14, height = 8,dpi = 800)
  ggsave(file=paste0("../imgs/attribute_",j,".eps"),scale=2,units = "cm", width = 14, height = 8,dpi = 800)

  }

t <- subset(datos,Attributes=="All")

print(ggplot(data = t, aes(x=Method,y=value,fill=Method)) +
        geom_point(stat="identity",size=2)  + geom_bar(stat="identity") +
        facet_grid(variable ~ Dataset,scales = "free_y") +
        scale_fill_grey(start=0.2,end=0.6) + labs(title="All features",x="",y="") +
        geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.5,size=0.5) + theme_bw()  + theme(legend.position="right") +
        scale_y_continuous(limits = c(0, NA),oob=squish)
)
j = "All"
ggsave(file=paste0("../imgs/attribute_",j,".png"),scale=2,units = "cm", width = 14, height = 8,dpi = 800)
ggsave(file=paste0("../imgs/attribute_",j,".eps"),scale=2,units = "cm", width = 14, height = 8,dpi = 800)

var = unique(datos$variable)

for(i in var){

  ggplot(data = subset(datos,variable==i), aes(x=Method,y=value)) + geom_point(stat="identity",size=3) +
    geom_bar(stat="identity",size=3) +
    facet_grid(Dataset ~ Attributes,scales = "free_y") +
    scale_fill_grey(start=0.2,end=0.8) + labs(title=i,x="Method",y="Seconds") +
    geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.2,size=0.25) + theme_bw()  + theme(legend.position="bottom") +
    scale_y_continuous(limits = c(0, NA),oob=squish)

  ggsave(file=paste0("../imgs/metric_",i,".eps"),scale=2.5,units = "cm", width = 16, height = 8,dpi = 800)
  ggsave(file=paste0("../imgs/metric_",i,".png"),scale=2.5,units = "cm", width = 16, height = 8,dpi = 800)
}

#Figure to replace Table 3
all <- read.csv(file = "datasets/all.csv",skip=0, header=TRUE, sep=";",blank.lines.skip = TRUE,strip.white = TRUE, colClasses = rep("character",7))

all <- melt(data = all,id.vars = c("Method"),measure.vars = c("R.","MAE","RMSE","RAE","RRSE","TIME"))

all$error <- as.numeric(sapply(str_split(all$value, '_'), '[', 2))
all$value <- as.numeric(sapply(str_split(all$value, '_'), '[', 1))

all$variable <- as.character(all$variable)
all[all$variable=="R.","variable"] <- "R"

all$variable <- factor(all$variable, c("R","MAE","RMSE","RAE","RRSE","TIME"))

ggplot(data = subset(all), aes(x=Method,y=value)) +
  geom_bar(aes(fill=Method),stat="identity",size=3) + geom_point(stat="identity",size=3) +
  facet_grid(variable ~ . ,scales = "free_y") +
  scale_fill_grey(start=0.2,end=0.6) + labs(title="",x="",y="") +
  geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.2,size=0.25) + theme_bw()  + theme(legend.position="right") +
  scale_y_continuous(limits = c(0, NA))

ggsave(file=paste0("../imgs/prediction_all_publisher_all_features_Table3.eps"),scale=2.5,units = "cm", width = 16, height = 8,dpi = 800)
ggsave(file=paste0("../imgs/prediction_all_publisher_all_features_Table3.png"),scale=2.5,units = "cm", width = 16, height = 8,dpi = 800)

#Reemplazo tabla 5

filenames_all_p <- list.files(path = "datasets/AllPublishers//",pattern = ".csv",full.names = TRUE)
ldf_p <- lapply(filenames_all_p, read.csv, skip=0, header=TRUE, sep=";",blank.lines.skip = TRUE,strip.white = TRUE, colClasses = rep("character",7))
for(i in seq(from=1,to=length(filenames_all_p),by = 1)){
  ldf_p[[i]]$Attributes <- sapply(str_split(filenames_all_p, '/'), '[', 5)[i]
  ldf_p[[i]]$Dataset <- "All Publisher"
}

m_p <- do.call(rbind,ldf_p)

rm(filenames_all_p)

datos <- melt(data = m_p,id.vars = c("Method","Attributes"),measure.vars = c("R.","MAE","RMSE","RAE","RRSE","TIME"),)

datos$Attributes <- str_replace(datos$Attributes,".csv","")

datos$error <- as.numeric(sapply(str_split(datos$value, '_'), '[', 2))
datos$value <- as.numeric(sapply(str_split(datos$value, '_'), '[', 1))

datos$variable <- as.character(datos$variable)
datos[datos$variable=="R.","variable"] <- "R"

datos$variable <- factor(datos$variable, c("R","MAE","RMSE","RAE","RRSE","TIME"))

ggplot(data = subset(datos), aes(x=Method,y=value)) +
  geom_bar(aes(fill=Method),stat="identity",size=3) + geom_point(stat="identity",size=3) +
  facet_grid(variable ~ Attributes ,scales = "free_y") +
  scale_fill_grey(start=0.2,end=0.6) + labs(title="All features",x="",y="") +
  geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.2,size=0.25) + theme_bw()  + theme(legend.position="right") +
  scale_y_continuous(limits = c(0, NA),oob=squish)

ggsave(file=paste0("../imgs/prediction_all_publisher_Table5.eps"),scale=2.5,units = "cm", width = 16, height = 8,dpi = 800)
ggsave(file=paste0("../imgs/prediction_all_publisher_Table5.png"),scale=2.5,units = "cm", width = 16, height = 8,dpi = 800)

#}

#
# p2 <- ggplot(data = subset(datos,Attributes==att[2]), aes(x=Method,y=value,color=Attributes,shape=Attributes)) + geom_point(stat="identity",size=2) +
#   facet_grid(variable ~ Dataset,scales = "free_y") +
#   scale_color_grey(start=0.0,end=0.2) + labs(title=att[2],x="",y="") +
#   geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.2,size=0.25) + theme_bw()  + theme(legend.position="none")
#
# multiplot(p1,p2,cols=1)
#
# #Time dataset, selection, method
#
#
# ggplot(data = subset(datos,variable=="TIME"), aes(x=Method,y=value)) + geom_point(stat="identity",size=3) +
#   geom_bar(stat="identity",size=3) +
#   facet_grid(Dataset ~ Attributes,scales = "free_y") +
#   scale_fill_grey(start=0.2,end=0.8) + labs(title="TIME",x="Method",y="Seconds") +
#   geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.2,size=0.25) + theme_bw()  + theme(legend.position="bottom")
#
#
# ggplot(data = subset(datos,variable=="MAE"), aes(x=Method,y=value)) + geom_bar(stat="identity",size=3) +
#   facet_grid(Dataset ~ Attributes,scales = "free_y") +
#   scale_fill_grey(start=0.2,end=0.8) + labs(title="MAE",x="Method",y="Units") +
#   geom_errorbar(aes(ymin=value-error,ymax=value+error), width=0.2,size=0.25) + theme_bw()  + theme(legend.position="bottom")
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
# ggplot(data = datos, aes(x=variable,y=value)) + geom_point() + facet_grid(Attributes ~ Dataset)
#
# ggplot(data = subset(datos,variable=="R2"), aes(x=Attributes,y=value,fill=Attributes)) + geom_bar(stat="identity",position="dodge") + facet_grid(variable ~ Dataset)
#
# ggplot(data = subset(datos), aes(x=Attributes,y=value,fill=Attributes)) + geom_bar(stat="identity",position="dodge") +
#   facet_grid(variable ~ Dataset,scales = "free_y") + theme(legend.position="bottom") + scale_fill_brewer(type="qual",palette = "Set1")
#
#
# dataset = unique(datos$Dataset)
#
# ggplot(data = subset(datos,Dataset==dataset[1]), aes(x=Attributes,y=value,fill=Attributes)) + geom_bar(stat="identity",position="dodge") +
#   facet_grid(variable ~ Method,scales = "free_y") + theme(legend.position="bottom", axis.title.x=element_blank(),
#                                                           axis.text.x=element_blank(),
#                                                           axis.ticks.x=element_blank()) +
#   scale_fill_grey(start=0.2,end=0.8) + labs(title=dataset[1],x="",y="")
#
#
#
# ggplot(data = subset(datos,Dataset==dataset[1]), aes(x=Attributes,y=value,fill=Attributes)) + geom_point(stat="identity",position="dodge") +
#   facet_grid(variable ~ Method,scales = "free_y") + theme(legend.position="bottom", axis.title.x=element_blank(),
#                                                           axis.text.x=element_blank(),
#                                                           axis.ticks.x=element_blank()) +
#   scale_fill_grey(start=0.2,end=0.8) + labs(title=dataset[1],x="",y="")
#
#
#


# CPS MORG data data available at https://www.nber.org/morg/annual/
# Data description avaialbe at https://www.nber.org/morg/annual/desc/

library(foreign)
datyears = c(12:14)
dat <- data.frame()
for(i in 1:3){
  yr <- datyears[i]
  filename <- paste0("morg", as.character(yr), ".dta")
  tmpdat <- read.dta(filename)
  tmpdat <- as.data.frame(cbind(tmpdat, "year"))
  colnames(tmpdat)[length(tmpdat)] <- "year"
  year <- as.integer(paste0("20", yr))
  tmpdat$year <- year
  tmpdat <- subset(tmpdat, select = c("hhid", "lineno", "stfips", "sex", "race", "ethnic", "class94", "age", "uhourse", "hourslw", "ftpt94", "otc", "paidhre", "earnwke", "earnhre", "earnwt", "weight", "year"))
  dat <- rbind(dat, tmpdat)
}

rm(tmpdat, filename, datyears, yr, year, i)

## Data clean-up and preparation for survey analysis

# gender
dat$sex <- factor(dat$sex, levels = c(1,2), labels = c("m", "f"))

# employed
dat <- as.data.frame(cbind(dat, "employed"))
colnames(dat)[19] <- "employed"
dat$employed <- ifelse(dat$class94 == "Self-Employed, Incorporated" | dat$class94 == "Self-Employed, Unincorporated" | dat$class94 == "Without Pay", yes = "n", no = "y")
dat$employed <-factor(dat$employed)

# race/ethnicity
# https://www2.census.gov/programs-surveys/cps/techdocs/questionnaires/Demographics.pdf
dat <- as.data.frame(cbind(dat, "race_ethnicity"))
colnames(dat)[20] <- "race_ethnicity"
dat$race_ethnicity <- NA
dat$race_ethnicity <- dat$race
dat$race_ethnicity[dat$race == 1] <- "White"
dat$race_ethnicity[dat$race == 2] <- "Black"
dat$race_ethnicity[dat$race == 3] <- "Native American"
dat$race_ethnicity[dat$race == 4] <- "Asian"
dat$race_ethnicity[dat$race == 5] <- "Pacific Islander"
dat$race_ethnicity[dat$race >= 6] <- "Other"
dat$race_ethnicity[dat$ethnic == 1] <- "Latinx"
dat$race_ethnicity <- factor(dat$race_ethnicity)

# hourly wages column set up
dat$earnhre <- dat$earnhre/100
dat$earnhre[is.na(dat$earnhre)] <- 0
dat <- cbind.data.frame(dat, "calwage")
colnames(dat)[21] <- "calwage"
dat <- cbind.data.frame(dat, "hourlywage")
colnames(dat)[22] <- "hourlywage"
dat$hourlywage <- 0
#dat$calwage <- ifelse(dat$otc != "y", (dat$earnwke/dat$uhourse), 0)
dat$calwage <- dat$earnwke/dat$uhourse
dat$calwage[is.infinite(dat$calwage)] <- 0
dat$calwage <- ifelse(is.na(dat$uhourse), dat$earnwke/dat$hourslw, dat$calwage)

# calculate from weekly
dat$hourlywage <- ifelse(dat$earnhre != 0, dat$earnhre, dat$calwage)
dat$hourlywage <- ifelse(dat$otc == "y" & dat$earnhre ==0, 0, dat$hourlywage)
dat$hourlywage <- round(dat$hourlywage, 2)
dat$hourlywage[dat$hourlywage == 0] <- NA
dat$hourlywage <- ifelse(dat$employed == "n", NA, dat$hourlywage)

# adjust wages for inflation
# https://www.minneapolisfed.org/community/teaching-aids/cpi-calculator-information/consumer-price-index-and-inflation-rates-1913
dat <- as.data.frame(cbind(dat, "awages"))
colnames(dat)[23] <- "awages"
dat$awages <- dat$hourlywage
dat$awages <- ifelse(dat$year == 2012, (dat$awages*1.021), dat$awages)
dat$awages <- ifelse(dat$year == 2013, (dat$awages*1.016), dat$awages)
dat$awages <- ifelse(dat$awages == 0, NA, dat$awages)

# adjust the suvey weights
dat <- as.data.frame(cbind(dat, "aweight"))
dat <- as.data.frame(cbind(dat, "aearn_wt"))
colnames(dat)[24:25] <- c("aweight", "aearn_wt")
dat[24:25] <- NA
dat$aweight <- dat$weight/9
dat$aweight <- ifelse(is.na(dat$weight), NA, dat$aweight)
dat$aearn_wt <- dat$earnwt/9
dat$aearn_wt <- ifelse(is.na(dat$earnwt), NA, dat$aearn_wt)
dat <- as.data.frame(cbind(dat, "total"))
colnames(dat)[26] <- "ntl"
dat$ntl <- factor(dat$ntl)

write.dta(dat, "morg1214.dta")


library(ape)
library(tidyverse)

mypalette=c(
  "#ED1C24", "#F7941D", "#FFC20E", "#8DC73F",
  "#00A651", "#008FD4", "#235192", "#662D91",
  "#C51B7D", "#F768A1", "#F1B6DA", "#8C510A",
  "#DFC27D", "#FFFFBF", "#01665E", "#80CDC1",
  "#92C5DE", "#9970AB", "#7B68EE", "#888888");

color_edge = function(edgecolors, mytree, node) {
  ### The purpose of this function is to color a parent edge of an interior node such that
  ### any edge with decendent leaves that are all the same color
  ### (monophyletic) gets the same color as its leaves.  If descendents
  ### of the node are different colors (polyphyletic), the edge is
  ### colored black.

  # root
  if (length(mytree$edge[which(mytree$edge[,2] == node), 2]) <1 )
    return (edgecolors)

  # already visitied node
  if (edgecolors[which(mytree$edge[,2] == node)] != 'black'  ) {
    return (edgecolors)
  }

  if (length(mytree$edge[which(mytree$edge[,1] == node),2]) > 0) {
    mycolor =  NULL
    siblings = mytree$edge[which(mytree$edge[,1] == node), 2]
    is_same_color = T

    # compare color of sibling nodes
    if (length(siblings) > 0) {

      for (sibling in c(2:length(siblings))) {
        mycolor = edgecolors[which(mytree$edge[,2] == siblings[sibling])]
        if (edgecolors[which(mytree$edge[,2] == siblings[(sibling-1)])] !=
            edgecolors[which(mytree$edge[,2] == siblings[sibling])]) {
          is_same_color = F
        }
      }
    }
    if (is_same_color)
      # monophyletic,
      edgecolors[which(mytree$edge[,2] == node)] = mycolor
  }
  edgecolors
}

color_interior_edges = function(edgecolors, mytree) {
  depth_first = reorder.phylo(mytree, "pruningwise")   # reorder tree$edge. depth-first traversal

  for (i in c(1:length(mytree$edge[,1]))) {
    edge=depth_first$edge[i,]
    edgecolors = color_edge(edgecolors, mytree, edge[1])
  }
  edgecolors
}

rainbowtree <- function (
                mytree,                     # the tree
                tablefile,                  # the lookup table file name
                                            #   a 3- or 5-column table. Sequence name (1st column),
                                            #   integer index (1-20) to colors on palette (2nd),
                                            #   and color category (3rd). The 4th column is for
                                            #   symbol ID's(0-18) and the 5th is for symbol group names.
                                            #   When label='symbol',  the 4,5th colums should be specified.
                treetype,                   #
                treetitle,                  # tree title
                label,                      # a string specifying the type of tip labels:
                                            #   'category', 'seqname',  'none'(no tip label)  or 'symbol'
                label4ut,                   # a string specifying the display of tip labels
                                            #   for unrooted trees: 'axial' or 'horizontal'
                legend,                     # a string specifying the legend style:
                                            #   'vertical', 'horizontal' or 'none'(no legend)
                legendpos,                  # legend location: 'bottomright', 'bottom', ???bottomleft???,
                                            #   ???left???, ???topleft???, ???top???, ???topright???, ???right??? or ???center'
                branchwidth,                # a positive number specifying the width of the branches
                outgroup,                   # a vector of numeric or character specifying the new outgroup
                color.int.edges,            # to propagate leaf colors upward into a tree until a mismatch is encountered
                show.node.lab,              # to displays the node labels
                textsize,
                cat,
                first.chars,
                field,
                delim,
                cat_file
                ) {

    ## read inputTable
    # format of inputTable is 3 columns.
    # first column has a sequence name that matches each leaf in the tree
    # second column is an integer used as index to mypalette (above)
    # third column(optional) is a category used as tip label or legend
    # mytable = if (label == 'symbol')
    #              read.table(tablefile, header=F, colClasses=c('character','numeric','character', 'numeric','character'))
    #          else
    #              read.table(tablefile, header=F, colClasses=c('character','numeric','character'))

  ### mytable
  if (cat == "cat_fc") {
      mytable = data.frame(V1 = mytree$tip.label, V3 = substr(mytree$tip.label, 1, first.chars))
  } else if (cat == "cat_field") {
    mytable = data.frame(V1 = mytree$tip.label) %>%
      group_by(V1) %>%
      mutate(V3 = strsplit(as.character(V1), delim)[[1]][field]) %>%
      ungroup()
  } else if (cat == "cat_table") {
    req(cat_file)
    cat_table = read.csv(cat_file, header = FALSE, col.names = c("V1", "V3")) %>%
      #mutate(V1 = strsplit(as.character(V1), " ")[[1]][1]) %>%
      mutate(V1 = as.character(V1), " ") %>%
      mutate(V3 = as.character(V3))
     mytable = data.frame(V1 = mytree$tip.label) %>%
      #mutate(V1 = strsplit(as.character(V1), " ")[[1]][1]) %>%
      mutate(V1 = as.character(V1), " ") %>%
      left_join(., cat_table, by = "V1")
  }
  mytable = mytable %>%
    mutate(V3 = as.character(V3)) %>%
    arrange(V3) %>%
    #mutate(V2 = 1:length(mytree$tip.label)) %>% ### V2 actually not needed
    mutate(V4 = match(V3, unique(V3))) ### make V4 with group numbers
  #print(mytable)

  # outgroup
    if (outgroup != "none") mytree = root(mytree, outgroup, resolve.root=TRUE)

    mytree = ladderize(mytree)
    # tip colors:
    tipcolors = rep('#000000', length(mytree$edge))

    # iterate over leaves in the tree
    # populate values in edgecolors vector with colors
    # replace tip.label with category if label == category
    edgecolors = rep('black', length(mytree$edge[,1]))

    for (myi in c(1:length(mytree$tip.label))) {
      seqid = mytree$tip.label[myi]
      #myinx = mytable$V2[which(mytable$V1 == seqid)]   # palette index
      myinx = mytable$V4[which(mytable$V1 == seqid)] ### NEW PALETTE INDEX

      # ensure that myinx is not null! as error check
      if (length(myinx) == 0)  stop('No color code for ', seqid, 'in *.txt')

      if (myinx > length(mypalette)) myinx = length(mypalette)

      # assign edge colors to color elements of mypalette vector
      edgecolors[which(mytree$edge[,2] == myi)] = mypalette[myinx]

      if (label == 'category')
        mytree$tip.label[myi] = paste(mytable$V3[c(which(mytable$V1 == seqid))])   # replace seqid with a category name
    }

    # legend
    legenditems=vector()
    legendcolors=vector()
    if (legend != 'none') {
      #pIndex = array(mytable$V2);
      pIndex = array(mytable$V4);
      pIndex[pIndex > length(mypalette)] = length(mypalette)
      pIndexf = factor(pIndex)
      legendvalues = tapply(array(mytable$V3), pIndexf, unique)
      inx_uniq=attr(legendvalues, "names")   # 'names' hold palette indices

      for (t in 1:length(inx_uniq)) {
        pindex = inx_uniq[t]
        legendcolors[t]= mypalette[as.numeric(pindex)]
        legenditems[t] = paste(sort(legendvalues[[pindex]]), collapse= ' ') # could be many itmes per color
      }
    }

    mypch = vector()
    mylty = vector()
    symbolcolors = vector()
    symbols = vector()

    if (label == 'symbol') {
      for (t in 1:length(legenditems)) {
        mypch[t] = NA;
        mylty[t] = 1;
      }

      uqSymbols = unique(mytable$V4);
      symLegenditems = vector()
      for (t in 1:length(uqSymbols)) {
        symLegenditems = c(symLegenditems, paste(mytable$V5[which(mytable$V4 == uqSymbols[t])[1]], uqSymbols[t], sep = ':::'))
      }

      symLegenditems = sort(symLegenditems)

      for (t in 1:length(symLegenditems)) {
        tmp=unlist(strsplit(symLegenditems[t], ":::"))
        legenditems = c(legenditems, tmp[1])
        legendcolors = c(legendcolors,'black')
        mypch = c(mypch, as.numeric(tmp[2]))
        mylty = c(mylty, NA)

      }
      for (tip in c(1:length(mytree$tip.label))) {
        symbols[tip] = mytable$V4[which(mytable$V1 ==  mytree$tip.label[tip])]
        symbolcolors[tip] = edgecolors[which(mytree$edge[,2] == tip )]
      }
    }

    ### color interior edges - pth 03 Dec 2012
    if (color.int.edges)
      edgecolors = color_interior_edges(edgecolors, mytree)

    ## prepare to write output
    showtiplabel = if (label == 'none' ) F else T

    # set margins
    par(oma = c(0,0,1.5,0))
    par(mai = c(0,0,0,0), adj = 0)

    # these influence how line ends are drawn and joined
    par(ljoin = 3, lend = 2)

    # this call to plot() is the main drawing method!
    cexvalue = if (label == 'category' ) 1 else ( if (treetype == 'fan') 0.5 else 0.75)

    if (label != 'symbol') {
      plot(mytree, show.node.label = show.node.lab, edge.width = branchwidth,
           edge.col = edgecolors, show.tip.label = showtiplabel, no.margin = T,
           type = treetype, font = 1.5, lab4ut = label4ut, label.offset = 0.001,
           cex = cexvalue * textsize, tip.color = tipcolors)
    } else {
      plot(mytree, show.node.label = show.node.lab, edge.width = branchwidth,
           edge.col = edgecolors, show.tip.label = F, no.margin = T, type = treetype)
      tiplabels(pch = symbols, col = symbolcolors, lwd = branchwidth * textsize)
    }

    # title
    if(!missing(treetitle))  {
      par(font.main = 2, cex = 1.5)
      title(main = treetitle, outer = FALSE);
    }

    # legend
    if (legend != 'none' ) {
      if (label != 'symbol') {
        legend(legendpos, horiz = (legend == 'horizontal'), legenditems,
               cex = 0.5 * textsize, bty='o', lwd = 2, col = legendcolors )
      } else {
        legend(legendpos, horiz = (legend == 'horizontal'), legenditems,
               cex = 0.5 * textsize, bty='o', lwd = 1, col = legendcolors,
               pch = mypch, lty = mylty )
      }
    }

    # scale bar
    add.scale.bar(lwd = branchwidth, cex = 0.5 * textsize) #, x = 0, y = -0.05)

}


# plotting immunogenecity profile for given sequence
# Keunwan Park, Kbio

library(ggplot2)
#library(gridExtra)
#library(RGraphics)
#library(cowplot)

options<-commandArgs(trailingOnly=T)
if(length(options) < 2) stop("Invalid argument number\n\nRscript .r [immunogenecity pred output] [out png file, only prefix!]\n")
if(!is.na(options[1])) input_dat=options[1]
if(!is.na(options[2])) out_png=options[2]

data <- read.table(input_dat,header=T)
#colnames(data) <- c("seq_id","aa","allele","score")

x_lab=vector()
x_idx=vector()

for(i in c(1:nrow(data)) ){
	idx <- as.integer( as.numeric(data[i,1]) )
	x_lab[ idx ] = paste(data[i,1],data[i,2],sep="")
	x_idx[ idx ] = data[i,1]
}

score1=as.vector(matrix(0,1,length(x_lab)))
score5=as.vector(matrix(0,1,length(x_lab)))
score10=as.vector(matrix(0,1,length(x_lab)))

for(i in c(1:nrow(data)) ){
	idx <- as.integer( as.numeric(data[i,1]) )
	if(data[i,"score"] < 0.1){
		score1[idx] = score1[idx] + 1
	}
	if(data[i,"score"] < 0.5){
		score5[idx] = score5[idx] + 1
	}
	if(data[i,"score"] < 1){
		score10[idx] = score10[idx] + 1
	}
}

score1_class=as.vector(matrix(0,1,length(x_lab)))
score5_class=as.vector(matrix(0,1,length(x_lab)))
score10_class=as.vector(matrix(0,1,length(x_lab)))

## ---- CUT OFF for promiscuous binding -----------
Promiscuity_cut = 0.25	# %
## ------------------------------------------------

n_allele = length(levels(data[,"allele"]))

for(i in c(1:length(score1))){
	if(score1[i]/n_allele > Promiscuity_cut){
		score1_class[i] = "red"
	}else{
		score1_class[i] = "white"
	}
	if(score5[i]/n_allele > Promiscuity_cut){
		score5_class[i] = "orange"
	}else{
		score5_class[i] = "white"
	}
	if(score10[i]/n_allele > Promiscuity_cut){
		score10_class[i] = "yellow"
	}else{
		score10_class[i] = "white"
	}

}

df1 <- data.frame( idx=x_idx, seq_id = x_lab, promiscuity = score1_class, value = score1, class="score1");
df5 <- data.frame( idx=x_idx, seq_id = x_lab, promiscuity = score5_class, value = score5, class="score5");
df10 <- data.frame( idx=x_idx, seq_id = x_lab, promiscuity = score10_class, value = score10, class="score10");

df <- rbind(df1,df5,df10)

base_size <- 9

col <- c("red","orange","yellow","white")

p1 <- ggplot(df, aes(class,idx)) +
	geom_tile(aes(fill=df$promiscuity),colour="grey50",size=0.5)  +
	scale_fill_identity("Class", labels =c("Promiscuous1","Promiscuous5","Promiscuous10","X"), breaks = col, guide = "legend") +
	#scale_fill_gradient(low = "white", high = "red",guide="legend")
	theme_grey(base_size = base_size) +
	labs(x = "", y = "", title = ">25%" )  +
	coord_fixed(ratio=0.7) +
	scale_y_discrete(expand = c(0, 0),limits=c(min(df$idx):max(df$idx)),labels=x_lab) +
	#scale_y_discrete(expand = c(0, 0)) +
    scale_x_discrete(expand = c(0, 0),labels=c("P1","P5","P10")) +
	theme_bw() +
	theme(plot.title = element_text(size = 10), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.border = element_rect(fill = NA, colour = "black", size = 1) )	+
	#theme(legend.position = "none",axis.ticks = element_blank(), axis.text.x = element_text(size = base_size, angle = 0, hjust = 0, colour = "black"), axis.text.y = element_text(size = base_size*0.8, hjust = 1, colour = "grey50"))
	theme(legend.position = "none",axis.ticks = element_blank(), axis.text.x = element_text(size = base_size, angle=300, hjust = 0, colour = "grey50"), axis.text.y = element_text(size = base_size*0.8, hjust = 1, colour = "grey50"))

ratio <- (length(x_lab)/200)
hei= as.integer(35*ratio)
#if(hei > 40){ hei = 39}

ggsave( file = paste(out_png,"_25.png",sep=""), height=hei , limitsize=FALSE )

### CUT 2, this is really stupid

## ---- CUT OFF for promiscuous binding -----------
Promiscuity_cut = 0.35	# %
## ------------------------------------------------

for(i in c(1:length(score1))){
	if(score1[i]/n_allele > Promiscuity_cut){
		score1_class[i] = "red"
	}else{
		score1_class[i] = "white"
	}
	if(score5[i]/n_allele > Promiscuity_cut){
		score5_class[i] = "orange"
	}else{
		score5_class[i] = "white"
	}
	if(score10[i]/n_allele > Promiscuity_cut){
		score10_class[i] = "yellow"
	}else{
		score10_class[i] = "white"
	}

}

df1 <- data.frame( idx=x_idx, seq_id = x_lab, promiscuity = score1_class, value = score1, class="score1");
df5 <- data.frame( idx=x_idx, seq_id = x_lab, promiscuity = score5_class, value = score5, class="score5");
df10 <- data.frame( idx=x_idx, seq_id = x_lab, promiscuity = score10_class, value = score10, class="score10");

df <- rbind(df1,df5,df10)

p2 <- ggplot(df, aes(class,idx)) +
	geom_tile(aes(fill=df$promiscuity),colour="grey50",size=0.5)  +
	scale_fill_identity("Class", labels =c("Promiscuous1","Promiscuous5","Promiscuous10","X"), breaks = col, guide = "legend") +
	#scale_fill_gradient(low = "white", high = "red",guide="legend")
	theme_grey(base_size = base_size) +
	labs(x = "", y = "", title = ">35%" )  +
	coord_fixed(ratio=0.7) +
	scale_y_discrete(expand = c(0, 0),limits=c(min(df$idx):max(df$idx)),labels=x_lab) +
	#scale_y_discrete(expand = c(0, 0)) +
    scale_x_discrete(expand = c(0, 0),labels=c("P1","P5","P10")) +
	theme_bw() +
	theme(plot.title = element_text(size = 10), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.border = element_rect(fill = NA, colour = "black", size = 1) )	+
	theme(legend.position = "none",axis.ticks = element_blank(), axis.text.x = element_text(size = base_size, angle = 300, hjust = 0, colour = "grey50"), axis.text.y = element_text(size = base_size*0.8, hjust = 1, colour = "grey50"))

ggsave( file = paste(out_png,"_35.png",sep=""), height=hei,limitsize=FALSE  )

### CUT 3, this is really stupid, too

## ---- CUT OFF for promiscuous binding -----------
Promiscuity_cut = 0.5	# %
## ------------------------------------------------

for(i in c(1:length(score1))){
	if(score1[i]/n_allele > Promiscuity_cut){
		score1_class[i] = "red"
	}else{
		score1_class[i] = "white"
	}
	if(score5[i]/n_allele > Promiscuity_cut){
		score5_class[i] = "orange"
	}else{
		score5_class[i] = "white"
	}
	if(score10[i]/n_allele > Promiscuity_cut){
		score10_class[i] = "yellow"
	}else{
		score10_class[i] = "white"
	}

}

df1 <- data.frame( idx=x_idx, seq_id = x_lab, promiscuity = score1_class, value = score1, class="score1");
df5 <- data.frame( idx=x_idx, seq_id = x_lab, promiscuity = score5_class, value = score5, class="score5");
df10 <- data.frame( idx=x_idx, seq_id = x_lab, promiscuity = score10_class, value = score10, class="score10");

df <- rbind(df1,df5,df10)

p3 <- ggplot(df, aes(class,idx)) +
	geom_tile(aes(fill=df$promiscuity),colour="grey50",size=0.5)  +
	scale_fill_identity("Class", labels =c("Promiscuous1","Promiscuous5","Promiscuous10","X"), breaks = col, guide = "legend") +
	#scale_fill_gradient(low = "white", high = "red",guide="legend")
	theme_grey(base_size = base_size) +
	labs(x = "", y = "",title=">50%")  +
	coord_fixed(ratio=0.7) +
	scale_y_discrete(expand = c(0, 0),limits=c(min(df$idx):max(df$idx)),labels=x_lab) +
	#scale_y_discrete(expand = c(0, 0)) +
    scale_x_discrete(expand = c(0, 0),labels=c("P1","P5","P10")) +
	theme_bw() +
	theme(plot.title = element_text(size = 10), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.border = element_rect(fill = NA, colour = "black", size = 1) )	+
	theme(legend.position = "none", axis.ticks = element_blank(), axis.text.x = element_text(size = base_size, angle = 300, hjust = 0, colour = "grey50"), axis.text.y = element_text(size = base_size*0.8, hjust = 1, colour = "grey50"))

ggsave( file = paste(out_png,"_50.png",sep=""), height=hei ,limitsize=FALSE )

##------------------Multiple Plots----

#grid.arrange(p1, p2, p3, legend, ncol=4, nrow=1, main="Promiscous Activity",widths=c(2.3, 2.3, 2.3,0.8))
#grid.arrange(p1, ncol=1, nrow=1, main="Promiscous Activity")

#save_plot(out_png, plot.mpg,base_aspect_ratio = 1.3)

#pdf(out_png,height=hei)

#grid.newpage()

# Create layout : nrow = 2, ncol = 2
#pushViewport(viewport(layout = grid.layout(1, 3)))

# A helper function to define a region on the layout
#define_region <- function(row, col){
#  viewport(layout.pos.row = row, layout.pos.col = col)
#}

# Arrange the plots
#print(p1, vp = define_region(1, 1))
#print(p2, vp = define_region(1, 2))
#print(p3, vp = define_region(1, 3))

#save_plot(out_png, base_aspect_ratio = 1.3)
#ggsave( file = out_png, height=hei  )

#dev.off()


#' 2D contours of a 3D surface
#'
#' @description
#' ggplot2 can not draw true 3D surfaces, but you can use `geom_contour()`,
#' `geom_contour_filled()`, and [geom_tile()] to visualise 3D surfaces in 2D.
#'
#' These functions require regular data, where the `x` and `y` coordinates
#' form an equally spaced grid, and each combination of `x` and `y` appears
#' once. Missing values of `z` are allowed, but contouring will only work for
#' grid points where all four corners are non-missing. If you have irregular
#' data, you'll need to first interpolate on to a grid before visualising,
#' using [interp::interp()], [akima::bilinear()], or similar.
#'
#' @eval rd_aesthetics("geom", "contour")
#' @eval rd_aesthetics("geom", "contour_filled")
#' @inheritParams layer
#' @inheritParams geom_point
#' @inheritParams geom_path
#' @param binwidth The width of the contour bins. Overridden by `bins`.
#' @param bins Number of contour bins. Overridden by `breaks`.
#' @param breaks One of:
#'   - Numeric vector to set the contour breaks
#'   - A function that takes the range of the data and binwidth as input
#'   and returns breaks as output. A function can be created from a formula
#'   (e.g. ~ fullseq(.x, .y)).
#'
#'   Overrides `binwidth` and `bins`. By default, this is a vector of length
#'   ten with [pretty()] breaks.
#' @seealso [geom_density_2d()]: 2d density contours
#' @export
#' @examples
#' # Basic plot
#' v <- ggplot(faithfuld, aes(waiting, eruptions, z = density))
#' v + geom_contour()
#'
#' # Or compute from raw data
#' ggplot(faithful, aes(waiting, eruptions)) +
#'   geom_density_2d()
#'
#' \donttest{
#' # use geom_contour_filled() for filled contours
#' v + geom_contour_filled()
#'
#' # Setting bins creates evenly spaced contours in the range of the data
#' v + geom_contour(bins = 3)
#' v + geom_contour(bins = 5)
#'
#' # Setting binwidth does the same thing, parameterised by the distance
#' # between contours
#' v + geom_contour(binwidth = 0.01)
#' v + geom_contour(binwidth = 0.001)
#'
#' # Other parameters
#' v + geom_contour(aes(colour = after_stat(level)))
#' v + geom_contour(colour = "red")
#' v + geom_raster(aes(fill = density)) +
#'   geom_contour(colour = "white")
#' }
geom_contour <- function(mapping = NULL, data = NULL,
                         stat = "contour", position = "identity",
                         ...,
                         bins = NULL,
                         binwidth = NULL,
                         breaks = NULL,
                         lineend = "butt",
                         linejoin = "round",
                         linemitre = 10,
                         na.rm = FALSE,
                         show.legend = NA,
                         inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomContour,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list2(
      bins = bins,
      binwidth = binwidth,
      breaks = breaks,
      lineend = lineend,
      linejoin = linejoin,
      linemitre = linemitre,
      na.rm = na.rm,
      ...
    )
  )
}

#' @rdname geom_contour
#' @export
geom_contour_filled <- function(mapping = NULL, data = NULL,
                                stat = "contour_filled", position = "identity",
                                ...,
                                bins = NULL,
                                binwidth = NULL,
                                breaks = NULL,
                                na.rm = FALSE,
                                show.legend = NA,
                                inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomContourFilled,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list2(
      bins = bins,
      binwidth = binwidth,
      breaks = breaks,
      na.rm = na.rm,
      ...
    )
  )
}

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
#' @include geom-path.r
GeomContour <- ggproto("GeomContour", GeomPath,
  default_aes = aes(
    weight = 1,
    colour = "#3366FF",
    size = 0.5,
    linetype = 1,
    alpha = NA
  )
)

#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
#' @include geom-polygon.r
GeomContourFilled <- ggproto("GeomContourFilled", GeomPolygon)


loadData <- function() {
    # Read all the files into a list
    filesInfo <- drop_dir('/phd/misc/surveytool/survey/server_files')
    filePaths <- filesInfo$path
    data <- lapply(filePaths, drop_read_csv, stringsAsFactors = FALSE)
    # Concatenate all data together into one data.frame
    data <- do.call(rbind, data)
    name <- quiz <- character()
    for(i in 1:nrow(data)){
        name <- c(name, substr(data[i,1], start = 1, stop = nchar(data[i,1])-2))
        quiz <- c(quiz, substr(data[i,1], start=nchar(data[i,1]), stop=nchar(data[i,1])))
    }
    data <- cbind(data,name,quiz)
    data <- data[order(data[,'name']), ]
    plot_table <- aggregate(x = data[,2], by = list(name = data[,'name']), FUN = sum)
    rownames(plot_table) <- plot_table[,'name']
    colnames(plot_table) <- c('name','Total')
    plot_table <- rbind(plot_table, data.frame(name = '', Total = rep(0, 16-nrow(plot_table))))
    return(plot_table)
}


library(fastercaster)

n <- 1e2

x <- factor(sample(1:3, size=n, replace=TRUE))
all.equal(as_integer(x), as.integer(as.character(x)))
all.equal(as_integer(x, by.level=FALSE), as.integer(x))

x <- factor(sample(rnorm(10), size=n, replace=TRUE))
all.equal(as_integer(x), as.integer(as.character(x)))
all.equal(as_integer(x, by.level=FALSE), as.integer(x))


#!/usr/bin/env Rscript
library("optparse")
library("qqman")
t_col <- function(color, percent = 50, name = NULL) {
  #      color = color name
  #    percent = % transparency
  #       name = an optional name for the color

## Get RGB values for named color
rgb.val <- col2rgb(color)

## Make new color using input color as base and alpha set by transparency
t.col <- rgb(rgb.val[1], rgb.val[2], rgb.val[3],
             max = 255,
             alpha = (100 - percent) * 255 / 100,
             names = name)

## Save the color
invisible(t.col)
}

#plotfreq(MergeAll[QC,],headaf, 'af_gwas_a1cat',cex_pt=90,alpha_pt=0.15,xlab='GWAS', ylab='GWAS Catalog')
#dataall<-MergeAll;freq1<-headaf;freq2<-'af_gwas_a1cat';cex_pt=90
plotfreq<-function(dataall,freq1, freq2,cex_pt,alpha_pt,xlab='GWAS frequencies', ylab='GWAS cat frequencies'){
nbcat=20
height=1
perctrans<-90
ht<-hist(dataall[,freq1], nbcat, plot=F)
ht$counts<-ht$counts/sum(ht$counts)*height
ht2<-hist(dataall[,freq2], nbcat, plot=F)
ht2$counts<-ht2$counts/sum(ht2$counts)*height
layout.matrix <- matrix(c(2, 1, 0, 3), nrow = 2, ncol = 2)
dataall<-na.omit(dataall[,c(freq1, freq2)])

layout(mat = layout.matrix,
       heights = c(max(ht$counts)*1.2, 1), # Heights of the two rows
       widths = c(2, max(ht2$counts)*2.4)) # Widths of the two columns
#layout.show(3)

#c(bottom, left, top, right)
par(mar=c(5, 4, 1, 1))
plot(c(0,1), c(0,1), type='n', cex=0.5, xlab=xlab, ylab=ylab, xlim=c(0,1), ylim=c(0,1), bty='n')
points(dataall[,freq1], dataall[,freq2], pch=22, ,col=t_col("blue",alpha_pt), bg=t_col("blue",alpha_pt),cex=cex_pt)
abline(a=0,b=1, lty=2 ,col=t_col('red'), lwd=2)
par(mar=c(0,4,1,0))
plot(ht, col=t_col("orange"), xlab="", ylab="", xlim=c(0,1),  xaxt='n',main="")
par(mar=c(5,0,1,1))
plot(c(0, max(ht2$counts)), c(0,1), type='n', cex=0.5, xlab='', ylab='', xlim=c(0,max(ht2$counts)), ylim=c(0,1), yaxt='n',bty='n')
rect(rep(0,length(ht2$counts)),(1:length(ht2$counts))/nbcat,
           ht2$counts,(1:length(ht2$counts))/nbcat-1/nbcat, col=t_col('red', perctrans), bg=t_col('red', perctrans))
}

plotZ<-function(dataall,Z1, Z2, cex_pt=0.5,alpha_pt=10,xlab='Z (GWAS cat)', ylab='Z (AWIGEN)'){
balise<-!is.na(dataall[,Z1]) & !is.na(dataall[,Z2])
dataall<-dataall[balise,]
r2<-cor(dataall[,Z1],dataall[,Z2], method='spearman')
r2abs<-cor(abs(dataall[,Z1]), abs(dataall[,Z2]), method='spearman')
plot(dataall[,Z1], dataall[,Z2], pch=22, cex=cex_pt,bg=t_col("blue", alpha_pt) ,col=t_col("blue",alpha_pt), xlab=xlab, ylab=ylab)
text(min(dataall[,Z1])-min(dataall[,Z1])*0.1,max(dataall[,Z2]), paste(paste("r2 :",round(r2,2)), paste("\n         r2 (abs) :",round(r2abs,2)), sep=""))
abline(h=0, col='red', lty=2)
abline(v=0, col='red', lty=2)
}

computedher<-function(beta, se, af,N){
#https://journals.plos.org/plosone/article/file?type=supplementary&id=info:doi/10.1371/journal.pone.0120758.s001
maf<-af
maf[!is.na(af) & af>0.5]<- 1 - maf[!is.na(af) & af>0.5]
ba<-!is.na(beta) & !is.na(se) & !is.na(maf) & !is.na(N)
a<-rep(NA, length(beta))
b<-rep(NA, length(beta))
a<-2*(beta[ba]**2)*(maf[ba]*(1-maf[ba]))
b<-2*(se[ba]**2)*N[ba]*maf[ba]*(1-maf[ba])
res<-rep(NA, length(beta))
res[ba]<-a[ba]/(a[ba]+b[ba])
res
}

option_list = list(
  make_option(c( "--gwascat"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c( "--gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c( "--pheno"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--chr_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--bp_gwascat"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--ps_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--a1_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--a2_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--beta_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--se_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--af_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--N_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--ps_gwascat"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--chr_gwascat"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--a1_gwascat"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--p_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--out"), type="character", default="out.txt",
              help="output file name [default= %default]", metavar="character")
);

checkhead<-function(head,Data, type){
if(length(which(head %in% names(Data)))==0){
print(names(Data))
print(paste('not found ', head,'for',type ,'data'))
q(2)
}
}

#--chr_gwas ${params.head_chr} --ps_gwas ${params.head_bp} --a1_gwas ${params.head_A1} --a2_gwas ${params.head_A2

opt_parser = OptionParser(option_list=option_list);
opt = parse_args(opt_parser);
Test=F
if(Test)opt=list(gwascat='meanMaxcIMT_eurld_all.csv',gwas='meanMaxcIMT_eurld_pos.init',chr_gwas='CHR',ps_gwas='BP',a1_gwas='ALLELE1',a2_gwas='ALLELE0' ,beta_gwas='BETA',se_gwas='SE',af_gwas='A1FREQ',chr_gwascat='chrom',bp_gwascat='chromEnd',p_gwas='P_BOLT_LMM',ps_gwascat='chromEnd',chr_gwascat='chrom',out='meanMaxcIMT_eurld_pos')

headse=opt[['se_gwas']];headps=opt[['ps_gwas']];headchr=opt[['chr_gwas']];headbeta=opt[['beta_gwas']];heada1=opt[['a1_gwas']];heada2=opt[['a2_gwas']];headpval=opt[['p_gwas']];headaf<-opt[['af_gwas']];headbeta=opt[['beta_gwas']]
headchrcat=opt[['chr_gwascat']];headbpcat=opt[['ps_gwascat']];heada1catrs<-opt[['a1_gwascat']];headzcat="z.cat";headafcat<-'risk.allele.af';heada1cat<-'risk.allele.cat'
outhead=opt[['out']]

datagwascat=read.csv(opt[['gwascat']])
#datagwascat[,heada1cat]<-sapply(strsplit(as.character(datagwascat[,heada1catrs]),split='-'),function(x)x[2])
datagwas<-read.table(opt[['gwas']], header=T)
checkhead(headaf, datagwas,'af');checkhead(headpval, datagwas,'pval');checkhead(headse, datagwas,'se');checkhead(headps, datagwas,'bp');checkhead(headchr, datagwas, 'chr');checkhead(headbeta, datagwas, 'beta')

checkhead(headbpcat,datagwascat,'bp cat');checkhead(headchrcat,datagwascat,'chro cat');

datagwas$p.adjust.fdr<-p.adjust(datagwas[,headpval],'fdr')
datagwas$p.adjust.bonf<-p.adjust(datagwas[,headpval],'bonferroni')
headN<-opt[['N_value']]
if(is.null(opt[['N_gwas']])){
if(is.null(opt[['N_value']]))Nval<-10000 else Nval=opt[['N_value']]
datagwas[,'N_gwas']<-Nval
headN<-'N_gwas'
}
datagwas$h2.gwas<-computedher(datagwas[,headbeta], datagwas[,headse], datagwas[,headaf],datagwas[,headN])
datagwas$z.gwas<-datagwas[,headbeta]/datagwas[,headse]

cat(c(headchr,headps,'\n'))
cat(c(headchrcat,headbpcat))
names(datagwas)
names(datagwascat)
MergeAll<-merge(datagwas, datagwascat,by.x=c(headchr,headps), by.y=c(headchrcat,headbpcat))

MergeAll[,heada1cat]<-as.character(MergeAll[,heada1cat])
MergeAll[,heada1]<-as.character(MergeAll[,heada1])

QC<-!is.na(MergeAll[,heada1]) & !is.na(MergeAll[,heada2]) & !is.na(MergeAll[,heada1cat]) & !is.na(MergeAll[,headafcat]) & (MergeAll[,heada1] == MergeAll[,heada1cat] | MergeAll[,heada2] == MergeAll[,heada1cat])
#print(table(MergeAll[,heada1] , MergeAll[,heada1cat]))
BaliseChange<-QC & MergeAll[,heada1]!=MergeAll[,heada1cat]
MergeAll[,'af_gwas_a1cat']<-NA
MergeAll[BaliseChange,'af_gwas_a1cat']<- 1 - MergeAll[BaliseChange,headafcat]
MergeAll[!BaliseChange,'af_gwas_a1cat']<-  MergeAll[!BaliseChange,headafcat]

svg(paste(outhead,'_cmpfrequencies.svg', sep=''))
cat('af ',headaf, 'afreq \n')
plotfreq(MergeAll[QC,],headaf, 'af_gwas_a1cat',cex_pt=1.5,alpha_pt=0.15,xlab='GWAS', ylab='GWAS Catalog')
dev.off()

QC<-!is.na(MergeAll[,heada1]) & !is.na(MergeAll[,heada2]) & !is.na(MergeAll[,heada1cat]) & !is.na(MergeAll[,headzcat]) & (MergeAll[,heada1] == MergeAll[,heada1cat] | MergeAll[,heada2] == MergeAll[,heada1cat])

BaliseChange<-QC & MergeAll[,heada1]!=MergeAll[,heada1cat]
MergeAll[,'z_gwas_a1cat']<-NA
MergeAll[BaliseChange,'z_gwas_a1cat']<- - MergeAll[BaliseChange,headzcat]
MergeAll[!BaliseChange,'z_gwas_a1cat']<-MergeAll[!BaliseChange,headzcat]

svg(paste(outhead,'_cmpz.svg', sep=''))
plotZ(MergeAll[QC,],'z.gwas','z_gwas_a1cat', cex_pt=1.5,alpha_pt=0.15,ylab='GWAS catalog', xlab='GWAS')
dev.off()

svg(paste(outhead,'_qq.svg', sep=''))
qq(MergeAll[,headpval])
dev.off()

write.csv(MergeAll, row.names=F,file=paste(opt[['out']], '.csv',sep=''))


dyn.load('/Library/Java/JavaVirtualMachines/jdk1.8.0_131.jdk/Contents/Home/jre/lib/server/libjvm.dylib')

setwd("/Users/mengmengjiang/all datas/conductivity")
library(xlsx)

# reading datasets

# compare qd and conductivitys
# 18nl/min-Gly1,sorts of
# 针对低电导率液体，我们想要看看电压和流量的影响
# 电压为三个，流量为2个，

k1<-read.xlsx("gly1.xlsx",sheetName="qd1-18",header=TRUE)
k2<-read.xlsx("gly1.xlsx",sheetName="qd1-19",header=TRUE)
k3<-read.xlsx("gly1.xlsx",sheetName="qd1-20",header=TRUE)

k4<-read.xlsx("gly1.xlsx",sheetName="qd2-18",header=TRUE)
k5<-read.xlsx("gly1.xlsx",sheetName="qd2-19",header=TRUE)
k6<-read.xlsx("gly1.xlsx",sheetName="qd2-20",header=TRUE)

#
yan<-rainbow(6)
pcc<-c(0,1,2,5,22,23)

#
error.bar <- function(x, y, upper, coll,lower=upper, length=0.05,...){
  if(length(x) != length(y) | length(y) !=length(lower) | length(lower) !=
     length(upper))
    stop("vectors must be same length")
  arrows(x,y+upper, x, y-lower,col=coll, angle=90, code=3, length=length, ...)
}

#
plot(k1$fv,k1$deva, col=0,xlab = expression(italic(f["v"]) (Hz)),
          ylab = expression(italic(d["d"]) (um)), mgp=c(1.1, 0, 0),tck=0.02,
               main = "", xlim = c(0,4000),ylim=c(15,60))

lines(k1$fv,k1$deva,col=yan[1],lwd=1.5,lty=2,type="b",pch=pcc[1],cex=0.8)
lines(k2$fv,k2$deva,col=yan[2],lwd=1.5,lty=2,type="b",pch=pcc[2],cex=0.8)
lines(k3$fv,k3$deva,col=yan[3],lwd=1.5,lty=2,type="b",pch=pcc[3],cex=0.8)

lines(k4$fv,k4$deva,col=yan[4],lwd=1.5,lty=2,type="b",pch=pcc[4],cex=0.8)
lines(k5$fv,k5$deva,col=yan[5],lwd=1.5,lty=2,type="b",pch=pcc[5],cex=0.8)
lines(k6$fv,k6$deva,col=yan[6],lwd=1.5,lty=2,type="b",pch=pcc[6],cex=0.8)

error.bar(k1$fv,k1$deva,k1$stdd/2,col=yan[1])
error.bar(k2$fv,k2$deva,k2$stdd/2,col=yan[2])
error.bar(k3$fv,k3$deva,k3$stdd/2,col=yan[3])

error.bar(k4$fv,k4$deva,k4$stdd/2,col=yan[4])
error.bar(k5$fv,k5$deva,k5$stdd/2,col=yan[5])
error.bar(k6$fv,k6$deva,k6$stdd/2,col=yan[6])

leg<-c("18nl/min-1.8kv","18nl/min-1.9kv","18nl/min-2kv","180nl/min-1.8kv",
        "180nl/min-1.9kv","180nl/min-2kv")

legend("topright",legend=leg,col=yan,pch=pcc,lwd=1.5,inset = .06,lty=2,bty="n")


## Weight by the margin probabilities ###
rm(list = ls())

# install.packages(c("tidyverse", "msm", "foreign", "boot", "car",
#                     "nnet", "haven", "lavaan", "cowplot", "readstata13", "reshape2" ),
#                     quiet=TRUE)
#detach("packages:dplyr")
source("/Users/chrisweber/Desktop/Authoritarianism_V2/Authoritarianism_V2/configurations/BookFunctions.R")
### User functions to calculate stuff:
### Dependdencies
require(dplyr)
library(msm)
library(boot)
library(ggplot2)
library(nnet)
library(lavaan)
library(cowplot)
require(readstata13)


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

# Set random number generator seed to make results reproducible

set.seed(123)

## load phenotype data

load('/dcl01/lieber/ajaffe/lab/brain-epigenomics/bumphunting/BSobj_bsseqSmooth_Neuron_minCov_3.Rdata')

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

## load coordinates, methylation counts and total coverage for filtered CpGs

gr = granges(BSobj)
df = data.frame(gr)
cov = getCoverage(BSobj, type = "Cov")
m = getCoverage(BSobj, type = "M")
rm(BSobj,gr)

## Format info for methylseekR

CGlist = list()
for (i in 1:ncol(cov)) {
	CGlist[[i]] = data.frame(df[,c("seqnames","start","end")], T = cov[,i], M = m[,i])
}
names(CGlist) = colnames(cov)
CGlist = lapply(CGlist, function(x) makeGRangesFromDataFrame(x, keep.extra.columns=T))
	# each element in the list are the counts for one sample
rm(dr,cov,m)

## load methylation counts and total coverage for filtered CH

load('/dcl01/lieber/ajaffe/lab/brain-epigenomics/bsseq/bsobj_by_chr/allChrs_postNatal_cleaned_nonCG_noHomogenate_highCov.Rdata')

gr = granges(BSobj)
df = data.frame(gr)
cov = getCoverage(BSobj, type = "Cov")
m = getCoverage(BSobj, type = "M")
rm(BSobj,gr)

## Format info for methylseekR

CHlist = list()
for (i in 1:ncol(cov)) {
	CHlist[[i]] = data.frame(df[,c("seqnames","start","end")], T = cov[,i], M = m[,i])
}
names(CHlist) = colnames(cov)
CHlist = lapply(CHlist, function(x) makeGRangesFromDataFrame(x, keep.extra.columns=T))
	# each element in the list are the counts for one sample
rm(cov, df, m)

save(CGlist, CHlist, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/methylSeekR_objects.rda")

## Plot the alpha values for one chromosome
	# α characterizes the distribution of methylation levels in sliding windows containing 100 consecutive CpGs along the genome

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/AlphaDistribution_CG.pdf")
lapply(CGlist, function(x) plotAlphaDistributionOneChr(m= x, chr.sel="chr22", num.cores=1))
dev.off()

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/AlphaDistribution_CH.pdf")
lapply(CHlist, function(x) plotAlphaDistributionOneChr(m= x, chr.sel="chr22", num.cores=1))
dev.off()

## Identify partially methylated domains (PMDs)

sLengths = seqlengths(Hsapiens)

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/PMDsegments_methylSeekR_CG.pdf")
PMDsegments.CG = lapply(CGlist, function(x) segmentPMDs(m = x, chr.sel="chr22", seqLengths=sLengths, num.cores=2))
dev.off()

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/PMDsegments_methylSeekR_CH.pdf")
PMDsegments.CH = lapply(CHlist, function(x) segmentPMDs(m = x, chr.sel="chr22", seqLengths=sLengths, num.cores=5))
dev.off()

save(PMDsegments.CG, PMDsegments.CH, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/PMDs_methylSeekR.rda")

## Plot example PMDs

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/PMDsegments_visualized_CG.pdf", width = 12, height = 12)
mapply(function(CG, PMD) plotPMDSegmentation(m = CG, segs = PMD), CGlist, PMDsegments.CG)
dev.off()

## Identify CpG Islands

session <- browserSession()
genome(session) <- "hg19"
query <- ucscTableQuery(session, "cpgIslandExt")
CpGislands.gr <- track(query)
genome(CpGislands.gr) <- NA
CpGislands.gr <- suppressWarnings(resize(CpGislands.gr, 5000, fix="center"))

## Calculate FDR threshold for calling UMRs and LMRs

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/calculateFDRthreshold_methylSeekR_CG.pdf")
stats.CG <- mapply(function(CG, PMD) calculateFDRs(m = CG, CGIs = CpGislands.gr, PMDs = PMD, num.cores=1), CGlist, PMDsegments.CG)
dev.off()
statcg = list()
for (i in 1:length(CGlist)) { statcg[[i]] =  stats.CG[,i] }
names(statcg) = names(CGlist)
stats.CG = statcg

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/calculateFDRthreshold_methylSeekR_CH.pdf")
stats.CH <- lapply(CHlist, function(CH) calculateFDRs(m = CH, CGIs = CpGislands.gr, num.cores=5))
dev.off()
stats.CH

FDR.cutoff <- 10
m.sel <- 0.5

n.sel.CG = lapply(stats.CG, function(x) as.integer(names(x$FDRs[as.character(m.sel), ][x$FDRs[as.character(m.sel), ]<FDR.cutoff])[1]))
n.sel.CH = lapply(stats.CH, function(x) as.integer(names(x$FDRs[as.character(m.sel), ][x$FDRs[as.character(m.sel), ]<FDR.cutoff])[1]))

save(stats.CG, n.sel.CG, stats.CH, n.sel.CH, file="/media/Backup1_/amanda/NewFigures/setting_n_methylSeekR.rda")

# Recalculate with limited PMDs to >100kb
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/PMDs_methylSeekR_100kbLimit.rda")
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/setting_n_methylSeekR.rda")

names(total) = gsub("Postnatal-","", names(total))
pmds = total[names(total) %in% names(CGlist)]
identical(names(pmds), names(CGlist))

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/calculateFDRthreshold_methylSeekR_CG.100kb.pdf")
stats.CG.100kb <- mapply(function(CG, PMD) calculateFDRs(m = CG, CGIs = CpGislands.gr, PMDs = PMD, num.cores=3), CGlist, pmds, SIMPLIFY = F)
dev.off()

n.sel.CG.100kb = lapply(stats.CG.100kb, function(x) as.integer(names(x$FDRs[as.character(m.sel), ][x$FDRs[as.character(m.sel), ]<FDR.cutoff])[1]))

save(stats.CG.100kb, n.sel.CG.100kb, stats.CG, n.sel.CG, stats.CH, n.sel.CH, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/setting_n_methylSeekR.rda")

## Calculate UMRs and LMRs

UMRLMRsegments.CG <- mapply(function(CG,n,PMD) segmentUMRsLMRs(m = CG, meth.cutoff = m.sel, nCpG.cutoff= n,
					 PMDs = PMD, num.cores=1, myGenomeSeq = Hsapiens, seqLengths = sLengths), CGlist, n.sel.CG, PMDsegments.CG)

load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/UMRs_LMRs_methylSeekR.rda")

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/UMRs_LMRs_methylseekr_100kbPMDs.pdf")
UMRLMRsegments.CG.100kb <- mapply(function(CG,n,PMD) segmentUMRsLMRs(m = CG, meth.cutoff = m.sel, nCpG.cutoff= n,
                                                               PMDs = PMD, num.cores=1, myGenomeSeq = Hsapiens, seqLengths = sLengths), CGlist, n.sel.CG.100kb, pmds)
dev.off()
save(UMRLMRsegments.CG,UMRLMRsegments.CG.100kb, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/UMRs_LMRs_methylSeekR.rda")

## Call DMVs (parameters from Mo et al. 2015 supplement)

DMVs = lapply(UMRLMRsegments.CG, function(x) x[which(x$type=="UMR" & x$pmeth <=0.15)])
DMVs = lapply(DMVs, function(x) x[which(width(x)>=5000)])

load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/DMVs_hypoDMRs_methylSeekR.rda")

DMVs.100kb = lapply(UMRLMRsegments.CG.100kb, function(x) x[which(x$type=="UMR" & x$pmeth <=0.15)])
DMVs.100kb = lapply(DMVs.100kb, function(x) x[which(width(x)>=5000)])

## Call large hypo-DMRs

load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/DMR/DMR_objects.rda")

split = unlist(lapply(DMR, function(x) split(x, x$Dir)), recursive = F)
gr <- lapply(lapply(lapply(split, makeGRangesFromDataFrame), sortSeqlevels), sort)
gr2 <- lapply(lapply(UMRLMRsegments.CG, sortSeqlevels), sort)

for (i in 1:length(gr)) {
  write.table(gr[[i]], file=paste0("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/PWMEnrich/hypoDMRs_",names(split)[i],".tab"),
              sep="\t", row.names = F,quote = F,col.names = F) }
for (i in 1:length(gr2)) {
  write.table(gr2[[i]], file=paste0("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/PWMEnrich/hypoDMRs_",names(UMRLMRsegments.CG)[i],".tab"),
              sep="\t", row.names = F,quote = F,col.names = F) }
write.table(data.frame(c(names(split),names(UMRLMRsegments.CG))),
            file="/dcl01/lieber/ajaffe/Amanda/sorted_nuclear_RNA/merged/hypoDMR_IDs.txt",
            sep="\t", row.names = F,quote = F,col.names = F)

# run merge_hypoDMRs.sh

hypoDMRs = lapply(as.list(c(names(split),names(UMRLMRsegments.CG))), function(x)
  read.table(paste0("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/PWMEnrich/",x,"_merged_hypoDMRs.tab"),
             col.names = c("chromosome", "start","end")))
names(hypoDMRs) = c(names(split),names(UMRLMRsegments.CG))
elementNROWS(hypoDMRs)
hypoDMRs = lapply(hypoDMRs, makeGRangesFromDataFrame)
hypoDMRs = lapply(hypoDMRs, function(x) split(x, width(x)>=2000))

save(hypoDMRs, DMVs,DMVs.100kb, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/DMVs_hypoDMRs_methylSeekR.rda")


# These are parameters to be fed into prep.r and model.r

# Parameters
#############

# Model parameters

model_folder_names <- c(
    "BGY-E0-C4-I8000-A0.8-T12-F10-V0",
    "BGY-E1-C4-I20000-A0.9-T12-F10-V0",
    "BGY-E1-C4-I20000-A0.99-T12-F50-V50",
    "BGY-E2-C4-I8000-A0.8-T12-F25-V0"
)

# model_folder_names <- c("BGY-E1-C4-I20000-A0.9-T12-F25-V0") # sanity check

# model_folder_names <- c(
#     "BGY-E0-C4-I8000-A0.8-T12-F50-V50",
#     "BGY-E1-C4-I8000-A0.8-T12-F50-V50",
#     "BGY-E2-C4-I8000-A0.8-T12-F50-V50",

#     "BGY-E0-C4-I8000-A0.8-T12-F25-V0",
#     "BGY-E1-C4-I8000-A0.8-T12-F25-V0",
#     "BGY-E2-C4-I8000-A0.8-T12-F25-V0",

#     "BMY-E0-C4-I8000-A0.8-T12-F25-V0",
#     "FAM-E0-C4-I8000-A0.8-T12-F25-V0",
#     "HAL-E0-C4-I8000-A0.8-T12-F25-V0",
#     "LTY-E0-C4-I8000-A0.8-T12-F25-V0",

#     "BMY-E1-C4-I8000-A0.8-T12-F25-V0",
#     "FAM-E1-C4-I8000-A0.8-T12-F25-V0",
#     "HAL-E1-C4-I8000-A0.8-T12-F25-V0",
#     "LTY-E1-C4-I8000-A0.8-T12-F25-V0",

#     "BMY-E2-C4-I8000-A0.8-T12-F25-V0",
#     "FAM-E2-C4-I8000-A0.8-T12-F25-V0",
#     "HAL-E2-C4-I8000-A0.8-T12-F25-V0",
#     "LTY-E2-C4-I8000-A0.8-T12-F25-V0"
# )

################################################################################
################################################################################
# model_params        <dataset><ll>-E<te>-C<chains>-I<iter>-A<ad>-T<td>

#     dataset         # BG = biogeographic realms,  GL = global, BM = biomes,
                      # LT = latitude-trop/not
#     te              # taxonomic effort 0=no taxonomic effort,
                      # 1=publication taxonomic effort
#     ll              # whether using lat lon data (Y) or
                      # global.distribution data (N)
#     chains          # stan's number of chains
#     iter            # stan's number of iterations
#     ad              # stan's adapt_delta
#     td              # stan's max tree depth

# note: GL and BM always Y; the rest can be either Y or N
################################################################################
################################################################################


#setwd('/Volumes/data/NF_eQTL_ALL/CAVIAR_newGWAS_2019/LD/test/')
library(tidyverse)
args = commandArgs(trailingOnly=TRUE)
ldfile <- args[1]
tmpdir <- args[2]
ecaviarfile <- args[3]
ld.matrix <- read_delim(ldfile,delim = '\t',col_names = F,col_types = cols('X1'='c')) %>% rename(chr=X1,pos=X2,rsnum=X3,ref=X4,alt=X5)
ld.info <- ld.matrix %>% mutate(Seq=seq_along(chr)) %>%  select(rsnum,Seq)
ld.matrix <- ld.matrix %>% select(-c(chr,pos,rsnum,ref,alt)) %>% as.matrix

ecaviar <- read_delim(paste0(tmpdir,'/',ecaviarfile),delim='\t',col_names=F)
colnames(ecaviar) <- c("gene_id","leadsnp","leadsnpincluded","rsnum","type")

genelist <- unique(ecaviar$gene_id)

for (gene in genelist){

  ld.matrix.seq <- NULL
  ld.matrix.seq2 <- NULL

  filename1 <- paste0(tmpdir,'/',gene,"/emerald.LD.txt")
  snplist <- ecaviar %>% filter(gene_id==gene,type=="ALL") %>% select(rsnum)
  rsindex <- snplist %>% left_join(ld.info) %>% pull(Seq)
  ld.matrix.seq <- ld.matrix[rsindex,rsindex]
  write.table(ld.matrix.seq, file=filename1, row.names=FALSE, col.names=FALSE,sep = '\t')

  filename2 <- paste0(tmpdir,'/',gene,"/emerald.50.LD.txt")
  snplist2 <- ecaviar %>% filter(gene_id==gene,type=="SNP50") %>% select(rsnum)
  rsindex2 <- snplist2 %>% left_join(ld.info) %>% pull(Seq)
  ld.matrix.seq2 <- ld.matrix[rsindex2,rsindex2]
  write.table(ld.matrix.seq2, file=filename2, row.names=FALSE, col.names=FALSE,sep = '\t')
}
### LEAVE EMPTY LINE BELOW ###


#NEON functional group tables.
#clear environment, source paths, packages and functions.
rm(list=ls())
library(data.table)
source('paths.r')

#set output paths.----
functional.output.path <- NEON_ITS_fastq_taxa_fg.path
     yeast.output.path <- NEON_ITS_fastq_yeast_taxa.path

#load data.----
sv <- readRDS(NEON_ITS_fastq_SV.table_clean.path)
map <- readRDS(hierarch_filled.path)
map <- map$core.obs
fun <- readRDS(NEON_ITS_fastq_fun_clean.path)

#Assign functional groups.----
#Colin double checked everything stays in order.
#Things can't be both ECM and SAP in dirlichet. Creates a sum to 1 problem.
tax <- data.table(fun)
tax[grep('Ectomycorrhizal', tax$guild),Ectomycorrhizal := 1]
tax[is.na(Ectomycorrhizal),            Ectomycorrhizal := 0]
tax[grep('Saprotroph', tax$guild),          Saprotroph := 1]
tax[is.na(Saprotroph),                      Saprotroph := 0]
tax[grep('Arbuscular', tax$guild),          Arbuscular := 1]
tax[is.na(Arbuscular),                      Arbuscular := 0]
tax[grep('Patho', tax$guild),                 Pathogen := 1]
tax[is.na(Pathogen),                          Pathogen := 0]
#assign yeast / non-yeast.
tax[grep('Yeast', tax$growthForm),               Yeast := 1]
tax[grep('Facultative Yeast', tax$growthForm),   Yeast := 0]
tax[grep('Facultative Yeast', tax$growthForm),   Facultative_Yeast := 1]
tax[is.na(Facultative_Yeast),         Facultative_Yeast:= 0]
tax[is.na(Yeast),                                Yeast := 0]
#If you are ECTO you can't be SAP
tax[Ectomycorrhizal == 1, Saprotroph := 0]
#if you are ecto or sap you not path.
tax[Ectomycorrhizal == 1,   Pathogen := 0]
tax[     Saprotroph == 1,   Pathogen := 0]
#convert back to data.frame.
tax <- as.data.frame(tax)
rownames(tax) <- rownames(fun)

#Get counts of fucntional groups. (ECM, AM, SAP, PATH)
function_groups <- c('Ectomycorrhizal','Arbuscular','Saprotroph','Pathogen')
fun.list <- list()
tax$map.ID <- rownames(tax)
z <- data.table(cbind(tax,t(sv)))
for(i in 1:length(function_groups)){
  k <- z[eval(parse(text=function_groups[i]))== 1,]
  start <- ncol(tax) + 1
  out <- colSums(k[,start:ncol(k)])
  fun.list[[i]] <- out
}
fun.list <- data.frame(t(do.call('rbind',fun.list)))
colnames(fun.list) <- function_groups

#get a yeast list.
yeast.list <- list()
function_groups <- c('Yeast','Facultative_Yeast')
z <- data.table(cbind(tax, t(sv)))
for(i in 1:length(function_groups)){
  k <- z[eval(parse(text=function_groups[i]))== 1,]
  start <- ncol(tax) + 1
  out <- colSums(k[,start:ncol(k)])
  yeast.list[[i]] <- out
}
yeast.list <- data.frame(t(do.call('rbind',yeast.list)))
colnames(yeast.list) <- function_groups

#Get together abundances and seq_total.----
seq_total <- colSums(z[,start:ncol(z)])
seq_total <- seq_total[order(match(names(seq_total),rownames(fun.list)))]
seq_total.yeast <- seq_total[order(match(names(seq_total), rownames(yeast.list)))]
other <- seq_total - rowSums(fun.list)
other.yeast <- seq_total.yeast - rowSums(yeast.list)
abundances <- cbind(other,fun.list)
yeast.abundances <- cbind(other.yeast, yeast.list)
rel.abundances <- abundances / seq_total
yeast.rel.abundances <- yeast.abundances/seq_total

#get other IDs in here. deprecatedVialID does not match all products.----
     abundances$geneticSampleID <- rownames(    abundances)
 rel.abundances$geneticSampleID <- rownames(rel.abundances)
yeast.abundances$geneticSampleID <- rownames(yeast.abundances)

#save output.----
dat.out <- list(abundances,rel.abundances,seq_total)
names(dat.out) <- c('abundances','rel.abundances','seq_total')
yeast.out <- list(yeast.abundances, yeast.rel.abundances, seq_total.yeast)
names(yeast.out) <- c('abundances','rel.abundances','seq_total')
saveRDS(dat.out, functional.output.path)
saveRDS(yeast.out, yeast.output.path)


library(ggplot2)
theme_set(theme_bw(18))
#setwd("~/cogsci/projects/stanford/projects/sinking_marbles/sinking-marbles/experiments/sinking-marbles-nullutterance/results/")
setwd("/Users/titlis/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/18_sinking-marbles_speaker_reliability/results/")
source("rscripts/helpers.r")
load("data/r.RData")
r = read.csv("data/sinking_marbles.csv")
nrow(r)
head(r)
r$trial = r$slide_number_in_experiment - 2
r = r[,c("assignmentid","workerid", "rt", "effect", "cause","language","gender.1","age","gender","other_gender","quantifier", "object_level", "response", "object","slider_id","num_objects","trial","enjoyment","asses","comments","Answer.time_in_minutes","trial_type","refexp","targetpos","stimtype")]
r$Item = as.factor(paste(r$effect,r$object))
table(r$Item)

pretrials = droplevels(subset(r, trial_type == "speakerreliability"))
pretrials = pretrials[, !apply(is.na(pretrials), 2, all)]
summary(pretrials)

pretrials$CorrectResponse = as.factor(ifelse(as.character(pretrials$targetpos) == as.character(pretrials$response), TRUE, FALSE))
head(pretrials)

ggplot(pretrials, aes(x=CorrectResponse, fill=stimtype)) +
  geom_histogram(position="dodge") +
  facet_wrap(~workerid)
ggsave(file="graphs/pretrial_subject_variability.pdf",width=10,height=8)

# 3 and 18 potentially worrisome (each got one wrong on overinformative trials)

r = droplevels(subset(r, trial_type == "cause_effect_prior"))
r = r[, !apply(is.na(r), 2, all)]
summary(r)

r$Proportion = factor(ifelse(r$slider_id == "all","100",ifelse(r$slider_id == "lower_half","1-50",ifelse(r$slider_id == "upper_half","51-99","0"))),levels=c("0","1-50","51-99","100"))

## add priors to data.frame
priorexpectations = read.table(file="~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/12_sinking-marbles-prior15/results/data/expectations.txt",sep="\t", header=T, quote="")
row.names(priorexpectations) = paste(priorexpectations$effect,priorexpectations$object)
r$PriorExpectation = priorexpectations[as.character(r$Item),]$expectation
r$PriorExpectationProportion = r$PriorExpectation/15

priorprobs = read.table(file="~/cogsci/projects/stanford/projects/thegricean_sinking-marbles/experiments/12_sinking-marbles-prior15/results/data/smoothed_15marbles_priors_withnames.txt",sep="\t", header=T, quote="")
head(priorprobs)
row.names(priorprobs) = paste(priorprobs$effect,priorprobs$object)
mpriorprobs = melt(priorprobs, id.vars=c("effect", "object"))
head(mpriorprobs)
row.names(mpriorprobs) = paste(mpriorprobs$effect,mpriorprobs$object,mpriorprobs$variable)
mpriorprobs$Proportion = factor(ifelse(mpriorprobs$variable == "X15","100",ifelse(mpriorprobs$variable == "X0","0",ifelse(mpriorprobs$variable %in% c("X1","X2","X3","X4","X5","X6","X7"),"1-50","51-99"))),levels=c("0","1-50","51-99","100"))
summary(mpriorprobs)
dppbs = ddply(mpriorprobs, .(effect,object,Proportion), summarise, Probability=sum(value))
row.names(dppbs) = paste(dppbs$effect,dppbs$object,dppbs$Proportion)
head(dppbs)
#test: all sums should be 1
ddply(dppbs, .(effect,object), summarise, S=sum(Probability))

r$PriorProbability = dppbs[paste(as.character(r$Item),as.character(r$Proportion),sep=" "),]$Probability
r$AllPriorProbability = priorprobs[paste(as.character(r$Item)),]$X15
head(r,15)

# compute normalized probabilities
r$response = as.numeric(as.character(r$response))
nr = ddply(r, .(workerid,trial), summarise, normresponse=response/(sum(response)),workerid=workerid,Proportion=Proportion)
row.names(nr) = paste(nr$workerid,nr$trial,nr$Proportion)
r$normresponse = nr[paste(r$workerid,r$trial,r$Proportion),]$normresponse
# test: sums should add to 1
sums = ddply(r, .(workerid,trial), summarise, sum(normresponse))
colnames(sums) = c("workerid","trial","sum")
summary(sums)

agr = aggregate(normresponse~workerid+quantifier+Proportion, data=r, FUN=mean)
nrow(agr)
ggplot(agr, aes(x=Proportion,y=normresponse)) +
  geom_bar(stat="identity") +
  facet_grid(workerid~quantifier)
ggsave(file="graphs/subject_variability.pdf",height=20,width=5)

save(r, file="data/r.RData")
save(pretrials, file="data/pretrials.RData")
##################

ggplot(aes(x=gender.1), data=r) +
  geom_histogram()

ggplot(aes(x=rt), data=r) +
  geom_histogram() +
  scale_x_continuous(limits=c(0,50000))

ggplot(aes(x=age), data=r) +
  geom_histogram()

ggplot(aes(x=age,fill=gender.1), data=r) +
  geom_histogram()

ggplot(aes(x=enjoyment), data=r) +
  geom_histogram()

ggplot(aes(x=asses), data=r) +
  geom_histogram()

ggplot(aes(x=quantifier), data=r) +
  geom_histogram()

ggplot(aes(x=Answer.time_in_minutes), data=r) +
  geom_histogram()

ggplot(aes(x=age,y=Answer.time_in_minutes,color=gender.1), data=unique(r[,c("assignmentid","age","Answer.time_in_minutes","gender.1")])) +
  geom_point() +
  geom_smooth()

unique(r$comments)


library(tidyr)
library(lubridate)
library(stringr)
library(tidyverse)
library(dplyr)
library(magrittr)

read_obs_data <- function(){
  # Read the deaths and cases data
  d <- read.csv("Italy/data/dpc-covid19-ita-regioni.csv")

  # Original column names
  # [1] "data"                       "stato"                      "codice_regione"             "denominazione_regione"      "lat"
  # [6] "long"                       "ricoverati_con_sintomi"     "terapia_intensiva"          "totale_ospedalizzati"       "isolamento_domiciliare"
  # [11] "totale_positivi"            "variazione_totale_positivi" "nuovi_positivi"             "dimessi_guariti"            "deceduti"
  # [16] "totale_casi"                "tamponi"                    "note_it"                    "note_en"

  d <- d %>% select(data,denominazione_regione,totale_casi, deceduti)
  colnames(d)<-c("DateRep","country","Cases","Deaths")

  d$DateRep<-as.Date(d$DateRep)
  d$country<-str_replace_all(d$country, " ", "_")
  d$country<-as.factor(d$country)

  #d$Cases<-as.numeric(d$Cases)
  #d$Deaths<-as.numeric(d$Deaths)
  #df<-d %>% group_by(DateRep) %>%  summarise(Cases=sum(Cases),Deaths = sum(Deaths))
  #write.csv(df,"Italy_18-04.csv")

  # Getting daily data from the cummulative data set
  d=  d %>% group_by(country) %>%
            arrange(DateRep) %>%
            mutate(Deaths = Deaths - lag(Deaths,default=0)) %>%
            mutate(Cases = Cases - lag(Cases,default=0)) %>%
            ungroup()

  # padding before
  regions<-levels(d$country)
  days<-length(seq(as.Date('2019/12/31'),as.Date(d$DateRep[1]-1),"days"))

  zeroes<-data.frame(DateRep=rep(seq(as.Date('2019/12/31'),as.Date(d$DateRep[1]-1),"days"),length(regions)),
                        country=regions[rep(seq_len(length(regions)), each = days)],
                        Cases=0,Deaths=0)

  d=bind_rows(zeroes,d)
  d$Cases[d$Cases<0] <- 0
  d$Deaths[d$Deaths<0] <- 0

  # Changing region names
  nametrans <- read.csv("Italy/data/province_name_translation.csv")
  colnames(nametrans)[which(colnames(nametrans)=="denominazione_regione")]<-"country"
  nametrans$country<-as.factor(nametrans$country)
  nametrans$country<-str_replace_all(nametrans$country, " ", "_")
  d_Italy<-data.frame(country="Italy",google_county="Italy",county="Italy")
  nametrans <- bind_rows(nametrans,d_Italy)
  d <- inner_join(d,nametrans,by.x="country",by.y="country") # fix names of regions
  d <- d[,-which(colnames(d) %in% c("country","google_county"))]
  colnames(d)[which(colnames(d)=="county")] <- "country"
  d$country<-str_replace_all(d$country, " ", "_")

  d <- d %>% select("country","DateRep","Cases","Deaths")

  return(d)
}

read_ifr_data <- function(regions){
  ifr.Italy.regional <- read.csv("Italy/data/weighted_ifrs_italy.csv")
  colnames(ifr.Italy.regional)[which(colnames(ifr.Italy.regional)=="state")]<-"country"
  colnames(ifr.Italy.regional)[which(colnames(ifr.Italy.regional)=="IFR")]<-"ifr"
  ifr.Italy.regional$country <- str_replace_all(ifr.Italy.regional$country, " ", "_")
  ifr.Italy.regional$country[which( ifr.Italy.regional$country=="Friuli_Venezia-Giulia")]<-"Friuli_Venezia_Giulia"
  ifr.Italy.regional$country[which( ifr.Italy.regional$country=="Provincia_Autonoma_Bolzano")]<-"P.A._Bolzano"
  ifr.Italy.regional$country[which( ifr.Italy.regional$country=="Provincia_Autonoma_Trento")]<-"P.A._Trento"
  ifr.Italy.regional$country[which( ifr.Italy.regional$country=="Valle_D'Aosta")]<-"Valle_d'Aosta"
  colnames(ifr.Italy.regional)[which(colnames(ifr.Italy.regional)=="total_pop")] <- "popt"

  # ## get IFR and population
  ifr.by.country = read.csv("data/popt_ifr.csv")
  ifr.by.country$country = as.character(ifr.by.country[,2])

  # Changing region names
  nametrans <- read.csv("Italy/data/province_name_translation.csv")
  colnames(nametrans)[which(colnames(nametrans)=="denominazione_regione")]<-"country"
  nametrans$country<-as.factor(nametrans$country)
  nametrans$country<-str_replace_all(nametrans$country, " ", "_")
  ifr.Italy.regional <- inner_join(ifr.Italy.regional,nametrans,by.x="country",by.y="country") # fix names of regions
  ifr.Italy.regional <- ifr.Italy.regional[,-which(colnames(ifr.Italy.regional) %in% c("country","google_county"))]
  colnames(ifr.Italy.regional)[which(colnames(ifr.Italy.regional)=="county")] <- "country"
  ifr.Italy.regional$country<-str_replace_all(ifr.Italy.regional$country, " ", "_")

  ifr.Italy.regional <- ifr.Italy.regional %>% select("country","X","ifr","popt")
  ifr.national<-ifr.by.country[which(ifr.by.country$country=="Italy"),]$ifr
  ifr.Italy.regional <- bind_rows(ifr.Italy.regional,data.frame(country="Italy",ifr=ifr.national,popt=60359546))
  ifr.Italy.regional$X[which(ifr.Italy.regional$country=="Italy")]<-23

  return(ifr.Italy.regional)
}

read_google_mobility <- function(Country){
  google_mobility <- read.csv('data/Global_Mobility_Report.csv', stringsAsFactors = FALSE)
  google_mobility$date = as.Date(google_mobility$date, format = '%Y-%m-%d')
  google_mobility[, c(6,7,8,9,10,11)] <- google_mobility[, c(6,7,8,9,10,11)]/100
  google_mobility[, c(6,7,8,9,10)] <- google_mobility[, c(6,7,8,9,10)] * -1
  google_mobility<-google_mobility[,c(2,3,5,6,7,8,9,10,11)]
  colnames(google_mobility)[which(colnames(google_mobility)=="country_region")]<-"state"
  colnames(google_mobility)[which(colnames(google_mobility)=="sub_region_1")]<-"country"
  colnames(google_mobility)[which(colnames(google_mobility)=="grocery_and_pharmacy_percent_change_from_baseline")]<-"grocery.pharmacy"
  colnames(google_mobility)[which(colnames(google_mobility)=="parks_percent_change_from_baseline")]<-"parks"
  colnames(google_mobility)[which(colnames(google_mobility)=="transit_stations_percent_change_from_baseline")]<-"transitstations"
  colnames(google_mobility)[which(colnames(google_mobility)=="workplaces_percent_change_from_baseline")]<-"workplace"
  colnames(google_mobility)[which(colnames(google_mobility)=="residential_percent_change_from_baseline")]<-"residential"
  colnames(google_mobility)[which(colnames(google_mobility)=="retail_and_recreation_percent_change_from_baseline")]<-"retail.recreation"
  google_mobility$country[which(google_mobility$country =="")]<-"Italy"

  mobility <- google_mobility
  nametrans <- read.csv("Italy/data/province_name_translation.csv")
  Italy<-data.frame(denominazione_regione="Italy",google_county="Italy",county="Italy")
  nametrans<-bind_rows(nametrans,Italy)
  mobility$country<-as.factor(mobility$country)
  nametrans$google_county<-as.factor(nametrans$google_county)
  #mobility <- mobility %>% filter(country !="")
  colnames(nametrans)[which(colnames(nametrans)=="google_county")]<-"country"
  mobility <- inner_join(mobility,nametrans,by.x="country",by.y="country") # fix names of regions
  mobility$country<-str_replace_all(mobility$denominazione_regione, " ", "_")
  mobility <- mobility %>% select(country,date,grocery.pharmacy,parks,residential,retail.recreation,transitstations,workplace)

  # Changing region names
  nametrans <- read.csv("Italy/data/province_name_translation.csv")
  colnames(nametrans)[which(colnames(nametrans)=="denominazione_regione")]<-"country"
  nametrans$country<-as.factor(nametrans$country)
  nametrans$country<-str_replace_all(nametrans$country, " ", "_")
  mobility <- mobility %>% filter(country !="Italy")
  mobility <- inner_join(mobility,nametrans,by.x="country",by.y="country") # fix names of regions
  mobility <- mobility[,-which(colnames(mobility) %in% c("country","google_county"))]
  colnames(mobility)[which(colnames(mobility)=="county")] <- "country"
  mobility$country<-str_replace_all(mobility$country, " ", "_")
  mobility <- mobility %>% select("country","date","grocery.pharmacy","parks","residential","retail.recreation","transitstations","workplace")
  return(mobility)
}

read_interventions <- function(){
  covariates<-read.csv("Italy/data/Italy_events.csv")
  covariates=covariates[c(1:105),c(1:5)]

  covariates=covariates %>% select(Regions,Intervention,Effective_date) %>%
    pivot_wider(names_from=Intervention,values_from=Effective_date)
  colnames(covariates)=c("country","School_closures","Case_based_measures","Social_distancing","Public_events","Lockdown")

  covariates$School_closures=dmy(covariates$School_closures)
  covariates$Case_based_measures=dmy(covariates$Case_based_measures)
  covariates$Social_distancing=dmy(covariates$Social_distancing)
  covariates$Lockdown=dmy(covariates$Lockdown)
  covariates$Public_events=dmy(covariates$Public_events)
  colnames(covariates)=c( "Country","schools_universities","self_isolating_if_ill","social_distancing_encouraged","public_events","lockdown" )
  covariates=as.data.frame(covariates)
  #covariates$country <- factor(covariates$country)
  covariates$Country <- factor(covariates$Country)
  write.csv(covariates,"Italy/data/Italy_interventions.csv")

  # add all of Italy
  covariates_countries <- read_csv("data/interventions.csv")
  covariates_countries <- covariates_countries[which(covariates_countries$Country=="Italy"), c('Country', 'Type', 'Date effective')]

  covariates_countries <- spread(covariates_countries, Type, 'Date effective')
  colnames(covariates_countries)=c("Country","schools_universities","public_events","lockdown","social_distancing_encouraged","self_isolating_if_ill")

  covariates_countries$schools_universities<-as.Date(covariates_countries$schools_universities,format="%Y-%m-%d")
  covariates_countries$public_events<-as.Date(covariates_countries$public_events,format="%Y-%m-%d")
  covariates_countries$lockdown<-as.Date(covariates_countries$lockdown,format="%Y-%m-%d")
  covariates_countries$social_distancing_encouraged<-as.Date(covariates_countries$social_distancing_encouraged,format="%Y-%m-%d")
  covariates_countries$self_isolating_if_ill<-as.Date(covariates_countries$self_isolating_if_ill,format="%Y-%m-%d")

  covariates<-bind_rows(covariates_countries,covariates)

  # Changing region names
  nametrans <- read.csv("Italy/data/province_name_translation.csv")
  colnames(nametrans)[which(colnames(nametrans)=="denominazione_regione")]<-"country"
  nametrans$country<-as.factor(nametrans$country)
  nametrans$country<-str_replace_all(nametrans$country, " ", "_")
  colnames(nametrans)[which(colnames(nametrans)=="country")]<-"Country"
  covariates <- inner_join(covariates,nametrans,by.x="Country",by.y="Country") # fix names of regions
  covariates <- covariates[,-which(colnames(covariates) %in% c("Country","google_county"))]
  colnames(covariates)[which(colnames(covariates)=="county")] <- "Country"
  covariates$Country<-str_replace_all(covariates$Country, " ", "_")

  covariates <- covariates %>% select("Country","schools_universities","public_events","lockdown","social_distancing_encouraged","self_isolating_if_ill")
  return(covariates)
}


#' @name earthqCHI
#' @title Chinese earthquake loss data set
#' @description The data set is collected from the ``China earthquake yearbook" .
#' This data set concerns the Chinese mainland, which contains risk information on 291 earthquake events with magnitude greater than 4.0 from 1990 to 2015.
#' @docType data
#' @usage data(earthqCHI)
#' @format earthqCHI contains six columns:
#' \itemize{
#'   \item year: occurrence year.
#'   \item y1: Economic Losses (adjusted). It is expressed in millions of Chinese Yuan (CNY) and are adjusted for inflation to reflect values in 2015.
#'   \item yraw: Economic Losses (original).
#'   \item death: the number of deaths from an earthquake event.
#'   \item inj: the number of injures from an earthquake event.
#'   \item magnitude, intensity : the magnitude and maximum intensity of an earthquake event.
#'   \item y2: casualties are defined as fatalities and injured people, which are due to damage to occupied buildings.
#'   \item u1: cdf of the fitted GLMGA regression model used in Li et al.,(2021) evaluated at y1.
#'   \item u2: cdf of the fitted composite Negative Binomial-Pareto model evaluated at y2.
#'   \item u2_: cdf of the fitted composite Negative Binomial-Pareto model evaluated at y2-1.
#'   \item f1: pdf of the fitted GLMGA regression model used in Li et al.,(2021) evaluated at y1.
#'   \item f2: pdf of the fitted composite Negative Binomial-Pareto model evaluated at y2.
#' }
#' @author Zhengxiao Li, 2021-08-03
#' @references Zhengxiao Li, Jan Beirlant, Shengwang Meng. Generalizing The Log-Moyal Distribution And Regression Models For Heavy-Tailed Loss Data. ASTIN Bulletin: The Journal of the IAA, 11(1):57-99, 2021.
#'
#'
"earthqCHI"

#' #' @name earth_model
#' #' @title Chinese earthquake loss data set
#' #' @description The data set is collected from the ``China earthquake yearbook" .
#' #' This data set concerns the Chinese mainland, which contains risk information on 291 earthquake events with magnitude greater than 4.0 from 1990 to 2015.
#' #' @docType data
#' #' @usage data(earth_model)
#' #' @format earth_model contains six columns:
#' #' \itemize{
#' #'   \item y1: Economic Losses (adjusted). It is expressed in millions of Chinese Yuan (CNY) and are adjusted for inflation to reflect values in 2015.
#' #'   \item yraw: Economic Losses (original)
#' #'   \item death: the number of deaths from an earthquake event
#' #'   \item inj: the number of injures from an earthquake event
#' #'   \item magnitude, intensity : the magnitude and maximum intensity of an earthquake event
#' #'   \item y2: casualties are defined as fatalities and injured people, which are due to damage to occupied buildings.
#' #'   \item u1: 12
#' #'   \item u2: 121
#' #'   \item u2_: 121
#' #'   \item f1: 121
#' #'   \item f2: 121
#' #' }
#' #' @source UCSC Table Browser
#' #' @author Zhengxiao Li, 2021-08-03
#' #'
#' #'
#' #'
#' "earth_model"


library("dplyr")

add_start_points <- function(pop_df, start_positions = 0.5) {

	original_colname <- "Generation"
	# rename Time column (original name will be restored later):
	if("Time" %in% colnames(pop_df) && !("Generation" %in% colnames(pop_df))) {
		colnames(pop_df)[colnames(pop_df) == "Time"] <- "Generation"
		original_colname <- "Time"
	}

	# set small time interval:
	all_gens_list <- unique(pop_df$Generation)
	delta <- abs(min(1E-2 * min(diff(all_gens_list)), 1E-4 * (max(all_gens_list) - min(all_gens_list))))
	delta_debug <- min(diff(all_gens_list))
	start_positions <- max(start_positions, delta)
	start_positions <- min(start_positions, 1 - delta)
	start_positions <- max(start_positions, 0.5) # Manual change for large datasets (LTEE)
	# set small initial population size:
	init_size <- 0

	# get reference list of generations at which new genotypes appear (and previous generations):
	min_gen <- min(pop_df$Generation)
	first_gens <- group_by_(pop_df, ~Identity) %>%
		filter_(~max(Population) > 0) %>%
		summarise_(start_time = ~min(Generation[which(Population > 0)]),
				   previous_time = ~lag(Generation)[min(which(Population > 0))]) %>%
		filter_(~start_time > min_gen) %>%
		ungroup()

	# if all genotypes appear at the first time point then don't make any changes:
	if(dim(first_gens)[1] == 0) return(pop_df)

	# function to get the generation previous to a specified generation:
	lag_gens <- function(x) {
		ans <- lag(all_gens_list)[which(all_gens_list == x)]
		if(is.na(ans)) return(0)
		return(ans)
	}

	# copy all rows for generations at which new genotypes appear:
	gens_list <- unique(first_gens$start_time)
	new_rows <- filter_(pop_df, ~Generation %in% gens_list)
	prev_rows <- filter_(pop_df, ~Generation %in% sapply(gens_list, lag_gens))
	# adjust generations of copied rows:
	new_rows$Generation <- new_rows$Generation - start_positions * (new_rows$Generation - sapply(new_rows$Generation, lag_gens))
	# adjust populations of copied rows:
	new_rows$Population <- (1 - start_positions) * new_rows$Population + start_positions * prev_rows$Population
	# add the copied rows to the dataframe:
	pop_df <- bind_rows(pop_df, new_rows) %>%
		arrange_(~Generation, ~Identity)

	# adjust generations in reference list:
	first_gens$Generation <- first_gens$start_time - start_positions * (first_gens$start_time - sapply(first_gens$start_time, lag_gens))
	# set small initial populations in reference list:
	first_gens$Population2 <- init_size

	# replace initial populations in the dataframe with values from reference list:
	pop_df <- merge(pop_df, first_gens, all.x = TRUE)
	pop_df$Population <- ifelse(is.na(pop_df$Population2), pop_df$Population, pop_df$Population2)
	pop_df <- pop_df[, !(names(pop_df) %in% c("Population2", "start_time", "previous_time"))]

	# restore original time column name:
	colnames(pop_df)[colnames(pop_df) == "Generation"] <- original_colname

	return(pop_df)
}

args = commandArgs(trailingOnly=TRUE)
#filename <- "/home/cld100/Documents/github/muller_diagrams/tests/test_get_muller_df_migration/data_add_start_points/B1_Muller.ggmuller.populations.tsv"
filename <- args[1]
pop_df <- read.csv(filename, sep = "\t", header = TRUE)

result <- add_start_points(pop_df)

write.table(result, args[2], sep = "\t", row.names = FALSE)