## This script was used to perform the meta-analysis combining the p values from EWAS performed in three different cohorts
## Filepaths and sample IDs have been removed for security reasons, therfore it serves as a guide to the analysis

library(IlluminaHumanMethylation450kanno.ilmn12.hg19)
library(qqman)

setwd("")
load("") ## load seed.SS object
load("") ## load simons.SS object
minerva<-read.csv("Analysis/CaseControl_Sex_Batch_HousemanCellComp_SmokingScore_BY_BM_GA_Urbanicity.csv", stringsAsFactors = FALSE, row.names = 1)

probes<-table(c(rownames(minerva), rownames(seed.SS), rownames(simons.SS)))
table(probes)

minerva<-minerva[names(probes)[which(probes > 1)],]
seed.SS<-seed.SS[names(probes)[which(probes > 1)],]
simons.SS<-simons.SS[names(probes)[which(probes > 1)],]

### look at overlap of top probes

par(mfrow = c(3,2))
plot(minerva$MeanDiff[which(minerva$P.value < 5e-5)], seed.SS$MeanDiff[which(minerva$P.value < 5e-5)], xlab = "Minerva", ylab = "seed", main = paste(length(which(sign(minerva$MeanDiff[which(minerva$P.value < 5e-5)]) == sign(seed.SS$MeanDiff[which(minerva$P.value < 5e-5)]))), "/", length(which(minerva$P.value < 5e-5)), " P = ", signif(binom.test(length(which(sign(minerva$MeanDiff[which(minerva$P.value < 5e-5)]) == sign(seed.SS$MeanDiff[which(minerva$P.value < 5e-5)]))), length(which(minerva$P.value < 5e-5)))$p.value,3), sep = ""), pch = 16)
abline(v = 0)
abline(h = 0)
plot(minerva$MeanDiff[which(minerva$P.value < 5e-5)], simons.SS$MeanDiff[which(minerva$P.value < 5e-5)], xlab = "Minerva", ylab = "simons", main = paste(length(which(sign(minerva$MeanDiff[which(minerva$P.value < 5e-5)]) == sign(simons.SS$MeanDiff[which(minerva$P.value < 5e-5)]))), "/", length(which(minerva$P.value < 5e-5)), " P = ", signif(binom.test(length(which(sign(minerva$MeanDiff[which(minerva$P.value < 5e-5)]) == sign(simons.SS$MeanDiff[which(minerva$P.value < 5e-5)]))), length(which(minerva$P.value < 5e-5)))$p.value,3), sep = ""), pch = 16)
abline(v = 0)
abline(h = 0)

plot(seed.SS$MeanDiff[which(seed.SS$pvalue < 5e-5)], minerva$MeanDiff[which(seed.SS$pvalue < 5e-5)], xlab = "seed", ylab = "Minerva", main = paste(length(which(sign(seed.SS$MeanDiff[which(seed.SS$pvalue < 5e-5)]) == sign(minerva$MeanDiff[which(seed.SS$pvalue < 5e-5)]))), "/", length(which(seed.SS$pvalue < 5e-5)), " P = ", signif(binom.test(length(which(sign(seed.SS$MeanDiff[which(seed.SS$pvalue < 5e-5)]) == sign(minerva$MeanDiff[which(seed.SS$pvalue < 5e-5)]))), length(which(seed.SS$pvalue < 5e-5)))$p.value,3), sep = ""), pch = 16)
abline(v = 0)
abline(h = 0)
plot(seed.SS$MeanDiff[which(seed.SS$pvalue < 5e-5)], simons.SS$MeanDiff[which(seed.SS$pvalue < 5e-5)], xlab = "seed", ylab = "simons", main = paste(length(which(sign(seed.SS$MeanDiff[which(seed.SS$pvalue < 5e-5)]) == sign(simons.SS$MeanDiff[which(seed.SS$pvalue < 5e-5)]))), "/", length(which(seed.SS$pvalue < 5e-5)), " P = ", signif(binom.test(length(which(sign(seed.SS$MeanDiff[which(seed.SS$pvalue < 5e-5)]) == sign(simons.SS$MeanDiff[which(seed.SS$pvalue < 5e-5)]))), length(which(seed.SS$pvalue < 5e-5)))$p.value,3), sep = ""), pch = 16)
abline(v = 0)
abline(h = 0)

plot(simons.SS$MeanDiff[which(simons.SS$pvalue < 5e-5)], minerva$MeanDiff[which(simons.SS$pvalue < 5e-5)], xlab = "simons", ylab = "Minerva", main = paste(length(which(sign(simons.SS$MeanDiff[which(simons.SS$pvalue < 5e-5)]) == sign(minerva$MeanDiff[which(simons.SS$pvalue < 5e-5)]))), "/", length(which(simons.SS$pvalue < 5e-5)), " P = ", signif(binom.test(length(which(sign(simons.SS$MeanDiff[which(simons.SS$pvalue < 5e-5)]) == sign(minerva$MeanDiff[which(simons.SS$pvalue < 5e-5)]))), length(which(simons.SS$pvalue < 5e-5)))$p.value,3), sep = ""), pch = 16)
abline(v = 0)
abline(h = 0)
plot(simons.SS$MeanDiff[which(simons.SS$pvalue < 5e-5)], seed.SS$MeanDiff[which(simons.SS$pvalue < 5e-5)], xlab = "simons", ylab = "seed", main = paste(length(which(sign(simons.SS$MeanDiff[which(simons.SS$pvalue < 5e-5)]) == sign(seed.SS$MeanDiff[which(simons.SS$pvalue < 5e-5)]))), "/", length(which(simons.SS$pvalue < 5e-5)), " P = ", signif(binom.test(length(which(sign(simons.SS$MeanDiff[which(simons.SS$pvalue < 5e-5)]) == sign(seed.SS$MeanDiff[which(simons.SS$pvalue < 5e-5)]))), length(which(simons.SS$pvalue < 5e-5)))$p.value,3), sep = ""), pch = 16)
abline(v = 0)
abline(h = 0)

par(mfrow = c(3,2))
plot(-log10(minerva$P.value[which(minerva$P.value < 5e-5)]), -log10(seed.SS$pvalue[which(minerva$P.value < 5e-5)]), xlab = "Minerva", ylab = "seed", pch = 16)
abline(v = 0)
abline(h = 0)
plot(-log10(minerva$P.value[which(minerva$P.value < 5e-5)]), -log10(simons.SS$pvalue[which(minerva$P.value < 5e-5)]), xlab = "Minerva", ylab = "simons", pch = 16)
abline(v = 0)
abline(h = 0)

### use fisher's method to combine p-values

res<-cbind(minerva[match(names(probes)[which(probes == 3)], rownames(minerva)), c("MeanDiff", "SE", "P.value")], seed.SS[match(names(probes)[which(probes == 3)], rownames(seed.SS)) , c("MeanDiff", "SE", "pvalue")], simons.SS[match(names(probes)[which(probes == 3)], rownames(simons.SS)), c("MeanDiff", "SE", "pvalue")])
res<-cbind(res, NA, 3)
colnames(res)<-c("Minerva:MeanDiff", "Minerva:SE", "Minerva:P", "seed:MeanDiff", "seed:SE", "seed:P","simons:MeanDiff", "simons:SE", "simons:P","Fishers_P", "n_studies")
rownames(res)<-names(probes)[which(probes ==3)]

### start with probes annotated in all 3 datasets
for(each in names(probes)[which(probes == 3)]){

	pval<-res[each,c(3,6,9)]

	### compare to fishers p value
	fisher<-(sum(-log(pval))*2)
	fisherp<-1-pchisq(fisher, 2*length(pval))

	res[each,10]<-fisherp
}

write.csv(res, "Analysis/CaseControl_ASD_MetaAnalysis_FishersP.csv")

### then consider probes tested in 2 datasets

res.2<-cbind(minerva[match(names(probes)[which(probes == 2)], rownames(minerva)), c("MeanDiff", "SE", "P.value")], seed.SS[match(names(probes)[which(probes == 2)], rownames(seed.SS)) , c("MeanDiff", "SE", "pvalue")], simons.SS[match(names(probes)[which(probes == 2)], rownames(simons.SS)), c("MeanDiff", "SE", "pvalue")])
res.2<-cbind(res.2, NA, 2)
colnames(res.2)<-c("Minerva:MeanDiff", "Minerva:SE", "Minerva:P", "seed:MeanDiff", "seed:SE", "seed:P","simons:MeanDiff", "simons:SE", "simons:P","Fishers_P", "n_studies")
rownames(res.2)<-names(probes)[which(probes == 2)]
res<-rbind(res,res.2)

for(each in names(probes)[which(probes == 2)]){
	if(is.na(minerva$MeanDiff[match(each, rownames(minerva))])){
	pval<-res[each,c(6,9)]
	} else {
		if(is.na(seed.SS$MeanDiff[match(each, rownames(seed.SS))])){
			pval<-res[each,c(3,9)]
		} else {
			if(is.na(simons.SS$MeanDiff[match(each, rownames(simons.SS))])){

				pval<-res[each,c(3,6)]
			}
		}
	}
	fisher<-(sum(-log(pval))*2)
	fisherp<-1-pchisq(fisher, 2*length(pval))
	res[each,10]<-fisherp
}

write.csv(res, "Analysis/CaseControl_ASD_MetaAnalysis_FishersP.csv")

data(IlluminaHumanMethylation450kanno.ilmn12.hg19)
probeAnnot<-as.data.frame(IlluminaHumanMethylation450kanno.ilmn12.hg19@data$Locations)
probeAnnot<-probeAnnot[rownames(res),]
res<-cbind(res, probeAnnot)
probeAnnot<-as.data.frame(IlluminaHumanMethylation450kanno.ilmn12.hg19@data$Other)
probeAnnot<-probeAnnot[rownames(res),]
res<-cbind(res, probeAnnot)
write.csv(res, "Analysis/CaseControl_ASD_MetaAnalysis_FishersP.csv")

qq(res$Fishers_P)
res$chr<-gsub("chr", "", res$chr)
res$chr[which(res$chr == "X")]<-23
res$chr<-as.numeric(res$chr)

##For manhattan plot redefine function to use symbools to indicate when all same direction of effects
manhattan<-function (x, chr = "CHR", bp = "BP", p = "P", snp = "SNP", col = c("gray10",
    "gray60"), chrlabs = NULL, suggestiveline = -log10(1e-05),
    genomewideline = -log10(5e-08), highlight = NULL, logp = TRUE,
    annotatePval = NULL, annotateTop = TRUE, pch = 20, ...)
{
    CHR = BP = P = index = NULL
    if (!(chr %in% names(x)))
        stop(paste("Column", chr, "not found!"))
    if (!(bp %in% names(x)))
        stop(paste("Column", bp, "not found!"))
    if (!(p %in% names(x)))
        stop(paste("Column", p, "not found!"))
    if (!(snp %in% names(x)))
        warning(paste("No SNP column found. OK unless you're trying to highlight."))
    if (!is.numeric(x[[chr]]))
        stop(paste(chr, "column should be numeric. Do you have 'X', 'Y', 'MT', etc? If so change to numbers and try again."))
    if (!is.numeric(x[[bp]]))
        stop(paste(bp, "column should be numeric."))
    if (!is.numeric(x[[p]]))
        stop(paste(p, "column should be numeric."))
    d = data.frame(CHR = x[[chr]], BP = x[[bp]], P = x[[p]])
    if (!is.null(x[[snp]]))
        d = transform(d, SNP = x[[snp]])
    d <- subset(d, (is.numeric(CHR) & is.numeric(BP) & is.numeric(P)))
    d <- d[order(d$CHR, d$BP), ]
    if (logp) {
        d$logp <- -log10(d$P)
    }
    else {
        d$logp <- d$P
    }
    d$pos = NA
    d$index = NA
    ind = 0
    for (i in unique(d$CHR)) {
        ind = ind + 1
        d[d$CHR == i, ]$index = ind
    }
    nchr = length(unique(d$CHR))
    if (nchr == 1) {
        d$pos = d$BP
        ticks = floor(length(d$pos))/2 + 1
        xlabel = paste("Chromosome", unique(d$CHR), "position")
        labs = ticks
    }
    else {
        lastbase = 0
        ticks = NULL
        for (i in unique(d$index)) {
            if (i == 1) {
                d[d$index == i, ]$pos = d[d$index == i, ]$BP
            }
            else {
                lastbase = lastbase + tail(subset(d, index ==
                  i - 1)$BP, 1)
                d[d$index == i, ]$pos = d[d$index == i, ]$BP +
                  lastbase
            }
            ticks = c(ticks, (min(d[d$index == i, ]$pos) + max(d[d$index ==
                i, ]$pos))/2 + 1)
        }
        xlabel = "Chromosome"
        labs <- unique(d$CHR)
    }
    xmax = ceiling(max(d$pos) * 1.03)
    xmin = floor(max(d$pos) * -0.03)
    def_args <- list(xaxt = "n", bty = "n", xaxs = "i", yaxs = "i",
        las = 1, pch = pch, xlim = c(xmin, xmax), ylim = c(0,
            ceiling(max(d$logp))), xlab = xlabel, ylab = expression(-log[10](italic(p))))
    dotargs <- list(...)
    do.call("plot", c(NA, dotargs, def_args[!names(def_args) %in%
        names(dotargs)]))
    if (!is.null(chrlabs)) {
        if (is.character(chrlabs)) {
            if (length(chrlabs) == length(labs)) {
                labs <- chrlabs
            }
            else {
                warning("You're trying to specify chromosome labels but the number of labels != number of chromosomes.")
            }
        }
        else {
            warning("If you're trying to specify chromosome labels, chrlabs must be a character vector")
        }
    }
    if (nchr == 1) {
        axis(1, ...)
    }
    else {
        axis(1, at = ticks, labels = labs, ...)
    }
    col = rep(col, max(d$CHR))
    if (nchr == 1) {
        with(d, points(pos, logp, pch = pch, col = col[1], ...))
    }
    else {
        icol = 1
        for (i in unique(d$index)) {
            with(d[d$index == unique(d$index)[i], ], points(pos,
                logp, col = col[icol], pch = pch, ...))
            icol = icol + 1
        }
    }
    if (suggestiveline)
        abline(h = suggestiveline, col = "blue")
    if (genomewideline)
        abline(h = genomewideline, col = "red")
    if (!is.null(highlight)) {
        if (any(!(highlight %in% d$SNP)))
            warning("You're trying to highlight SNPs that don't exist in your results.")
        d.highlight = d[which(d$SNP %in% highlight), ]
        with(d.highlight, points(pos, logp, col = "green3", pch = pch,
            ...))
    }
    if (!is.null(annotatePval)) {
        topHits = subset(d, P <= annotatePval)
        par(xpd = TRUE)
        if (annotateTop == FALSE) {
            with(subset(d, P <= annotatePval), textxy(pos, -log10(P),
                offset = 0.625, labs = topHits$SNP, cex = 0.45),
                ...)
        }
        else {
            topHits <- topHits[order(topHits$P), ]
            topSNPs <- NULL
            for (i in unique(topHits$CHR)) {
                chrSNPs <- topHits[topHits$CHR == i, ]
                topSNPs <- rbind(topSNPs, chrSNPs[1, ])
            }
            textxy(topSNPs$pos, -log10(topSNPs$P), offset = 0.625,
                labs = topSNPs$SNP, cex = 0.5, ...)
        }
    }
    par(xpd = FALSE)
}

pchInd<-rep(2, nrow(res))
pchInd[which(abs(rowSums(sign(res[,c(1,4,7)]), na.rm = TRUE)) == rowSums(!is.na(res[,c(1,4,7)])))]<-16

