library("data.table")
library("ggplot2")
library("reshape2")
library("gridExtra")

install.packages("data.table")
install.packages("ggplot2")
install.packages("reshape2")
install.packages("gridExtra")

in_dirs <- dir("datasets",full.names = T)
base_dirs <- paste(in_dirs,"/tables",sep="")
in_files <- dir(base_dirs,full.names = T)

x <- in_files[1]
x
tmp <- lapply(in_files,function(x){
    method   <- unlist(strsplit(dirname(x),"/"))[2]
    test_set <- unlist(strsplit(basename(x),"_"))[3]
    ont      <- unlist(strsplit(basename(x),"[_.]"))[4]
    tmp_perf <- read.table(x,header = T,sep = "\t")

    pr <- mean(tmp_perf$num_tp/(tmp_perf$num_tp+tmp_perf$num_fp))
    rc <- mean(tmp_perf$num_tp/(tmp_perf$num_tp+tmp_perf$num_fn))
    f_stat <- 2*pr*rc/(pr+rc)
    num_genes <- length(unique(tmp_perf$gene))
    c(method,test_set,ont,pr,rc,f_stat,num_genes)
})

all_pr_rc <- data.frame(do.call(rbind,tmp))

all_pr_rc[,4:6] <- apply(all_pr_rc[,4:6],2,function(x){as.numeric(as.character(x))})
colnames(all_pr_rc) <- c("method","test_set","ont","pr","rc","f_stat","num_genes")
all_pr_rc
plot_data <- melt(all_pr_rc[,c(1:3,6,7)],id.vars = c("method","test_set","ont","num_genes"))
plot_data$num_genes <- as.numeric(as.character(plot_data$num_genes))
plot_data$value <- round(as.numeric(plot_data$value),2)
plot_data
plot_data$method <- factor(plot_data$method,levels = c("tair","uniprot","interpro","argot2","fanngo","pannzer","gramene"))
xlbls <- c("TAIR","Plant","InterProScan","Argot2","FANNGO","PANNZER","Gramene")

tool_cats <- read.table("annot_tool_cat.txt",header = T,sep = "\t",as.is = )
plot_data_cat <- merge(plot_data,tool_cats,by.x = "method",by.y = "tool")
plot_data_cat$category <- factor(plot_data_cat$category,levels=c("BLAST","InterProScan","CAFA","Gramene"))

mz_gdb <- plot_data_cat[plot_data$test_set=="maizegdb",]
mz_gdb

cbbpallette = c("#FFF2CC","#DEEBF7","#E2F0D9","#FBE5D6")
#png("plots/perf.plot.png",width=15.5,height=6,units = "in",res = 300)
p <- ggplot(mz_gdb,aes(x=method,y=value,ymax=1.05,fill=category))
p <- p + geom_bar(stat = "identity",position = "dodge",width=0.8,color="black")
p <- p + geom_text(aes(label=num_genes),vjust=-0.3,position = position_dodge(width=1),size=4)
p <- p + facet_grid(.~ont)
#p <- p + scale_fill_brewer(labels = xlbls,type = "qual")
p <- p + theme(axis.text.x = element_text(angle=45,vjust=0.6),legend.position="right")
p <- p + scale_x_discrete("Tool", labels=xlbls) + ylim(0,1.2)
p <- p + scale_fill_manual(values=cbbpallette)
p <- p + ggtitle("Evaluations based on Manual Annotations from MaizeGDB")
p <- p + ylab("F-Score")
p

png("plots/perf.plot.png",width = 13.6,height = 5,units = "in",res = 300)
print(p)
dev.off()

uniprot_test <- plot_data[plot_data$test_set=="uniprot",]
#png("plots/perf.plot.png",width=15.5,height=6,units = "in",res = 300)
uniprot_plot <- ggplot(uniprot_test,aes(x=method,y=value,ymax=1.05,fill=method))
uniprot_plot <- uniprot_plot + geom_bar(stat = "identity",position = "dodge",width=0.8)
uniprot_plot <- uniprot_plot + geom_text(aes(label=num_genes),vjust=-0,position = position_dodge(width=1),size=4)
#p <- p + geom_bar(stat = "identity")
uniprot_plot <- uniprot_plot + facet_grid(.~ont)
#uniprot_plot <- uniprot_plot + guides(fill=F)
uniprot_plot <- uniprot_plot + theme(axis.text.x = element_text(angle=90,vjust=0.5))
uniprot_plot <- uniprot_plot + scale_fill_brewer(labels = xlbls,type = "qual")
uniprot_plot <- uniprot_plot + guides(fill=guide_legend(title="Tool"))
uniprot_plot <- uniprot_plot + scale_x_discrete("Tool", labels=xlbls)
#p <- p + scale_fill_gradient(breaks=seq(0,500,100))
uniprot_plot <- uniprot_plot + ggtitle("B) Evaluations based on Uniprot test dataset")
uniprot_plot <- uniprot_plot + ylab("F-Score") + ylim(0,1.2)
uniprot_plot
#dev.off()

#png("plots/perf.plot.png",width = 15.5,height = 5,units = "in",res = 300)
#grid.arrange(p,uniprot_plot,ncol=2,widths=c(7,8.5))
#dev.off()


wd="D:/Dropbox/current work/IUCN_threat_analysis_redo/"
#wd="C:/Users/Kaipo Dye/Dropbox/PICCC/IUCN_threats_analysis_outputs/"
setwd(wd)
species_types=c("critically endangered", "endangered", "least concern")
proj_names=c("all", "CC", "nCC")
groups=c("none", "single", "multiple")

species_type=species_types[1]
proj_name=proj_names[1]
group=groups[1]
for (proj_name in proj_names){
  for (species_type in species_types){

    name = paste0("results/", proj_name, "_threat_count_distr_summary_",species_type,"_species.csv") #names jpeg file to be created
    table=read.csv(name, header = T, row.names = NULL, check.names = FALSE) #
    table=cbind(proj_name, species_type, table)
    for (group in groups){
      jnk=table[1,group]/sum(table[1,groups])
      table=cbind(table, jnk)
      names(table)[dim(table)[2]]=paste0(group,"_prop")
    }
    if ((species_type==species_types[1]) & (proj_name==proj_names[1])){
      all_tables=table
    }else{
      all_tables=rbind(all_tables, table)
    }
  }
}
all_tables=cbind(all_tables, upper=all_tables$mean.n.threats.nonZero+all_tables$sd.n.threats.nonZero)
all_tables=cbind(all_tables, lower=all_tables$mean.n.threats.nonZero-all_tables$sd.n.threats.nonZero)
write.table(all_tables, file = paste0("results/all_threat_count_tables",".csv"), sep=",", row.names = FALSE)

library(ggplot2)
# plot proportion of multiple threat species
a=ggplot(all_tables, aes(x=proj_name, y=multiple_prop, fill=species_type)) +
  geom_bar(aes(fill = species_type), position = "dodge", stat="identity")
a
ggsave(a, file="results/proportion_of_species_under_multiple_threats.tiff", width=6, height=4)

# plot proportion of single threat species
a=ggplot(all_tables, aes(x=proj_name, y=single_prop, fill=species_type)) +
  geom_bar(aes(fill = species_type), position = "dodge", stat="identity")
a
ggsave(a, file="results/proportion_of_species_under_single_threat.tiff", width=6, height=4)

# plot number of mean number of threats for species with threat info
a=ggplot(all_tables, aes(x=proj_name, y=mean.n.threats.nonZero, fill=species_type)) +
  geom_bar(position=position_dodge(), stat="identity")
a
ggsave(a, file="results/mean.n.threats.nonZero.tiff", width=6, height=4)

#with error
a=ggplot(all_tables, aes(x=proj_name, y=mean.n.threats.nonZero, fill=species_type)) +
  geom_bar(position=position_dodge(), stat="identity") +
  geom_errorbar(aes(ymin=lower, ymax=upper),
                width=.2,                    # Width of the error bars
                position=position_dodge(.9))
a
ggsave(a, file="results/mean.n.threats.nonZero.with.error.tiff", width=6, height=4)

older/older version of repository/2_collect_all_stats.r


#!/usr/bin/env R
#
# largest_mono.r
#
# author = thomas huber
# mail = thomas.huber@evobio.eu
#
# script to find the largest monophylies for each taxon within a given SNP set
# input: (1) replicate folder, which has topology and replicate info files
#
# output: lists of largest monophyletic sets per taxon
#

# MORE OR LESS USELESS for our analysis - we do not have monophyletic taxa...

library(ape)
library(phangorn)
library(stringr)

##### FUNCTIONS #####
### get biggest monophylum of specified group of ind ###
selected_ind = selnam
tree = tr
taxa = direction
catch_monos = function(selected_ind, tree, taxa) {
  # wall_monop = data.frame()
  seltax = names(selected_ind)

  monop = data.frame()
  for (i in c(length(selected_ind):1)){
    psblts = combn(seltax, i)
    for (psb in c(1:ncol(psblts))) {
      sel_tax = psblts[,psb]
      check2 = is.monophyletic(tree, sel_tax)
      if (check2) {
        the_line = paste(sel_tax, collapse = ',')
        new_line = data.frame('taxon' = taxa, 'monophylum' = the_line)
        monop = rbind(monop, new_line)
      }
    }
    if (nrow(monop) > 0) {
    #   for (columca in c(1:ncol(monop))){
    #     columna = monop[,columca]
    #     the_line = paste(columna, collapse = ',')
    #     new_line = data.frame('taxon' = taxa, 'monophylum' = the_line)
    #     wall_monop = rbind(wall_monop, new_line)
    #   }
    #   new_line = data.frame('taxon' = taxa, 'monophylum' = the_line)
       break
    }
  }
  monop
}
### for general mps ###
simple_monophylies = function(tree, assigned_names){
  all_monop = data.frame()
  the_tips = assigned_names[tree$tip.label]
  cols = as.numeric(as.factor(the_tips))

  for (taxc in unique(cols)) {
    tax = levels(as.factor(assigned_names[tree$tip.label]))[taxc]
    selnam = the_tips[unname(the_tips) == tax]
    all_monop = rbind(all_monop, catch_monos(selnam, tree, tax))
  }
  all_monop
}
### for monophyles with west, east distribution ###
sclas_monophylies = function(tree, assigned_names){
  all_monop = data.frame()
  the_tips = assigned_names[tree$tip.label]
  cols = as.numeric(as.factor(the_tips))

  for (direction in c('west', 'east')) {
    meck = sapply(the_tips, function(xx) grepl(direction, xx, ignore.case = T))
    selnam = as.factor(assigned_names[tree$tip.label])[meck]
    all_monop = rbind(all_monop, catch_monos(selnam, tr, direction))
  }
  all_monop
}

##### ANALYSIS #####
ARGS = commandArgs(trailingOnly = TRUE)
setwd(ARGS[1])
# setwd('/Users/Thomsn/Desktop/Studium/MEME Programme [current]/Universite de Montpellier [Sem2]/internship_scornavacca_lab/git_lab/phylogenetto/data/real_data/vitis/')

tr = read.nexus('rep_new_topo.nex')
summatr = read.csv('replicate_data.csv')
summatr$cut_names[summatr$cut_names %in% tr$tip.label]
plot(tr)
sumnam = setNames(summatr$pop, summatr$cut_names)

tre_tips = sumnam[tr$tip.label]

colr = as.numeric(as.factor(tre_tips))
plot(tr, tip.color = colr)
write.nexus(tr, file = '')
tr$edge.length

simple_monophylies(tr, sumnam)

sclas_monophylies(tr, sumnam)


library(GenomicRanges)
library(bumphunter)
library(RColorBrewer)

load('/dcl01/lieber/ajaffe/lab/brain-epigenomics/bumphunting/BSobj_bsseqSmooth_Neuron_minCov_3.Rdata')
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/DMR/DMR_objects.rda")
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/bumphunting/rda/limma_Neuron_CpGs_minCov_3_ageInfo_dmrs.Rdata")

# load HARs
HARs = openxlsx::read.xlsx('/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/HARs_hg19_Doan_Walsh_Table_S1.xlsx')
hars = makeGRangesFromDataFrame(HARs, keep.extra.columns=T)
length(hars) # 2737

# Identify all CpG clusters in the genome
gr <- granges(BSobj)
cl = clusterMaker( chr = as.character(seqnames(gr)),
                   pos = start(gr),   maxGap = 1000)
gr.clusters = split(gr, cl)
gr.clusters = unlist(range(gr.clusters))
df.clusters = as.data.frame(gr.clusters)

# Find overlaps with DMRS in all three models

dmrs = split(dmrs, dmrs$k6cluster_label)
names(dmrs) = c("Gr1","Gr2","Gr3","Gr4","Gr5","Gr6")
oo = lapply(dmrs, function(x) findOverlaps(x, makeGRangesFromDataFrame(DMR$Interaction)))
dmrs = lapply(oo, function(x) DMR$Interaction[subjectHits(x),])

DMRgr = lapply(c(DMR, dmrs), function(x) makeGRangesFromDataFrame(x[which(x$fwer<=0.05),], keep.extra.columns=T))