manhattan(res, p = "Fishers_P", chr = "chr", bp = "pos", suggestiveline = -log10(5e-5), genomewideline = -log10(1e-7), pch = pchInd)


library(dplyr)
library(tidyr)
library(shiny)
library(plotly)
library(ggplot2)
library(markdown)
devtools::install_github("jcheng5/bubbles")

library(bubbles)

#Get the right amount of Apprehended data
apprehended <- read.csv("data/apprehended.csv", stringsAsFactors = FALSE)
apprehended <- apprehended[3:5, 2:6 ]
colnames(apprehended) <- c("2006","2007","2008","2009","2010")
apprehended <- apprehended[-c(2), ]
apprehended <- gather(apprehended,"Year", "Apprehended",1:5)
apprehended <- apprehended[-c(1,3,5,7,9), ]
#Same with Immigrant
immigrant <- read.csv("data/us.immigrant.csv", stringsAsFactors = FALSE)
cols <- c("Year","Drug","Immigration","Other")
colnames(immigrant) <- cols
immigrant <- immigrant[31:35, ]
#Join together to plot later
immigrant <- full_join(immigrant,apprehended)
#Get rid of commas in the values
immigrant$Drug<-as.numeric(gsub(",", "", immigrant$Drug))
immigrant$Immigration<-as.numeric(gsub(",", "", immigrant$Immigration))
immigrant$Other<-as.numeric(gsub(",", "", immigrant$Other))
immigrant$Apprehended<-as.numeric(gsub(",", "", immigrant$Apprehended))
#Create extra tables based on the data
immigrant <- mutate(immigrant,Total = Drug+Immigration)
immigrant <- mutate(immigrant,Ratio = Total/Apprehended)

#Present graph
main.plot <- ggplot(data = immigrant)+
  geom_line(mapping = aes(x= Year, y= Ratio, group=1))+
  ggtitle("Percentage of People who are Arrested/Apprehended")

#Call above graph and use this function at the bottom
bar.it <- function(year){
year <- as.numeric(year)

#How big youd want the bubble graph to be
n<-1000
random<-1:n
ims <- filter(immigrant,Year == year)
ims<- gather(ims,"Reason","Amount", 1:7) %>%
  filter(Reason == "Ratio")
ratio<- as.numeric(ims$Amount)*n
sample <- sample(random,ratio)

#use bubbles!
bubble.frame <- data.frame(random,0)
colnames(bubble.frame) <- c("Set", "Hit")

bubble.frame$Hit <- "green"
bubble.frame$Hit[sample] <- "blue"

bubbles(value = sample(10), label=" ", key = , tooltip = "One out of A Thousand", color = bubble.frame$Hit,
        textColor = "#333333", width = NULL, height = NULL)

}


NMF_method1<-function(tg_list,data_ng,data_normalized,max_ES_cut=0.3)
{
	tg_selected_R4_RR<-tg_list
	data.matrix0_s<-data_ng
	data_23_s<-data_normalized
	Rbase_selected_R4_RR<-Compute_Rbase_SVD(data.matrix0,tg_selected_R4_RR)
	stat_selected_R4_RR<-compute_IM_stat(tg_list_c=tg_selected_R4_RR)
	stat_selected_R4_RR_max<-apply(stat_selected_R4_RR,1,max)
	tg_I_id<-which(stat_selected_R4_RR_max==max(stat_selected_R4_RR_max))[1]
	tg_selected_id<-tg_I_id
	X_I<-data.matrix0[tg_selected_R4_RR[[tg_I_id]],]
	N<-0
	NMF_list_c<-list()
	N<-N+1
	NMF_list_c[[N]]<-tg_selected_R4_RR[[tg_I_id]]
	names(NMF_list_c)<-"T"
	NMF_self_c1<-Building_NMF_input_no_cancer(tg_data=X_I,tg_list=NMF_list_c,tg_list_add=list())
	V_I<-t(as.matrix(Rbase_selected_R4_RR[tg_I_id,]))
	V_I_n<-normalize_data2(V_I)
	V_c<-V_I_n
	ccc<-compute_CompRowspace_NN(data_23_s,module_RB=V_c,ROUNDS=min(nrow(V_I),3))
	ES_I<-RMSE_row(ccc)/RMSE_row(data_23_s)
	ES_base_c<-Compute_base_ES_score(ES_I,tg_selected_R4_RR)
	ES_max<-max(ES_base_c)
	while(ES_max>max_ES_cut)
	{
		N<-N+1
		tg_id<-which(abs(ES_base_c-max(ES_base_c))<0.01)
		tg_id<-setdiff(tg_id,tg_selected_id)
		tg_id_add<-tg_id[which(stat_selected_R4_RR_max[tg_id]==max(stat_selected_R4_RR_max[tg_id]))[1]]
		tg_selected_id<-c(tg_selected_id,tg_id_add)
		NMF_list_c[[N]]<-tg_selected_R4_RR[[tg_id_add]]
		names(NMF_list_c)<-names(tg_selected_R4_RR)[tg_selected_id]
		NMF_self_c1<-Building_NMF_input_no_cancer(tg_data=data.matrix0_s,tg_list=NMF_list_c,tg_list_add=list())
		qnmf_result_c <- run_NMF(NMF_self_c1,RR0=0.8, maxIter=2000)
		X1 = qnmf_result_c[["X1"]]
		U = qnmf_result_c[["U"]]
		V = qnmf_result_c[["V"]]
		ttt1 = qnmf_result_c[["ttt1"]]
		########check correlation between: V and true Proportion
		ictd.ccc= t(cor(t(tProp),V) )
		o6_predict_ture = apply(ictd.ccc, 1, max)
		o6_predict_ture2 = apply(ictd.ccc, 2, max)
		print(N)
		print(o6_predict_ture2)
		print(apply(cor(t(tProp),t(Rbase_selected_R4_RR[tg_selected_id,])),1,max))
		V_c<-normalize_data2(t(V))
		ccc<-compute_CompRowspace_NN(data_23_s,module_RB=V_c,ROUNDS=min(nrow(V_I),3))
		ES_I<-RMSE_row(ccc)/RMSE_row(data_23_s)
		ES_base_c<-Compute_base_ES_score(ES_I,tg_selected_R4_RR)
		ES_max<-max(ES_base_c)
	}
	return(qnmf_result_c)
}

Compute_base_ES_score<-function(ES_c,tg_selected_c)
{
	ccc<-c()
	for(i in 1:length(tg_selected_c))
	{
		ccc<-c(ccc,mean(ES_c[tg_selected_c[[i]]]))
	}
	names(ccc)<-names(tg_selected_c)
	return(ccc)
}

compute_CompRowspace_NN_selflist<-function(tg_data,tg_data_ng,tg_list,ROUNDS=3)
{
	Rbase_selected_R4_og<-Compute_Rbase_SVD(tg_data_ng,tg_list)
	Rbase_selected_R4<-Compute_Rbase_SVD(tg_data,tg_list)
	aaa<-matrix(0,length(tg_list),ROUNDS)
	bbb<-matrix(0,length(tg_list),ROUNDS)
	ddd<-matrix(0,length(tg_list),ROUNDS)
      for(j in 1:length(tg_list))
      {
		tg_data_c<-tg_data[tg_list[[j]],]
        	Base_c<-Rbase_selected_R4[-j,]
		#print(tg_data_c[,1:5])
		#print(j)
		#print(Base_c[,1:5])
		#print(j)
		tg_id_kk<-setdiff(1:length(tg_list),j)
		ccc<-c()
		ccc<-compute_CompRowspace_NN_uni(tg_data_c,module_RB=Base_c,ROUNDS=3)
		#print(ccc)
		if(length(ccc)>0)
		{
			tg_id1<-tg_id_kk[ccc[1,]]
			aaa[j,1:length(tg_id1)]<-tg_id1
			bbb[j,1:length(tg_id1)]<-ccc[2,]
			ddd[j,1:length(tg_id1)]<-ccc[3,]
		}
  	}
	tg_ids<-which(apply(bbb,1,min)<0.2)
	c_cell_depend<-list()
	N<-0
	nn<-c()
	for(j in 1:length(tg_ids))
	{
		tg_c<-aaa[tg_ids[j],which(ddd[tg_ids[j],]>0.1)]
		if(length(tg_c)>0)
		{
			data_ccc<-t(Rbase_selected_R4_og[c(tg_ids[j],tg_c),])
			colnames(data_ccc)<-c("Y",tg_c)
			rownames(data_ccc)<-1:nrow(data_ccc)
			data_ccc<-as.data.frame(data_ccc)
			lm_cc<-lm(Y~.+0,data=data_ccc)
			ccc<-summary(lm_cc)$coefficients
			cc1<-which((ccc[,4]<0.01)&ccc[,1]>0)
			cc2<-which((ccc[,4]<0.01)&ccc[,1]<0)
			dd1<-c()
			dd2<-c()
			if(length(cc1)>0)
			{
				dd1<-tg_c[cc1]
			}
			if(length(cc2)>0)
			{
				dd2<-tg_c[cc2]
			}
			dd3<-setdiff(tg_c,c(dd1,dd2))
			c_l<-c(tg_ids[j],dd2)
			c_r<-c(dd1)
			cc<-list(c_l,c_r)
			names(cc)<-c("right","left")
			N<-N+1
			c_cell_depend[[N]]<-cc
			nn<-c(nn,tg_ids[j])
		}
	}
	names(c_cell_depend)<-nn
	baba<-c()
	didi<-c()
	for(i in 1:length(c_cell_depend))
	{
		cc<-c_cell_depend[[i]]
		if((length(cc[[1]])==1)&(length(cc[[2]])>1))
		{
			baba<-c(baba,cc[[1]])
			didi<-c(didi,cc[[2]])
		}
	}
	baba<-unique(sort(baba))
	didi<-setdiff(unique(sort(didi)),baba)
	daye<-setdiff(1:length(tg_list),unique(sort(c(didi,baba))))
	ccc<-list(didi,baba,daye,c_cell_depend)
	names(ccc)<-c("Leaf_CT","Root_CT","Other_leat_CT","Cell_dependency")
      return(ccc)
}

compute_CompRowspace_NN<-function(data_cc=tg_data,module_RB=module_selected[[4]],ROUNDS=3)
{
        data_CORS_cancer<-data_cc
        for(ii in 1:ROUNDS)
        {
        ccc<-cor(t(data_CORS_cancer),t(module_RB))
        if(nrow(module_RB)>1)
        {
                ddd<-apply(ccc,1,order)
                eee<-ddd[nrow(ddd),]
                eee<-eee*(apply(ccc,1,max)>0)
                tg_ids<-sort(setdiff(unique(eee),0))
                if(length(tg_ids)>0)
                {
                        for(i in 1:length(tg_ids))
                        {
                                ttt_ccc<-module_RB[tg_ids[i],]%*%t(module_RB[tg_ids[i],])/sum((module_RB[tg_ids[i],])^2)
                                data_CORS_cancer[names(which(eee==tg_ids[i])),]<-data_CORS_cancer[names(which(eee==tg_ids[i])),]-data_CORS_cancer[names(which(eee==tg_ids[i])),]%*%ttt_ccc
                        }
                }
        }
        else
        {
                ddd<-apply(ccc,1,order)
                eee<-ddd
                eee<-eee*(as.vector(ccc)>0)
                tg_ids<-sort(setdiff(unique(eee),0))
                if(length(tg_ids)>0)
                {
                        for(i in 1:length(tg_ids))
                        {
                                ttt_ccc<-module_RB[tg_ids[i],]%*%t(module_RB[tg_ids[i],])/sum((module_RB[tg_ids[i],])^2)
                                data_CORS_cancer[names(which(eee==tg_ids[i])),]<-data_CORS_cancer[names(which(eee==tg_ids[i])),]-data_CORS_cancer[names(which(eee==tg_ids[i])),]%*%ttt_ccc
                        }
                }
        }
        }
        return(data_CORS_cancer)
}

compute_IM_stat<-function(tg_list_c,immune_cell_uni_table=immune_cell_uni_table0_GS,IM_id_list0=ICTD::IM_id_list)
{
	ccc<-c()
	nn<-c()
	for(i in 1:length(tg_list_c))
	{
        ccc0<-c()
        for(j in 1:length(ICTD::IM_id_list))
        {
      if(length(ICTD::IM_id_list[[j]])>1)
      {
            cc0<-apply(immune_cell_uni_table[tg_list_c[[i]],IM_id_list0[[j]]],1,sum)/sum((1/(1:length(IM_id_list0[[j]]))))
      }
      else
      {
           cc0<-immune_cell_uni_table[tg_list_c[[i]],IM_id_list0[[j]]]
      }
                ccc0<-cbind(ccc0,cc0)
        }
        colnames(ccc0)<-names(ICTD::IM_id_list)
      ddd<-apply(ccc0,2,mean)
      ccc<-rbind(ccc,ddd)
      nn<-c(nn,colnames(ccc0)[which(ddd==max(ddd))[1]])
	}
	rownames(ccc)<-nn
	return(ccc)
}

#######################
run_NMF<-function(NMF_input1=NMF_input1,RR0=0.8, maxIter=20000, tProp){

###########Preprocess the data
P_fix=NMF_input1$S_indi
NMF_indi_all = NMF_input1$NMF_indi_all

data_t=NMF_input1$NMF_data
addP=NMF_input1$NMF_P_pre
NMF_indi_all0<-NMF_indi_all[which(apply(NMF_indi_all,1,sum)<=2),]
NMF_indi_all01<-NMF_indi_all0[,which(apply(NMF_indi_all0,2,sum)>0 | P_fix==0)] #?????0#######if 5 is okay, originally it was 10
NMF_indi_all01<-NMF_indi_all01[which(apply(NMF_indi_all01,1,sum)>0),]
NMF_indi_all=NMF_indi_all01[rownames(NMF_indi_all01)%in%rownames(data_t),]
X1=data_t[match(rownames(NMF_indi_all),rownames(data_t)),]###take only those rows that correspond to rows in NMF_indi_all
K=ncol(NMF_indi_all)
indiS=1-NMF_indi_all
indiS[,which(P_fix==0)]=0*indiS[,which(P_fix==0)]
###########

###########Parameter settings
RR=RR0##penalty parameter for constraints on NMF_indi_all
indiS_method="nonprdescent" ##the updating scheme for the structural constraints
iter=maxIter
alpha=beta=gamma=roh=0
#gamma=0.1
#roh=0.1 ##roh has to be equal to 0 in order to implement addP
UM=VM=NULL
qq=1
epslog=8
nPerm=2
initial_U=initial_V=NULL
mscale=0###########1
cnormalize=1
###########

###########Run the constrained qNMF
ttt1=qnmf_indisS_all_revise_addP_RR(X1,initial_U,initial_V,NMF_indi_all,indiS_method,UM,VM,alpha,beta,gamma,roh,RR,qq,iter,epslog,mscale,cnormalize,addP, P_fix, tProp)
#ttt1=qnmf_indisS_all_revise_addP_old(X1,initial_U,initial_V,NMF_indi_all,indiS_method,UM,VM,alpha,beta,gamma,roh,theta,qq,iter,epslog,mscale,cnormalize,addP, P_fix)
###########
X1=ttt1$X1
U=ttt1$U
V=ttt1$V
extraOut=ttt1$extraOut
#sum((X1-(ttt1$U)%*%t(ttt1$V))^2)
#diag(cor(ttt1$U,NMF_indi_all, method="spearman"))
###########Run cross validation of the constrained qNMF
#devs1=cv_qnmf(X1,indiS_method,NMF_indi_all,alpha,beta,gamma,roh,theta,qq,iter,epslog,nPerm,mscale,cnormalize)
#############################################

return(list(X1=X1, U=U, V=V, extraOut=extraOut, ttt1=ttt1))

}

identify_max_base<-function(tg_R1_c,data.matrix,tProp)
{
	cc<-Compute_Rbase_SVD(data.matrix,tg_R1_c)
	tg_R1_c_list<-list()
	dd<-cor(t(cc),t(tProp))
	for(i in 1:ncol(dd))
	{
		tg_id<-which(dd[,i]==max(dd[,i]))[1]
		tg_R1_c_list[[i]]<-tg_R1_c[[tg_id]]
	}
	names(tg_R1_c_list)<-colnames(dd)
	return(tg_R1_c_list)
}

identify_max_base2<-function(tg_R1_c,data.matrix,tProp)
{
	cc<-Compute_Rbase_SVD(data.matrix,tg_R1_c)
	tg_R1_c_list<-list()
	dd<-cor(t(cc),t(tProp))
	ff<-c()
	for(i in 1:ncol(dd))
	{
		tg_id<-which(dd[,i]==max(dd[,i]))[1]
		tg_R1_c_list[[i]]<-tg_R1_c[[tg_id]]
		ff<-c(ff,tg_id)
	}
	print(ff)
	names(tg_R1_c_list)<-colnames(dd)
	return(tg_R1_c_list)
}

select_R_base<-function(tg_R1_c,tg_id)
{
	tg_R1_cc<-list()
	for(i in 1:length(tg_id))
	{
		tg_R1_cc[[i]]<-tg_R1_c[[tg_id[i]]]
	}
	names(tg_R1_cc)<-names(tg_R1_c)[tg_id]
	return(tg_R1_cc)
}


## Run colocalisation analysis of genetic signals for DNA methylation and ASD following method in Giambartolomei et al.
## Tests ASD against all DNA methylation sites found within 250 kb of a ASD GWAS loci as identified by the PGC-iPSYCH meta-analysis.

removeAlleles<-function(text){
	tmp<-unlist(strsplit(unlist(strsplit(gsub("X", "", text), "\\.")), "_"))
	if(length(tmp) == 3){
		return(tmp)
	} else {
		return(c(tmp[1:2], paste(tmp[3:length(tmp)], collapse = "_")))
	}
}

library(coloc)
library(data.table)
library(IlluminaHumanMethylation450kanno.ilmn12.hg19)
data(IlluminaHumanMethylation450kanno.ilmn12.hg19)

setwd("")

probeAnnot<-as.data.frame(IlluminaHumanMethylation450kanno.ilmn12.hg19@data$Locations)

gwas<-fread("") ## Load ASD GWAS results
output<-NULL

regions<-read.table("Analysis/AdditionalAutismRegions.txt", header = TRUE, row.names = 1)
regions<-regions[1:3,] ## only first 3 are genome-wide significant

for(i in 1:3){

	chr<-regions$CHR[i]
	start<-regions$BP[i]-250000
	stop<-regions$BP[i]+250000
	expression_file_name<-paste("MatrixEQTL/Methylation_ProbesForASDColocAnalysis_Chr", chr, "_", start, "_", stop, ".txt", sep = "")
	SNP_file_name = paste("MatrixEQTL/Genotypes_MinGenoCount5_Chr", chr, ".txt", sep = "")
	snps_location_file_name = paste("MatrixEQTL/Genotypes_MapInfo_Chr", chr, ".txt", sep = "")

  ## load mQTL results
	mQTL<-read.table(paste("MatrixEQTL/Output/AllmQTLsforASDColocAnalysis_mQTL_chr", chr,"_", start, "_", stop, ".txt", sep = ""), stringsAsFactors = FALSE, header = TRUE)
	mQTL<-cbind(unlist(lapply(strsplit(mQTL$SNP, "_"), head, n = 1)), mQTL)

  ## load variants frequencies
	freq<-read.table("01_Genotypes/FilteredGenotypes/GT_hwe_mind_geno_maf_freq.frq", header = TRUE, stringsAsFactors = FALSE)
	gwas.sub<-gwas[which(gwas$CHR == chr),]

	mQTL<-cbind(mQTL, paste(freq$SNP, apply(apply(freq[,c("A1", "A2")], 1, sort), 2, paste, collapse = "_"), sep = "_")[match(mQTL[,7], freq$SNP)])
	colnames(mQTL)[ncol(mQTL)]<-"SNP2"
	mQTL$SNP2<-as.character(mQTL$SNP2)

	dataset2<-list(beta= log(gwas.sub$OR), varbeta= (gwas.sub$SE^2), type = "cc", snp = gwas.sub$SNP, MAF = (gwas.sub$FRQ_A_18381*18381+gwas.sub$FRQ_U_27969*27969)/(18381+27969), N=46350, s = 0.397)

	for(each in unique(mQTL$gene)){
		mQTL.sub<-mQTL[which(mQTL$gene == each),]
		if(nrow(mQTL.sub) > 1){
			dataset1<-list(beta=mQTL.sub$beta,varbeta=(mQTL.sub$beta/mQTL.sub$t.stat)^2,type = "quant",snp = mQTL.sub[,1], MAF = freq$MAF[match(mQTL.sub[,1], freq$SNP)], N=1157)
			my.res<-coloc.abf(dataset1, dataset2)
			output<-rbind(output, c("trait2"=each, my.res$summary, i))
			}
		}
	}
}

sum<-as.numeric(output[,6])+as.numeric(output[,7])
ratio<-as.numeric(output[,7])/as.numeric(output[,6])
output<-cbind(output, sum, ratio)

## Annotate results
probeAnnot<-as.data.frame(IlluminaHumanMethylation450kanno.ilmn12.hg19@data$Locations)
probeAnnot<-probeAnnot[match(output[,1], rownames(probeAnnot)),c("chr", "pos")]
output<-cbind(output, probeAnnot)
probeAnnot<-as.data.frame(IlluminaHumanMethylation450kanno.ilmn12.hg19@data$Other)
probeAnnot<-probeAnnot[match(output[,1], rownames(probeAnnot)),5:14]
output<-cbind(output, probeAnnot)

write.csv(output, "Coloc/ColocAnalysis_ASD_GenomeWideSigRegionsOnly.csv")


library(tidyverse)

train <-
  read_csv("./0_raw/train.csv")

test <-
  read_csv("./0_raw/test.csv")

features <-
  readRDS('./2_model/final_features.rds')

fill_numeric_na <- function(x){

}

# new_train <-
#   train[c(features$features, 'NU_NOTA_MT')] %>%
#   mutate_at(vars(c('NU_NOTA_CH', 'NU_NOTA_CN', 'NU_NOTA_LC', 'NU_NOTA_REDACAO', 'NU_NOTA_MT')), function(x){as.integer(ifelse(is.na(x), 0, x))}) %>%
#   mutate_at(vars(c('TP_PRESENCA_CH', 'TP_PRESENCA_CN', 'TP_PRESENCA_LC', 'TP_STATUS_REDACAO')), function(x){as.factor(ifelse(is.na(x), -1, x))})
#
# new_test <-
#   test[c(features$features, 'NU_INSCRICAO')] %>%
#   mutate_at(vars(c('NU_NOTA_CH', 'NU_NOTA_CN', 'NU_NOTA_LC', 'NU_NOTA_REDACAO')),
#             function(x){as.integer(ifelse(is.na(x), 0, x))}) %>%
#   mutate_at(vars(c('TP_PRESENCA_CH', 'TP_PRESENCA_CN', 'TP_PRESENCA_LC', 'TP_STATUS_REDACAO')), function(x){as.factor(ifelse(is.na(x), -1, x))}) #%>%
#   #mutate(NU_NOTA_MT = NA)

new_train <-
  train[c('NU_NOTA_CH', 'NU_NOTA_CN', 'NU_NOTA_LC', 'NU_NOTA_REDACAO', 'NU_NOTA_MT')] %>%
  mutate_at(vars(c('NU_NOTA_CH', 'NU_NOTA_CN', 'NU_NOTA_LC', 'NU_NOTA_REDACAO', 'NU_NOTA_MT')),
                         function(x){as.integer(ifelse(is.na(x), -1, x))})

new_test <-
  test[c('NU_NOTA_CH', 'NU_NOTA_CN', 'NU_NOTA_LC', 'NU_NOTA_REDACAO', 'NU_INSCRICAO')] %>%
  mutate_at(vars(c('NU_NOTA_CH', 'NU_NOTA_CN', 'NU_NOTA_LC', 'NU_NOTA_REDACAO')),
            function(x){as.integer(ifelse(is.na(x), -1, x))})

recipe <-
  recipe(NU_NOTA_MT ~ ., data = new_train) %>%
  step_normalize(all_numeric(), -all_outcomes()) %>%
  #remove_role(NU_INSCRICAO, old_role = "predictor") %>%
  #update_role(NU_INSCRICAO, new_role = "id variable") %>%
  prep(.)

train_baked <-
  recipe %>%
  bake(new_data = new_train)

#summary(recipe)

modl_ml <-
  rand_forest(mode = "regression", trees = 100) %>%
  set_engine("ranger", importance = "impurity")

fit_ml <-
  modl_ml %>%
  fit(NU_NOTA_MT ~ ., data = train_baked)

test_baked <-
  recipe %>%
  bake(new_data = new_test) %>%
  bind_cols(., new_test %>% select(NU_INSCRICAO))

test_final <- test_baked

test_final$NU_NOTA_MT <- predict(fit_ml, new_test)$.pred
test_final <- test_final %>% select(NU_INSCRICAO, NU_NOTA_MT)
write_csv(test_final, './2_model/prediction_celso.csv')


#script rasterizes land protection shapefiles

rm(list=ls())

library(raster)
library(sf)

#unzip(zipfile="Data/sim10_BRmunis_latlon_5kmzip",exdir="Data")  #unzip if needed
munis.r <- raster("Data/sim10_BRmunis_latlon_5km.asc") #for rasterization

#LandProtect is for all services
LandProtect<- st_read("Data/landProtection/protected_areas_clip.shp")
Lp2001<- LandProtect["FID_ucsmi"]
Lpr<-rasterize(Lp2001, munis.r, field='FID_ucsmi')

#Indigenous is for all services
Indigenous <- st_read("Data/landProtection/indigenous.shp")
Indigenous <- Indigenous["GID0"]
Indig <-rasterize(Indigenous, munis.r, field='GID0')

#Amazon is for Soy and Pasture
Amazon <- st_read("Data/landProtection/Amazon_area.shp")
Amazon <- Amazon['NOME']
Amzn <- rasterize(Amazon, munis.r, field='NOME')

#Land Protection
#set all values to 1 (not protected) or 0 (protected)
LP_bin <- Lpr
LP_bin[!is.na(Lpr)] <- 0
LP_bin[is.na(Lpr)] <- 1

#add indig at
LP_bin[Indig == 1] <- 0.1

#LandProtect currently is the only restriction on OAgri and Maize
#output data
writeRaster(LP_bin, "Data/All_ProtectionMap.asc", format = 'ascii', overwrite=T)

#lc 2006 needed for Soy Moratorium
lc2006 <- raster("Data/ObservedLCmaps/LandCover2006_PastureB_Disagg.asc")

#where 2006 nature AND Amazon Biome, Soy should be prevented
Soy_bin <- Amzn
Soy_bin[lc2006 != 1] <- NA
Soy_bin[!is.na(Soy_bin)] <- 0  #protected
Soy_bin[is.na(Soy_bin)] <- 1   #not protected

#then combine with 'standard' land protection
Soy_bin[LP_bin == 0] <- 0      #protected
Soy_bin[LP_bin == 0.1] <- 0.1  #indigenous

#output data
writeRaster(Soy_bin, "Data/Soy_ProtectionMap_2006.asc", format = 'ascii', overwrite=T)

#lc 2008 needed for Beef Moratorium
lc2009 <- raster("Data/ObservedLCmaps/LandCover2009_PastureB_Disagg.asc")

#where 2008 nature AND Amazon Biome, Pature should be prevented
Pas_bin <- Amzn
Pas_bin[lc2009 != 1] <- NA
Pas_bin[!is.na(Pas_bin)] <- 0  #protected
Pas_bin[is.na(Pas_bin)] <- 1   #not protected

#then combine with 'standard' land protection
Pas_bin[LP_bin == 0] <- 0      #protected
Pas_bin[LP_bin == 0.1] <- 0.1  #indigenous

#output data
writeRaster(Pas_bin, "Data/Pasture_ProtectionMap_2009.asc", format = 'ascii', overwrite=T)


library(ape)
upham <- read.nexus("data/upham_tree.nex")
D <- cophenetic(upham)

df <- data.frame(D["Homo_sapiens",])
colnames(df) <- c("phylodist")
write.csv(df, "artifacts/phylo_distance_to_human.csv")


# Exploratory plots for TSM

require(mgcv)
require(data.table)
require(ggplot2)
require(lattice)

dat <- fread('temp/warmingtolerance_byspecies.csv')