oo = lapply(DMRgr, function(x) findOverlaps(gr.clusters, x))
lapply(oo, function(x) length(unique(queryHits(x))))

harOverlap = findOverlaps(hars, gr.clusters)

df.clusters$regionID = paste0(df.clusters$seqnames,":",df.clusters$start,"-",df.clusters$end)
df.clusters$rnum = 1:length(gr.clusters)
df.clusters$CellType = ifelse(df.clusters$rnum %in% queryHits(oo$CellType), "CellType","no")
df.clusters$Age = ifelse(df.clusters$rnum %in% queryHits(oo$Age), "Age","no")
df.clusters$Interaction = ifelse(df.clusters$rnum %in% queryHits(oo$Interaction), "Interaction","no")
df.clusters$Gr1 = ifelse(df.clusters$rnum %in% queryHits(oo$Gr1), "Gr1","no")
df.clusters$Gr2 = ifelse(df.clusters$rnum %in% queryHits(oo$Gr2), "Gr2","no")
df.clusters$Gr3 = ifelse(df.clusters$rnum %in% queryHits(oo$Gr3), "Gr3","no")
df.clusters$Gr4 = ifelse(df.clusters$rnum %in% queryHits(oo$Gr4), "Gr4","no")
df.clusters$Gr5 = ifelse(df.clusters$rnum %in% queryHits(oo$Gr5), "Gr5","no")
df.clusters$Gr6 = ifelse(df.clusters$rnum %in% queryHits(oo$Gr6), "Gr6","no")
df.clusters$HARs = ifelse(df.clusters$rnum %in% subjectHits(harOverlap), "HAR","no")

## make contingency tables