#############################
##### Thab only plots ###
#############################
# plot un-adjusted thab vs. adjustments for elevation (all from climatology)
	cex = 0.5
	quartz(width=10,height=4)
	# pdf(width=10, height=4, file='figures/thab.adj_vs_thab.pdf')
	par(mfrow=c(1,3), las=1, mai=c(0.5, 0.5, 0.3, 0.05), mgp=c(2,1,0))

	dat[Realm=='Terrestrial',plot(thabsum, thabsum.adj-thabsum, xlim=c(-10,45), ylim=c(-16,16), col='green', main='thabsum elevation adjustment', cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial',plot(thabmaxmo, thabmaxmo.adj-thabmaxmo, xlim=c(-10,45), ylim=c(-16,16), col='green', main='thabmaxmo elevation adjustment', cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial',plot(thabmaxhr, thabmaxhr.adj-thabmaxhr, xlim=c(-10,45), ylim=c(-16,16), col='green', main='thabmaxhr elevation adjustment', cex=cex)]
	abline(h=0)

	dev.off()

# plot NM vs. Thab_maxhr (climatology, elevation-corrected). Terrestrial only.
	cex = 0.5
	quartz(width=10,height=4)
	# pdf(width=10, height=4, file='figures/NM_vs_thabmaxhr.adj.pdf')
	par(mfrow=c(1,4), las=1, mai=c(0.5, 0.5, 0.3, 0.05), mgp=c(2,1,0), omi=c(0,0,0.25,0))

	dat[Realm=='Terrestrial',plot(thabmaxhr.adj, NM_1cm_airshade, main='1 cm shade', cex=cex)]
	abline(0,1)

	dat[Realm=='Terrestrial',plot(thabmaxhr.adj, NM_2m_airshade, main='2 m shade', cex=cex)]
	abline(0,1)

	dat[Realm=='Terrestrial',plot(thabmaxhr.adj, NM_exposed_bodytemp, main='Exposed body', cex=cex)]
	abline(0,1)

	dat[Realm=='Terrestrial',plot(thabmaxhr.adj, NM_exposed_air, main='Exposed air', cex=cex)]
	abline(0,1)

	mtext('NicheMapper vs. air temperatures', side=3, outer=TRUE)

	dev.off()

# plot NM and Thab vs. latitude (no elevation correction)
	# ylims <- dat[,range(thabsum, thabmaxmo, thabmaxhr, NM_exposed_air, NM_exposed_bodytemp, na.rm=TRUE)]
	ylims <- dat[,range(thabsum, thabmaxmo, NM_1cm_airshade, NM_2m_airshade, NM_exposed_air, NM_exposed_bodytemp, na.rm=TRUE)]
	xlims <- c(-80, 80)
	cex=0.5
	setkey(dat, lat)

	quartz(width=8, height=4)
	# pdf(width=8, height=4, file='figures/thab_vs_lat.pdf')
	par(mfrow=c(1,2))

	dat[Realm=='Terrestrial', plot(lat, thabsum, ylim=ylims, xlim=xlims, cex=cex, main='Terrestrial', xlab='Latitude', ylab='Temperature °C')]
		dat[Realm=='Terrestrial' & !is.na(lat) & !is.na(thabsum),lines(lat, predict(loess(thabsum~lat)))]
	dat[Realm=='Terrestrial', points(lat, thabmaxmo, col='pink', cex=cex)]
		dat[Realm=='Terrestrial' & !is.na(lat) & !is.na(thabmaxmo),lines(lat, predict(loess(thabmaxmo~lat)), col='pink')]
	dat[Realm=='Terrestrial', points(lat, NM_2m_airshade, col='red', cex=cex)]
		dat[Realm=='Terrestrial' & !is.na(lat) & !is.na(NM_1cm_airshade),lines(lat, predict(loess(NM_1cm_airshade~lat)), col='red')]
	dat[Realm=='Terrestrial', points(lat, NM_exposed_air, col='purple', cex=cex)]
		dat[Realm=='Terrestrial' & !is.na(lat) & !is.na(NM_exposed_air),lines(lat, predict(loess(NM_exposed_air~lat)), col='purple')]
	dat[Realm=='Terrestrial', points(lat, NM_exposed_bodytemp, col='darkslateblue', cex=cex)]
		dat[Realm=='Terrestrial' & !is.na(lat) & !is.na(NM_exposed_bodytemp),lines(lat, predict(loess(NM_exposed_bodytemp~lat)), col='darkslateblue')]

	dat[Realm=='Marine', plot(lat, thabsum, ylim=ylims, xlim=xlims, cex=cex, main='Marine', xlab='Latitude', ylab='Temperature °C')]
		dat[Realm=='Marine' & !is.na(lat) & !is.na(thabsum),lines(lat, predict(loess(thabsum~lat)))]
	dat[Realm=='Marine', points(lat, thabmaxmo, col='pink', cex=cex)]
		dat[Realm=='Marine' & !is.na(lat) & !is.na(thabmaxmo),lines(lat, predict(loess(thabmaxmo~lat)), col='pink')]
	dat[Realm=='Marine', points(lat, thabmaxhr, col='red', cex=cex)]
		dat[Realm=='Marine' & !is.na(lat) & !is.na(thabmaxhr),lines(lat, predict(loess(thabmaxhr~lat)), col='red')]

	legend('topleft', col=c('black', 'pink', 'red', 'purple', 'darkslateblue'), legend=c('Summer', 'Warmest month', 'Daily max (land: 2m shade)', 'Air - exposed', 'Body - exposed'), pch=1, cex=0.6)

	dev.off()

#############################
##### Tmax plots ###
#############################
# Examine Thab values used for Tmax adjustments: plot tmax_acc with thabsum, thabmaxmo, thabmaxhr (like Fig. S6C in Sunday et al. 2014 PNAS)
	setkey(dat, thabmaxhr.adj)
	cex1 <- 0.6
	cex2 <- 0.4

	quartz(width=8, height=4)
	# pdf(width=8, height=4, file='figures/acclimation_corrections.pdf')
	par(mfrow=c(1,2))
	dat[Realm=='Terrestrial',plot(1:.N, tmax_acc, col='grey', cex=cex1, main='Terrestrial', ylab='°C', xlab='Rank order', ylim=c(-10,45))]
	dat[Realm=='Terrestrial',points(1:.N, thabmaxhr.adj, col='black', cex=cex1)]
	dat[Realm=='Terrestrial',points(1:.N, thabmaxmo.adj, col='red', cex=cex1)]
	dat[Realm=='Terrestrial',points(1:.N, thabsum.adj, col='pink', cex=cex2)]

	dat[Realm=='Marine',plot(1:.N, tmax_acc, col='grey', cex=cex1, main='Marine', ylab='°C', xlab='Rank order', ylim=c(-10,45))]
	dat[Realm=='Marine',points(1:.N, thabmaxhr.adj, col='black', cex=cex1)]
	dat[Realm=='Marine',points(1:.N, thabmaxmo.adj, col='red', cex=cex1)]
	dat[Realm=='Marine',points(1:.N, thabsum.adj, col='pink', cex=cex2)]

	legend('topleft', legend=c('tmax_acc', 'thabmaxhr.adj', 'thabmaxmo.adj', 'thabsum.adj'), col=c('grey', 'black', 'red', 'pink'), pch=1, cex=0.5)

	dev.off()

# plot adjustments for acclimation and elevation and duration vs un-adjusted tmax
# acclimation: accounts for difference between experimental acclimation temperature and max monthly habitat temperature
# duration: accounts for difference between 30 or 90 days and acclimation duration time
	cex=0.7

	quartz(width=5,height=6.5)
	# pdf(width=5, height=6.5, file='figures/tmax.adjDelta_vs_tmax.pdf')
	par(mfrow=c(3,2), las=1, mai=c(0.5, 0.5, 0.3, 0.05), mgp=c(2,1,0))

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tmax, tmax.accsum-tmax, xlim=c(3,60), ylim=c(-6,6), col='green', main='acclimation to thabsum', cex=cex, cex.main=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tmax, tmax.accsum-tmax, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tmax, tmax.accsum-tmax, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tmax, tmax.accsum-tmax, col='blue', pch=2, cex=cex)]

	legend('topright', legend=c('Terrestrial', 'Marine', 'crit', 'leth'), col=c('green', 'blue', 'black', 'black'), pch=c(1,1,1,2), cex=cex)
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tmax, tmax.accmo-tmax, xlim=c(3,60), ylim=c(-6,6), col='green', main='acclimation to thab_maxmo', cex=cex, cex.main=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tmax, tmax.accmo-tmax, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tmax, tmax.accmo-tmax, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tmax, tmax.accmo-tmax, col='blue', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tmax, tmax.accsum.elev-tmax, xlim=c(3,60), ylim=c(-6,6), col='green', main='acclimation to thabsum\nand elevation adjustment', cex=cex, cex.main=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tmax, tmax.accsum.elev-tmax, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tmax, tmax.accsum.elev-tmax, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tmax, tmax.accsum.elev-tmax, col='blue', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tmax, tmax.accmo.elev-tmax, xlim=c(3,60), ylim=c(-6,6), col='green', main='acclimation to thab_maxmo\nand elevation adjustment', cex=cex, cex.main=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tmax, tmax.accmo.elev-tmax, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tmax, tmax.accmo.elev-tmax, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tmax, tmax.accmo.elev-tmax, col='blue', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tmax, tmax.accsum.elev.dur-tmax, xlim=c(3,60), ylim=c(-6,6), col='green', main='acclimation to thabsum & time\nand elevation adjustment', cex=cex, cex.main=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tmax, tmax.accsum.elev.dur-tmax, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tmax, tmax.accsum.elev.dur-tmax, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tmax, tmax.accsum.elev.dur-tmax, col='blue', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tmax, tmax.accmo.elev.dur-tmax, xlim=c(3,60), ylim=c(-6,6), col='green', main='acclimation to thab_maxmo & time\nand elevation adjustment', cex=cex, cex.main=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tmax, tmax.accmo.elev.dur-tmax, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tmax, tmax.accmo.elev.dur-tmax, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tmax, tmax.accmo.elev.dur-tmax, col='blue', pch=2, cex=cex)]
	abline(h=0)

	dev.off()

# Examine acclimation, elevation, and duration adjustments by plotting adjusted vs. unadjusted Tmax:

	quartz(width=5, height=6.5)
	# pdf(width=5, height=6.5, file='figures/tmax.adj_vs_tmax.pdf')
	par(mfrow=c(3,2), las=1, mai=c(0.5, 0.5, 0.3, 0.05), mgp=c(2,1,0), omi=c(0,0,0.3,0))

		# plot tmax.acc vs. tmax
	dat[, plot(tmax, tmax.accmo, type='n', main='Acclimation to max month')] # set up axes
	dat[Realm=='Terrestrial', points(tmax, tmax.accmo, col='green')]
	dat[Realm=='Marine', points(tmax, tmax.accmo, col='blue')]
	abline(0,1)

	dat[, plot(tmax, tmax.accsum, type='n', main='Acclimation to summer')]
	dat[Realm=='Terrestrial', points(tmax, tmax.accsum, col='green')]
	dat[Realm=='Marine', points(tmax, tmax.accsum, col='blue')]
	abline(0,1)

		# plot tmax.acc.elev vs. tmax.acc
	dat[, plot(tmax.accmo, tmax.accmo.elev, type='n', main='Adjust for elevation')]
	dat[Realm=='Terrestrial', points(tmax.accmo, tmax.accmo.elev, col='green')]
	dat[Realm=='Marine', points(tmax.accmo, tmax.accmo.elev, col='blue')]
	abline(0,1)

	dat[, plot(tmax.accsum, tmax.accsum.elev, type='n', main='Adjust for elevation')]
	dat[Realm=='Terrestrial', points(tmax.accsum, tmax.accsum.elev, col='green')]
	dat[Realm=='Marine', points(tmax.accsum, tmax.accsum.elev, col='blue')]
	abline(0,1)

		# plot tmax.acc.elev.dur vs. tmax.acc.elev
	dat[, plot(tmax.accmo.elev, tmax.accmo.elev.dur, type='n', main='Adjust for duration')]
	dat[Realm=='Terrestrial', points(tmax.accmo.elev, tmax.accmo.elev.dur, col='green')]
	dat[Realm=='Marine', points(tmax.accmo.elev, tmax.accmo.elev.dur, col='blue')]
	abline(0,1)

	dat[, plot(tmax.accsum.elev, tmax.accsum.elev.dur, type='n', main='Adjust for duration')]
	dat[Realm=='Terrestrial', points(tmax.accsum.elev, tmax.accsum.elev.dur, col='green')]
	dat[Realm=='Marine', points(tmax.accsum.elev, tmax.accsum.elev.dur, col='blue')]
	abline(0,1)

	mtext('Tmax adjustments', side=3, outer=TRUE, line=0.5)

	dev.off()

# plot tmax.adj with NM_2m_airshade (land) & thab_maxhr (ocean) against latitude
	setkey(dat, lat)
	ylims <- dat[,c(0,max(c(thabmaxhr.adj, thabmaxhr, tmax, tmax.accsum.elev, predict(loess(NM_exposed_bodytemp~lat, na.action=na.exclude))), na.rm=TRUE))]
	xlims <- c(-80, 80)

	quartz(width=8, height=4)
	# pdf(width=8, height=4, file='figures/tmax_and_thabmaxhr_vs_lat.pdf')
	par(mfrow=c(1,2), mai=c(0.7,0.7,0.5,0.2), mgp=c(2,0.7,0), cex.axis=0.8)
	dat[Realm=='Terrestrial',plot(lat, NM_2m_airshade, ylim=ylims, xlim=xlims, main='Terrestrial', ylab='Temperature (°C)', xlab='Latitude (°N)', cex=0.7)]
	dat[Realm=='Terrestrial',points(lat, thabmaxhr, col='grey', cex=0.7)] # w/out elevation adjustment
	dat[Realm=='Terrestrial',points(lat, tmax.accsum.elev, col='red', cex=0.7)]
	dat[Realm=='Terrestrial',points(lat, tmax, col='pink', cex=0.5)] # w/out tmax_acc and tmax_metric adjustment

		dat[Realm=='Terrestrial',lines(lat, predict(loess(NM_2m_airshade~lat, na.action=na.exclude)))]
		dat[Realm=='Terrestrial',lines(lat, predict(loess(thabmaxhr~lat, na.action=na.exclude)), col='grey')]
		dat[Realm=='Terrestrial',lines(lat, predict(loess(NM_exposed_bodytemp~lat, na.action=na.exclude)), col='purple')]

		dat[Realm=='Terrestrial' & !is.na(tmax.accsum.elev),lines(lat, predict(loess(tmax.accsum.elev~lat, na.action=na.exclude)), col='red')]
		dat[Realm=='Terrestrial' & !is.na(tmax.accsum.elev.dur),lines(lat, predict(loess(tmax.accsum.elev.dur~lat, na.action=na.exclude)), col='red', lty=2)] # with tmax duration adjustment as well (fewer data points)
		dat[Realm=='Terrestrial',lines(lat, predict(loess(tmax~lat, na.action=na.exclude)), col='pink')]

	dat[Realm=='Marine',plot(lat, thabmaxhr.adj, ylim=ylims, xlim=xlims, main='Marine', ylab='Temperature (°C)', xlab='Latitude (°N)', cex=0.7)]
	dat[Realm=='Marine',points(lat, tmax.accsum.elev, col='red', cex=0.7)]
	dat[Realm=='Marine',points(lat, tmax, col='pink', cex=0.5)] # w/out tmax_acc adjustment

		dat[Realm=='Marine',lines(lat, predict(loess(thabmaxhr.adj~lat, na.action=na.exclude)))]
		dat[Realm=='Marine',lines(lat, predict(loess(tmax.accsum.elev~lat, na.action=na.exclude)), col='red')]
		dat[Realm=='Marine' & !is.na(tmax.accsum.elev.dur),lines(lat, predict(loess(tmax.accsum.elev.dur~lat, na.action=na.exclude)), col='red', lty=2)]
		dat[Realm=='Marine',lines(lat, predict(loess(tmax~lat, na.action=na.exclude)), col='pink')]

	legend('topleft', legend=c('NM_2m_airshade/thabmaxhr', 'thabmaxhr', 'NM_exposed_bodytemp', 'tmax.accsum.elev (tmax_acc&elevation)', 'tmax.accsum.elev.dur (tmax_acc&elevation&duration)', 'tmax'), col=c('black', 'grey', 'purple', 'red', 'red', 'pink'), pch=c(1,1,NA,1,NA,1), lty=c(1,1,1,1,2,1), cex=0.5, bty='n')

	dev.off()

#############################
##### TSM plots ###
#############################
# plot un-adjusted tsm vs. adjustments for acclimation, elevation, and duration (only using air temperature from climatologies)
# former accounts for difference between experimental acclimation temperature and max monthly habitat temperature
	cex=0.7
	ylims=c(-15,12)
	xlims=c(-10,30)

	quartz(width=6,height=6)
	# pdf(width=6, height=6, file='figures/tsm_adj_vs_tsm.pdf')
	par(mfrow=c(3,3), las=1, mai=c(0.5, 0.5, 0.3, 0.05), mgp=c(2,0.7,0), cex.main=0.8, cex.lab=0.8)

	plot(0,0,bty='n', xaxt='n', yaxt='n', xlab='', ylab='', col='white')

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_maxhr_accsum-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thabsum\nno elevation correction', cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tsm_maxhr, tsm_maxhr_accsum-tsm_maxhr, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accsum-tsm_maxhr, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accsum-tsm_maxhr, col='blue', pch=2, cex=cex)]
	legend('topright', legend=c('Terrestrial', 'marine', 'crit', 'leth'), col=c('green', 'blue', 'black', 'black'), pch=c(1,1,1,2), cex=0.7)
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_maxhr_accmo-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thab_maxmo\nno elevation correction', cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tsm_maxhr, tsm_maxhr_accmo-tsm_maxhr, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accmo-tsm_maxhr, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accmo-tsm_maxhr, col='blue', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_maxhr_elev-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='no acclimation\nw/ elevation correction', cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tsm_maxhr, tsm_maxhr_elev-tsm_maxhr, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_elev-tsm_maxhr, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_elev-tsm_maxhr, col='blue', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_maxhr_accsum.elev-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thabsum\nw/ elevation correction', cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tsm_maxhr, tsm_maxhr_accsum.elev-tsm_maxhr, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accsum.elev-tsm_maxhr, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accsum.elev-tsm_maxhr, col='blue', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_maxhr_accmo.elev-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thab_maxmo\nw/ elevation correction', cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tsm_maxhr, tsm_maxhr_accmo.elev-tsm_maxhr, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accmo.elev-tsm_maxhr, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accmo.elev-tsm_maxhr, col='blue', pch=2, cex=cex)]
	abline(h=0)

	plot(0,0,bty='n', xaxt='n', yaxt='n', xlab='', ylab='', col='white')

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_maxhr_accsum.elev.dur-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thabsum\nw/ elevation&duration correction', cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tsm_maxhr, tsm_maxhr_accsum.elev.dur-tsm_maxhr, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accsum.elev.dur-tsm_maxhr, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accsum.elev.dur-tsm_maxhr, col='blue', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_maxhr_accmo.elev.dur-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thab_maxmo\nw/ elevation&duration correction', cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='crit',points(tsm_maxhr, tsm_maxhr_accmo.elev.dur-tsm_maxhr, col='blue', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accmo.elev.dur-tsm_maxhr, col='green', pch=2, cex=cex)]
	dat[Realm=='Marine' & tmax_metric=='leth',points(tsm_maxhr, tsm_maxhr_accmo.elev.dur-tsm_maxhr, col='blue', pch=2, cex=cex)]
	abline(h=0)

	dev.off()