tables = list()
for (i in 1:length(names(DMRgr))) {
  tables[[i]] = data.frame(YesHAR = c(nrow(df.clusters[df.clusters$HARs=="HAR" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                      nrow(df.clusters[df.clusters$HARs=="HAR" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                           NoHAR = c(nrow(df.clusters[df.clusters$HARs=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                     nrow(df.clusters[df.clusters$HARs=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                           row.names = c("YesDMR","NoDMR"))
}
names(tables) = names(DMRgr)

fisher = lapply(tables, fisher.test)

df = do.call(rbind, Map(cbind, lapply(fisher, function(x) data.frame(OR = x$estimate,
                                                                     upper = x$conf.int[2],
                                                                     lower = x$conf.int[1],
                                                                     pval = x$p.value)), Model = as.list(names(fisher))))
df$fdr = p.adjust(df$pval, method= "fdr")

## test for enrichment of conserved, evolutionarily dated enhancers

noonan = openxlsx::read.xlsx('/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/Emera_Noonan_supptable_1.xlsx')
x = GRanges(noonan[,1])
mcols(x) = noonan[,2:3]
noonan = x
length(noonan) # 30526
noonan = c(list(enhancers = noonan), as.list(split(noonan, noonan$Phylogenetic.age.assignment)))

noonanOv = lapply(noonan, function(x) findOverlaps(x, gr.clusters))

hits = lapply(noonanOv, function(x) ifelse(df.clusters$rnum %in% subjectHits(x), "yes","no"))

for (i in 1:length(hits)) { df.clusters[,17+i] = hits[[i]] }
colnames(df.clusters)[18:28] = names(hits)

## make contingency tables

tables = list()
for (i in 1:length(names(DMRgr))) {
  tables[[i]] = list(enhancers = data.frame(YesHit = c(nrow(df.clusters[df.clusters$enhancers=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                       nrow(df.clusters[df.clusters$enhancers=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                            NoHit = c(nrow(df.clusters[df.clusters$enhancers=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                      nrow(df.clusters[df.clusters$enhancers=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                            row.names = c("YesDMR","NoDMR")),
                     Amniota = data.frame(YesHit = c(nrow(df.clusters[df.clusters$Amniota=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                     nrow(df.clusters[df.clusters$Amniota=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                          NoHit = c(nrow(df.clusters[df.clusters$Amniota=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                    nrow(df.clusters[df.clusters$Amniota=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                          row.names = c("YesDMR","NoDMR")),
                     Eutheria = data.frame(YesHit = c(nrow(df.clusters[df.clusters$Eutheria=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                      nrow(df.clusters[df.clusters$Eutheria=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                           NoHit = c(nrow(df.clusters[df.clusters$Eutheria=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                     nrow(df.clusters[df.clusters$Eutheria=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                           row.names = c("YesDMR","NoDMR")),
                     Gnathostomata = data.frame(YesHit = c(nrow(df.clusters[df.clusters$Gnathostomata=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                           nrow(df.clusters[df.clusters$Gnathostomata=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                                NoHit = c(nrow(df.clusters[df.clusters$Gnathostomata=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                          nrow(df.clusters[df.clusters$Gnathostomata=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                                row.names = c("YesDMR","NoDMR")),
                     Human = data.frame(YesHit = c(nrow(df.clusters[df.clusters$Human=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                   nrow(df.clusters[df.clusters$Human=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                        NoHit = c(nrow(df.clusters[df.clusters$Human=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                  nrow(df.clusters[df.clusters$Human=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                        row.names = c("YesDMR","NoDMR")),
                     Mammalia = data.frame(YesHit = c(nrow(df.clusters[df.clusters$Mammalia=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                      nrow(df.clusters[df.clusters$Mammalia=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                           NoHit = c(nrow(df.clusters[df.clusters$Mammalia=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                     nrow(df.clusters[df.clusters$Mammalia=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                           row.names = c("YesDMR","NoDMR")),
                     "No age assignment" = data.frame(YesHit = c(nrow(df.clusters[df.clusters$"No age assignment"=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                                 nrow(df.clusters[df.clusters$"No age assignment"=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                                      NoHit = c(nrow(df.clusters[df.clusters$"No age assignment"=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                                nrow(df.clusters[df.clusters$"No age assignment"=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                                      row.names = c("YesDMR","NoDMR")),
                     Primate = data.frame(YesHit = c(nrow(df.clusters[df.clusters$Primate=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                     nrow(df.clusters[df.clusters$Primate=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                          NoHit = c(nrow(df.clusters[df.clusters$Primate=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                    nrow(df.clusters[df.clusters$Primate=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                          row.names = c("YesDMR","NoDMR")),
                     Tetrapoda = data.frame(YesHit = c(nrow(df.clusters[df.clusters$Tetrapoda=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                       nrow(df.clusters[df.clusters$Tetrapoda=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                            NoHit = c(nrow(df.clusters[df.clusters$Tetrapoda=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                      nrow(df.clusters[df.clusters$Tetrapoda=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                            row.names = c("YesDMR","NoDMR")),
                     Theria = data.frame(YesHit = c(nrow(df.clusters[df.clusters$Theria=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                    nrow(df.clusters[df.clusters$Theria=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                         NoHit = c(nrow(df.clusters[df.clusters$Theria=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                   nrow(df.clusters[df.clusters$Theria=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                         row.names = c("YesDMR","NoDMR")),
                     Vertebrata = data.frame(YesHit = c(nrow(df.clusters[df.clusters$Vertebrata=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                        nrow(df.clusters[df.clusters$Vertebrata=="yes" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                             NoHit = c(nrow(df.clusters[df.clusters$Vertebrata=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]==names(DMRgr)[i],]),
                                                       nrow(df.clusters[df.clusters$Vertebrata=="no" & df.clusters[,colnames(df.clusters)==names(DMRgr)[i]]=="no",])),
                                             row.names = c("YesDMR","NoDMR")))
}
names(tables) = names(DMRgr)

fisher = lapply(tables, function(x) lapply(x, fisher.test))
res = do.call(rbind, Map(cbind, lapply(fisher, function(y)
           do.call(rbind, Map(cbind, lapply(y, function(x) data.frame(OR = x$estimate,
                                                                      upper = x$conf.int[2],
                                                                      lower = x$conf.int[1],
                                                                      pval = x$p.value)), Feature = as.list(names(y))))),
           Model = as.list(names(fisher))))
res$fdr = p.adjust(res$pval, method= "fdr")
res$Feature = gsub("enhancers","All Enhancers", res$Feature)
res$Feature = gsub("assignment","assigned", res$Feature)
res$Feature = factor(res$Feature, levels=c("All Enhancers","No age assigned","Vertebrata","Gnathostomata","Tetrapoda",
                                           "Amniota","Mammalia","Theria","Eutheria","Primate","Human"))

res = rbind(res, cbind(df[,1:4], Feature = "HAR", df[,5:6]))
rownames(res) = NULL
write.csv(res, quote=F, file = "/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/DMR/HAR_conservedEnhancers_fisher.results.csv")

## Plot results

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/DMR/figures/HARs_DMR_oddsRatios.pdf", height = 4)
ggplot(df[which(df$Model %in% c("CellType", "Age", "Interaction")),], aes(Model, OR, fill = Model)) +
  geom_col() + theme_classic() +
  ylab("Odds Ratio") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  xlab("") + geom_hline(yintercept=1, linetype="dotted") +
  ggtitle("Enrichment for HARs") +
  theme(title = element_text(size = 20)) + theme(text = element_text(size = 20), legend.title=element_blank()) + theme(legend.position="bottom")
ggplot(df[which(df$Model %in% c("Gr1", "Gr2", "Gr3","Gr4","Gr5","Gr6")),], aes(Model, OR, fill = Model)) +
  geom_col() + scale_fill_brewer(8, palette="Dark2") +
  theme_classic() + geom_hline(yintercept=1, linetype="dotted") +
  ylab("Odds Ratio") +
  xlab("") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  ggtitle("Enrichment for HARs") +
  theme(title = element_text(size = 20)) + theme(text = element_text(size = 20), legend.title=element_blank()) + theme(legend.position="bottom")
dev.off()

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/DMR/figures/conservedEnhancers_DMR_oddsRatios.pdf", width = 16, height = 4)
ggplot(res[which(res$Model %in% c("CellType", "Age", "Interaction") & res$fdr<=0.05),], aes(Model,OR, fill = Model)) +
  geom_col() + theme_classic() +
  facet_grid(. ~ Feature) +
  ylab("Odds Ratio") +
  xlab("") + geom_hline(yintercept=1, linetype="dotted") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  ggtitle("Enrichment for Enhancers") +
  theme(title = element_text(size = 20)) + theme(text = element_text(size = 20), legend.title=element_blank()) + theme(legend.position="bottom")
ggplot(res[which(res$Model %in% c("Gr1", "Gr2", "Gr3","Gr4","Gr5","Gr6") & res$fdr<=0.05),], aes(Model,OR, fill = Model)) +
  geom_col() + scale_fill_brewer(8, palette="Dark2") +
  theme_classic() + geom_hline(yintercept=1, linetype="dotted") +
  facet_grid(. ~ Feature) +
  ylab("Odds Ratio") +
  xlab("") + theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  ggtitle("Enrichment for Enhancers") +
  theme(title = element_text(size = 20)) + theme(text = element_text(size = 20), legend.title=element_blank()) + theme(legend.position="bottom")
dev.off()

df = read.csv("../Desktop/BAMS/HAR_conservedEnhancers_fisher.results.csv")
df$sig = ifelse(df$fdr<=0.05, "Significant", "Not Significant")
df$sig = factor(df$sig, levels = c("Significant", "Not Significant"))
df = df[which(df$Model %in% c("Gr1", "Gr2", "Gr3","Gr4","Gr5","Gr6")),]
df$Model = factor(df$Model, levels = c("Gr1", "Gr2", "Gr3","Gr4","Gr5","Gr6"))
df$Feature = factor(df$Feature, levels=c("HAR","All Enhancers","No age assigned","Vertebrata","Gnathostomata",
                                         "Tetrapoda", "Amniota","Mammalia","Theria","Eutheria","Primate","Human"))

pdf("./brain-epigenomics/DMR/figures/conservedEnhancers_DMR_oddsRatios_dotplot.pdf",
    height = 5.5, width = 9.5)
ggplot(data = df[-which(df$Feature %in% c("HAR", "Primate", "Human")),],
       aes(x = Model, y = log(OR), col = Model, shape = sig)) +
  geom_point() + geom_pointrange(aes(ymin = log(lower), ymax = log(upper))) +
  theme_bw() + facet_wrap(. ~ Feature) +
  xlab("") + ylab("log(OR)") +
  geom_hline(yintercept = 0, lty = 2) +
  scale_shape_manual(values = c(16, 1)) +
  scale_size_manual(values = c(2, 1)) +
  scale_colour_brewer(8, palette="Dark2") +
  ggtitle("Enrichment for Enhancers") +
  theme(axis.ticks.x = element_blank(),
        title = element_text(size = 20),
        text = element_text(size = 20),
        legend.title = element_blank(),
        legend.position = "bottom") +
  guides(col = FALSE)
dev.off()

df$Model = gsub("Gr1", "Gr1\n(G-N+)", df$Model)
df$Model = gsub("Gr2", "Gr2\n(G0N+)", df$Model)
df$Model = gsub("Gr3", "Gr3\n(G0N-)", df$Model)
df$Model = gsub("Gr4", "Gr4\n(G+N0)", df$Model)
df$Model = gsub("Gr5", "Gr5\n(G+N-)", df$Model)
df$Model = gsub("Gr6", "Gr6\n(G-N0)", df$Model)
df$Model = factor(df$Model, levels = c("Gr1\n(G-N+)","Gr2\n(G0N+)","Gr3\n(G0N-)",
                                       "Gr4\n(G+N0)","Gr5\n(G+N-)","Gr6\n(G-N0)"))

pdf("./brain-epigenomics/DMR/figures/HARs_DMR_oddsRatios_dotplot.pdf",
    height = 2.5, width = 6)
ggplot(data = df[which(df$Feature=="HAR"),],
       aes(x = Model, y = log(OR), col = Model, shape = sig, size = sig)) +
  geom_point() + geom_pointrange(aes(ymin = log(lower), ymax = log(upper))) +
  theme_bw() +
  xlab("") + ylab("log(OR)") +
  geom_hline(yintercept = 0, lty = 2) +
  scale_shape_manual(values = c(16, 1)) +
  scale_size_manual(values = c(1, 2)) +
  scale_colour_brewer(8, palette="Dark2") +
  ggtitle("Enrichment for HARs") +
  theme(axis.ticks.x = element_blank(),
        title = element_text(size = 20),
        text = element_text(size = 20)) +
  guides(col = FALSE, shape = FALSE, size = FALSE)
dev.off()


#!/usr/bin/env Rscript
#
# Conduct an association analysis using QTCAT. Requires a tab-delimited
# file with strain names in the first column and phenotype values in the
# second column (with NA string recognized by R for missing data). Also
# requires a file with genotypes in QTCAT format.
#
# qtcat_gwas.r --alpha <FDR level> [--maf <min MAF> --missing <max missing>]
#   --family <gaussian or binomial> <pheno> <snps>
#
# This script was written using the QTCAT documentation on github as a
# guide (https://github.com/QTCAT/qtcat.data).
#

library(optparse)

library(qtcat)

optlist = list(make_option('--output'),
               make_option('--nsplits', type='double', default=50),
               make_option('--alpha', type='double', default=NaN),
               make_option('--maf', type='double', default=0),
               make_option('--family'),
               make_option('--keep'),
               make_option('--missing', type='double', default=1.0))
parser = OptionParser(option_list=optlist)
opts = parse_args(parser, positional_arguments=TRUE)

outfile = opts$options$output
n_splits = opts$options$nsplits
alpha = opts$options$alpha
min_maf = opts$options$maf
max_miss = opts$options$missing
model_family = opts$options$family
keep_file = opts$options$keep
pheno_file = opts$args[1]
var_file = opts$args[2]

### Read data
var_data = read.snpData(var_file, sep='\t', quote='', na.string='NN')
pheno_data = read.table(pheno_file, sep='\t', as.is=TRUE,
                        colClasses=c('character', 'numeric'))

if(!is.null(keep_file)) {
    keep = scan(keep_file, what='character')
    var_data = var_data[rownames(var_data) %in% keep, ]
    pheno_data = pheno_data[pheno_data[, 1] %in% keep, ]
}

non_missing_strains = pheno_data[!is.na(pheno_data[, 2]), 1]
var_data = var_data[rownames(var_data) %in% non_missing_strains, ]
pheno_data = pheno_data[!is.na(pheno_data[, 2]), ]

### Filter variants
missing_freq = naFreq(var_data, 2)
maf = alleleFreq(var_data, maf=TRUE)
filt_var_data = var_data[, missing_freq <= max_miss & maf >= min_maf]

### Counts of data left after filtering
cat('Number of variants =', ncol(filt_var_data), '\n', file=stderr())
cat('Number of individuals =', nrow(filt_var_data), '\n', file=stderr())
cat('Number of individuals phenotyped =', nrow(pheno_data), '\n', file=stderr())
category_counts = table(pheno_data[, 2])   # Really only applies to binary traits
cat('Number of categories =', length(category_counts), '\n', file=stderr())
cat('Number in categories =', category_counts, '\n', file=stderr())

### Cluster variants
var_clust = qtcatClust(snp=filt_var_data)

### Create genotype and phenotype objects
pheno_obj = qtcatPheno(names=pheno_data[, 1],
                       pheno=pheno_data[, 2],
                       family=model_family)
geno_obj = qtcatGeno(snp=filt_var_data,
                     snpClust=var_clust)

### Run "HIT" analysis
hit_result = qtcatHit(pheno_obj, geno_obj, B=n_splits)
qtcs = qtcatQtc(hit_result, alpha=alpha)

### Write output
write.table(qtcs, file=outfile, sep='\t', col.names=TRUE,
            row.names=FALSE, quote=FALSE)


#!/usr/bin/env Rscript

# FLYCOP
# Author: Beatriz García-Jiménez
# April 2018

args = commandArgs(trailingOnly=TRUE)
if (length(args)<4) {
   stop("At least 4 arguments must be supplied: <input_file.txt> <output_file.pdf> <met1_ID> <met2_ID> <strain1> <strain2>.", call.=FALSE)
} else {
  inputFile=args[1]
  outFile=args[2]
  met1=args[3]
  met2=args[4]
  if(length(args)==6){
    strain1=args[5]
    strain2=args[6]
  }else{
    strain1="strain1"
    strain2="strain2"
  }
}

df=read.csv(inputFile,sep='\t',header=FALSE,col.names=c('hours','biomass1','biomass2','sub1','sub2'))

yMax=max(df$biomass1,df$biomass2)
yMax=1.5

pdf(outFile,pointsize=20)
par(lwd=3)
plot(df$hours*0.1,df$biomass1,xlab='time(h)',ylab='biomass (gr/L)',type='l',lwd=4,col="black",ylim=c(0,yMax))
par(new=TRUE)
plot(df$hours*0.1,df$biomass2,xlab="",ylab="",type='l',lwd=4,col="black",lty=2,ylim=c(0,yMax))
par(new=TRUE,lwd=2)
plot(df$hours*0.1,df$sub1,type='l',lwd=4,col="blue",axes=FALSE,xlab="",ylab="",ylim=c(0, max(df$sub1,df$sub2)))
par(new=TRUE)
plot(df$hours*0.1,df$sub2,type='l',lwd=4,col="red",axes=FALSE,xlab="",ylab="",ylim=c(0, max(df$sub1,df$sub2)))
axis(side=4)
mtext('metabolite Conc. (mM)',side=4,cex=par("cex.lab"))
par(lty=1)
legend("topright", c(strain1,strain2,met1,met2), lty=c(1,2,1,1), lwd=c(4,4,4,4), col=c("black","black","blue","red"))
invisible(dev.off())


\docType{data}
\name{atış}
\alias{atış}
\title{Atış istatistikleri tablosu}
\format{46.699 satır ve 30 sütundan oluşan bir data.frame
\describe{
\item{oyuncu}{Özgün oyuncu kodu}
\item{yıl}{Yıl}
\item{takım_sırası}{Oyuncunun bir sezon içinde takımlar arası yaptığı geçiş sayısı}
\item{takım}{Takım kodu (faktör)}
\item{lig}{Lig kodu (faktör) (AA, AL, FL, NL, PL, UA)}
\item{galibiyet}{Galibiyet sayısı}
\item{mağlubiyet}{Mağlubiyet sayısı}
\item{oyun}{Oyun sayısı}
\item{başlama}{Oyuna başlama sayısı}
\item{tamamlama}{Oyuncunun başladığı oyunları tamamlama sayısı}
\item{shutout}{Tek bir atıcının tam bir oyun atması ve rakip takımın bir tur atmasına izin vermemesi}
\item{save}{Bitime yakın oyuna giren atıcının galip durumu koruması}
\item{ip_outs}{Outs Pitched (innings pitched x 3)}
\item{hit}{Vurucunun topu uygun alana vurduktan sonra birinci bölgeye başarıyla ulaşma sayısı}
\item{earned_rounds}{Atıcı hatası nedeniyle kazanılan koşular}
\item{home_run}{Vurucunun topu oyun alanı dışına yollama sayısı}
\item{walk}{Atıcının dört defa vurucunun vuruş bölgesi dışına atış yapması nedeniyle vurucunun birinci kaleye yürüme hakkı kazanması}
\item{strikeout}{Atıcının yaptığı atışlar sonucunda, üç ıska ile vurucunun devre dışı kalması}
\item{ort_vuruş}{Atıcının rakibine sağladığı ortalama vuruş sayısı}
\item{ort_earnedrounds}{Atıcının karşı takıma kazandırdığı koşuların maç başına ortalaması}
\item{kasti_walk}{Rakibe kasıtlı verilen walk}
\item{karavana}{Atıcının topu doğru bölgeye fırlatamadığı atış sayısı}
\item{vurucuya_isabet}{Atıcının topu vurucunun vücuduna isabet ettirdiği atış sayısı}
\item{balk}{Rakibi aldatmaya yönelik kural dışı atış sayısı}
\item{batters_faced}{Batters faced by Pitcher}
\item{biten_oyunlar}{Başlatan atıcının bitirdiği oyunlar}
\item{koşular}{Atıcıya karşı yapılan koşu sayısı}
\item{sacrifice_hit}{Kalelerde bulunan koşucuların ilerlemesi için bilerek bunting vurma sayısı}
\item{sacrifice_fly}{Üçüncü kalede bulunan koşucunun başlangıç kalesine dönerek sayı alabilmesi uğruna topu olabildiğince uzağa vurma sayısı}
\item{double_play}{Savunma oyuncularının hücum oyuncularını art arda dışarıda bırakması}
}}
\usage{atış}
\description{Atış istatistikleri}
\seealso{\code{\link[Lahman]{Pitching}}}
\keyword{datasets}


v = c("Here", "are", "some", "sample", "strings", "to", "be", "sorted")
print(v[order(-nchar(v), tolower(v))])


#!/usr/bin/env Rscript
####################################################################################
### Copyright (C) 2015-2019 by ABLIFE
####################################################################################

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

####################################################################################
# Date           Version       Author            ChangeLog

# 2016-8-16		 v2.0
#####################################################################################

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

#####################################################################################
suppressPackageStartupMessages(library("optparse"))
suppressPackageStartupMessages(library("stats"))

usage = "Rscript /users/ablife/ablife-R/Bar/Bar_Rpkm/latest/Bar_single_Mapping_distribution.r -f -t -n -o

example: Rscript /users/ablife/ablife-R/Bar/Bar_Rpkm/latest/Bar_single_Mapping_distribution.r
		-f /users/ablife/ablife-R/Bar/Bar_Rpkm/latest/Mapping_distribution.txt
		-t Mapping_distribution
		-n Mapping_distribution
		-o ./"

option_list <- list(
	make_option(c("-f", "--file"),action = "store",type = "character",
		help = "The Input file"),
	make_option(c("-t", "--title"),action = "store",type = "character",
		help = "The title of outimage"),
	make_option(c("-n", "--filename"),action = "store",type = "character",
		help = "The name of outimage"),
	make_option(c("-o", "--outdir"),action = "store",type = "character",default = "./",
		help = "The outdir")
	)
opt <- parse_args(OptionParser(option_list = option_list,usage=usage))

setwd(opt$outdir)						####

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

###################################################################################
library(ggplot2)
library(reshape2)
library(plotrix)
library(methods)
###################################################################################
colour <- c('#85A2EF','#D285EF','#A2EF85','#4682B4','#A0522D','#87CEEB','#6B8E23','#6A5ACD','#E59B95','#EFD285','#B4B643','#2E9AFE','#A1DDBB','#FF8C00')

#######data format sample########
#type	sample1
#CDS	4940.93
#noncoding_exon	14008.73
#five_prime_UTR	7765.00
#intergenic	4687472.87
#intron	1719.35
#three_prime_UTR	273.12
#
#################################

######Instruction for data#######
#first column is the X axis
#from second to end is the data for ploting
#first row is the head to declare the data
#
#################################

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

title <- gsub('_',' ',opt$title)
data <- read.table(file= opt$file,header = T,sep = "\t")#####	must with header
colname <- colnames(data)
dim_data <- dim(data)
sample <-colname[2]
data<-data[order(data[,2]),]

newdata <- data
percent <-data[,2]
label <- data[,1]

percent <- percent/sum(percent)
percent <- round(percent*100,2)
newdata[,2] <- percent

Percent <- paste(percent,'%',sep='')	###for show
percentage <- paste(percent,'%)',sep='')
label <- paste(label,percentage,sep='(')
colour <- c('#85A2EF','#D285EF','#A2EF85','#4682B4','#A0522D','#87CEEB','#6B8E23','#6A5ACD','#E59B95','#EFD285','#B4B643','#2E9AFE','#A1DDBB','#FF8C00')

ablife_theme_bar <- function(base_size = 12){
	library(grid)		####for using unit function
	theme(
		plot.title = element_text(size=12,lineheight = 10,colour="#000000",vjust=1),

		axis.title.x = element_text(size=12,colour = "#000000"),
		axis.title.y = element_text(size=12,colour = "#000000"),
		axis.text.x = element_text(size = 12,colour = "#000000"),
		axis.text.y = element_text(size = 12 ,colour = "#000000"),
		axis.ticks.length = unit(0.2,"cm"),
		axis.ticks = element_line(colour = "#000000"),

		legend.title = element_text(size = 12),
		legend.text = element_text(size = 12),
		legend.key.size = unit(1.2,"cm"),

		panel.background = element_rect(colour="black")
		# panel.background = element_rect(fill = "white",colour = NA),
		# # panel.border = element_rect(size = 1,colour = "#8B8B8B",fill =NA),
		# panel.border = element_rect(size = 1.5,colour = "#000000",fill =NA),
		# # panel.grid.major = element_line(size=0.5,colour = "#BFBFBF"),
		# panel.grid.major.x = element_line(size=0.5,colour = "#909090"),
		# panel.grid.major.y = element_line(size=0.5,colour = "#909090",linetype = "dotted"),
		# panel.grid.minor = element_line(size=0.1,colour = "#7F7F7F")
		)
}

# png(file=paste(opt$filename,'_Bar.png',sep=''),pointsize=40,width=1000,height=600)
ggplot(newdata)+
		geom_bar(aes(x = c(1:dim_data[1]) ,y=newdata[,2],fill = label,stat = "identity"),width = 0.5,stat = "identity")+

		labs(x="Genomic Region",y= "Percentage(%)")+
		coord_flip()+
		geom_text(aes(x=c(1:dim_data[1]) ,y=newdata[,2],label=Percent),size = 4,hjust = -0.1)+
		theme(legend.position = 'none')+
		ablife_theme_bar()+
		scale_y_continuous(limits=c(0,100))+
		scale_x_reverse(breaks= c(1:dim_data[1]) ,labels=newdata[,1])+
		scale_fill_manual(name=sample,values = colour[1:dim_data[1]])

ggsave(file = paste(opt$filename,"_Bar.pdf",sep=''), width = 180,height = 120,dpi = 450,units = "mm")
ggsave(file = paste(opt$filename,"_Bar.png",sep=''), width = 180,height = 120,dpi = 450,units = "mm")


suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(patchwork))

source("viz_themes.R")
source("plotting_functions.R")
source("data_functions.R")

# The threshold indicats above the 95% percentile of carefully-controlled null distribution
threshold <- 0.05
plot_thresh <- -log10(threshold)

results_dir <- file.path("../1.Data-exploration/Profiles_level4/")

output_figure_base <- file.path("figures", "supplementary", "supfigure3")
extensions <- c(".png", ".pdf")

# Load percent replicating with different input data
cell_painting_pr_spherized_pval <- load_percent_replicating_nonparametric_pvals(
    assay="cellpainting",
    results_dir=results_dir,
    cp_file_indicator=""
)

cell_painting_pr_nonspherized_pval <- load_percent_replicating_nonparametric_pvals(
    assay="cellpainting",
    results_dir=results_dir,
    cp_file_indicator="_nonspherized"
)

cell_painting_pr_subsample_pval <- load_percent_replicating_nonparametric_pvals(
    assay="cellpainting",
    results_dir=results_dir,
    cp_file_indicator="_subsample"
)

l1000_pval <- load_percent_replicating_nonparametric_pvals(
    assay="l1000",
    results_dir=results_dir,
    l1000_file_indicator=""
)

l1000_w_pval <- load_percent_replicating_nonparametric_pvals(
    assay="l1000",
    results_dir=results_dir,
    l1000_file_indicator="_w"
)

pr_pval_df <- dplyr::bind_rows(
    cell_painting_pr_nonspherized_pval,
    cell_painting_pr_spherized_pval,
    cell_painting_pr_subsample_pval,
    l1000_pval,
    l1000_w_pval,
)  %>%
    dplyr::mutate(
        pass_thresh = p_value < threshold,
        neg_log_10_p_val = -log10(p_value),
        assay_norm_group = paste0(assay, " (", normalization, ")\n", category)
    )

pr_pval_df$dose <- factor(pr_pval_df$dose, levels = dose_order)
pr_pval_df$neg_log_10_p_val[pr_pval_df$neg_log_10_p_val == Inf] = 3.5

recode_dataset_name <- c(
    "Cell Painting (spherized)\nall_data" = "Cell Painting spherized",
    "Cell Painting (spherized)\nsubsampled" = "Cell Painting subsampled",
    "Cell Painting (non_spherized)\nall_data" = "Cell Painting nonspherized",
    "L1000 (spherized)\nall_data" = "L1000 spherized",
    "L1000 (non_spherized)\nall_data" = "L1000 nonspherized"
)

pr_pval_df$assay_norm_group <- dplyr::recode(pr_pval_df$assay_norm_group, !!!recode_dataset_name)
pr_pval_df$assay_norm_group <- factor(pr_pval_df$assay_norm_group, levels = paste(recode_dataset_name))

print(dim(pr_pval_df))
head(pr_pval_df, 2)

percent_replicating_df <- pr_pval_df %>%
    dplyr::group_by(assay_norm_group, dose) %>%
    dplyr::mutate(percent_replicating = paste0(100 * round((sum(pass_thresh) / length(pass_thresh)), 2), "%")) %>%
    dplyr::select(assay_norm_group, dose, percent_replicating) %>%
    dplyr::distinct()

head(percent_replicating_df, 2)

# Load WELL MATCHED NULL percent replicating with different input data
cell_painting_pr_spherized_pval <- load_percent_replicating_nonparametric_pvals(
    assay="cellpainting",
    results_dir=results_dir,
    cp_file_indicator="",
    well_specific_null=TRUE
) %>% dplyr::mutate(
    normalization="spherized",
    category="all_data",
    assay = "Cell Painting"
)

cell_painting_pr_nonspherized_pval <- load_percent_replicating_nonparametric_pvals(
    assay="cellpainting",
    results_dir=results_dir,
    cp_file_indicator="_nonspherized",
    well_specific_null=TRUE
) %>% dplyr::mutate(
    normalization="non_spherized",
    category="all_data",
    assay = "Cell Painting"
)

cell_painting_pr_subsample_pval <- load_percent_replicating_nonparametric_pvals(
    assay="cellpainting",
    results_dir=results_dir,
    cp_file_indicator="_subsample",
    well_specific_null=TRUE
) %>% dplyr::mutate(
    normalization="spherized",
    category="subsampled",
    assay = "Cell Painting"
)

l1000_pval <- load_percent_replicating_nonparametric_pvals(
    assay="l1000",
    results_dir=results_dir,
    l1000_file_indicator="",
    well_specific_null=TRUE
) %>% dplyr::mutate(
    normalization="non_spherized",
    category="all_data",
    assay = "L1000"
)

l1000_w_pval <- load_percent_replicating_nonparametric_pvals(
    assay="l1000",
    results_dir=results_dir,
    l1000_file_indicator="W",
    well_specific_null=TRUE
) %>% dplyr::mutate(
    normalization="spherized",
    category="all_data",
    assay = "L1000"
)

pr_pval_well_null_df <- dplyr::bind_rows(
    cell_painting_pr_nonspherized_pval,
    cell_painting_pr_spherized_pval,
    cell_painting_pr_subsample_pval,
    l1000_pval,
    l1000_w_pval,
) %>%
    dplyr::mutate(
        pass_thresh = p_value < threshold,
        neg_log_10_p_val = -log10(p_value),
        assay_norm_group = paste0(assay, " (", normalization, ")\n", category),
        dose = dose_recode
    )

pr_pval_well_null_df$dose <- dplyr::recode_factor(pr_pval_well_null_df$dose_recode, !!!dose_rename)
pr_pval_well_null_df$neg_log_10_p_val[pr_pval_well_null_df$neg_log_10_p_val == Inf] = 3.5

recode_dataset_name <- c(
    "Cell Painting (spherized)\nall_data" = "Cell Painting spherized",
    "Cell Painting (spherized)\nsubsampled" = "Cell Painting subsampled",
    "Cell Painting (non_spherized)\nall_data" = "Cell Painting nonspherized",
    "L1000 (spherized)\nall_data" = "L1000 spherized",
    "L1000 (non_spherized)\nall_data" = "L1000 nonspherized"
)

pr_pval_well_null_df$assay_norm_group <- dplyr::recode(pr_pval_well_null_df$assay_norm_group, !!!recode_dataset_name)
pr_pval_well_null_df$assay_norm_group <- factor(pr_pval_well_null_df$assay_norm_group, levels = paste(recode_dataset_name))

print(dim(pr_pval_well_null_df))
head(pr_pval_well_null_df, 2)

table(pr_pval_well_null_df$dose)

percent_replicating_well_null_df <- pr_pval_well_null_df %>%
    dplyr::group_by(assay_norm_group, dose) %>%
    dplyr::mutate(percent_replicating = paste0(100 * round((sum(pass_thresh) / length(pass_thresh)), 2), "%")) %>%
    dplyr::select(assay_norm_group, dose, percent_replicating) %>%
    dplyr::distinct()

head(percent_replicating_well_null_df, 2)

percent_replicating_all_gg <- (
    ggplot(pr_pval_df, aes(x = matching_score, y = neg_log_10_p_val))
    + geom_point(aes(color = no_of_replicates), alpha = 0.05)
    + geom_text(data = percent_replicating_df, aes(label = percent_replicating, x = 0.65, y = 2.5))
    + facet_grid("assay_norm_group~dose")
    + geom_hline(linetype = "dashed", color = "blue", yintercept = 2)
    + theme_bw()
    + figure_theme
    + scale_color_continuous(
        "Number of\nreplicates\nper compound",
        values = scales::rescale(c(0, 0.5, 1, 1.5, 2, 3, 6)),
        limits = c(2, 10),
        type = "viridis"
    )
    + ggtitle("Full non-replicate null distribution")
    + xlab("Median pairwise Pearson correlation between replicate profiles")
    + ylab("Non-parametric -log10 p value")
)

percent_replicating_all_gg

percent_replicating_all_well_null_gg <- (
    ggplot(pr_pval_well_null_df, aes(x = median_score, y = neg_log_10_p_val))
    + geom_point(aes(color = no_of_compounds), alpha = 0.05)
    + geom_text(data = percent_replicating_well_null_df, aes(label = percent_replicating, x = 0.65, y = 2.5))
    + facet_grid("assay_norm_group~dose")
    + geom_hline(linetype = "dashed", color = "blue", yintercept = 2)
    + theme_bw()
    + figure_theme
    + scale_color_continuous(
        "Number of\nreplicates\nper compound",
        values = scales::rescale(c(0, 0.5, 1, 1.5, 2, 3, 6)),
        limits = c(2, 10),
        type = "viridis"
    )
    + ggtitle("Well-controlled non-replicate null distribution")
    + xlab("Median pairwise Pearson correlation between replicate profiles")
    + ylab("Non-parametric -log10 p value")
)

percent_replicating_all_well_null_gg

sup_fig3_gg <- (
    percent_replicating_all_gg
    + percent_replicating_all_well_null_gg
    + plot_layout(guides = 'collect')
    + plot_annotation(tag_levels = 'a')
    )

sup_fig3_gg

for (extension in extensions) {
    output_file <- paste0(output_figure_base, extension)
    cowplot::save_plot(output_file, sup_fig3_gg, base_width = 15, base_height = 8.5, dpi = 500)
}


library(dplyr)
library(glmmTMB)
library(lubridate)
library(readr)
library(stringr)
library(tidyr)
library(tigris)

# the first date we will analyze
first_analysis_date = as.Date("2020-03-22")

# a guess of the date they generated their figure
run_date_guess = as.Date("2020-09-07")

# the dates we will consider
dates_data =
  tibble(date = seq(first_analysis_date, run_date_guess, by = "day"))

# an early date that Wu used to figure out which counties JHU is keeping track
# of
reference_date = as.Date("2020-03-30")

# commit to use in the CSSE data
# this one is from September 9, 2020
CSSE_commit = "968f9e627140a318cc5876b79fb959298da9a348"

source("code/counties.r")

source("code/age_groups.r")
source("code/census.r")
source("code/covid.r")
source("code/health.r")
source("code/hospitals.r")
source("code/pm.r")
source("code/policy.r")
source("code/temperature.r")

county_controls =
  county_data %>%
  left_join(pm_data) %>%
  left_join(temperature_data) %>%
  left_join(census_data) %>%
  left_join(health_data) %>%
  left_join(age_group_data) %>%
  left_join(hospitals_data) %>%
  mutate(
    # Fill 0 for missing
    hospital_beds = coalesce(hospital_beds, 0)
  ) %>%
  # Only use counties mentioned in both the PM data and the census data
  filter(in_pm_data & in_census_data) %>%
  group_by(metro_code) %>%
  mutate(
    # There is a clear bug in Wu et al's code where they accidentally aggregate
    # population early
    buggy_population =
      ifelse(
        primary,
        sum(population),
        population
      )
  ) %>%
  ungroup()

metro_controls =
  county_controls %>%
  group_by(state_name, metro_code) %>%
  summarize(
    # Weight most things by population.
    PM2.5_concentration = weighted.mean(PM2.5_concentration, buggy_population),
    proportion_poor = weighted.mean(proportion_poor, buggy_population),
    median_house_value = weighted.mean(median_house_value, buggy_population),
    median_household_income = weighted.mean(median_household_income, buggy_population),
    proportion_owner_occupied = weighted.mean(proportion_owner_occupied, buggy_population),
    proportion_no_high_school = weighted.mean(proportion_no_high_school, buggy_population),
    proportion_black = weighted.mean(proportion_black, buggy_population),
    proportion_hispanic = weighted.mean(proportion_hispanic, buggy_population),
    proportion_65_and_over = weighted.mean(proportion_65_and_over, buggy_population),
    proportion_15_to_44 = weighted.mean(proportion_15_to_44, buggy_population),
    proportion_45_to_64 = weighted.mean(proportion_45_to_64, buggy_population),
    proportion_obsese = weighted.mean(proportion_obsese, buggy_population),
    proportion_smoke = weighted.mean(proportion_smoke, buggy_population),
    summer_mean_maximum_temperature = weighted.mean(summer_mean_maximum_temperature, buggy_population),
    summer_mean_relative_humidity = weighted.mean(summer_mean_relative_humidity, buggy_population),
    winter_mean_maximum_temperature = weighted.mean(winter_mean_maximum_temperature, buggy_population),
    winter_mean_relative_humidity = weighted.mean(winter_mean_relative_humidity, buggy_population),
    # Sum these last 2.
    hospital_beds = sum(hospital_beds),
    population = sum(population)
  ) %>%
  left_join(
    county_controls %>%
    # Maybe another bug in Wu et al's code
    # They used the quantile of the primary county to represent the whole metro.
    # This probably doesn't make a difference though, because all NYC boroughs
    # are likely in the highest quantile
    filter(primary) %>%
    select(
      metro_code,
      population_density_quantile
    )
  )

all_data =
  full_join(
    # Replicate the control data for all dates.
    metro_controls,
    dates_data,
    by = character()
  ) %>%
  left_join(expanded_covid_data) %>%
  filter(
    # Wu only used counties mentioned by in the covid data
    in_original_covid_data | in_no_early_covid
  ) %>%
  mutate(
    # Maybe another bug in Wu et al's code.
    # If the first covid data is after the date of analysis, set to 0.
    days_since_covid =
      ifelse(
        first_confirmed_date <= date,
        date - first_confirmed_date + 1,
        NA
      ) %>%
      coalesce(0)
  ) %>%
  left_join(policy_data) %>%
  mutate(
    # Maybe another bug in Wu et al's code
    # If the first social distancing mandate is after the date of analysis,
    # set to 0
    days_since_social_distancing =
      as.numeric(run_date_guess - social_distancing_date) %>%
      coalesce(0)
  ) %>%
  # Only use states which we have policy information for
  filter(in_policy_data)

analyze_one_date = function(
  one_day_data,
  # Z-score for a 95% confidence interval
  confidence_interval_z_score = 1.96
) {
  print(first(one_day_data$date))
  glmmTMB.off.main = glmmTMB(
    cumulative_covid_deaths ~
      PM2.5_concentration +
      factor(population_density_quantile) +
      scale(proportion_poor) +
      scale(log(median_house_value)) +
      scale(log(median_household_income)) +
      scale(proportion_owner_occupied) +
      scale(proportion_no_high_school) +
      scale(proportion_black) +
      scale(proportion_hispanic) +
      scale(proportion_65_and_over) +
      scale(proportion_15_to_44) +
      scale(proportion_45_to_64) +
      scale(days_since_social_distancing) +
      scale(days_since_covid) +
      scale(hospital_beds/population) +
      scale(proportion_obsese) +
      scale(proportion_smoke) +
      scale(summer_mean_maximum_temperature) +
      scale(winter_mean_maximum_temperature) +
      scale(summer_mean_relative_humidity) +
      scale(winter_mean_relative_humidity) +
      offset(log(population)) +
      (1 | state_name),
    data = one_day_data,
    family = nbinom2,
    ziformula = ~ 1
  )
  coefficients = summary(glmmTMB.off.main)["coefficients"]$coefficients$cond
  log_estimate = coefficients["PM2.5_concentration", "Estimate"]
  standard_error = coefficients["PM2.5_concentration", "Std. Error"]
  tibble(
    # Exponentiate
    lower_bound = exp(log_estimate - confidence_interval_z_score * standard_error),
    estimate = exp(log_estimate),
    upper_bound = exp(log_estimate + confidence_interval_z_score * standard_error)
  )
}

all_data %>%
  group_by(date) %>%
  summarize(analyze_one_date(cur_data_all())) %>%
  write_csv("data/daily_estimates.csv")


#!/usr/bin/env Rscript

# Submit optimisation jobs to backend
# Blame to Jian Liu, Junqi Zhu
library(RLinuxModules)
apsimxsif = "apsimx/2020.08.04.5350"
module(paste("load", apsimxsif))
module("load openlava")
module("load asub/2.1")
module ("load R/3.6.1")

apsimx <- "apsimx-2020.08.04.5350.sif"
#Set up directories
apsimx_flag <- "/Edit"
apsimx_file <- here::here("grapevine_base.apsimx")
apsimx_sims_dir <- here::here("apsimxFiles/")

source(here::here("optimisation_14_8.R"))

t1 = Sys.time()
#DEoptim
maxIt = 70
np = 6
idLength = 4

##branching rate 0.6, 0.9
#RUE 1,2, c(0.8, 1.3)
#priority factor
#shoot biomass, 0.3
#root,trunk, cordon structural biomass, 0.3
#root,trunk, cordon storage, 0.2-0.8
#berry biomass, 1.2

#priority factor of shoot
#priority factor of root and trunk

editNodes =
  c(
    ".Simulations.Replacements.Grapevine.Structure.BranchingRate.ScaleFactor.FixedValue = ",
    ".Simulations.Replacements.Grapevine.Leaf.Photosynthesis.RUE.Vegetative.Constant.FixedValue =",
    ".Simulations.Replacements.Grapevine.Leaf.Photosynthesis.RUE.Reproductive.Constant.FixedValue =",
    ".Simulations.Replacements.Grapevine.Shoot.DMDemandPriorityFactors.Structural.FixedValue =",
    ".Simulations.Replacements.Grapevine.Berry.DMDemandPriorityFactors.Structural.FixedValue =",
    '.Simulations.Replacements.Grapevine.Fibrousroot.DMDemandPriorityFactors.Structural.FixedValue =',
    '.Simulations.Replacements.Grapevine.Fibrousroot.DMDemandPriorityFactors.Storage.Juvenile.Constant.FixedValue = ',
    '.Simulations.Replacements.Grapevine.Fibrousroot.DMDemandPriorityFactors.Storage.Reproductive.Constant.FixedValue ='

  )

lower = c(0.6, 0.7, 0.9,  0.1,  1.1,  0.1,  0.1, 0.1)
upper = c(0.95, 1.1, 1.4, 0.4,  2,    0.5,  1,   1.2)

# initialPop = matrix(nrow = 40, ncol=4)
# initialPop[1,] = c(5.323079,30.514018,42.386243,24.456818)
# initialPop[2,] = c(3.150276,28.458947,38.594053,24.581769)
# initialPop[3,] = c(5.594849,30.213733,40.648709,20.775019)
# initialPop[4,] = c(4.447903,28.599034,37.316855,21.768780)
# initialPop[5,] = c(2.51085677,22.2450914,40.31615624, 44.00759)
#
# for(i in 6:40)
# {
#   if (i %% 5 == 1) initialPop[i,] = initialPop[1,] +
#         runif(1)* (initialPop[3,] - initialPop[1,])
#
#   if (i %% 5 == 2) initialPop[i,] = initialPop[2,] +
#         runif(1)* (initialPop[3,] - initialPop[2,])
#
#   if (i %% 5 == 3) initialPop[i,] = initialPop[3,] +
#         runif(1)* (initialPop[4,] - initialPop[3,])
#
#   if (i %% 5 == 4) initialPop[i,] = initialPop[4,] +
#         runif(1)* (initialPop[3,] - initialPop[4,])
#
#   if (i %% 5 == 0) initialPop[i,] = initialPop[5,] +
#         runif(1)* (initialPop[3,] - initialPop[5,])
#
#
# }

# The observaion value that will be used as the benchmark
# obspara = c("FloweringDAWS", "VeraisonDAWS")
obspara = c("leaf.area.vine", "leaf.dw.vine","shoot.dw.mean", "TotalBerryDW",
            'total.NSC.concentration.trunk', 'total.NSC.concentration.root' )

opt.res =
  DEoptim::DEoptim(fn=cost.function,
                   lower = lower,
                   upper = upper,
                   control=list(NP=np*10,
                                itermax=maxIt,
                                strategy = 1,
                                parallelType=1,
                                storepopfrom = 1,
                                #initialpop = initialPop,
                                packages = c('RSQLite'),
                                parVar = c(
                                  'editNodes',
                                  'apsimx',
                                  'apsimx_flag',
                                  'apsimx_file',
                                  'apsimx_sims_dir',
                                  'APSIMEditFun',
                                  'APSIMRun',
                                  'llik',
                                  'calcCost',
                                  'idLength')),

                   obspara = obspara

  )

save(opt.res, file =  file.path(here::here(paste0('IntRes/', Sys.Date(), 'opt.res', ".RData"))))

fit.par = data.frame(estimates = opt.res$optim$bestmem, cost = opt.res$optim$bestval)

#output the statistical test
par = fit.par$estimates
write.csv(par, file.path(
  here::here(paste0('IntRes/', Sys.Date(), "opt.par.csv"))), row.names=F)

t2 = Sys.time()
t2-t1


options(error=recover)

#GETTING THE DATA FROM Human Microbiome Project OTU table
library(phangorn)

hmpData <- "../../../fodor/otu_table_psn_v35.txt"
hmpMetadata <- "../../../fodor/v35_map_uniquebyPSN.txt"
treeFile <- "../../../fodor/rep_set_v35.tre"

id <- read.table(hmpMetadata, header=TRUE, sep="\t", row.names=1)
otu <- t( read.table(hmpData, header=T, sep="\t", row.names=1, check.names=FALSE) )
tree <- read.tree(treeFile)
# BODY SITES
#  [1] "Anterior_nares"               "Attached_Keratinized_gingiva"
#  [3] "Buccal_mucosa"                "Hard_palate"
#  [5] "Left_Antecubital_fossa"       "Left_Retroauricular_crease"
#  [7] "Mid_vagina"                   "Palatine_Tonsils"
#  [9] "Posterior_fornix"             "Right_Antecubital_fossa"
# [11] "Right_Retroauricular_crease"  "Saliva"
# [13] "Stool"                        "Subgingival_plaque"
# [15] "Supragingival_plaque"         "Throat"
# [17] "Tongue_dorsum"                "Vaginal_introitus"

td <- "Tongue_dorsum"

td.id <- rownames(id)[which(id$HMPbodysubsite==td)]

td.otu <- site <- otu[rownames(otu) %in% td.id,]

otuIDs <- colnames(td.otu)

td.otu <- apply(td.otu, 1, function(x){as.numeric(x)})

# remove all samples with read count lower than 2,000
td.sum <- apply(td.otu,2,sum)

td.otu <- td.otu[,which(td.sum>2000)]

#pick random samples from each category

nSamples <- 40

td.rand <- td.otu[,as.integer(sample(seq(1,length(colnames(td.otu)),1),nSamples,replace=FALSE))]

#concatenate

data <- data.frame(td.rand)
colnames(data) <- sub("^X", "", colnames(data))
rownames(data) <- otuIDs
#make condition vector

groups <- as.factor(c(rep("td_A",nSamples/2),rep("td_B",nSamples/2)))

#get rid of zero sum rows

data.sum <- apply(data,1,sum)
data.0 <- data[data.sum > 0,]
data <- data.0

# get rid of extra OTUs in tree
tree$tip.label <- gsub("'","",tree$tip.label)
absent <- tree$tip.label[!(tree$tip.label %in% rownames(data))]
if (length(absent) != 0) {
		tree <- drop.tip(tree, absent)
}
write.tree(tree,file="tongue_tongue_subtree.tre")

#make sample names that contain condition

colnames(data) <- paste(groups,colnames(data),sep="_")

#write otu counts into table
write.table(data,file="tongue_tongue_data.txt",sep="\t",quote=FALSE)
# read in with read.table("hmp_mouth_data.txt",sep="\t",header=TRUE,row.names=1)


p <- suppressMessages(ggplot(ledger_data, aes(account, balance)) +
            geom_point(aes(balance, account)) + geom_segment(aes(x = 0, xend = balance, y = account, yend = account)) +
            xlab(commodity) + ylab(""))

suppressMessages(ggsave(file = "dotplot-balance-vs-account.svg", plot = p, width = 14, height = .5 * length(ledger_data$account)))


#!/usr/lib/R/bin/Rscript

library(methods)
library(ggplot2)
library(reshape2)

args  = commandArgs(T)
rack  = read.table(file=args[1], sep=',', header=T)
rails = read.table(file=args[2], sep=',', header=T)

Concurrent = rack$concurrent
Rack = rack$throughput
Rails = rails$throughput

df = data.frame(Concurrent, Rack, Rails)
df.long = melt(df, id.vars='Concurrent')

sd = c(rack$sd, rails$sd)
df.long = cbind(df.long, sd)

g = ggplot(df.long, aes(Concurrent, value, shape=variable)) +
	scale_x_log10(breaks=c(10, 50, 100, 500, 1000, 5000, 10000)) +
	scale_y_continuous(breaks=round(seq(1000, 15000, by=1000), 1)) +
    scale_shape(name='Framework') +
    ylab('Requests per second') +
	xlab('Concurrent clients (log.)') +
	geom_line() +
	geom_point() +
 	geom_errorbar(aes(ymin=value-sd, ymax=value+sd)) +
	theme_bw()

path = paste(args[1], 'frameworks', 'pdf', sep='.')
print(path)
ggsave(g, file=path)


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

PreprocessFeatures <- function(train.name="train",test.name=NULL,args,
	train.cols=NULL,train.data.std=NULL,train.data.na=NULL,
	target=NULL) {
	# Preprocesses feature data according to list of arguments in args
	#
	# Args:
	#	train.name: base name of training data
	#	test.name: base name of test data
	# 	- Possible combinations:
	#		train.name, test.name: processes train data with all data
	#		train.name, test.name=NULL: processes train data with just train data
	#		train.name=NULL,test.name: processes test data with train.cols,
	#		train.data.std, and train.data.na, which may have been created with
	#		just train data or all data
	#	args: list of arguments
	#	- pls: TRUE means predicting the last score rather than the slope
	#	- prune: TRUE means keeping only features with data for at least 918/2
	#		patients
	#	- std: TRUE means standardize columns by subtracting away column means
	#	- features: a character vector of feature sets to get for the training
	#		data.  Choose from "static","alsfrs","fvc","svc","vital","lab"
	#	- slope.features: a character vector of datasets to get slope features
	#		for.  Choose from NULL if no slopes are desired, or among "static",
	#		"alsfrs","fvc","svc","vital","lab"
	#	train.cols: the names of the training data columns after pruning.  Used to
	#		make sure the training and test data columns match
	#	train.data.std: the training data prior to standardization.  Used to
	#		standardize test data with train data column means
	#	train.data.na: the training data prior to imputation of NAs.  Used to impute
	#		NAs in the test data with the training data.
	#
	# Returns:
	#	Feature dataset with features processed according to the arguments
	#	train.cols
	#	train.data.std
	#	train.data.na
	#	target
	#
	# Example usage:
	if (FALSE) {
		features <- c("static","alsfrs","fvc","svc","vital")
	   	slope.features <- NULL
	   	args <- list(R=1,pls=TRUE,prune=TRUE,std=TRUE,features=features,
	   	slope.features=slope.features)

	   	# Process training set on both training and test set
		trainf<-PreprocessFeatures(train.name="train",test.name="test",args)

		# Process test set based on processing of training set
		testf<-PreprocessFeatures(train.name=NULL,test.name="test",args,
			train.cols=trainf$train.cols,train.data.std=trainf$train.data.std,
			train.data.na=trainf$train.data.na)
	}

	# Extract arguments
	pls <- args[["pls"]]
	prune<-args[["prune"]]
	std<-args[["std"]]
	features<-args[["features"]]
	slope.features<-args[["slope.features"]]

	# Get targets for training data
	if (!is.null(train.name)) {
		if (is.null(target)) {target<-Slopes(GetAlsfrsData(train.name),3,12,"f")}
	}

	# Get feature data
	if (!is.null(train.name)) {
		# Get training data if train name exists
		feature.data<-GetFeatureSet(train.name,features,slope.features)
		if (!is.null(test.name)) {
			# Stack with test data if test data is provided
			num.train.rows<-nrow(feature.data)
			test.data<-GetFeatureSet(test.name,features,slope.features)
			feature.data<-rbind(feature.data,test.data)
		}
	}
	else {
		# Get test data if train name is null
		feature.data<-GetFeatureSet(test.name,features,slope.features)
	}

	# Prune data
	if (prune) {
		if (!is.null(train.name)) {
			# Prune training data using training data
			feature.data <- PruneFeatures(feature.data)
			# Keep a copy of columns at this stage
			train.cols<-colnames(feature.data)
		}
		else {
			# Prune test data based on earlier pruning of training data
			feature.data<-feature.data[,train.cols]
		}
	}

	# Predict on last score

	if (pls) {
		if (!is.null(train.name)) {
			scaling.train<-PlsScale(train.name)
		}
		else {
			scaling.train<-NULL
		}
		if (!is.null(test.name)) {
			scaling.test<-PlsScale(test.name)
		}
		else {
			scaling.test<-NULL
		}
		scaling<-rbind(scaling.train,scaling.test)
		feature.data[,-1]<-sweep(feature.data[,-1],1,scaling$time.scale,"*")
		if (!is.null(train.name)) {
			target<-target+scaling.train$score.first*scaling.train$time.scale
		}
	}

	# Impute NAs
	if (!is.null(train.name)) {
		# Keep a copy of train data with NAs for imputing purposes
		train.data.na<-feature.data
	}
	feature.data<-ImputeNas(train.data.na,feature.data)

	# Standardize features
	if (std) {
		if (!is.null(train.name)) {
			# Keep copy of old train data to standardize test data features
			train.data.std<-feature.data
		}
		feature.data[,-1]<-StandardizeFeatures(train.data.std[,-1],feature.data[,-1])
	}

	# Separate out train data if both train and test data stats were used for processing
	if (!is.null(train.name)&!is.null(test.name)) {
		feature.data<-feature.data[1:num.train.rows,]
	}

	# Create a list with return values
	return.values<-list(feature.data=feature.data,target=target,train.cols=train.cols,
		train.data.std=train.data.std,train.data.na=train.data.na)

	return(return.values)
}

PlsScale <- function(train.name) {
# Gets scaling factors when predicting the last score

	# Get slope components for past and future
	slope.past<-SlopeComponents(GetAlsfrsData(train.name),0,3,"p")
	slope.future<-SlopeComponents(GetAlsfrsData(train.name),3,12,"f")

	# Get the first date, estimated as the last past date
	time.first<-slope.past$last.date
	# Fill in any blanks with the average
	time.first[is.na(time.first)]<-mean(time.first,na.rm=TRUE)

	# Get the first score, estimated as the last past score
	score.first<-slope.past$last.score
	# Fill in any blanks with the average
	score.first[is.na(score.first)]<-mean(score.first,na.rm=TRUE)

	# Get the last date, estimated as the average of all last future dates
	time.last<-rep(mean(slope.future$last.date),nrow(slope.future))

	# Get the real last score
	score.last<-slope.future$last.score

	# Get time scaling
	time.scale<-1/(time.last-time.first)

	# Return score.first and time.scale
	return(data.frame(score.first,time.scale))
}


library(parallel)
library(caret)
library(MASS)
library(xgboost)

library(OptimalCutpoints)
library(pROC)
library(ROCR)

library(ggplot2)
library(cowplot)
library(gridExtra)
library(viridis)
library(gplots)

setwd("/media/yuri/Data/home1/GNI_data/infection/ModelsSciRep")
load('Sepsis_WGCNA_XGB.Rdat')
XGB_model_bst <- xgb.load('Sepsis_WGCNA_XGB.model')

dtrain0 <- xgb.DMatrix(data = as.matrix(training0[,-1]), label = as.numeric(training0$Y)-1)
dvalid <- xgb.DMatrix(data = as.matrix(validation[,-1]), label = as.numeric(validation$Y)-1)

# predict discovery and validation cohorts (probs)
Ytrain_prob <- predict(XGB_model_bst, dtrain0, ntree = XGB_model_ntree, outputmargin=TRUE)
Yvalid_prob <- predict(XGB_model_bst, dvalid,  ntree = XGB_model_ntree, outputmargin=TRUE)

################################################################################
# Find optimal cutpoint from the ROC curve maximizing the product of Sensitivity and Specificity
p_cut <- optimal.cutpoints(y~x, status=Ytrain0, tag.healthy = 0, data= data.frame(y=Ytrain_prob, x = as.numeric(Ytrain0) -1),
methods="MaxProdSpSe", ci.fit=TRUE, control = control.cutpoints(ci.SeSp = "AgrestiCoull", ci.PV = "AgrestiCoull") )
cutoff <- p_cut$MaxProdSpSe$Global$optimal.cutoff$cutoff[1]

# predict discovery and validation cohorts (classes)
p_train_class <- factor(as.numeric(ifelse(Ytrain_prob <= cutoff, 0, 1)), levels = c(0,1))
p_valid_class  <- factor(as.numeric(ifelse(Yvalid_prob  <= cutoff, 0, 1)), levels = c(0,1))

# Model summary bACC - balanced accuracy, Sensitivity, Specificity
conf_train <- confusionMatrix(p_train_class, Ytrain0, "0")
conf_valid  <- confusionMatrix(p_valid_class, Yvalid, "0")

conf_table <- data.frame( bACC = c( conf_train$byClass[[11]], conf_valid$byClass[[11]] ),
Sensitivity = c( conf_train$byClass[[1]], conf_valid$byClass[[1]] ),
Specificity = c( conf_train$byClass[[2]], conf_valid$byClass[[2]] )
)
conf_table <- t(conf_table)
colnames(conf_table) <- c("discovery", "validation")
conf_table <- round(conf_table, 3)

################################################################################
# Variable importance
var_imp <- xgb.importance(dimnames(dtrain0)[[2]], model = XGB_model_bst)
# var_imp <- var_imp[ order(as.numeric(gsub("x", "", var_imp$Feature))),]
# var_imp$Feature <- ids[as.numeric(gsub("x", "", var_imp$Feature))]
var_imp <- var_imp[order(var_imp$Gain, decreasing=F),]
var_imp <- as.data.frame(var_imp)
rownames(var_imp) <- gsub("ME", "", var_imp[,1])
var_imp <- var_imp[,-1]

colors <- rownames(var_imp)
colors[colors == "age"] <- "black"

################################################################################
setwd("/media/yuri/Data/home1/GNI_data/infection/ResultsSciRep/Figures/")
pdf("FigureS9A.pdf", width=4, height=9)

# k <- which(colors == "grey")+1
# m <- length(colors)
par(mar=c(4,16,1,0.5))
barplot(var_imp[,1], horiz = T, names.arg = rownames(var_imp), col = col2hex(colors),
      xlab = "Gain", main = "variable importance",las=1, cex.axis=0.7, cex.names = 0.7)

dev.off()
################################################################################

Train_roc <- roc(Ytrain0, Ytrain_prob)
Train_auc <- lapply(pROC::ci(Ytrain0, Ytrain_prob), function(x) round(x, 3))

Valid_roc <- roc(Yvalid, Yvalid_prob)
Valid_auc <- lapply(pROC::ci(Yvalid, Yvalid_prob), function(x) round(x, 3))

################################################################################
pdf("FigureS6C.pdf", width=6, height=6)

plot(Train_roc, lty = 1, lwd = 2, col=4, type="s")
plot(Valid_roc, add=TRUE, lty = 1, lwd = 2, col=2, type="s")
legend("bottomright", legend =
  c(paste("discovery cohort: AUC = ", Train_auc[[2]], " (", Train_auc[[1]], ", ", Train_auc[[3]], ")", sep=""),
    paste("validation cohort: AUC = ", Valid_auc[[2]], " (", Valid_auc[[1]], ", ", Valid_auc[[3]], ")", sep="")),
lty=1, lwd=2, col=c(4,2), bty="n")

dev.off()
################################################################################
# enrichment

setwd("/media/yuri/Data/home1/GNI_data/infection/DataSciRep/")
load("org.Hs.core_paths.Rdat")

names(kegg_path) <- paste0("kegg:", names(kegg_path))
names(corum_core) <- paste0("complex:", names(corum_core))
corum_core$`complex:mitochondrial respiratory chain complex I assembly` <- NULL
core_paths <- c(corum_core, kegg_path)

topME <- rev(colors)
topME <- topME[topME!="black"]

# For explanetion of gene set enrichment see
# http://pedagogix-tagc.univ-mrs.fr/courses/ASG1/practicals/go_statistics_td/go_statistics_td_2015.html
N <- length(unlist(core_paths)[!duplicated(unlist(core_paths))])
m <- sapply(core_paths, length)
n <- N-m

topME_ens <- lapply(topME, function(module) {

  k <- sum(GeneNames[dynamicColors %in% module] %in% unlist(core_paths)[!duplicated(unlist(core_paths))])
  x <- sapply(core_paths, function(x) sum(x %in% GeneNames[dynamicColors %in% module]) )

  sig <- phyper(q = x -1, m=m, n=n, k=k, lower.tail=FALSE)
  sig <- p.adjust(sig, "fdr")
  res <- sig[sig < 1e-02]

  if(length(res) > 0) {
    res <- data.frame(module = module, ensemble = names(res), fdr = -log10(res))
    res <- res[order(res$fdr, decreasing = T),]
    rownames(res) <- NULL
  } else {res <- NULL}

  res

})

topME_ens <- do.call(rbind, topME_ens)
topME_ens <- topME_ens[!duplicated(topME_ens$ensemble),]
topME_ens <- topME_ens[nrow(topME_ens):1,]
topME_ens$fdr[topME_ens$fdr > -log10(1e-10)] <- -log10(1e-10)

setwd("/media/yuri/Data/home1/GNI_data/infection/ResultsSciRep/Figures/")
pdf("FigureS9B.pdf", width=4, height=9)
  # k <- max(which(topME_ens[,'module'] == "grey"))+1
  # m <- length(topME_ens[,'module'])
  par(mar=c(4,16,1,0.5))
  barplot(topME_ens[,'fdr'], horiz = T, names.arg = topME_ens[,'ensemble'], col = col2hex(topME_ens[,'module']),
        xlab = "-log10(fdr)", main = "WGCNA enrichment (fdr < 0.01)",las=1, cex.axis=0.7, cex.names = 0.7)
dev.off()


##title: Check out my fancy report
##author: Vijay

## Here is some text
library(ggplot2)
ggplot(mtcars,aes(mpg,hp,colour=as.factor(gear)))+
	geom_point()
#' Here is more text


library(kernlab)
library(caret)
library(keras)
library(shiny)
# install_keras()

ui <- fluidPage(uiOutput("tab"),
                theme = "paper",
                titlePanel("League of Legends Winner Prediction"),
                sidebarPanel(

                  helpText("League of Legends is a MOBA where 2 teams (blue and red)",
                           "face off. There are 3 lanes, a jungle, and 5 roles. The ",
                           "goal is to take down the enemy Nexus to win the game."),

                  numericInput("kill", "Please input the kill number of blue:", 8),

                  numericInput("death", "Please input the death number of blue:", 6),

                  numericInput("gold", "Please input the gold difference:", 0),

                  helpText("Gold Diff = Blue Gold - Red Gold"),

                  numericInput("exp", "Please input the experience difference:", 0),

                  helpText("Exp Diff = Blue Exp - Red Exp"),

                  numericInput("ward_place", "Please input the wards placed difference:", 0),

                  helpText("Ward Placed Diff = Blue Ward Placed - Red Ward Placed"),

                  numericInput("ward_des", "Please input the wards destroyed difference:", 0),

                  helpText("Ward Destroyed Diff = Blue Ward Destroyed - Red Ward Destroyed"),

                  selectInput("first", "Frist blood", choices = c("Blue", "Red", "No")),

                  numericInput("assist", "Please input the assists difference:", 0),

                  helpText("Assist Diff = Blue Assist - Red Assist"),

                  selectInput("dragon", "Who get the dragon", choices = c("Blue", "Red", "No")),

                  selectInput("herald", "Who get the herald", choices = c("Blue", "Red", "No")),

                  numericInput("level", "Please input the average level difference:", 0),

                  helpText("Average Level Diff = Blue Average Level - Red Average Level"),

                  numericInput("jg", "Please input the jungle monsters killed difference:", 0),

                  helpText("Jungle monsters killed Diff = Blue killed - Red killed"),

                  numericInput("cs", "Please input the total minions killed difference:", 0),

                  helpText("Minions killed Diff = Blue killed - Red killed"),

                  submitButton("Submit")
                ),
                mainPanel(
                  h4("The data your entered : "),
                  dataTableOutput("table"),
                  h4("Predicted Winner"),
                  verbatimTextOutput("result"),
                ),
)


#load DESeq2
library("DESeq2")
library("edgeR")
library(dplyr)

###########User functions############
round_df <- function(x, digits) {
  # round all numeric variables
  # x: data frame
  # digits: number of digits to round
  numeric_columns <- sapply(x, mode) == 'numeric'
  x[numeric_columns] <-  round(x[numeric_columns], digits)
  x
}

substrRight <- function(x, n){
  substr(x, nchar(x)-n+1, nchar(x))
}

substrLeft <- function(x, n){
  substr(x, 1, 0+n)
}

###########################
getwd()

setwd("C:/Users/User/Desktop/quantseq/zdf_Liver")

#leans first

name_of_csv_data_file = "name_of_spreadsheet.csv"

#read in data file
seqdata <- as.matrix(read.csv(name_of_csv_data_file, row.names=1))

head(seqdata)

#seqdata turn zeros to NA
seqdata[seqdata == 0] <- NA

#make selection variable for data we want to keep
sel <- apply( seqdata, 1, function(x) sum(is.na(x))<2 )

#select only the ones with low
new_seq_data <- seqdata[ sel, ]
NROW(seqdata)
#number of rows in new data without zeros in most of the samples
NROW(new_seq_data)
colnames(new_seq_data)
#extract groups from colnames
split <- (strsplit(colnames(new_seq_data), "_"))
split
g <- sapply(strsplit(colnames(new_seq_data), "_"), `[`, 1)
g

#nvert NA to 0 counts
new_seq_data[is.na(new_seq_data)] <- 0
head(new_seq_data)

#print the organized csv file
csv_output_file_name <- paste("Non_Zero_", name_of_csv_data_file, sep="_")
#write the new csv file
write.csv(new_seq_data, file = csv_output_file_name)

#normalize by TMM or RLE method
RLE_norm_factor <- calcNormFactors(new_seq_data, method = "RLE") #or TMM
RLE_norm_factor
# normalize data by RLE method
RLE_normed_seqdata <- t(apply(new_seq_data, 1,function(x)x*RLE_norm_factor))

RLE_normed_seqdata <- round_df(RLE_normed_seqdata,0)

#print the organized csv file
csv_output_file_name <- paste("RLE_Normalized_",name_of_csv_data_file, sep="_")

write.csv(RLE_normed_seqdata, file = csv_output_file_name)

#stop here if only normalizing, otherwise the following runs differential expression
g
trt <- as.factor(g)
trt

# create a DESeqDataSet object from a matrix
d <- DESeqDataSetFromMatrix(countData = RLE_normed_seqdata,
                            colData = data.frame(trt),
                            design = formula(~ trt))

# differential expression analysis based on the NB distribution
ds2 <- DESeq(d, fitType = "local", quiet = T)
# extract results from a DESeq analysis
res <- results(ds2)

# p value for rejecting the null hypothesis: two conditions have same mean
pvalue <- res$pvalue
head(pvalue)
# dynamically rename the files according to each one

file_original = "RLE_deseq"

csv_output_file_name <- paste(file_original,name_of_csv_data_file, sep="_")

write.csv(res[order(res$pvalue), ], file = csv_output_file_name)


.libPaths(c("/home/che82/R/x86_64-pc-linux-gnu-library/4.1","/usr/local/lib/R/site-library","/usr/lib/R/site-library","/usr/lib/R/library" ))

library(rdist)
library(SCORPIUS)
library(Rmagic)
library(pheatmap)
library(Linnorm)
#######on alignment##########
set.seed(1000)
library(reshape2)
Sys.setenv(RETICULATE_PYTHON = "/home/che82/miniconda3/bin/python")
library(reticulate)
#set pathon path#########hcf
path_to_python<-'/home/che82/miniconda3/bin/python'
use_python(path_to_python)
##########################
library(ManiNetCluster)
library(plyr)
library(RColorBrewer)
library(stringr)
library(limma)

library(ComplexHeatmap)
library(circlize)
#######load and processing data#########
source('func.r')

#####load prepare data from align######
load('bulk_start.RData')

rdata1 = rdata_human; meta1=meta_human
rdata2 = rdata_organoid; meta2=meta_organoid

###################
#regions=c('MFC','OFC','DFC','VFC','M1C','S1C','IPC','A1C','STC','ITC','V1C','HIP','AMY','STR','MD','CBC')
regions = unique(meta1$Region)
form.data1=rdata1[,meta1$Species=='Human' & meta1$Region %in% regions];form.meta1=meta1[meta1$Species=='Human' & meta1$Region %in% regions,]
form.data2=rdata2;form.meta2=meta2

form.meta1$time=form.meta1$Period
form.meta2$time=form.meta2$Days

#??????? find significance DE in any condition#######

deg_list1 = DE.list(form.data1,form.meta1)
deg_list2 = DE.list(form.data2,form.meta2)

#####MAIN: start align##########
######focus on genes of interest#########
##co-exp genes+HVG genes
sel.genes = intersect(intersect(deg_list1,deg_list2),unique(all.rec$gene))
## co-expression genes
#sel.genes = intersect(intersect(row.names(form.data1),row.names(form.data2)),unique(all.rec$gene))
##all genes
#sel.genes = intersect(row.names(rdata1),row.names(rdata2))
##highly variable genes only
#sel.genes = intersect(row.names(form.data1),row.names(form.data2))

#select expression based genes,log transform and reorder
sel.data1 = form.data1[row.names(form.data1) %in% sel.genes,]; sel.data1 = sel.data1[!duplicated(row.names(sel.data1)),]; sel.meta1=form.meta1  #on human data
sel.data2 = form.data2[row.names(form.data2) %in% sel.genes,]; sel.data2 = sel.data2[!duplicated(row.names(sel.data2)),]; sel.meta2=form.meta2  #on organoid data

#reorder
exp1 = sel.data1[order(row.names(sel.data1)),order(sel.meta1$time)];sel.meta1=sel.meta1[order(sel.meta1$time),]
exp2 = sel.data2[order(row.names(sel.data2)),order(sel.meta2$time)];sel.meta2=sel.meta2[order(sel.meta2$time),]

#######below needs to refine#############
ps.mat1 = t(exp1);ps.time1=sel.meta1$time
ps.mat2 = t(exp2);ps.time2=sel.meta2$time

#align and visual
algn_res = runMSMA_dtw(ps.mat1,ps.mat2)

df2 = algn_res[[3]]

###########some plots############
#df2$time = c(sel.meta1$time,as.numeric(as.factor(sel.meta2$time)))
df2$time = c(sel.meta1$time,sel.meta2$time)
########calculate pairwise distances between cells after MSMA#####
pair_dist = apply(df2[df2$data=='sample1',c(3:5)],1,function(x) {
	d = apply(df2[df2$data=='sample2',c(3:5)],1,function(y) eu.dist(x,y))
})
row.names(pair_dist)=row.names(ps.mat2)
colnames(pair_dist)=row.names(ps.mat1)
sim_dist = 1/(1+pair_dist)
#hmtp3-2nd align
cols1 = c(brewer.pal(9,'YlGnBu')[c(2:9)],brewer.pal(11,'BrBG')[c(8:11)]);names(cols1) = unique(ps.time1)
annot1=rowAnnotation(H_time=factor(ps.time1,levels=unique(ps.time1)),col=list(H_time=cols1))
cols2 = c(brewer.pal(9,'YlOrRd')[c(2:9)],brewer.pal(11,'BrBG')[rev(1:4)]);names(cols2) = unique(ps.time2)
annot2=columnAnnotation(O_time=factor(ps.time2,levels=unique(ps.time2)),col=list(O_time=cols2))

sim_mat = t(sim_dist)
Heatmap(sim_mat,name='human_vs_humanOrg',show_row_names=F,show_column_names=F,cluster_rows=F,cluster_columns=F,left_annotation=annot1,top_annotation=annot2,col=colorRamp2(c(0.8,max(sim_dist)),c('white','red')))

####plot 3D trajectors####
pdf('3d1.pdf')
time.cols1 = colorRampPalette(brewer.pal(n=9,'Greens'))(12)
#time.cols1 = c(brewer.pal(9,'YlGnBu')[c(2:9)],brewer.pal(11,'BrBG')[c(8:11)])
res = data.frame(df2[df2$data=='sample1',])
res0 = data.frame(df2)
library(plot3D)
s3d<-scatter3D(x=res[,3],y=res[,4],z=res[,5],colvar=as.numeric(mapvalues(res$time,names(table(res$time)),c(2:13))),col = c(time.cols1),pch=c(16,17)[as.numeric(as.factor(res$data))],colkey=F,theta = 300, phi = 30,cex=2,
xlim=c(min(res0$Val0),max(res0$Val0)),
ylim=c(min(res0$Val1),max(res0$Val1)),
zlim=c(min(res0$Val2),max(res0$Val2)))
legend("top", legend = levels(as.factor(res$data)), pch = c(16, 17),inset = -0.1, xpd = TRUE, horiz = TRUE)
legend("right", legend = levels(as.factor(res$time)), col = c(time.cols1),pch=16,inset =-0.05, xpd = TRUE, horiz = F,cex=1.2)
dev.off()

#time.cols2 = colorRampPalette(brewer.pal(n=12,'Set2'))(12)
#time.cols2 = c(brewer.pal(9,'YlOrRd')[c(2:9)],brewer.pal(11,'BrBG')[rev(1:4)])
#c25 <- c( "dodgerblue2", "#E31A1C",  "green4", "#6A3D9A",  "#FF7F00",  "black", "gold1", "skyblue2", "#FB9A99",  "palegreen2", "#CAB2D6",  "#FDBF6F", "gray70", "khaki2", "maroon", "orchid1", "deeppink1", "blue1", "steelblue4", "darkturquoise", "green1", "yellow4", "yellow3", "darkorange4", "brown")
#time.cols2 = c25[1:12]

#time.cols2 = colorRampPalette(brewer.pal(9, "YlOrBr"))(12) #for human
time.cols2 = colorRampPalette(brewer.pal(9, "Blues"))(12) #for organoid

res = data.frame(df2[df2$data=='sample2',])
#res = data.frame(df2)
res0 = data.frame(df2)
library(plot3D)
pdf('3D2.pdf',width=10)
s3d<-scatter3D(x=res[,3],y=res[,4],z=res[,5],pch=24,col='gray',bg=time.cols2[as.numeric(mapvalues(res$time,names(table(res$time)),c(1:12)))],colkey=F,theta = 300, phi = 30,cex=2,lwd=1,
xlim=c(min(res0$Val0),max(res0$Val0)),
ylim=c(min(res0$Val1),max(res0$Val1)),
zlim=c(min(res0$Val2),max(res0$Val2)))
legend("top", legend = levels(as.factor(res$data)), pch = c(16, 17),inset = -0.1, xpd = TRUE, horiz = TRUE)
legend("right", legend = levels(as.factor(res$time)), col = c(time.cols2),pch=16,inset = -0.05, xpd = TRUE, horiz = F,cex=1.2)
dev.off()

#######corrplot on timepoint wise averaged similarity
library(corrplot)
sim_avg = matrix(0,nrow=length(unique(ps.time1)),ncol=length(unique(ps.time2)))

i = 0
for(t1 in unique(ps.time1)) {
	i = i+1
	j = 0
	for (t2 in unique(ps.time2)) {
		j = j+1
		sim_tmp = sim_mat[ps.time1==t1,ps.time2==t2]
		avg_tmp = mean(sim_tmp)
		sim_avg[i,j] = avg_tmp
	}
}
sim_avg = t(sim_avg)
colnames(sim_avg) = unique(ps.time1)
row.names(sim_avg) = unique(ps.time2)

library(RColorBrewer)
pdf('corr.plot.bulk.human.vs.org1.pdf')
corrplot(sim_avg,col=rev(colorRampPalette(brewer.pal(9,'PRGn'))(200)),cl.lim=c(0.7,1),is.corr=F,tl.col="black")
dev.off()


library(dplyr)
library(ggplot2)
library(bootstrap)
library(lme4)

theme_set(theme_bw(18))
setwd("/Users/elisakreiss/Documents/stanford/study/overinformativeness/experiments/17_prod_calibr_noInformTrial/results")
# setwd("/Users/titlis/cogsci/projects/stanford/projects/overinformativeness/experiments/17_prod_calibr_noInformTrial/results")
source("rscripts/helpers.r")

d = read.table(file="data/norming.csv",sep=",", header=T)#, quote="")
head(d)
nrow(d)
summary(d)
totalnrow = nrow(d)
d$Trial = d$slide_number_in_experiment - 1
length(unique(d$workerid))

typ = read.table(file="../../11_color_norming/results/data/meantypicalities.csv",sep=",",header=T)
row.names(typ) = paste(typ$Color,typ$Item)
head(typ)

# look at turker comments
unique(d$comments)

ggplot(d, aes(rt)) +
  geom_histogram() +
  scale_x_continuous(limits=c(0,15000))

ggplot(d, aes(log(rt))) +
  geom_histogram()

summary(d$Answer.time_in_minutes)
ggplot(d, aes(Answer.time_in_minutes)) +
  geom_histogram()

ggplot(d, aes(gender)) +
  stat_count()

ggplot(d, aes(asses)) +
  stat_count()

ggplot(d, aes(age)) +
  geom_histogram()
table(d$age)

ggplot(d, aes(education)) +
  stat_count()

ggplot(d, aes(language)) +
  stat_count()

ggplot(d, aes(enjoyment)) +
  stat_count()

# process production data
production = d
production$NormedTypicality = typ[paste(production$target_color,production$target_item),]$Typicality
production$binaryTypicality = as.factor(ifelse(production$NormedTypicality > .5, "typical", "atypical"))
production <- production[,colSums(is.na(production))<nrow(production)]
production$ColorMentioned = ifelse(grepl("green|purple|white|black|brown|purple|violet|yellow|gold|orange|silver|blue|pink|red", production$response, ignore.case = TRUE), T, F)
production$CleanedResponse = gsub("([bB]ananna|[Bb]annna|[Bb]anna|[Bb]annana|[Bb]anan)","banana",as.character(production$response))
production$CleanedResponse = gsub("[Cc]arot|[Cc]arrrot","carrot",as.character(production$CleanedResponse))
production$CleanedResponse = gsub("([Tt]omaot|tmatoe|tamato)","tomato",as.character(production$CleanedResponse))
production$CleanedResponse = gsub("[Aa]ppe","apple",as.character(production$CleanedResponse))
production$ItemMentioned = ifelse(grepl("apple|banana|orange|carrot|tomato|pear|pepper", production$CleanedResponse, ignore.case = TRUE), T, F)
prop.table(table(production$ColorMentioned,production$ItemMentioned))
# 1% cases of neither type nor color mention (eg, bad location modifiers like "the first one" or taboo-like reference to item like "long skinny vegetable")
production[!production$ColorMentioned & !production$ItemMentioned,]$response
production[!production$ColorMentioned & !production$ItemMentioned,]$target_item
production[!production$ColorMentioned & !production$ItemMentioned,]$target_color
# another 15% where color is mentioned but not type -- this seems to be just 3 subject who are being contrarian
production[production$ColorMentioned & !production$ItemMentioned,c("response")]
table(production[production$ColorMentioned & !production$ItemMentioned,]$target_item,production[production$ColorMentioned & !production$ItemMentioned,]$binaryTypicality)
table(production[production$ColorMentioned & !production$ItemMentioned,]$target_item,production[production$ColorMentioned & !production$ItemMentioned,]$workerid)

#exclude cases where locative modifiers were used
#production = droplevels(production[!(!production$ColorMentioned & !production$ItemMentioned),])

table(production$condition,production$binaryTypicality)
table(production$condition,production$binaryTypicality,production$target_item)
agr = production %>%
  group_by(condition,binaryTypicality) %>%
  summarise(PropColorMentioned=mean(ColorMentioned),ci.low=ci.low(ColorMentioned),ci.high=ci.high(ColorMentioned))
agr = as.data.frame(agr)
agr$YMin = agr$PropColorMentioned - agr$ci.low
agr$YMax = agr$PropColorMentioned + agr$ci.high

ggplot(agr, aes(x=binaryTypicality,y=PropColorMentioned,color=condition)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax),width=.25)
ggsave("graphs/distribution_effect_production.png",height=3.5)
# ggsave("graphs/distribution_effect_production.pdf",height=3.5)

# by subject
agr = production %>%
  group_by(condition,binaryTypicality,workerid) %>%
  summarise(PropColorMentioned=mean(ColorMentioned),ci.low=ci.low(ColorMentioned),ci.high=ci.high(ColorMentioned))
agr = as.data.frame(agr)
agr$YMin = agr$PropColorMentioned - agr$ci.low
agr$YMax = agr$PropColorMentioned + agr$ci.high

ggplot(agr, aes(x=binaryTypicality,y=PropColorMentioned,color=condition)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax),width=.25) +
  facet_wrap(~workerid)
ggsave("graphs/distribution_effect_production_bysubject.png",height=8.5)
# ggsave("graphs/distribution_effect_production.pdf",height=3.5)

# by trial
production$FirstTrial = ifelse(production$Trial == 3, "first","not-first")
agr = production %>%
  group_by(condition,binaryTypicality,FirstTrial) %>%
  summarise(PropColorMentioned=mean(ColorMentioned),ci.low=ci.low(ColorMentioned),ci.high=ci.high(ColorMentioned))
agr = as.data.frame(agr)
agr$YMin = agr$PropColorMentioned - agr$ci.low
agr$YMax = agr$PropColorMentioned + agr$ci.high

ggplot(agr, aes(x=binaryTypicality,y=PropColorMentioned,color=condition)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax),width=.25) +
  facet_wrap(~FirstTrial)
ggsave("graphs/distribution_effect_production_byfirsttrial.png",height=8.5)
# ggsave("graphs/distribution_effect_production.pdf",height=3.5)

# condition on whether or not item was mentioned
table(production$condition,production$binaryTypicality)
agr = production %>%
  group_by(condition,binaryTypicality,ItemMentioned) %>%
  summarise(PropColorMentioned=mean(ColorMentioned),ci.low=ci.low(ColorMentioned),ci.high=ci.high(ColorMentioned))
agr = as.data.frame(agr)
agr$YMin = agr$PropColorMentioned - agr$ci.low
agr$YMax = agr$PropColorMentioned + agr$ci.high

ggplot(agr, aes(x=binaryTypicality,y=PropColorMentioned,color=condition)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax),width=.25) +
  facet_grid(~ItemMentioned)
ggsave("graphs/distribution_effect_production_byitemmention.png",height=3)
# ggsave("graphs/distribution_effect_production_byitemmention.pdf",height=3)

# only color mention
production$OnlyColorMentioned = ifelse(production$ColorMentioned & !production$ItemMentioned,T,F)
agr = production %>%
  group_by(condition,binaryTypicality) %>%
  summarise(PropOnlyColorMentioned=mean(OnlyColorMentioned),ci.low=ci.low(OnlyColorMentioned),ci.high=ci.high(OnlyColorMentioned))
agr = as.data.frame(agr)
agr$YMin = agr$PropOnlyColorMentioned - agr$ci.low
agr$YMax = agr$PropOnlyColorMentioned + agr$ci.high

ggplot(agr, aes(x=binaryTypicality,y=PropOnlyColorMentioned,color=condition)) +
  geom_point() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax),width=.25)
ggsave("graphs/png/excl_orange_distribution_colorOnly_production.png",height=3.5)
# ggsave("graphs/distribution_color_production.pdf",height=3.5)

agr = production %>%
  group_by(condition,target_item,NormedTypicality,ItemMentioned) %>%
  summarise(PropColorMentioned=mean(ColorMentioned),ci.low=ci.low(ColorMentioned),ci.high=ci.high(ColorMentioned))
agr = as.data.frame(agr)
agr$YMin = agr$PropColorMentioned - agr$ci.low
agr$YMax = agr$PropColorMentioned + agr$ci.high

ggplot(agr, aes(x=NormedTypicality,y=PropColorMentioned,color=target_item,linetype=condition,group=interaction(condition,target_item))) +
  geom_point() +
  geom_line() +
  geom_errorbar(aes(ymin=YMin,ymax=YMax),width=.25) +
  facet_grid(~ItemMentioned)
ggsave("graphs/production_byitem.png",height=3)


library("limma")
library("edgeR")

load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/brainseq_pipeline/polyA_unstranded/rse_gene_polyA_dlpfc_n41.Rdata", verbose = T)

# format phenotype table

hompd = colData(rse_gene)

# format counts

geneCounts = assay(rse_gene)
geneCounts = geneCounts[rowSums(geneCounts)>0,]
identical(colnames(geneCounts), rownames(hompd))

## Differential expression: gene level

design <- model.matrix(~ hompd$Age)
dge <- DGEList(counts = geneCounts)
dge <- calcNormFactors(dge)
dat <- voom(dge, design, plot = TRUE)
fit_gene <- lmFit(dat, design)
fit_gene_all <- eBayes(fit_gene)

## now only on postnatal samples

postpd = hompd[hompd$Age>0,]
geneCounts = geneCounts[,colnames(geneCounts) %in% rownames(postpd)]
geneCounts = geneCounts[rowSums(geneCounts)>0,]
identical(colnames(geneCounts), rownames(postpd))

## Differential expression: gene level

design <- model.matrix(~ postpd$Age)
dge <- DGEList(counts = geneCounts)
dge <- calcNormFactors(dge)
dat <- voom(dge, design, plot = TRUE)
fit_gene <- lmFit(dat, design)
fit_gene_post <- eBayes(fit_gene)

## Reformat combined results

homRNAres = as.data.frame(cbind(fit_gene_all$coefficients, fit_gene_all$t, fit_gene_all$p.value))
colnames(homRNAres) = c("Coeff.Intercept", "Coeff", "Tstat.Intercept", "Tstat", "pval.Intercept", "pval")
homRNAres$FDR = p.adjust(homRNAres$pval, method = "fdr")
homRNAres$gencodeID = rownames(homRNAres)

postRNAres = as.data.frame(cbind(fit_gene_post$coefficients, fit_gene_post$t, fit_gene_post$p.value))
colnames(postRNAres) = c("Coeff.Intercept", "Coeff", "Tstat.Intercept", "Tstat", "pval.Intercept", "pval")
postRNAres$FDR = p.adjust(postRNAres$pval, method = "fdr")
postRNAres$gencodeID = rownames(postRNAres)

save(fit_gene_post, fit_gene_all, postRNAres,homRNAres,hompd,postpd, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/homogenate_RNA/DE_limma_results_homogenateRNAseq.rda")