# plot un-adjusted tsm vs. adjustments for acclimation, elevation, and duration (for NicheMapper)
# former accounts for difference between experimental acclimation temperature and max monthly habitat temperature
	cex=0.7
	ylims=c(-10,10)
	xlims=c(-10,30)

	quartz(width=6,height=6)
	# pdf(width=6, height=6, file='figures/tsm_NM_1cm_airshade_vs_tsm.pdf')
	par(mfrow=c(3,3), las=1, mai=c(0.5, 0.5, 0.3, 0.05), mgp=c(2,0.7,0), cex.main=0.8, cex.lab=0.7)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_NM_1cm_airshade-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='no acclimation\nno elevation correction', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_NM_1cm_airshade-tsm_maxhr, col='green', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_NM_1cm_airshade_accsum-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thabsum\nno elevation correction', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_NM_1cm_airshade_accsum-tsm_maxhr, col='green', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_NM_1cm_airshade_accmo-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thabmaxmo\nno elevation correction', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_NM_1cm_airshade_accmo-tsm_maxhr, col='green', pch=2, cex=cex)]
	abline(h=0)

	plot(0,0,bty='n', xaxt='n', yaxt='n', xlab='', ylab='', col='white')
	legend('topright', legend=c('Terrestrial', 'marine', 'crit', 'leth'), col=c('green', 'blue', 'black', 'black'), pch=c(1,1,1,2), cex=0.7, bty='n')

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_NM_1cm_airshade_accsum.elev-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thabsum\nw/elevation correction', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_NM_1cm_airshade_accsum.elev-tsm_maxhr, col='green', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_NM_1cm_airshade_accmo.elev-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thabmaxmo\nw/ elevation correction', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_NM_1cm_airshade_accmo.elev-tsm_maxhr, col='green', pch=2, cex=cex)]
	abline(h=0)

	plot(0,0,bty='n', xaxt='n', yaxt='n', xlab='', ylab='', col='white')

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_NM_1cm_airshade_accsum.elev.dur-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thabsum\nw/elevation&duration correction', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_NM_1cm_airshade_accsum.elev.dur-tsm_maxhr, col='green', pch=2, cex=cex)]
	abline(h=0)

	dat[Realm=='Terrestrial' & tmax_metric=='crit',plot(tsm_maxhr, tsm_NM_1cm_airshade_accmo.elev.dur-tsm_maxhr, xlim=xlims, ylim=ylims, col='green', main='acclimation to thabmaxmo\nw/ elevation&duration correction', cex=cex)]
	dat[Realm=='Terrestrial' & tmax_metric=='leth',points(tsm_maxhr, tsm_NM_1cm_airshade_accmo.elev.dur-tsm_maxhr, col='green', pch=2, cex=cex)]
	abline(h=0)

	dev.off()

# tsm_maxhr by Class boxplot
	ylims=c(-7,30)
	quartz(width=8, height=4)
	# pdf(width=8, height=4, file='figures/tsm_maxhr_vs_Class.pdf')
	par(mfrow=c(1,2), las=2)
	boxplot(tsm_maxhr_adjadjsum ~ Class, cex.axis=0.5, data=droplevels(dat[Realm=='Terrestrial',]), main='terrestrial\ntsm_maxhr_adjadjsum', ylim=ylims, ylab='Thermal Safety Margin °C')
		abline(h=0, lty=2, col='grey')
	boxplot(tsm_maxhr_adjadjsum ~ Class, cex.axis=0.5, data=droplevels(dat[Realm=='Marine',]), main='marine\ntsm_maxhr_adjadjsum', ylim=ylims)
		abline(h=0, lty=2, col='grey')

	dev.off()

# tsm_NM_2m_airshade (terrestrial non-amphibian) and tsm_NM_shade_body_wet (amphibian) and tsm_maxhr (marine) by lat
	setkey(dat, lat)
	xlims <- c(-80,80)
	ylims <- dat[,range(tsm_NM_favorable, tsm_maxhr_accsum.elev, na.rm=TRUE)]
	cols1 <- c('#b2df8a70', '#a6cee370') # land, ocean light transparent
	cols2 <- c('#33a02c', '#1f78b4') # land, ocean dark
	cex=0.5

	l1 <- dat[Realm=='Terrestrial' & !is.na(tsm_NM_favorable),loess(tsm_NM_favorable~lat, na.action=na.exclude)]
	l2 <- dat[Realm=='Marine' & !is.na(tsm_maxhr_accsum.elev),loess(tsm_maxhr_accsum.elev~lat, na.action=na.exclude)]
	p1 <- predict(l1, se=TRUE)
	p2 <- predict(l2, se=TRUE)
	p1$lat <- dat[Realm=='Terrestrial' & !is.na(tsm_NM_favorable), lat]
	p2$lat <- dat[Realm=='Marine' & !is.na(tsm_maxhr_accsum.elev), lat]

	quartz(width=5, height=4)
	# pdf(width=5, height=4, file='figures/tsm_vs_lat_loess_noexposed.pdf')
	par(las=1, mai=c(0.7, 0.7, 0.3, 0.1), mgp=c(2.5,0.7,0))

	plot(-100,0, xlim=xlims, ylim=ylims, main='Thermal Safety Margins', xlab='Latitude (°N)', ylab='Thermal safety margin (°C)') # set up
	abline(h=0, lty=2, col='grey')

		# terrestrial shade or wet skin (favorable microclimate)
	dat[Realm=='Terrestrial', points(lat, tsm_NM_favorable, col=cols1[1], cex=cex)]
		with(p1, polygon(c(lat, rev(lat)), c(fit+1.96*se.fit, rev(fit-1.96*se.fit)), col=cols1[1], border=NA)) # 95%CI
		with(p1, lines(lat, fit, col=cols2[1], lwd=2)) # mean

		# marine
	dat[Realm=='Marine', points(lat, tsm_maxhr_accsum.elev, col=cols1[2], cex=cex)]
		with(p2, polygon(c(lat, rev(lat)), c(fit+1.96*se.fit, rev(fit-1.96*se.fit)), col=cols1[2], border=NA))
		with(p2, lines(lat, fit, col=cols2[2], lwd=2))

	legend('bottomleft', legend=c('Terrestrial shade (+wet skin for amphibians)', 'Marine surface'), pch=1, col=cols1, lty=1, bty='n', cex=0.5)

	dev.off()

# tsm_NM_2m_airshade (terrestrial non-amphibian) and tsm_NM_shade_body_wet (amphibian) and tsm_maxhr (marine) by lat
# also show tsm_NM_exposed_bodytemp for comparison
	setkey(dat, lat)
	xlims <- c(-80,80)
	ylims <- dat[,range(tsm_NM_favorable, tsm_NM_exposed_bodytemp_accsum.elev, tsm_maxhr_accsum.elev, na.rm=TRUE)]
	cols1 <- c('#AAAAAA70', '#b2df8a70', '#a6cee370') # exposed, land, ocean light transparent
	cols2 <- c('#808080', '#33a02c', '#1f78b4') # exposed, land, ocean dark
	cex=0.5

	quartz(width=5, height=4)
	# pdf(width=5, height=4, file='figures/tsm_vs_lat_loess.pdf')
	# pdf(width=5, height=4, file='figures/tsm_vs_lat_loess_only_landshade.pdf')
	# pdf(width=5, height=4, file='figures/tsm_vs_lat_loess_only_landshade&exposed.pdf')
	par(las=1, mai=c(0.7, 0.7, 0.3, 0.1), mgp=c(2.5,0.7,0))

	plot(-100,0, xlim=xlims, ylim=ylims, main='Thermal Safety Margins', xlab='Latitude (°N)', ylab='Thermal safety margin (°C)') # set up
	abline(h=0, lty=2, col='grey')

		# exposed
	dat[Realm=='Terrestrial', points(lat, tsm_NM_exposed_bodytemp_accsum.elev, col=cols1[1], cex=cex)]
		dat[Realm=='Terrestrial' & !is.na(tsm_NM_exposed_bodytemp_accsum.elev),lines(lat, predict(loess(tsm_NM_exposed_bodytemp_accsum.elev~lat, na.action=na.exclude)), col=cols2[1], lwd=2)]
			# could add polygon of loess +/- SE

		# terrestrial shade or wet skin
	dat[Realm=='Terrestrial', points(lat, tsm_NM_favorable, col=cols1[2], cex=cex)]
		dat[Realm=='Terrestrial' & !is.na(tsm_NM_favorable),lines(lat, predict(loess(tsm_NM_favorable~lat, na.action=na.exclude)), col=cols2[2], lwd=2)]
			# could add polygon of loess +/- SE

		# marine
	dat[Realm=='Marine', points(lat, tsm_maxhr_accsum.elev, col=cols1[3], cex=cex)]
		dat[Realm=='Marine' & !is.na(tsm_maxhr_accsum.elev),lines(lat, predict(loess(tsm_maxhr_accsum.elev~lat, na.action=na.exclude)), col=cols2[3], lwd=2)]
			# could add polygon of loess +/- SE

	legend('bottomleft', legend=c('Terrestrial exposed body', 'Terrestrial shade (wet skin for amphibians)', 'Marine surface'), pch=1, col=cols1, lty=1, bty='n', cex=0.5)

	dev.off()

# tsm_NM_1cm_airshade (terrestrial) and tsm_maxhr (marine) by lat NO AMPHIBIANS
	setkey(dat, lat)
	xlims <- c(-80,80)
	ylims <- dat[Class != 'Amphibia',range(tsm_NM_1cm_airshade_accsum.elev, tsm_NM_exposed_bodytemp_accsum.elev, tsm_maxhr_accsum.elev, na.rm=TRUE)]

	quartz(width=5, height=4)
	# pdf(width=5, height=4, file='figures/tsm_vs_lat_loess_no_amphib.pdf')
	par(las=1, mai=c(0.7, 0.7, 0.3, 0.1), mgp=c(2.5,0.7,0))

	dat[Realm=='Terrestrial' & Class != 'Amphibia', plot(lat, tsm_NM_exposed_bodytemp_accsum.elev, col='grey', xlim=xlims, ylim=ylims, main='Thermal Safety Margins no Amphibians')]
		dat[Realm=='Terrestrial' & !is.na(tsm_NM_exposed_bodytemp_accsum.elev) & Class != 'Amphibia',lines(lat, predict(loess(tsm_NM_exposed_bodytemp_accsum.elev~lat, na.action=na.exclude)), col='grey')]
		abline(h=0, lty=2, col='grey')

	dat[Realm=='Terrestrial' & Class != 'Amphibia', points(lat, tsm_NM_1cm_airshade_accsum.elev, col='green')]
		dat[Realm=='Terrestrial' & !is.na(tsm_NM_1cm_airshade_accsum.elev) & Class != 'Amphibia',lines(lat, predict(loess(tsm_NM_1cm_airshade_accsum.elev~lat, na.action=na.exclude)), col='green')]
	dat[Realm=='Marine' & Class != 'Amphibia', points(lat, tsm_maxhr_accsum.elev, col='blue')]
		dat[Realm=='Marine' & !is.na(tsm_maxhr_accsum.elev) & Class != 'Amphibia',lines(lat, predict(loess(tsm_maxhr_accsum.elev~lat, na.action=na.exclude)), col='blue')]

	legend('bottomleft', legend=c('Terrestrial 1cm shade', 'Marine surface', 'Terrestrial exposed body'), pch=1, col=c('green', 'blue', 'grey'), lty=1, bty='n', cex=0.5)

	dev.off()

# Amphibians: tsm_NM_2m_airshade vs. tsm_NM_exposed_body_wet
	dat[animal.type=='amphibian', plot(tsm_NM_2m_airshade, tsm_NM_exposed_body_wet)]
		abline(0,1, lty=2)

	dat[animal.type=='amphibian', mean(tsm_NM_2m_airshade - tsm_NM_exposed_body_wet)] #

# tsm_maxhr vs. lat by Class
	require(RColorBrewer)
	setkey(dat, lat) # sort by lat
	ylims <- dat[,range(c(tsm_maxhr, tsm_maxhr_adjadjsum), na.rm=TRUE)]
	xlims <- c(-90,90)
	cols <- brewer.pal(12, 'Paired')[c(1:12, 1:8)] # repeat to get to 20
	pchs <- c(rep(1, 10), rep(4,10))
	i1 <- dat$Realm=='Terrestrial' & !is.na(dat$tsm_maxhr)
	i2 <- dat$Realm=='Marine' & !is.na(dat$tsm_maxhr)
	i3 <- dat$Realm=='Terrestrial' & !is.na(dat$tsm_maxhr_adjadjsum)
	i4 <- dat$Realm=='Marine' & !is.na(dat$tsm_maxhr_adjadjsum)

	quartz(width=8, height=6)
	# pdf(width=8, height=6, file='figures/tsm_maxhr_vs_lat_by_Class.pdf')
	par(mfrow=c(2,2), mgp=c(2,0.7,0), las=1, cex.axis=0.8, mai=c(0.7, 0.7, 0.2, 0.1))

		# tsm_maxhr
	dat[i1, plot(tsm_maxhr ~ lat_max, main='Terrestrial', ylim=ylims, xlim=xlims, ylab='Thermal Safety Margin °C \n(tsm_maxhr)', col=cols[as.numeric(Class)], pch=pchs[as.numeric(Class)])]
		dat[i1 & Class=='Reptilia',lines(lat, predict(loess(tsm_maxhr~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Reptilia'])]
		dat[i1 & Class=='Amphibia',lines(lat, predict(loess(tsm_maxhr~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Amphibia'])]
		dat[i1 & Class=='Insecta',lines(lat, predict(loess(tsm_maxhr~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Insecta'])]
	legend('topright', legend=levels(dat$Class), col=cols, pch=pchs, cex=0.3)

	dat[i2, plot(tsm_maxhr ~ lat_max, main='Marine', ylim=ylims, xlim=xlims, col=cols[as.numeric(Class)], pch=pchs[as.numeric(Class)])]
		dat[i2 & Class=='Actinopterygii',lines(lat, predict(loess(tsm_maxhr~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Actinopterygii'])]
		dat[i2 & Class=='Bivalvia',lines(lat, predict(loess(tsm_maxhr~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Bivalvia'])]

		# tsm_maxhr_adjadjsum
	plot(tsm_maxhr_adjadjsum ~ lat_max, data=dat[i3,], main='Terrestrial', ylim=ylims, xlim=xlims, ylab='Thermal Safety Margin °C \n(tsm_maxhr_adjadjsum)', col=cols[as.numeric(dat$Class[i3])], pch=pchs[as.numeric(dat$Class[i3])])
		dat[i3 & Class=='Reptilia',lines(lat, predict(loess(tsm_maxhr_adjadjsum~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Reptilia'])]
		dat[i3 & Class=='Amphibia',lines(lat, predict(loess(tsm_maxhr_adjadjsum~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Amphibia'])]
		dat[i3 & Class=='Insecta',lines(lat, predict(loess(tsm_maxhr_adjadjsum~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Insecta'])]

	plot(tsm_maxhr_adjadjsum ~ lat_max, data=dat[i4,], main='Marine', ylim=ylims, xlim=xlims, col=cols[as.numeric(dat$Class[i4])], pch=pchs[as.numeric(dat$Class[i4])])
		dat[i4 & Class=='Actinopterygii',lines(lat, predict(loess(tsm_maxhr_adjadjsum~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Actinopterygii'])]
		dat[i4 & Class=='Bivalvia',lines(lat, predict(loess(tsm_maxhr_adjadjsum~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Bivalvia'])]

	dev.off()

# tsm_NM_1cm_airshade vs. lat by Class
	require(RColorBrewer)
	setkey(dat, lat) # sort by lat
	ylims <- dat[,range(c(tsm_NM_1cm_airshade, tsm_maxhr_accsum.elev), na.rm=TRUE)]
	xlims <- c(-90,90)
	cols <- brewer.pal(12, 'Paired')[c(1:12, 1:8)] # repeat to get to 20
	pchs <- c(rep(1, 10), rep(4,10))
	i1 <- dat$Realm=='Terrestrial' & !is.na(dat$tsm_maxhr_accsum.elev)
	i2 <- dat$Realm=='Marine' & !is.na(dat$tsm_maxhr_accsum.elev)
	i3 <- dat$Realm=='Terrestrial' & !is.na(dat$tsm_NM_1cm_airshade)
	i2 <- dat$Realm=='Marine' & !is.na(dat$tsm_maxhr_accsum.elev)

	quartz(width=8, height=6)
	# pdf(width=8, height=6, file='figures/tsm_maxhr_w_NM_vs_lat_by_Class.pdf')
	par(mfrow=c(2,2), mgp=c(2,0.7,0), las=1, cex.axis=0.8, mai=c(0.7, 0.7, 0.2, 0.1))

		# tsm_maxhr_accsum.elev
	plot(tsm_maxhr_accsum.elev ~ lat_max, data=dat[i1,], main='Terrestrial', ylim=ylims, xlim=xlims, ylab='Thermal Safety Margin °C \n(tsm_maxhr_accsum.elev)', col=cols[as.numeric(dat$Class[i1])], pch=pchs[as.numeric(dat$Class[i1])])
		dat[i1 & Class=='Reptilia',lines(lat, predict(loess(tsm_maxhr_accsum.elev~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Reptilia'])]
		dat[i1 & Class=='Amphibia',lines(lat, predict(loess(tsm_maxhr_accsum.elev~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Amphibia'])]
		dat[i1 & Class=='Insecta',lines(lat, predict(loess(tsm_maxhr_accsum.elev~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Insecta'])]

		abline(h=0, col='grey', lty=2)

	plot(tsm_maxhr_accsum.elev ~ lat_max, data=dat[i2,], main='Marine', ylim=ylims, xlim=xlims, col=cols[as.numeric(dat$Class[i2])], pch=pchs[as.numeric(dat$Class[i2])])
		dat[i2 & Class=='Actinopterygii',lines(lat, predict(loess(tsm_maxhr_accsum.elev~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Actinopterygii'])]
		dat[i2 & Class=='Bivalvia',lines(lat, predict(loess(tsm_maxhr_accsum.elev~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Bivalvia'])]

		abline(h=0, col='grey', lty=2)

		# tsm_NM_1cm_airshade_accsum.elev
	plot(tsm_NM_1cm_airshade_accsum.elev ~ lat_max, data=dat[i1,], main='terrestrial NicheMapper', ylim=ylims, xlim=xlims, ylab='Thermal Safety Margin °C \n(tsm_NM_1cm_airshade_accsum.elev)', col=cols[as.numeric(dat$Class[i1])], pch=pchs[as.numeric(dat$Class[i1])])
		dat[i1 & Class=='Reptilia',lines(lat, predict(loess(tsm_NM_1cm_airshade_accsum.elev~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Reptilia'])]
		dat[i1 & Class=='Amphibia',lines(lat, predict(loess(tsm_NM_1cm_airshade_accsum.elev~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Amphibia'])]
		dat[i1 & Class=='Insecta',lines(lat, predict(loess(tsm_NM_1cm_airshade_accsum.elev~lat, na.action=na.exclude)), col=cols[levels(dat$Class)=='Insecta'])]

		abline(h=0, col='grey', lty=2)

	plot(0,0,bty='n', xaxt='n', yaxt='n', xlab='', ylab='', col='white')
	legend('topright', legend=levels(dat$Class), col=cols, pch=pchs, cex=0.7, ncol=3, bty='n')

	dev.off()

# tsm_maxhr: plot model result on top of data (unfolded lat)
	cols <- c('#b2df8a', '#1f78b4') # land, ocean
	cols2 <- c('#b2df8a88', '#1f78b488') # land, ocean faded somewhat
	cols3 <- c('#b2df8a55', '#1f78b455') # land, ocean faded

	quartz(width=5, height=5)
	plot(dat$tsm_maxhr~dat$lat, type="n", ylab="Thermal safety margin", xlab="latitude")

	with(dat[dat$Realm=="marine",], points(tsm_maxhr~lat, col=cols2[2], pch=16))
	with(dat[dat$Realm=="terrestrial",], points(tsm_maxhr~lat, col=cols2[1], pch=16))

#	with(newdat[newdat$Realm=='Marine' & newdat$lat > -80,], polygon(c(lat, rev(lat)), c(tsm+se, rev(tsm-se)), col=cols3[2], border=FALSE))
#	with(newdat[newdat$Realm=='Terrestrial' & newdat$lat > -55 & newdat$lat < 70,], polygon(c(lat, rev(lat)), c(tsm+se, rev(tsm-se)), col=cols3[1], border=FALSE))

	with(newdat[newdat$Realm=='Marine' & newdat$lat > -80,], lines(tsm_maxhr~lat, col=cols[2], lwd=3)) # current TSM
	with(newdat[newdat$Realm=='Terrestrial' & newdat$lat > -55 & newdat$lat < 70,], lines(tsm_maxhr~lat, col=cols[1], lwd=3))

#	with(newdat[newdat$Realm=='Marine' & newdat$lat > -80,], polygon(c(lat, rev(lat)), c(tsm_fut+sefut, rev(tsm_fut-sefut)), col=cols3[2], border=FALSE))
#	with(newdat[newdat$Realm=='Terrestrial' & newdat$lat > -55 & newdat$lat < 70,], polygon(c(lat, rev(lat)), c(tsm_fut+sefut, rev(tsm_fut-sefut)), col=cols3[1], border=FALSE))
	with(newdat[newdat$Realm=='Marine' & newdat$lat > -80,], lines(tsm_fut85~lat, col=cols[2], lwd=3, lty=2)) # future TSM
	with(newdat[newdat$Realm=='Terrestrial' & newdat$lat > -55 & newdat$lat < 70,], lines(tsm_fut85~lat, col=cols[1], lwd=3, lty=2))

	with(newdat[newdat$Realm=='Marine' & newdat$lat > -80,], lines(tsm_sum~lat, col=cols[2], lwd=1, lty=1)) # current TSM summer
	with(newdat[newdat$Realm=='Terrestrial' & newdat$lat > -55 & newdat$lat < 70,], lines(tsm_sum~lat, col=cols[1], lwd=1, lty=1))

	with(newdat[newdat$Realm=='Marine' & newdat$lat > -80,], lines(tsm_fut85sum~lat, col=cols[2], lwd=1, lty=2)) # future TSM summer
	with(newdat[newdat$Realm=='Terrestrial' & newdat$lat > -55 & newdat$lat < 70,], lines(tsm_fut85sum~lat, col=cols[1], lwd=1, lty=2))

	with(newdat[newdat$Realm=='Marine' & newdat$lat > -80,], lines(tsm_futacc85~lat, col=cols[2], lwd=3, lty=2)) # future TSM acc
	with(newdat[newdat$Realm=='Terrestrial' & newdat$lat > -55 & newdat$lat < 70,], lines(tsm_futacc85~lat, col=cols[1], lwd=3, lty=2))

	with(newdat[newdat$Realm=='Marine' & newdat$lat > -80,], lines(tsm_futacc85sum~lat, col=cols[2], lwd=1, lty=2)) # future TSM acc summer
	with(newdat[newdat$Realm=='Terrestrial' & newdat$lat > -55 & newdat$lat < 70,], lines(tsm_futacc85sum~lat, col=cols[1], lwd=1, lty=2))

	legend('topleft', legend=c('land', 'ocean'), col=cols, lwd=1, bty='n')

######################################
## Combined Tmax, Thab, TSM plots
######################################

# TSM vs. Tb
par(mfrow=c(1,2))
dat[Realm=='Terrestrial', plot(tb_favorableGHCND95, tsm_favorableGHCND95)]
dat[Realm=='Marine', plot(tb_favorableGHCND95, tsm_favorableGHCND95)]

	# lattice plot
	latshingle <- shingle(dat$lat, intervals=matrix(c(seq(-90,60,by=15), seq(-60,90,by=15)),byrow=FALSE, ncol=2))
	xyplot(tsm_favorableGHCND95 ~ tb_favorableGHCND95 | latshingle,
		data = dat[Realm=='Terrestrial',])

# TSM vs. Tmax
	# lattice plot
	latshingle <- shingle(dat$lat, intervals=matrix(c(seq(-90,60,by=15), seq(-60,90,by=15)),byrow=FALSE, ncol=2))
	xyplot(tsm_favorableGHCND95 ~ tmax.accsum.elev | latshingle,
		data = dat[Realm=='Terrestrial',])


rm(list=ls())
library(tidyverse)
library(readxl)
library(lubridate)
library(stringr)

remove_acentos <- function(x) iconv(x, to = "ASCII//TRANSLIT")

info_munic <- read.csv2('data/informacoes_municipais_seade.csv') %>%
  mutate(munic = tolower(munic),
         munic = remove_acentos(munic),
         munic = str_replace_all(munic, '-', ' '))

arquivo_xlsx <- 'data/Municipios informacoes dia.xlsx'

df <- excel_sheets(arquivo_xlsx) %>%
  map(function(x){
    tabela <- read_excel(arquivo_xlsx, x)

    if(length(tabela) < 3) {
      n <- str_which(tabela[[1]], "Cidade")

      tabela_casos <- tabela %>%
        slice(1:(n-2))

      names(tabela_casos) <- c('munic', 'casos')

      tabela_obitos <- tabela %>%
        slice((n+1):n())

      names(tabela_obitos) <- c('munic', 'obitos')

      tabela <- full_join(tabela_casos, tabela_obitos, by = 'munic')
    }

    tabela <- tabela %>%
      mutate(dia_mes = x,
             dia = as.numeric(substr(dia_mes, 1,2)),
             mes = substr(dia_mes, 4, 6),
             mes = replace(mes, mes == 'mar', 3),
             mes = replace(mes, mes == 'abr', 4),
             mes = as.numeric(mes)) %>%
      select(-dia_mes)

    names(tabela) <- c('munic', 'casos', 'obitos', 'dia', 'mes')

    tabela <- tabela %>%
      mutate(munic = tolower(munic),
             munic = remove_acentos(munic),
             munic = str_replace_all(munic, '-', ' '),
             munic = str_replace_all(munic, '\\?', ''),
             casos = as.numeric(casos),
             obitos = as.numeric(obitos)) %>%
      filter(!is.na(munic)) %>%
      filter(munic != 'total')

  })  %>%
  reduce(bind_rows) %>%
  left_join(info_munic, by = 'munic')

df %>%
  write_csv2('data/dados_covid_sp.csv')

tail(df)


#Code for Figure 4A: Compares neoantigens/nonsynonymous mutation rates
#Also provides correlation between mutation and neoantigen load (used in manuscript)
#Query at the top joins analysis.neoag_freq materialized view to other tables to make figure that shows subtype and timepoint-specific fractions
#-----------------------------------------------------
library(DBI)
library(odbc)
library(ggplot2)
library(reshape)

rm(list=ls())

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

q = "SELECT gs.tumor_pair_barcode,
COALESCE(neo1.neoag_count::numeric,0) AS neoag_count_a,
COALESCE(neo1.mt_count::numeric,0) AS mt_count_a,
COALESCE(neo1.prop_immunogenic::numeric,0) AS prop_immunogenic_a,
COALESCE(neo2.neoag_count::numeric,0) AS neoag_count_b,
COALESCE(neo2.mt_count::numeric,0) AS mt_count_b,
COALESCE(neo2.prop_immunogenic::numeric,0) AS prop_immunogenic_b,
clin.idh_codel_subtype AS subtype,
CASE WHEN mf.coverage_adj_mut_freq >= 10 THEN 1 WHEN mf.coverage_adj_mut_freq < 10 THEN 0 END AS hypermutator
FROM analysis.gold_set gs
LEFT JOIN analysis.neoag_freq neo1 ON neo1.aliquot_barcode = gs.tumor_barcode_a
LEFT JOIN analysis.neoag_freq neo2 ON neo2.aliquot_barcode = gs.tumor_barcode_b
LEFT JOIN clinical.subtypes clin ON  clin.case_barcode = gs.case_barcode
INNER JOIN analysis.mut_freq mf ON mf.aliquot_barcode = gs.tumor_barcode_b
ORDER BY gs.tumor_pair_barcode"

neo <- dbGetQuery(con,q)

#get the n's for this plot
tmp <- neo[,"subtype"]
tmp <- tmp[order(tmp)]
rle(tmp)

#get average proportion of mutations giving rise to neoantigens
mean(c(neo[,"prop_immunogenic_a"],neo[,"prop_immunogenic_b"]))		#42%

#get correlation between mutation and neoantigen load
cor(c(neo[,"neoag_count_a"],neo[,"neoag_count_b"]),c(neo[,"mt_count_a"],neo[,"mt_count_b"]),method="s")	#0.89

prop <- c(neo[,"prop_immunogenic_a"],neo[,"prop_immunogenic_b"])
pair <- rep(neo[,"tumor_pair_barcode"],2)
subtype <- rep(neo[,"subtype"],2)
timepoint <- c(rep("Initial",nrow(neo)),rep("Recurrent",nrow(neo)))
res <- data.frame(pair,prop,subtype,timepoint)

#Figure 4A
pdf("/projects/varnf/GLASS/Figures/resubmission/final/Figure4A_points.pdf",width=2,height=2)
p1 <- ggplot(res,aes(y = prop, x = timepoint, fill = subtype)) +
	geom_bar(position="dodge",stat="summary",fun.y="mean",color="black") +
	geom_point(position=position_dodge(width = .9),size=0.01) +
	geom_errorbar(stat="summary",fun.data="mean_sdl", fun.args=list(mult=1) ,size=0.4,width=0.35, position=position_dodge(.9))+
	theme_bw() +
	labs(x = "", y = "Neoantigens/nonsynonymous") +
	theme(axis.text.x=element_text(size=7),axis.text.y = element_text(size=7),
	axis.title.x = element_blank(),axis.title.y = element_text(size=7),
	panel.grid.major=element_blank(),panel.grid.minor=element_blank(),
	legend.position="none") +
	coord_cartesian(ylim=c(0,0.9))
p1
dev.off()

subtypes <- unique(neo[,"subtype"])
prop_pri <- prop_rec <- neoag_sd_pri <- neoag_sd_rec <- rep(0,length(subtypes))
for(i in 1:length(subtypes))
{
	sub_res <- res[which(res[,"subtype"]==subtypes[i]),]
	prop_pri[i] <- mean(sub_res[which(sub_res[,"timepoint"]=="Initial"),"prop"])
	prop_rec[i] <- mean(sub_res[which(sub_res[,"timepoint"]=="Recurrent"),"prop"])
	neoag_sd_pri[i] <- sd(sub_res[which(sub_res[,"timepoint"]=="Initial"),"prop"])
	neoag_sd_rec[i] <- sd(sub_res[which(sub_res[,"timepoint"]=="Recurrent"),"prop"])

}

#Significance tests
g1 <- res[which(res[,"timepoint"]=="Initial" & res[,"subtype"] == "IDHmut-codel"),"prop"]
g2 <- res[which(res[,"timepoint"]=="Initial" & res[,"subtype"] == "IDHmut-noncodel"),"prop"]
g3 <- res[which(res[,"timepoint"]=="Initial" & res[,"subtype"] == "IDHwt"),"prop"]

g4 <- res[which(res[,"timepoint"]=="Recurrent" & res[,"subtype"] == "IDHmut-codel"),"prop"]
g5 <- res[which(res[,"timepoint"]=="Recurrent" & res[,"subtype"] == "IDHmut-noncodel"),"prop"]
g6 <- res[which(res[,"timepoint"]=="Recurrent" & res[,"subtype"] == "IDHwt"),"prop"]

wilcox.test(g1,g4)		#0.35
wilcox.test(g2,g5)		#0.82
wilcox.test(g3,g6)		#0.90

wilcox.test(g1,g2)		#0.19
wilcox.test(g1,g3)		#0.38
wilcox.test(g2,g3)		#0.61

wilcox.test(g4,g5)		#0.66
wilcox.test(g4,g6)		#0.92
wilcox.test(g5,g6)		#0.26

#Plot A (old)
plot_res <- data.frame(c(prop_pri,prop_rec),
			c(neoag_sd_pri,neoag_sd_rec),
			c(rep("Initial",3),rep("Recurrent",3)),
			c(rep("prop_immunogenic",6)),
			rep(subtypes,2))
colnames(plot_res) <- c("fraction","sd","status","neoag","subtypes")

pdf("/projects/varnf/GLASS/Figures/resubmission/final/Figure4A_old.pdf",width=2,height=2)
p1 <- ggplot(plot_res,aes(y = fraction, x = status, fill = subtypes)) +
	geom_bar(position="dodge",stat="identity",color="black") +
	geom_point(size=0.5,position="dodge") +
	geom_errorbar(aes(ymin=fraction-sd,ymax=fraction+sd),size=0.4,width=0.35,position=position_dodge(.9))+
	theme_bw() +
	labs(x = "", y = "Neoantigens/nonsynonymous") +
	theme(axis.text.x=element_text(size=7),axis.text.y = element_text(size=7),
	axis.title.x = element_blank(),axis.title.y = element_text(size=7),
	panel.grid.major=element_blank(),panel.grid.minor=element_blank(),
	legend.position="none") +
	coord_cartesian(ylim=c(0,0.60))
p1
dev.off()

#Other analyses
#-------------------------------------

#Mut and neoag load comparisons
neo_box <- neo
neo_box[,"neoag_count"] <- as.numeric(neo_box[,"neoag_count"])
neo_box[,"mt_count"] <- as.numeric(neo_box[,"mt_count"])
neo_box <- neo_box[which(neo_box[,"hypermutator"]==0),]
pdf("/projects/varnf/GLASS/Figures/resubmission/neaog_load_boxplot.pdf",width=4,height=2)
p1 <- ggplot(neo_box,aes(y = neoag_count, x = sample_type,fill=subtype)) +
	geom_boxplot(outlier.shape=NA) +
	geom_line(aes(group=case_barcode),linetype=2,colour="gray50",size=0.1) +
	geom_point(size=0.5) +
	theme_bw() +
	facet_grid(.~subtype) +
	labs(x = "", y = "Mutation count") +
	theme(axis.text.x=element_text(size=7),axis.text.y = element_text(size=7),
	axis.title.x = element_blank(),axis.title.y = element_text(size=7),
	panel.grid.major=element_blank(),panel.grid.minor=element_blank(),
	legend.position="none")
p1
dev.off()

pdf("/projects/varnf/GLASS/Figures/resubmission/mut_load_boxplot.pdf",width=4,height=2)
p1 <- ggplot(neo_box,aes(y = mt_count, x = sample_type,fill=subtype)) +
	geom_boxplot(outlier.shape=NA) +
	geom_line(aes(group=case_barcode),linetype=2,colour="gray50",size=0.1) +
	geom_point(size=0.5) +
	theme_bw() +
	facet_grid(.~subtype) +
	labs(x = "", y = "Neoantigen count") +
	theme(axis.text.x=element_text(size=7),axis.text.y = element_text(size=7),
	axis.title.x = element_blank(),axis.title.y = element_text(size=7),
	panel.grid.major=element_blank(),panel.grid.minor=element_blank(),
	legend.position="none")
p1
dev.off()

#Hypermutator plot
g1 <- neo[which(neo[,"hypermutator"]==1),"prop_immunogenic"]
g2 <- neo[which(neo[,"hypermutator"]==0 & neo[,"sample_type"]=="R"),"prop_immunogenic"]

hm <- neo[which(neo[,"hypermutator"]==1),]
subtypes <- unique(neo[,"subtype"])
prop_immunogenic_pri <- prop_immunogenic_rec <- neoag_sd_pri <- neoag_sd_rec <- rep(0,length(subtypes))
for(i in 1:length(subtypes))
{
	sub_neo <- neo[which(neo[,"subtype"]==subtypes[i]),]
	prop_immunogenic_pri[i] <- mean(sub_neo[which(sub_neo[,"sample_type"]=="P"),"prop_immunogenic"])
	prop_immunogenic_rec[i] <- mean(sub_neo[which(sub_neo[,"sample_type"]=="R"),"prop_immunogenic"])
	neoag_sd_pri[i] <- sd(sub_neo[which(sub_neo[,"sample_type"]=="P"),"prop_immunogenic"])
	neoag_sd_rec[i] <- sd(sub_neo[which(sub_neo[,"sample_type"]=="R"),"prop_immunogenic"])

}

plot_res <- data.frame(c(prop_immunogenic_pri,prop_immunogenic_rec),
			c(neoag_sd_pri,neoag_sd_rec),
			c(rep("Primary",3),rep("Recurrent",3)),
			c(rep("prop_immunogenic",6)),
			rep(subtypes,2))
colnames(plot_res) <- c("fraction","sd","status","neoag","subtypes")


##' Plot infection prevalence as predicted by EpiNow2
##'
##' @return ggplot object
##' @importFrom EpiNow2 calc_summary_measures
##' @param counties counties to plot, including the possibilities of "pilot" (for all pilot counties), "non-pilot" (for all non-pilot counties) and "all"
plot_predicted_prevalence <- function(counties = NULL) {
  prev <- prevalence.samples
  if (!is.null(counties)) {
    prev <- prev %>%
      filter(county %in% counties)
  }

  prev_summary <- calc_summary_measures(prev[, value := prev_ratio],
                                        summarise_by = "county",
                                        CrIs = 0.95)
}


# This is an example code to run Quantile function on a Hadoop Cluster
# Prior to running the R Script, launch the H2O hadoop jar on the cluster

# Detach and remove old H2O package if it exists
detach("package:h2o", unload=TRUE)
remove.packages("h2o",.libPaths())

# Install the same version of H2O from online repository that is running on your Hadoop Cluster
install.packages("h2o", repos=(c("http://h2o-release.s3.amazonaws.com/h2o/rel-kahan/2/R", getOption("repos"))))

#Load H2O library
library(h2o)

#Connect to H2O instance by specifying ip and port
myIP = "192.168.1.153"
myPort =  54321
remote.h2o = h2o.init( ip = myIP, port = myPort )

#Import the data file from HDFS and parse it into H2O memory
qfile = h2o.importHDFS.FV(remote.h2o,"hdfs://abc.loc:2312/datasets/quant_file.csv",key="qfile")
#If the data file sits on your local machine, upload and parse it into H2O memory
#qfile=h2o.uploadFile.FV(remote.h2o,"/Users/nidhimehta/Desktop/quant_file.csv",key="qfile")

#Check dimensions of data file
dim(qfile)

#Run summary
summary(qfile)

#Print column names
cname = colnames(qfile)
print(cname)

# Get a single quantile for a column
quantile(qfile$M1, probs = 0.60, na.rm = T)

#Get qunatiles for specified multiple probabilites for a column
quantile(qfile$M11,probs=seq(0,1,.1))
quantile(qfile$M1,probs=seq(0,1,.01))

#Get quartiles of a column
quantile(qfile$M10,probs=seq(0,1,.25), na.rm = T)

#Print 99.9 quantile for each column in the data file
for(i in 16:length(cname)){
  print(paste(cname[i],quantile(qfile[,i],prob = .999, na.rm = T)))
}


#' Draw meanfield model attractor
#'
#' @param model
#' @param times
#' @param parms
#' @param method
#' @param rho
#' @param colors
#'
#' @import foreach
#'
#' @return
#' @export
#' @examples
#'
#' p <- set_parms(livestock$parms, set = list(b = 0.1, f = 0.5, p = 0.9, L = 1.5))
#' par(mfrow = c(1,2))
#' plot_pairapproximation(livestock, parms = p) -> out
#' plot_pairapproximation(out, parms = p, side = "plain")

plot_pairapproximation <- function(
  model,
  parms = model$parms,
  side = "rho",
  rho_1_ini = seq(0,1, length = 11),
  rho_11_ini = seq(0,1, length = 11),
  times = c(0,1000),
  method = "ode45",
  rho = seq(0,1,length = 100),
  colors = c("#000000","#009933"),
  #fog = TRUE,
  new = TRUE,
  ...
) {

  #par(mfrow = c(1,3))
  # open new base plot if none exists
  if(dev.cur() == 1 | new == TRUE) plot_base(ylim = switch(side, plain = c(0,1), c(0,0.25) ),
                                             ylab = switch(side, plain = "local cover", "plant mortality/growth" ),
                                             xlab = switch(side, q = "local cover","vegetation cover"), ...)

  # draw trajectories of mortality and growth
  if(class(model) == "attractor") {
    trajectories <- model$trajectories
  } else {
    trajectories <- sim_trajectories(model = model, parms = parms, rho_1_ini = rho_1_ini, times = times, method = method)
  }

  # visualize trajectories to the attractor
  sapply(trajectories, function(x){
    rho <- ini_rho(x$rho_1, x$rho_11)
    mort <- limit(mortality(rho, parms))
    grow <- limit(growth(rho, parms))
    q_11_vec <- q_11(rho)
    #fog_m <- highlight(q_11_vec, colrange = c(paste0(colors[1],"88"),colors[1]))
    #fog_g <- highlight(q_11_vec, colrange = c(paste0(colors[2],"88"),colors[2]))

    switch(side,
        rho = {
          lines(rho$rho_1,  mort)
          #arrows(tail(rho$rho_1,2)[1],tail(mort,2)[1],tail(rho$rho_1,1),tail(mort,1), length = 0.1 )
          lines(rho$rho_1, grow, col = "#009933")
          #arrows(tail(rho$rho_1,2)[1],tail(grow,2)[1],tail(rho$rho_1,1),tail(grow,1), length = 0.1 , col = "#009933")

          },
        q = {
          lines(q_11_vec,  mort)
          #arrows(tail(q_11_vec,2)[1],tail(mort,2)[1],tail(q_11_vec,1),tail(mort,1), length = 0.1 )
          lines(q_11_vec, grow, col = "#009933")
          #arrows(tail(q_11_vec,2)[1],tail(grow,2)[1],tail(q_11_vec,1),tail(grow,1), length = 0.1 , col = "#009933")

        },
        plain = {
          lines(rho$rho_1,  q_11_vec)
          #arrows(tail(rho$rho_1,2)[1],tail(q_11_vec,2)[1],tail(rho$rho_1,1),tail(q_11_vec,1), length = 0.1 )
          lines(rho$rho_1+0.002, q_11_vec+0.002, col = "#009933")
          #arrows(tail(rho$rho_1,2)[1],tail(q_11_vec,2)[1],tail(rho$rho_1,1),tail(q_11_vec,1), length = 0.1 , col = "#009933")

        }

    )

  }
  )

  if(class(model) == "attractor") {
    eq <- model$eq
  } else {
    eq <- get_equilibria(y = model$template, func = model$pair, parms = parms, method = method, t_max = 130)
  }

    rho_steady <- ini_rho(c(eq$lo[1],eq$hi[1]),c(eq$lo[2],eq$hi[2]))
  q_steady <- q_11(rho_steady)
  switch(side,
         rho = {
           points(rho_steady$rho_1, mortality(rho_steady, parms = parms), xpd = TRUE, pch = 20, cex = 2)

         },
         q = {
           points(q_steady, mortality(rho_steady, parms = parms), xpd = TRUE, pch = 20, cex = 2)

         },
         plain = {
           points(rho_steady$rho_1, q_steady, xpd = TRUE, pch = 20, cex = 2)

         }

  )

  output <- list(trajectories = trajectories,
                 eq = eq
                 )
  class(output) <- "attractor"
  return(output)

}


#' Plots segments on underlying point data
#'
#' @param segs  segment data
#' @param aes  ggplot mapping (required: y)
#' @param fml  formula for mapping between pts and segs
#' @param breaks  dashed line breaks indicating secondary axis
#' @param name  name of the secondary axis
#' @return  ggplot2 object
segs = function(segs, aes, fml, ..., breaks=NULL, name=waiver()) {
    if ("GRanges" %in% class(segs))
        segs = as.data.frame(segs)

    default_segs = aes(x=start, xend=end)
    default_segs[['yend']] = aes[['y']]
    aes_segs = utils::modifyList(default_segs, aes)

    args = list(...)
    defaults = list(size=1.5, color="green")
    defaults = defaults[!names(defaults) %in% names(aes_segs)]
    args = utils::modifyList(defaults, args)

    fscale = eval(fml[[2]][[3]], envir=environment(fml))
    if (is.null(breaks) && nrow(segs) > 0)
        breaks = 1:ceiling(max(segs[[as.character(aes[['y']][[2]])]])/fscale)
    breaks = breaks * fscale

    list(geom_hline(yintercept=breaks, color="grey", linetype="dashed"),
         do.call(geom_segment, c(list(data=segs, mapping=aes_segs), args)),
         facet_grid(. ~ seqnames, scales="free_x"),
         scale_y_continuous(sec.axis=sec_axis(fml, breaks=breaks, name=name)))
}


# For use with baseballdatawrangling2.r

brett <- bavg %>%
  filter(batterid=='bretg001') %>%
  select(H,AB,RDate) %>%
  arrange(RDate) %>%
  mutate(Total_H=cumsum(H), Total_AB=cumsum(AB)) %>%
  mutate(AVG = round((Total_H / Total_AB),3)) %>%
  mutate(player='George Brett')


### tripsAndDip uses read counts for biallelic SNPS to determine if a sample is diploid or triploid
### Input
### counts is either a matrix or a dataframe with each row corresponding to a different sample
### the columns correspond to the read counts for each locus, in a two column per locus format
### So, column 1 is the read counts for locus1Allele1, column two is the read counts for locus1Allele2, locus2Allele1, locus2Allele2, ...
### the rownames of the matrix or dataframe should be the sample names
### h is a list of h values for each locus in the same order that the loci are ordered in counts
### eps is a list of epsilon (error rate per read) values for each locus in the same order that the loci are ordered in counts
### min_reads is the minimum number of reads needed to use a locus in the algorithm
### min_loci is the minimum number of loci needed to attempt to calculate an LLR
### Output
### a dataframe with column 1 containing sample names, column 2 containing calculated LLRs (larger means more likely triploid)
###    and column 3 containing the number of loci used to calculate the LLR
######
### note that constant values for h and epsilon can be easily implemented usign the rep() function in R, for example
###### constant_h <- rep(1, (ncol(allele_counts))/2)
###### constant_eps <- rep(.01, (ncol(allele_counts))/2)
###### results <- tripsAndDip(allele_counts, constant_h, constant_eps)

tripsAndDip <- function(counts, h, eps, min_reads = 30, min_loci = 15, binom_p_value = .05){
	### input error checking
	if(!is.matrix(counts) && !is.data.frame(counts)){
		cat("\nError. Counts must be either a matrix or a dataframe.\n")
		return()
	}
	if((ncol(counts)/2) != length(h)){
		cat("\nError. The number of columns of counts is not equal to twice the length of h.\n")
		return()
	}
	if(length(eps) != length(h)){
		cat("\nError. The length of h is not equal to the length of eps.\n")
		return()
	}
	if(min_reads < 1){
		cat("\nError. min_reads must be 1 or greater.\n")
		return()
	}
	if(min_loci < 1){
		cat("\nError. min_loci must be 1 or greater.\n")
		return()
	}
	if(binom_p_value < 0 || binom_p_value > 1){
		cat("\nError. binom_p_value must be between 0 and 1.\n")
		return()
	}

	### calculate llr for each sample
	num_counts <- ncol(counts)
	llr <- apply(counts, 1, function(x){
		#separate allele1 and allele2
		count1 <- x[seq(1, (num_counts - 1), 2)]
		count2 <- x[seq(2, num_counts, 2)]
		#caluculate total read count and which is larger
		n <- count1 + count2
		#determine whether to include loci based on read count
		count1 <- count1[n >= min_reads]
		count2 <- count2[n >= min_reads]
		h_corr <- h[n >= min_reads]
		eps_corr <- eps[n >= min_reads]
		n <- n[n >= min_reads]
		# determine if enough loci
		if (length(n) < min_loci){
			return(c(NA, length(n)))
		}

		k <- mapply(max, count1, count2)
		#flip h as necessary
		h_corr[count2 > count1] <- 1/h_corr[count2 > count1]

		#calculate probabilities
		#based on model with error and allelic bias from Gerard et al. 2018
		p_temp <- (0.6666667*(1 - eps_corr) + (0.3333333)*eps_corr)
		prob_trip <- p_temp / (h_corr*(1 - p_temp) + p_temp)
		p_temp <- 0.5 # (0.5*(1 - eps_corr) + (0.5)*eps_corr) simplifies to 0.5
		prob_dip <- p_temp / (h_corr*(1 - p_temp) + p_temp)

		#determine which loci to include using binomial test
		binom_results <- mapply(function(x,y,z){
				return(binom.test(x, y, z, "greater")$p.value)
			}, k, n, prob_trip)
		binom_results <- binom_results > binom_p_value

		h_corr <- h_corr[binom_results]
		eps_corr <- eps_corr[binom_results]
		n <- n[binom_results]
		k <- k[binom_results]
		prob_trip <- prob_trip[binom_results]
		prob_dip <- prob_dip[binom_results]
		# determine if enough loci
		if (length(n) < min_loci){
			return(c(NA, length(n)))
		}

		#calculate log likelihoods
		trip <- (k*log(prob_trip)) + ((n-k)*log(1-prob_trip))
		dip <- (k*log(prob_dip)) + ((n-k)*log(1-prob_dip))
		#sum accros loci
		trip <- sum(trip)
		dip <- sum(dip)

		return(c(trip - dip, length(n)))

	})
	# associate llr's with sample names and return
	return(data.frame(sample_name = rownames(counts),
			 LLR = llr[1,], loci_used=llr[2,], stringsAsFactors = F, row.names = NULL))
}


#' The ATA.BoxCoxAttr function works with many different types of inputs.
#'
#' @param bcMethod Choose method to be used in calculating lambda. "guerrero" (Guerrero, V.M. (1993) is default. Other method is "loglik").
#' @param bcLower Lower limit for possible lambda values. The lower value is limited by -5. Default value is 0.
#' @param bcUpper Upper limit for possible lambda values. The upper value is limited by 5. Default value is 5.
#' @param bcBiasAdj Use adjusted back-transformed mean for Box-Cox transformations.
#' If transformed data is used to produce forecasts and fitted values, a regular back transformation will result in median forecasts.
#' If bcBiasAdj is TRUE, an adjustment will be made to produce mean forecasts and fitted values.
#' If bcBiasAdj=TRUE. Can either be the forecast variance, or a list containing the interval \code{level}, the corresponding \code{upper} and \code{lower} intervals.
#'
#' @return An object of class \code{ataoptim}.
#'
#' @author Ali Sabri Taylan and Hanife Taylan Selamlar
#'
#' @seealso \code{\link{BoxCox}}, \code{\link{InvBoxCox}}, \code{\link{BoxCox.lambda}}
#'
#' @references
#'
#' #'\insertRef{boxcox1964}{ATAforecasting}
#'
#' #'\insertRef{guerrero1993}{ATAforecasting}
#'
#'
#'
#' @export
ATA.BoxCoxAttr <- function(bcMethod = "guerrero", bcLower = 0, bcUpper = 5, bcBiasAdj = FALSE)
{
  if ((bcMethod != "guerrero" & bcMethod != "loglik") | !is.character(bcMethod)){
    warning("Selected method for calculating lambda must be string. guerrero or loglik for calculating lambda.")
    bcMethod <- "guerrero"
  }
  if(bcLower < 0){
    warning("Specified lower value is less than the minimum, setting bcLower=0")
    bcLower <- 0
  }else if(bcUpper > 5){
    warning("Specified upper value is larger than the maximum, setting bcUpper=5")
    bcUpper <- 5
  }
  if (!is.logical(bcBiasAdj)) {
    warning("bcBiasAdj information not found, defaulting to FALSE.")
    biasadj <- FALSE
  }
  mylist <- list("bcMethod"=bcMethod, "bcLower"=bcLower, "bcUpper"=bcUpper, "bcBiasAdj"=bcBiasAdj)
  attr(mylist, "class") <- "ataoptim"
  return(mylist)
}


Square <- function(x) {
      return(x^2)
}

cat("R program running")
print(Square(4))

while (TRUE) {
    Sys.sleep(3)
}


library(Cairo)
library(ape)

treefiles = dir()
treefiles = treefiles[grep('(phylip|nexus)',treefiles)]

CairoSVG( 'trees.svg', width=3*length(treefiles),height=3)
par(mfrow=c(1,length(treefiles)))
for( treefile in treefiles ){
  outname = gsub('(phylip|nexus)','svg',treefile)
  tree    = read.tree( file=treefile )

  plot( tree )

}
dev.off()


mnum=40000
ooi<-"NC_000913"
mRNA_only<-TRUE

da<-read.csv("CopraRNA2_prep_anno_addhomologs_padj_amountsamp.csv") ## edit prw changed file name
options <- read.table("CopraRNA_option_file.txt", sep=":")
root<-as.numeric(as.character(options[14,2]))

en<-grep("Annotation", colnames(da))
da2<-da[,3:(en-1)]
namegenomes<-colnames(da2)
genomes<-list()

myfun<-function(da2){
	int_table<-gsub("^([^\\|]*\\|[^\\|]*\\|)", "",da2)
	int_table<-gsub("\\|.*","",int_table)
	int_table
}

int_table<-apply(da2, 2, myfun)

int_table<-matrix(as.numeric(int_table),nrow(int_table),ncol(int_table))
colnames(int_table)<-colnames(da2)
rownames(int_table)<-seq(1,nrow(int_table))

weight<-read.csv("zscore.weight", header=F, sep=";")

weight<-weight[ match(colnames(da2),toupper(weight[,1])),]

if(root==0){
	weight[,2]<-1
}

if(root>0){
	weight[,2]<-weight[,2]^(1/root)
}

qtrans<-function(dat2){
		if(is(dat2)[1]=="numeric"){
			dat2<-matrix(dat2,1,length(dat2))
		}
        for(i in 1:ncol(dat2)){
                dat2[,i]<-qnorm(dat2[,i], lower.tail=FALSE)
        }
        dat2
}

if(ooi_close_analysis==TRUE){

mnum<-40000
if(chooseclose==TRUE){
	close_name_vector<-c()
}

if(auto_close==TRUE){
	command<-paste("clustalo -i ", "input_sRNA.fa", " --distmat-out=distmatout.txt --full --percent-id --output-order=input-order --force --max-hmm-iterations=-1", sep="")
	system(command)
	temp<-read.delim("distmatout.txt",sep="",header=F, , skip=1)
	unlink("distmatout.txt")
	na<-temp[,1]
	temp<-temp[,2:ncol(temp)]
	colnames(temp)<-na
	rownames(temp)<-na
	ooi_pos<-grep(ooi, colnames(temp))
	ooi_col<-temp[,ooi_pos]
	names(ooi_col)<-na
	ooi_col<-sort(ooi_col,decreasing = TRUE)
	num<-floor(length(ooi_col)*close)
	ooi_col<-ooi_col[1:4]
}

load("conservation_table.Rdata")

con_table<-conservation_table[[3]]
con_table_sub<-conservation_table[[4]]

p_table<-con_table
p_table[]<-NA

mRNA_test<-function(x){
	out<-NA
	if(is.na(x[1])==F){
		if(length(x)==4){
			if(x[2]=="TRUE"){
				out<-as.numeric(x[1])
			}
		}
	}
	out
}
mRNA_and_sRNA_test<-function(x){
	out<-NA
	if(is.na(x[1])==F){
	if(length(x)==4){
		if(x[2]=="TRUE"){
			if(x[3]=="TRUE" | x[4]=="TRUE"){
				out<-as.numeric(x[1])
			}
		}
	}
	}
	out
}

for(i in 1:nrow(p_table)){

	if(mRNA_only==TRUE){
		con_temp<-con_table[i,]
		con_temp<-strsplit(con_temp, "\\|")
		con_temp_sub<-con_table_sub[i,]
		con_temp_sub<-strsplit(con_temp_sub, "\\|")
		con_temp<-unlist(lapply(con_temp,mRNA_test))
		con_temp_sub<-unlist(lapply(con_temp_sub,mRNA_test))
		na<-which(is.na(con_temp))
		if(length(na)>0){
			con_temp[na]<-con_temp_sub[na]
		}

		p_table[i,]<-con_temp
	}

	if(mRNA_only==FALSE){
		con_temp<-con_table[i,]
		con_temp<-strsplit(con_temp, "\\|")
		con_temp_sub<-con_table_sub[i,]
		con_temp_sub<-strsplit(con_temp_sub, "\\|")
		con_temp<-unlist(lapply(con_temp,mRNA_and_sRNA_test))
		con_temp_sub<-unlist(lapply(con_temp_sub,mRNA_and_sRNA_test))
		na<-which(is.na(con_temp))
		if(length(na)>0){
			con_temp[na]<-con_temp_sub[na]
		}

		p_table[i,]<-con_temp
	}
}
nan<-colnames(p_table)
p_table<-matrix(as.numeric(p_table),nrow(p_table),ncol(p_table))
colnames(p_table)<-nan

close_pos<-match(names(ooi_col),colnames(p_table))
p_table<-p_table[,close_pos]

posvec<-rep(NA,10^7)
vari<-rep(NA,10^7)
count<-0
for(i in 1:nrow(p_table)){
	temp<-order(p_table[i,], na.last=NA)

	if(length(temp)>2){
		for(j in 1:(length(temp)-2)){
			count<-count+1
			vari[count]<-paste(sort(temp[1:(j+2)]), collapse="_")
			posvec[count]<-i
		}
	}
}

vari<-na.omit(vari)
posvec<-na.omit(posvec)
dups<-which(duplicated(vari))
first_occurence<-match(vari[dups], vari)
posvec2<-posvec

for(i in 1:length(dups)){
	posvec2[first_occurence[i]]<-paste(posvec2[first_occurence[i]],posvec[dups[i]], sep="_")

}
posvec2<-posvec2[-dups]
vari<-unique(vari)

spa<-floor(length(vari)/mnum)
print(length(vari))
rest<-length(vari)-(mnum*spa)
spal<-rep(mnum,spa)
if(rest>0){
spa<-spa+1
spal<-c(spal,rest)
}

ooilist<-rep((list(rep(NA,nrow(int_table)))), spa)

na<-paste("_",vari,"_",sep="")
count<-1
ooi_pos<-grep(ooi, colnames(p_table))
for(jj in 1:spa){

out<-rep((list(rep(NA,nrow(int_table)))), spal[jj])

for(i in count:(count+spal[jj]-1)){

	temp1<-as.numeric(strsplit(vari[i],"_")[[1]])
	temp<-na.omit(int_table[,temp1])
	wtemp<-weight[temp1,2]
	position<-as.numeric(strsplit(posvec2[i],"_")[[1]])
	print(i)
	dat2<-qtrans(temp)
    a<-rowSums(t(t(dat2)*wtemp))
    b<-sum(wtemp)^2
    d<-sum(wtemp^2)
	l<-length(a)
    k<-1/l
	y<-k * seq(1,l)
    dat3<-data.frame(y,a,d,b)

	rhotemp<-coef(nls(y~sort(pnorm(a/sqrt((1-rho)*d+rho*b), lower.tail=F)), data=dat3, start=list(rho=0), control=list(minFactor = 1/128, tol = 1e-05, warnOnly = TRUE)))

	temp<-na.omit(p_table[position,temp1])
	wtemp<-weight[temp1,2]
	position<-as.numeric(strsplit(posvec2[i],"_")[[1]])

	dat2<-qtrans(temp)
    a<-rowSums(t(t(dat2)*wtemp))
    b<-sum(wtemp)^2
    d<-sum(wtemp^2)

	out[[i-count+1]][position]<-pnorm(a/sqrt((1-rhotemp)*d+rhotemp*b),lower.tail=F)

}
	names(out)<-na[count:(count+spal[jj]-1)]
	save(out, file=paste("ooi_ooi_cons_full_table_",jj,".Rdata",sep=""))
	temp<-grep(paste("_",ooi_pos,"_",sep=""), na[count:(count+spal[jj]-1)])
	if(length(temp)>0){
	ooilist[[jj]]<-do.call(pmin, c(out[temp],list(na.rm=T)))
	}

count<-count+spal[jj]

}
################################

out_ooi<-do.call(pmin, c(ooilist,list(na.rm=T)))

out_ooi_fdr<-p.adjust(out_ooi, method="BH")
out_ooi<-cbind(out_ooi_fdr,out_ooi)
colnames(out_ooi)<-c("fdr","p-value")
out_ooi<-cbind(out_ooi, da[,3:ncol(da)])

initial_sorting<-seq(1,nrow(p_table))
out_ooi<-cbind(out_ooi, initial_sorting)
out_ooi<-out_ooi[order(as.numeric(out_ooi[,2])),]

write.table(out_ooi, file="ooi_ooi_cons_close_orgs.csv",sep=",", quote=F, row.names=F)

}