library(GenomicFeatures)
library(ggplot2)
library(GenomicRanges)
library(bumphunter)
library(data.table)
library(VennDiagram)
library("limma")
library("edgeR")

load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/DMV_gene_comps.rda")
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/sorted_nuclear_RNA/DE_limma_results_objects.rda", verbose=T)
load("/dcl01/lieber/ajaffe/CellSorting/RNAseq_pipeline/rawCounts_CellSorting_July5_n12.rda")
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/homogenate_RNA/DE_limma_results_homogenateRNAseq.rda", verbose=T)
load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/brainseq_pipeline/polyA_unstranded/rse_gene_polyA_dlpfc_n41.Rdata", verbose = T)

## Format pd objects

hompd = colData(rse_gene)
metrics[grep("12", metrics$SampleID),"Age"] = 0.36
metrics[grep("13", metrics$SampleID),"Age"] = 14.01
metrics[grep("14", metrics$SampleID),"Age"] = 2.71
metrics$CellType = ifelse(metrics$NeuN=="NeuN_Minus", "Glia", "Neuron")

# format counts

prenCounts = assay(rse_gene)
prenMap = rowData(rse_gene)
identical(rownames(prenCounts), rownames(geneCounts))

polyaCounts = geneCounts[,grep("PolyA", colnames(geneCounts))]
riboCounts = geneCounts[,grep("Ribo", colnames(geneCounts))]
combinedCounts = polyaCounts + riboCounts

ctCounts = cbind(combinedCounts, prenCounts[,colnames(prenCounts) %in% rownames(hompd[hompd$Age<0,])])

newpd = rbind(data.frame(sampleID = rownames(metrics[grep("PolyA",rownames(metrics)),]), CellType = metrics[grep("PolyA",rownames(metrics)),"CellType"],
                         Age = metrics[grep("PolyA",rownames(metrics)),"Age"]),
              data.frame(sampleID = rownames(hompd[hompd$Age<0,]), CellType = "Prenatal", Age = hompd[hompd$Age<0,"Age"]))
newpd = newpd[order(newpd$sampleID),]
newpd$CellType = factor(newpd$CellType, levels = c("Prenatal","Glia","Neuron"))
ctCounts = ctCounts[,order(colnames(ctCounts))]
rownames(newpd) = newpd$sampleID
ctCounts = ctCounts[rowSums(ctCounts)>0,]

hompd = hompd[hompd$Age>0,]
hompd[hompd$Age<1,"Age.Bin"] = "Infant"
hompd[hompd$Age>=1 & hompd$Age<=12,"Age.Bin"] = "Child"
hompd[hompd$Age>12 & hompd$Age<=17,"Age.Bin"] = "Teen"
hompd[hompd$Age>17,"Age.Bin"] = "Adult"
hompd$Age.Bin = factor(hompd$Age.Bin, levels = c("Infant","Child","Teen","Adult"))
geneCounts = prenCounts[,colnames(prenCounts) %in% rownames(hompd)]
geneCounts = geneCounts[rowSums(geneCounts)>0,]

## Differential expression

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/DMV_gene_expr.pdf")

newpd$CellType = factor(newpd$CellType, levels = c("Prenatal","Glia","Neuron"))
design <- model.matrix(~ newpd$CellType)
dge <- DGEList(counts = ctCounts)
dge <- calcNormFactors(dge)
dat <- voom(dge, design, plot = TRUE)
fit_gene_ct <- lmFit(dat, design)
fit_gene_ct <- eBayes(fit_gene_ct)
newpd$CellType = factor(newpd$CellType, levels = c("Neuron","Prenatal","Glia"))
design <- model.matrix(~ newpd$CellType)
dge <- DGEList(counts = ctCounts)
dge <- calcNormFactors(dge)
dat <- voom(dge, design, plot = TRUE)
fit_gene_ct2 <- lmFit(dat, design)
fit_gene_ct2 <- eBayes(fit_gene_ct2)
hompd$Age.Bin = factor(hompd$Age.Bin, levels = c("Infant","Child","Teen","Adult"))
design <- model.matrix(~ hompd$Age.Bin)
dge <- DGEList(counts = geneCounts)
dge <- calcNormFactors(dge)
dat <- voom(dge, design, plot = TRUE)
fit_gene_age <- lmFit(dat, design)
fit_gene_age <- eBayes(fit_gene_age)
hompd$Age.Bin = factor(hompd$Age.Bin, levels = c("Adult","Infant","Child","Teen"))
design <- model.matrix(~ hompd$Age.Bin)
dge <- DGEList(counts = geneCounts)
dge <- calcNormFactors(dge)
dat <- voom(dge, design, plot = TRUE)
fit_gene_age2 <- lmFit(dat, design)
fit_gene_age2 <- eBayes(fit_gene_age2)
hompd$Age.Bin = factor(hompd$Age.Bin, levels = c("Child","Adult","Infant","Teen"))
design <- model.matrix(~ hompd$Age.Bin)
dge <- DGEList(counts = geneCounts)
dge <- calcNormFactors(dge)
dat <- voom(dge, design, plot = TRUE)
fit_gene_age3 <- lmFit(dat, design)
fit_gene_age3 <- eBayes(fit_gene_age3)
dev.off()

## Make results objects

ageRNAres = as.data.frame(cbind(fit_gene_age$coefficients, fit_gene_age$t, fit_gene_age$p.value,
                                fit_gene_age2$coefficients, fit_gene_age2$t, fit_gene_age2$p.value,
                                fit_gene_age3$coefficients, fit_gene_age3$t, fit_gene_age3$p.value))
ageRNAres = ageRNAres[,-grep("Intercept", colnames(ageRNAres))]
colnames(ageRNAres) = c("Coeff.Infant.Child", "Coeff.Infant.Teen", "Coeff.Infant.Adult", "Tstat.Infant.Child", "Tstat.Infant.Teen", "Tstat.Infant.Adult",
                        "pval.Infant.Child",  "pval.Infant.Teen",   "pval.Infant.Adult", "Coeff.Adult.Infant",   "Coeff.Adult.Child",  "Coeff.Adult.Teen",
                        "Tstat.Adult.Infant", "Tstat.Adult.Child",  "Tstat.Adult.Teen", "pval.Adult.Infant", "pval.Adult.Child",  "pval.Adult.Teen",
                        "Coeff.Child.Adult",  "Coeff.Child.Infant", "Coeff.Child.Teen", "Tstat.Child.Adult",  "Tstat.Child.Infant", "Tstat.Child.Teen",
                        "pval.Child.Adult",  "pval.Child.Infant", "pval.Child.Teen")
ageRNAres = ageRNAres[,colnames(ageRNAres) %in% c("Coeff.Infant.Child", "Coeff.Infant.Teen", "Coeff.Infant.Adult", "Tstat.Infant.Child",
                                                  "Tstat.Infant.Teen", "Tstat.Infant.Adult","pval.Infant.Child",  "pval.Infant.Teen",
                                                  "pval.Infant.Adult", "Coeff.Adult.Child", "Coeff.Adult.Teen",
                                                  "Tstat.Adult.Child", "Tstat.Adult.Teen", "pval.Adult.Child", "pval.Adult.Teen",
                                                  "Coeff.Child.Teen", "Tstat.Child.Teen", "pval.Child.Teen")]
ageRNAres$FDR.Infant.Child = p.adjust(ageRNAres$pval.Infant.Child, method = "fdr")
ageRNAres$FDR.Infant.Teen = p.adjust(ageRNAres$pval.Infant.Teen, method = "fdr")
ageRNAres$FDR.Infant.Adult = p.adjust(ageRNAres$pval.Infant.Adult, method = "fdr")
ageRNAres$FDR.Adult.Child = p.adjust(ageRNAres$pval.Adult.Child, method = "fdr")
ageRNAres$FDR.Adult.Teen = p.adjust(ageRNAres$pval.Adult.Teen, method = "fdr")
ageRNAres$FDR.Child.Teen = p.adjust(ageRNAres$pval.Child.Teen, method = "fdr")
ageRNAres$gencodeID = rownames(ageRNAres)

ctRNAres = as.data.frame(cbind(fit_gene_ct$coefficients, fit_gene_ct$t, fit_gene_ct$p.value,
                               fit_gene_ct2$coefficients, fit_gene_ct2$t, fit_gene_ct2$p.value))
ctRNAres = ctRNAres[,-grep("Intercept", colnames(ctRNAres))]
colnames(ctRNAres) = c("Coeff.Prenatal.Glia","Coeff.Prenatal.Neuron", "Tstat.Prenatal.Glia", "Tstat.Prenatal.Neuron",
                        "pval.Prenatal.Glia",  "pval.Prenatal.Neuron", "Coeff.Neuron.Prenatal", "Coeff.Neuron.Glia",
                        "Tstat.Neuron.Prenatal", "Tstat.Neuron.Glia", "pval.Neuron.Prenatal", "pval.Neuron.Glia")
ctRNAres = ctRNAres[,colnames(ctRNAres) %in% c("Coeff.Prenatal.Glia","Coeff.Prenatal.Neuron", "Tstat.Prenatal.Glia", "Tstat.Prenatal.Neuron",
                                               "pval.Prenatal.Glia",  "pval.Prenatal.Neuron", "Coeff.Neuron.Glia",
                                               "Tstat.Neuron.Glia", "pval.Neuron.Glia")]
ctRNAres$FDR.Prenatal.Glia = p.adjust(ctRNAres$pval.Prenatal.Glia, method = "fdr")
ctRNAres$FDR.Prenatal.Neuron = p.adjust(ctRNAres$pval.Prenatal.Neuron, method = "fdr")
ctRNAres$FDR.Neuron.Glia = p.adjust(ctRNAres$pval.Neuron.Glia, method = "fdr")
ctRNAres$gencodeID = rownames(ctRNAres)

## Associate with gene expression

DMV.CTcomps = Map(cbind, lapply(DMV.CTcomps, function(x) x[,1:13]), lapply(DMV.CTcomps, function(x) ctRNAres[match(x$gencodeID, ctRNAres$gencodeID),]))
elementNROWS(DMV.CTcomps)
CT = do.call(rbind, list(PnotN = data.frame(Comp = "PnotN", tstat = DMV.CTcomps$PnotN$Tstat.Prenatal.Neuron, fdr = DMV.CTcomps$PnotN$pval.Prenatal.Neuron),
                         NnotP = data.frame(Comp = "NnotP", tstat = -(DMV.CTcomps$NnotP$Tstat.Prenatal.Neuron), fdr = DMV.CTcomps$NnotP$pval.Prenatal.Neuron),
                         PnotG = data.frame(Comp = "PnotG", tstat = DMV.CTcomps$PnotG$Tstat.Prenatal.Glia, fdr = DMV.CTcomps$PnotG$pval.Prenatal.Glia),
                         GnotP = data.frame(Comp = "GnotP", tstat = -(DMV.CTcomps$GnotP$Tstat.Prenatal.Glia), fdr = DMV.CTcomps$GnotP$pval.Prenatal.Glia),
                         GnotN = data.frame(Comp = "GnotN", tstat = -(DMV.CTcomps$GnotN$Tstat.Neuron.Glia), fdr = DMV.CTcomps$GnotN$pval.Neuron.Glia),
                         NnotG = data.frame(Comp = "NnotG", tstat = DMV.CTcomps$NnotG$Tstat.Neuron.Glia, fdr = DMV.CTcomps$NnotG$pval.Neuron.Glia)))
CT$Sig = ifelse(CT$fdr<=0.05,"FDR<0.05","FDR>0.05")

# Genes that are escaping the DMV state (likely accumulating DNAm) are higher expressed in the cell type in which the gene escapes

DMV.Agecomps = Map(cbind, lapply(DMV.Agecomps, function(x) x[,1:13]), lapply(DMV.Agecomps, function(x) ageRNAres[match(x$gencodeID, ageRNAres$gencodeID),]))
elementNROWS(DMV.Agecomps)
AgeN = do.call(rbind, list(InotC = data.frame(Comp = "InotC", tstat = DMV.Agecomps$InotC$Tstat.Infant.Child, fdr = DMV.Agecomps$InotC$pval.Infant.Child),
                           CnotI = data.frame(Comp = "CnotI", tstat = -(DMV.Agecomps$CnotI$Tstat.Infant.Child), fdr = DMV.Agecomps$CnotI$pval.Infant.Child),
                           InotT = data.frame(Comp = "InotT", tstat = DMV.Agecomps$InotT$Tstat.Infant.Teen, fdr = DMV.Agecomps$InotT$pval.Infant.Teen),
                           TnotI = data.frame(Comp = "TnotI", tstat = -(DMV.Agecomps$TnotI$Tstat.Infant.Teen), fdr = DMV.Agecomps$TnotI$pval.Infant.Teen),
                           InotA = data.frame(Comp = "InotA", tstat = DMV.Agecomps$InotA$Tstat.Infant.Adult, fdr = DMV.Agecomps$InotA$pval.Infant.Adult),
                           AnotI = data.frame(Comp = "AnotI", tstat = -(DMV.Agecomps$AnotI$Tstat.Infant.Adult), fdr = DMV.Agecomps$AnotI$pval.Infant.Adult),
                           CnotT = data.frame(Comp = "CnotT", tstat = DMV.Agecomps$CnotT$Tstat.Child.Teen, fdr = DMV.Agecomps$CnotT$pval.Child.Teen),
                           TnotC = data.frame(Comp = "TnotC", tstat = -(DMV.Agecomps$TnotC$Tstat.Child.Teen), fdr = DMV.Agecomps$TnotC$pval.Child.Teen),
                           CnotA = data.frame(Comp = "CnotA", tstat = -(DMV.Agecomps$CnotA$Tstat.Adult.Child), fdr = DMV.Agecomps$CnotA$pval.Adult.Child),
                           AnotC = data.frame(Comp = "AnotC", tstat = DMV.Agecomps$AnotC$Tstat.Adult.Child, fdr = DMV.Agecomps$AnotC$pval.Adult.Child),
                           TnotA = data.frame(Comp = "TnotA", tstat = -(DMV.Agecomps$TnotA$Tstat.Adult.Teen), fdr = DMV.Agecomps$TnotA$pval.Adult.Teen),
                           AnotT = data.frame(Comp = "AnotT", tstat = DMV.Agecomps$AnotT$Tstat.Adult.Teen, fdr = DMV.Agecomps$AnotT$pval.Adult.Teen)))
AgeN$Sig = ifelse(AgeN$fdr<=0.05,"FDR<0.05","FDR>0.05")

DMV.AgecompsG = Map(cbind, lapply(DMV.AgecompsG, function(x) x[,1:13]), lapply(DMV.AgecompsG, function(x) ageRNAres[match(x$gencodeID, ageRNAres$gencodeID),]))
elementNROWS(DMV.AgecompsG)
AgeG = do.call(rbind, list(InotC = data.frame(Comp = "InotC", tstat = DMV.AgecompsG$InotC$Tstat.Infant.Child, fdr = DMV.AgecompsG$InotC$pval.Infant.Child),
                           CnotI = data.frame(Comp = "CnotI", tstat = -(DMV.AgecompsG$CnotI$Tstat.Infant.Child), fdr = DMV.AgecompsG$CnotI$pval.Infant.Child),
                           InotT = data.frame(Comp = "InotT", tstat = DMV.AgecompsG$InotT$Tstat.Infant.Teen, fdr = DMV.AgecompsG$InotT$pval.Infant.Teen),
                           TnotI = data.frame(Comp = "TnotI", tstat = -(DMV.AgecompsG$TnotI$Tstat.Infant.Teen), fdr = DMV.AgecompsG$TnotI$pval.Infant.Teen),
                           InotA = data.frame(Comp = "InotA", tstat = DMV.AgecompsG$InotA$Tstat.Infant.Adult, fdr = DMV.AgecompsG$InotA$pval.Infant.Adult),
                           AnotI = data.frame(Comp = "AnotI", tstat = -(DMV.AgecompsG$AnotI$Tstat.Infant.Adult), fdr = DMV.AgecompsG$AnotI$pval.Infant.Adult),
                           CnotT = data.frame(Comp = "CnotT", tstat = DMV.AgecompsG$CnotT$Tstat.Child.Teen, fdr = DMV.AgecompsG$CnotT$pval.Child.Teen),
                           TnotC = data.frame(Comp = "TnotC", tstat = -(DMV.AgecompsG$TnotC$Tstat.Child.Teen), fdr = DMV.AgecompsG$TnotC$pval.Child.Teen),
                           CnotA = data.frame(Comp = "CnotA", tstat = -(DMV.AgecompsG$CnotA$Tstat.Adult.Child), fdr = DMV.AgecompsG$CnotA$pval.Adult.Child),
                           AnotC = data.frame(Comp = "AnotC", tstat = DMV.AgecompsG$AnotC$Tstat.Adult.Child, fdr = DMV.AgecompsG$AnotC$pval.Adult.Child),
                           TnotA = data.frame(Comp = "TnotA", tstat = -(DMV.AgecompsG$TnotA$Tstat.Adult.Teen), fdr = DMV.AgecompsG$TnotA$pval.Adult.Teen),
                           AnotT = data.frame(Comp = "AnotT", tstat = DMV.AgecompsG$AnotT$Tstat.Adult.Teen, fdr = DMV.AgecompsG$AnotT$pval.Adult.Teen)))
AgeG$Sig = ifelse(AgeG$fdr<=0.05,"FDR<0.05","FDR>0.05")

expr = rbind(cbind(CT, Model = "Cell Type"), cbind(AgeN, Model = "Neurons"), cbind(AgeG, Model = "Glia"))
write.csv(expr, quote=F, file = "/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/DMV_gene_expression.csv")

expr = read.csv("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/DMV_gene_expression.csv")
expr$Model = factor(expr$Model, levels = c("Cell Type", "Glia", "Neurons"))

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/DMV_gene_expression.pdf",
    height=4.75, width = 6)
ggplot(expr[which(expr$Model=="Cell Type" & expr$fdr<=0.05),],
       aes(x = Comp, y = tstat)) + geom_boxplot() +
  scale_fill_brewer(8, palette="Dark2") +
  labs(fill="") + geom_hline(yintercept=0, linetype="dotted") +
  ylab("T Statistic") + xlab("") +
  ggtitle("DMV Gene Expression Enrichment") +
  theme(title = element_text(size = 20),
        text = element_text(size = 20))

ggplot(expr[which(expr$Model!="Cell Type" & expr$fdr<=0.05),],
       aes(x = Comp, y = tstat, fill = Model)) + geom_boxplot() +
  facet_grid(Model ~ .) + guides(fill=FALSE) +
  labs(fill="") + geom_hline(yintercept=0, linetype="dotted") +
  ylab("T Statistic") + xlab("") + scale_fill_brewer(8, palette="Dark2") +
  ggtitle("DMV Gene Expression Enrichment") +
  theme(title = element_text(size = 20), text = element_text(size = 20),
        axis.text.x = element_text(angle = 25, hjust = 1))
dev.off()

table(expr[which(expr$Model=="Cell Type"),"fdr"]<=0.05)
#FALSE  TRUE
# 8484 19290

table(expr[which(expr$Model=="Neurons"),"fdr"]<=0.05)
#FALSE  TRUE
# 3530  1086
1086/(1086+3530) # 0.2352686

table(expr[which(expr$Model=="Glia"),"fdr"]<=0.05)
#FALSE  TRUE
# 3779  1043
1043/(1043+3779) # 0.2163003

## How does this relate to DNAm at these genes?

load('/dcl01/lieber/ajaffe/lab/brain-epigenomics/bsseq/bsobj_by_chr/allChrs_postNatal_cleaned_nonCG_noHomogenate_highCov.Rdata')
BSobj_ch = BSobj
meth_ch = getMeth(BSobj_ch, type = 'raw')
methMap_ch = granges(BSobj_ch)

load('/dcl01/lieber/ajaffe/lab/brain-epigenomics/bumphunting/BSobj_bsseqSmooth_Neuron_minCov_3.Rdata')
postpd = pData(BSobj)
postpd$Race[postpd$Race== "CAUC "] <- 'CAUC'
postpd$Sex[postpd$Sex == " M"] <- 'M'
postpd$RIN <- as.numeric(gsub(" ", "", postpd$RIN))
postpd$pg.DNA.nuclei.input <- as.numeric(postpd$pg.DNA.nuclei.input)
postpd$Reads <- as.numeric(postpd$Reads)
postpd$Percent.GreaterThan.Q30 <- as.numeric(postpd$Percent.GreaterThan.Q30)
meth =getMeth(BSobj, type = 'raw')
methMap = granges(BSobj)

## CpG

ids = lapply(c(DMV.CTcomps,DMV.Agecomps,DMV.AgecompsG), function(x) paste0(x$Chr,":",x$Start,"-",x$End,":",x$Strand))
ids = lapply(ids, function(x) GRanges(x[which(x != "NA:NA-NA:NA")]))
oo = lapply(ids, function(x) findOverlaps(x, methMap))

meanMeth = lapply(oo, function(x) do.call("rbind", lapply(split(subjectHits(x), factor(queryHits(x))), function(ii) colMeans(t(t(meth[ii,]))))))
meanMeth = lapply(meanMeth, reshape2::melt)

tstat.CT = list(PnotN.NnotP = t.test(meanMeth$GnotN[meanMeth$GnotN$Var2 %in% pd[pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                     meanMeth$NnotG[meanMeth$NnotG$Var2 %in% pd[pd$Cell.Type=="Glia","Data.ID"],"value"]),
                PnotG.GnotP = t.test(meanMeth$GnotN[meanMeth$GnotN$Var2 %in% pd[pd$Cell.Type=="Glia","Data.ID"],"value"],
                                     meanMeth$NnotG[meanMeth$NnotG$Var2 %in% pd[pd$Cell.Type=="Glia","Data.ID"],"value"]),
                GnotN.NnotG = t.test(meanMeth$GnotN[meanMeth$GnotN$Var2 %in% pd[pd$Cell.Type=="Glia","Data.ID"],"value"],
                                     meanMeth$NnotG[meanMeth$NnotG$Var2 %in% pd[pd$Cell.Type=="Neuron","Data.ID"],"value"]))
ct = data.frame(Tstat = unlist(lapply(tstat.CT, function(x) x$statistic)), mean1 = unlist(lapply(tstat.CT, function(x) x$estimate[1])),
                mean2 = unlist(lapply(tstat.CT, function(x) x$estimate[2])), pval = unlist(lapply(tstat.CT, function(x) x$p.value)), comps = names(tstat.CT), row.names = NULL)

names(meanMeth)[29:46] = paste0(names(meanMeth)[29:46],".G")
tstat.N = list(InotC.CnotI = t.test(meanMeth$InotC[meanMeth$InotC$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth$CnotI[meanMeth$CnotI$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Neuron","Data.ID"],"value"]),
               InotT.TnotI = t.test(meanMeth$InotT[meanMeth$InotT$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth$TnotI[meanMeth$TnotI$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Neuron","Data.ID"],"value"]),
               InotA.AnotI = t.test(meanMeth$InotA[meanMeth$InotA$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth$AnotI[meanMeth$AnotI$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Neuron","Data.ID"],"value"]),
               CnotT.TnotC = t.test(meanMeth$CnotT[meanMeth$CnotT$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth$TnotC[meanMeth$TnotC$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Neuron","Data.ID"],"value"]),
               CnotA.AnotC = t.test(meanMeth$CnotA[meanMeth$CnotA$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth$AnotC[meanMeth$AnotC$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Neuron","Data.ID"],"value"]),
               TnotA.AnotT = t.test(meanMeth$TnotA[meanMeth$TnotA$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth$AnotT[meanMeth$AnotT$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Neuron","Data.ID"],"value"]))
neuro = data.frame(Tstat = unlist(lapply(tstat.N, function(x) x$statistic)), mean1 = unlist(lapply(tstat.N, function(x) x$estimate[1])),
                   mean2 = unlist(lapply(tstat.N, function(x) x$estimate[2])), pval = unlist(lapply(tstat.N, function(x) x$p.value)), comps = names(tstat.N), row.names = NULL)

tstat.G = list(InotC.CnotI = t.test(meanMeth$InotC.G[meanMeth$InotC.G$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth$CnotI.G[meanMeth$CnotI.G$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Glia","Data.ID"],"value"]),
               InotT.TnotI = t.test(meanMeth$InotT.G[meanMeth$InotT.G$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth$TnotI.G[meanMeth$TnotI.G$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Glia","Data.ID"],"value"]),
               InotA.AnotI = t.test(meanMeth$InotA.G[meanMeth$InotA.G$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth$AnotI.G[meanMeth$AnotI.G$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Glia","Data.ID"],"value"]),
               CnotT.TnotC = t.test(meanMeth$CnotT.G[meanMeth$CnotT.G$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth$TnotC.G[meanMeth$TnotC.G$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Glia","Data.ID"],"value"]),
               CnotA.AnotC = t.test(meanMeth$CnotA.G[meanMeth$CnotA.G$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth$AnotC.G[meanMeth$AnotC.G$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Glia","Data.ID"],"value"]),
               TnotA.AnotT = t.test(meanMeth$TnotA.G[meanMeth$TnotA.G$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth$AnotT.G[meanMeth$AnotT.G$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Glia","Data.ID"],"value"]))
gli = data.frame(Tstat = unlist(lapply(tstat.G, function(x) x$statistic)), mean1 = unlist(lapply(tstat.G, function(x) x$estimate[1])),
                 mean2 = unlist(lapply(tstat.G, function(x) x$estimate[2])), pval = unlist(lapply(tstat.G, function(x) x$p.value)), comps = names(tstat.G), row.names = NULL)

dfCG = rbind(cbind(neuro, Comp = "Neurons Age"), cbind(gli, Comp = "Glia Age"), cbind(ct, Comp = "Cell Type"))

## CpH

ids = lapply(c(DMV.CTcomps,DMV.Agecomps,DMV.AgecompsG), function(x) paste0(x$Chr,":",x$Start,"-",x$End,":",x$Strand))
ids = lapply(ids, function(x) GRanges(x[which(x != "NA:NA-NA:NA")]))
oo_ch = lapply(ids, function(x) findOverlaps(x, methMap_ch))
meanMeth_ch = lapply(oo_ch, function(x) do.call("rbind", lapply(split(subjectHits(x), factor(queryHits(x), levels=1:length(unique(queryHits(x))))),
                                                                function(ii) colMeans(t(t(meth_ch[ii,]))))))
meanMeth_ch = lapply(meanMeth_ch, reshape2::melt)

GnotN.NnotG = t.test(meanMeth_ch$GnotN[meanMeth_ch$GnotN$Var2 %in% pd[pd$Cell.Type=="Glia","Data.ID"],"value"],
                     meanMeth_ch$NnotG[meanMeth_ch$NnotG$Var2 %in% pd[pd$Cell.Type=="Neuron","Data.ID"],"value"])
ct = data.frame(Tstat = GnotN.NnotG$statistic, mean1 = GnotN.NnotG$estimate[1], mean2 = GnotN.NnotG$estimate[2], pval = GnotN.NnotG$p.value, comps = "GnotN.NnotG")

names(meanMeth_ch)[29:46] = paste0(names(meanMeth_ch)[29:46],".G")
tstat.N = list(InotC.CnotI = t.test(meanMeth_ch$InotC[meanMeth_ch$InotC$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth_ch$CnotI[meanMeth_ch$CnotI$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Neuron","Data.ID"],"value"]),
               InotT.TnotI = t.test(meanMeth_ch$InotT[meanMeth_ch$InotT$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth_ch$TnotI[meanMeth_ch$TnotI$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Neuron","Data.ID"],"value"]),
               InotA.AnotI = t.test(meanMeth_ch$InotA[meanMeth_ch$InotA$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth_ch$AnotI[meanMeth_ch$AnotI$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Neuron","Data.ID"],"value"]),
               CnotT.TnotC = t.test(meanMeth_ch$CnotT[meanMeth_ch$CnotT$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth_ch$TnotC[meanMeth_ch$TnotC$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Neuron","Data.ID"],"value"]),
               CnotA.AnotC = t.test(meanMeth_ch$CnotA[meanMeth_ch$CnotA$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth_ch$AnotC[meanMeth_ch$AnotC$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Neuron","Data.ID"],"value"]),
               TnotA.AnotT = t.test(meanMeth_ch$TnotA[meanMeth_ch$TnotA$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Neuron","Data.ID"],"value"],
                                    meanMeth_ch$AnotT[meanMeth_ch$AnotT$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Neuron","Data.ID"],"value"]))
neuro = data.frame(Tstat = unlist(lapply(tstat.N, function(x) x$statistic)), mean1 = unlist(lapply(tstat.N, function(x) x$estimate[1])),
                   mean2 = unlist(lapply(tstat.N, function(x) x$estimate[2])), pval = unlist(lapply(tstat.N, function(x) x$p.value)), comps = names(tstat.N), row.names = NULL)

tstat.G = list(InotC.CnotI = t.test(meanMeth_ch$InotC.G[meanMeth_ch$InotC.G$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth_ch$CnotI.G[meanMeth_ch$CnotI.G$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Glia","Data.ID"],"value"]),
               InotT.TnotI = t.test(meanMeth_ch$InotT.G[meanMeth_ch$InotT.G$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth_ch$TnotI.G[meanMeth_ch$TnotI.G$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Glia","Data.ID"],"value"]),
               InotA.AnotI = t.test(meanMeth_ch$InotA.G[meanMeth_ch$InotA.G$Var2 %in% pd[pd$Age<=1 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth_ch$AnotI.G[meanMeth_ch$AnotI.G$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Glia","Data.ID"],"value"]),
               CnotT.TnotC = t.test(meanMeth_ch$CnotT.G[meanMeth_ch$CnotT.G$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth_ch$TnotC.G[meanMeth_ch$TnotC.G$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Glia","Data.ID"],"value"]),
               CnotA.AnotC = t.test(meanMeth_ch$CnotA.G[meanMeth_ch$CnotA.G$Var2 %in% pd[pd$Age>1 & pd$Age<=12 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth_ch$AnotC.G[meanMeth_ch$AnotC.G$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Glia","Data.ID"],"value"]),
               TnotA.AnotT = t.test(meanMeth_ch$TnotA.G[meanMeth_ch$TnotA.G$Var2 %in% pd[pd$Age>12 & pd$Age<=17 & pd$Cell.Type=="Glia","Data.ID"],"value"],
                                    meanMeth_ch$AnotT.G[meanMeth_ch$AnotT.G$Var2 %in% pd[pd$Age>17 & pd$Cell.Type=="Glia","Data.ID"],"value"]))
gli = data.frame(Tstat = unlist(lapply(tstat.G, function(x) x$statistic)), mean1 = unlist(lapply(tstat.G, function(x) x$estimate[1])),
                 mean2 = unlist(lapply(tstat.G, function(x) x$estimate[2])), pval = unlist(lapply(tstat.G, function(x) x$p.value)), comps = names(tstat.G), row.names = NULL)

dfmeth = rbind(cbind(dfCG[,-1], Context = "CpG"), cbind(rbind(cbind(neuro, Comp = "Neurons Age"), cbind(gli, Comp = "Glia Age"), cbind(ct, Comp = "Cell Type")), Context = "CpH"))
dfmeth$FDR = p.adjust(dfmeth$pval, method = "fdr")

write.csv(dfmeth, quote=F, file = "/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/t.test_DMV_gene_methylation.csv")

library(PWMEnrich.Hsapiens.background)
data(MotifDb.Hsap)
tfs = unlist(lapply(MotifDb.Hsap, function(x) x$name))
tfs = tfs[-grep("UW",tfs)]

not = tfs[!tfs %in% geneMap$Symbol]
not = na.omit(not[-grep("::", not, fixed=T)])

nomatch = c("SMCR7L","DUX4","MYF","MZF1_1-4","MZF1_5-13","RORA_1","RORA_2","MIZF","EWSR1-FLI1","ZNF238",
            "ZNF306","POU5F1P1","BHLHB2","BHLHB3","CART1","RAXL1","TRP53","TRP73","ZNF435","HNF1B")
nomatch[which(nomatch %in% geneMap$Symbol)]
nomatch[which(nomatch %in% good)]

tfs = unique(c(tfs[tfs %in% geneMap$Symbol], c("HINFP1","RBM8B"), unique(unlist(strsplit(not[grep("::", not, fixed=T)], "::", fixed=T)))))
tfs = geneMap[which(geneMap$Symbol %in% tfs),] # 830 genes


## ----setup, include = FALSE----------------------------------------------
knitr::opts_knit$set(root.dir = "~/Dropbox (EHA)/repositories/gains-summary")
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)

# Load required packages
library(dplyr)

## ----, results = "asis"--------------------------------------------------
viruses_per_animal <- country_gains %>%
  group_by(AnimalID) %>%
  summarize(viruses_matched = length(unique(na.omit(VirusName)))) %>%
  group_by(viruses_matched) %>%
  summarize(individuals = length(viruses_matched))

viruses_per_animal$percent <- round(viruses_per_animal$individuals / sum(viruses_per_animal$individuals) * 100, 2)

knitr::kable(viruses_per_animal, col.names = c("Viruses per animal", "Number of animals", "Percentage"), caption = "Individual animals by sum of viruses")

## ----, include = FALSE---------------------------------------------------
total_tested <- length(unique(country_gains$AnimalID))
total_positive <- length(unique(country_gains$AnimalID[country_gains$positive > 0]))
total_risk1 <- length(na.omit(unique(country_gains$AnimalID[country_gains$RiskLevel == 1])))

## ----, results = "asis"--------------------------------------------------
animals <- country_gains %>%
  group_by(SpeciesScientificName) %>%
  summarize(SpeciesCommonNameEnglish = unique(SpeciesCommonNameEnglish),
            number = length(unique(AnimalID))) %>%
  arrange(desc(number))

names(animals) <- c("scientific", "common", "number")
animals$common <- sapply(animals$common, function(x) strsplit(x, " within")[[1]][1])

knitr::kable(animals, col.names = c("Scientific name", "Common name", "Number tested"), caption = "Number of individuals tested per animal species")

## ----, results = "asis"--------------------------------------------------
PIG <- country_gains %>%
  group_by(PrimaryInterfaceGroup) %>%
  summarize(number = length(unique(AnimalID))) %>%
  arrange(desc(number))

PIG$percent <- round(PIG$number / sum(PIG$number) * 100, 2)

knitr::kable(PIG, col.names = c("Primary interface group", "Number of individuals", "Percentage"), caption = "Number of individuals tested per primary interface group")

## ----, results = "asis"--------------------------------------------------
SIG <- country_gains %>%
  group_by(SecondaryInterfaceGroup) %>%
  summarize(number = length(unique(AnimalID))) %>%
  arrange(desc(number))

SIG$percent <- round(SIG$number / sum(SIG$number) * 100, 2)

knitr::kable(SIG, col.names = c("Secondary interface group", "Number of individuals", "Percentage"), caption = "Number of individuals tested per secondary interface group")

## ----, results = "asis"--------------------------------------------------
risk1_crosstab <- country_gains %>%
  group_by(AnimalID) %>%
  filter(Positive == 1) %>%
  summarize(risk1 = ifelse(summary(RiskLevel)["High"] > 0, 1, 0),
            viruses_matched = length(unique(na.omit(VirusName)))) %>%
  group_by(viruses_matched) %>%
  summarize(individuals = length(viruses_matched),
            risk1 = sum(risk1))

risk1_crosstab$percent <- round(risk1_crosstab$risk1/risk1_crosstab$individuals * 100, 2)

knitr::kable(risk1_crosstab, col.names = c("Viruses", "Individuals, total", "Individuals, 'high risk'", "Percentage"), caption = "Cross tabs of number of viruses in individuals by presence of risk level 1 virus")

## ----, results = "asis"--------------------------------------------------
risk1_viruses <- country_gains %>%
  filter(RiskLevel == "High") %>%
  group_by(VirusName) %>%
  summarize(animals = length(unique(na.omit(AnimalID)))) %>%
  select(VirusName, animals) %>%
  arrange(desc(animals))

knitr::kable(risk1_viruses, col.names = c("Virus name", "Number of animals"), caption = "'High risk' viruses")

## ----, results = "asis"--------------------------------------------------
risk1_individual <- country_gains %>%
  group_by(AnimalID) %>%
  summarize(scientific = unique(SpeciesScientificName),
            common = unique(SpeciesCommonNameEnglish),
            risk1 = ifelse(summary(RiskLevel)["High"] > 0, 1, 0),
            PIG = unique(PrimaryInterfaceGroup),
            SIG = unique(SecondaryInterfaceGroup))

risk1_species <- risk1_individual %>%
  group_by(scientific) %>%
  summarize(common = unique(common),
            animals = length(unique(AnimalID)),
            risk1 = length(risk1[risk1 == 1]),
            percent = round(risk1 / animals * 100, 2)) %>%
  filter(risk1 > 0) %>%
  arrange(desc(percent))

risk1_species$common <- sapply(risk1_species$common, function(x) strsplit(x, " within")[[1]][1])

knitr::kable(risk1_species, col.names = c("Scientific name", "Common name", "Tested", "'High risk'", "%"), caption = "Number of animals with 'high risk' viruses per species")

## ----, results = "asis"--------------------------------------------------
risk1_PIG <- risk1_individual %>%
  group_by(PIG) %>%
  summarize(animals = length(unique(AnimalID)),
            risk1 = length(risk1[risk1 == 1]),
            percent = round(risk1 / animals * 100, 2)) %>%
  arrange(desc(percent))

knitr::kable(risk1_PIG, col.names = c("Primary interface group", "Tested", "'High risk'", "%"), caption = "Number of animals with 'high risk' viruses per primary interface group")

## ----, results = "asis"--------------------------------------------------
risk1_SIG <- risk1_individual %>%
filter(!(SIG == "")) %>%
  group_by(SIG) %>%
  summarize(animals = length(unique(AnimalID)),
            risk1 = length(risk1[risk1 == 1]),
            percent = round(risk1 / animals * 100, 2)) %>%
  arrange(desc(percent))

knitr::kable(risk1_SIG, col.names = c("Secondary interface group", "Tested", "'High risk'", "%"), caption = "Number of animals with 'high risk' viruses per secondary interface group")


#' @import data.table
NULL

#' Load a Matrix
#'
#' This function loads a file as a matrix. It assumes that the first column
#' contains the rownames and the subsequent columns are the sample identifiers.
#' Any rows with duplicated row names will be dropped with the first one being
#' kepted.
#'
#' @param data Path to the input file
#' @param org_beta Path to the input file
#' @param org_cols Path to the input file
#' @param org_trait Path to the input file
#' @return A matrix of the infile
#' @export
w.score <- function(data, org_beta, org_cols = c(), org_trait = NA) {
  org_beta <- org_beta[org_beta$Trait == org_trait, org_cols, with = F]
  snps <- org_beta[[1]]
  beta <- org_beta[[2]]
  data_ <- copy(data)
  for (j in snps) set(data_, j = j, value = data_[[j]] * abs(unlist(org_beta[j, 2])) )
  data[, paste0(org_trait, "_w_score") := (rowSums(data_[, ,snps, with = F]) / sum(abs(beta))) * length(snps) ]
}

#' Load a Matrix
#'
#' This function loads a file as a matrix. It assumes that the first column
#' contains the rownames and the subsequent columns are the sample identifiers.
#' Any rows with duplicated row names will be dropped with the first one being
#' kepted.
#'
#' @param x Path to the input file
#' @param y Path to the input file
#' @param data Path to the input file
#' @param covars Path to the input file
#' @param u_cols Path to the input file
#' @param w_cols Path to the input file
#' @return A matrix of the infile
#' @export
tsls.ancon <- function(x, y, data, covars, u_cols = c(), w_cols = c()) {
  mv_tsls_u <- AER::ivreg(as.formula(paste(y, " ~ ", x, " + ", covars, " | ", u_cols, " + ", covars)), data = data)
  mv_tsls_w <- AER::ivreg(as.formula(paste(y, " ~ ", x, " + ", covars, " | ", w_cols, " + ", covars)), data = data)
  paste0(names(y), "_u_score", collapse=" + ")
  dt <- data.table(
    Exposure = x,
    Outcome = "breast_cancer",
    BETA_u = summary(mv_tsls_u)$coef[2, 1],
    SE_u = summary(mv_tsls_u)$coef[2, 2],
    P_u = summary(mv_tsls_u)$coef[2, 4],
    BETA_w = summary(mv_tsls_w)$coef[2, 1],
    SE_w = summary(mv_tsls_w)$coef[2, 2],
    P_w = summary(mv_tsls_w)$coef[2, 4]
  )
  return(dt)
}


# Calculate future TSM (thermal safety margins) from warmest hourly temperature

require(ncdf4)
require(abind)
require(raster)
require(data.table)

##################
# Functions
##################

# round a single value (x) to nearest value in a vector (y)
roundto <- function(x, y){
	a <- abs(x - y)
	i <- which(a==min(a)) # can return 1 or 2 matches
	return(y[i])
}

####################################################
# Subtract anomalies from TSM to get time-series
# Calculate year TSM crosses zero
# Calculate fractional change by 2100
####################################################

## Parameters
#set Acclimation Response Ratio for terrestrial and marine organisms and for time
# from Gunderson and Stillman model-averaged results (Gunderson pers. comm.)
ARRland <- 0.11
ARRoce <- 0.24

## Read in data
# load the deltas for the warmest hour
load('temp/tasmax26dyr.rdata')
load('temp/tasmax85dyr.rdata')
load('temp/tosmax26dyr.rdata')
load('temp/tosmax85dyr.rdata')

# read in TSMs
dat <- fread('temp/warmingtolerance_byspecies.csv')
dat <- dat[,c('Genus', 'Species', 'Phylum', 'Class', 'Order', 'Family', 'animal.type', 'Realm', 'lat', 'lon', 'tmax_metric',  'tsm_favorableGHCND95')] # trim to relevant columns

# read in species-specific ARR
arr <- fread('data/tmax_data/dataset_1_ARRs.tsv')

# merge TSMs and ARRs
nrow(dat)
dat <- merge(dat, arr, all.x=TRUE, by=c('Genus', 'Species'))
nrow(dat) # didn't lose any rows

# Initialize variables
dat$tsm_2081_2100_rcp26 <- NA # TSM in 2081-2100, RCP2.6
dat$tsm_2081_2100_rcp85 <- NA
dat$tsm_2081_2100_acc_rcp26 <- NA # TSM in 2081-2100 with acclimation
dat$tsm_2081_2100_acc_rcp85 <- NA
dat$tsm_2081_2100_accbyspp_rcp26 <- NA # TSM in 2081-2100 with species-specific acclimation
dat$tsm_2081_2100_accbyspp_rcp85 <- NA

# Get lists of latitude and longitude values in the temperature data
llons <- as.numeric(colnames(tasmax85dyr))
llats <- as.numeric(rownames(tasmax85dyr))
slons <- as.numeric(colnames(tosmax85dyr))
slats <- as.numeric(rownames(tosmax85dyr))

llonstep <- abs(diff(llons)[1])
slonstep <- abs(diff(slons)[1])
llatstep <- abs(diff(llats)[1])
slatstep <- abs(diff(slats)[1])

# loop through and calculate future TSM metrics
for(i in 1:nrow(dat)){

	if(dat$Realm[i]=='Terrestrial' & !is.na(dat$tsm_favorableGHCND95[i])){
		if(dat$lon[i] < 0){ # may need to correct lon to 0-360
			lons <- roundto(dat$lon[i] + 360, llons) # find the closest longitude (or lons)
		} else {
			lons <- roundto(dat$lon[i], llons)
		}
		lats <- roundto(dat$lat[i], llats) # find the closest latitudes (or latitudes)

		# look for grid cell with data
		temp <- mean(tasmax85dyr[as.character(lats), as.character(lons),1], na.rm=TRUE) # test

		if(is.na(temp)){ # if didn't get a value, try searching in a slightly wider area (may have moved off land in rounding)
			cat(paste('Going to wider search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
			origlats <- lats
			origlons <- lons

			if(all(lats > dat$lat[i])){ # move down one step if all rounded lats are greater
				lats <- c(lats, lats - llatstep)
			}
			if(all(lats < dat$lat[i])){
				lats <- c(lats, lats + llatstep)
			}
			if(all(lons > dat$lon[i])){
				lons <- c(lons, lons - llonstep)
			}
			if(all(lons < dat$lon[i])){
				lons <- c(lons, lons + llonstep)
			}

			temp <- mean(tasmax85dyr[as.character(lats), as.character(lons),1], na.rm=TRUE) # land temp
			cat(paste('temp now', temp, '\n'))

			if(is.na(temp)){ # if still don't get a value, try searching in 9-grid area
				cat(paste('\tGoing to 9-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
				lats <- c(origlats-llatstep, origlats, origlats+llatstep)
				lons <- c(origlons-llonstep, origlons, origlons+llonstep)
				temp <- mean(tasmax85dyr[as.character(lats), as.character(lons),1], na.rm=TRUE) # land temp
				cat(paste('\ttemp now', temp, '\n'))
			}
		}

		# calculate warming at this location and subtract from TSM to get future TSMs
		deltas26 <- apply(tasmax26dyr[as.character(lats), as.character(lons),,drop=FALSE], MARGIN=3, FUN=mean, na.rm=TRUE) # drop=FALSE so that array keeps 3 dimensions even if some are 1
		deltas85 <- apply(tasmax85dyr[as.character(lats), as.character(lons),,drop=FALSE], MARGIN=3, FUN=mean, na.rm=TRUE)
		tsms26 <- dat$tsm_favorableGHCND95[i] - deltas26
		tsms85 <- dat$tsm_favorableGHCND95[i] - deltas85

			# plot(as.numeric(names(tsms)), tsms)

		# account for acclimation
		deltas26_acc <- deltas26*(1-ARRland)
		deltas85_acc <- deltas85*(1-ARRland)
		tsms26_acc <- dat$tsm_favorableGHCND95[i] - deltas26_acc
		tsms85_acc <- dat$tsm_favorableGHCND95[i] - deltas85_acc

		# TSM in 2081-2100
		dat$tsm_2081_2100_rcp26[i] <- mean(tsms26[names(tsms26) %in% 2081:2100])
		dat$tsm_2081_2100_rcp85[i] <- mean(tsms85[names(tsms85) %in% 2081:2100])

		# TSM in 2081-2100 with acclimation
		dat$tsm_2081_2100_acc_rcp26[i] <- mean(tsms26_acc[names(tsms26_acc) %in% 2081:2100])
		dat$tsm_2081_2100_acc_rcp85[i] <- mean(tsms85_acc[names(tsms85_acc) %in% 2081:2100])

		# account for species-specific acclimation if available
		if(!is.na(dat$ctmax_ARR_GS[i])){
			deltas26_accbyspp <- deltas26*(1-dat$ctmax_ARR_GS[i])
			deltas85_accbyspp <- deltas85*(1-dat$ctmax_ARR_GS[i])
			tsms26_accbyspp <- dat$tsm_favorableGHCND95[i] - deltas26_accbyspp
			tsms85_accbyspp <- dat$tsm_favorableGHCND95[i] - deltas85_accbyspp
			dat$tsm_2081_2100_accbyspp_rcp26[i] <- mean(tsms26_accbyspp[names(tsms26_accbyspp) %in% 2081:2100])
			dat$tsm_2081_2100_accbyspp_rcp85[i] <- mean(tsms85_accbyspp[names(tsms85_accbyspp) %in% 2081:2100])
		}

	}

	if(dat$Realm[i]=='Marine' & !is.na(dat$tsm_favorableGHCND95[i])){
		if(dat$lon[i] < 0){ # may need to correct lon to 0-360
			lons <- roundto(dat$lon[i] + 360, slons) # find the closest longitude (or lons)
		} else {
			lons <- roundto(dat$lon[i], slons)
		}
		lats <- roundto(dat$lat[i], slats) # find the closest latitudes (or latitudes)

		# look for grid cell with data
		temp <- mean(tosmax85dyr[as.character(lats), as.character(lons),1], na.rm=TRUE) # test

		if(is.na(temp)){ # if didn't get a value, try searching in a slightly wider area (may have moved off land in rounding)
			cat(paste('Going to wider search area for i=', i, dat$Genus[i], dat$Species[i], 'at sea\n'))
			origlats <- lats
			origlons <- lons

			if(all(lats > dat$lat[i])){ # move down one step if all rounded lats are greater
				lats <- c(lats, lats - slatstep)
			}
			if(all(lats < dat$lat[i])){
				lats <- c(lats, lats + slatstep)
			}
			if(all(lons > dat$lon[i])){
				lons <- c(lons, lons - slonstep)
			}
			if(all(lons < dat$lon[i])){
				lons <- c(lons, lons + slonstep)
			}

			temp <- mean(tosmax85dyr[as.character(lats), as.character(lons),1], na.rm=TRUE) # ocean temp
			cat(paste('temp now', temp, '\n'))

			if(is.na(temp)){ # if still don't get a value, try searching in 9-grid area
				cat(paste('\tGoing to 9-grid search area for i=', i, dat$Genus[i], dat$Species[i], 'on land\n'))
				lats <- c(origlats-llatstep, origlats, origlats+llatstep)
				lons <- c(origlons-llonstep, origlons, origlons+llonstep)
				temp <- mean(tosmax85dyr[as.character(lats), as.character(lons),1], na.rm=TRUE) # land temp
				cat(paste('\ttemp now', temp, '\n'))
			}
		}

		# calculate warming at this location and subtract from TSM
		deltas26 <- apply(tosmax26dyr[as.character(lats), as.character(lons),,drop=FALSE], MARGIN=3, FUN=mean, na.rm=TRUE) # drop=FALSE so that array keeps 3 dimensions even if some are 1
		deltas85 <- apply(tosmax85dyr[as.character(lats), as.character(lons),,drop=FALSE], MARGIN=3, FUN=mean, na.rm=TRUE)
		tsms26 <- dat$tsm_favorableGHCND95[i] - deltas26
		tsms85 <- dat$tsm_favorableGHCND95[i] - deltas85

			# plot(as.numeric(names(tsms)), tsms)

		# account for acclimation
		deltas26_acc <- deltas26*(1-ARRoce)
		deltas85_acc <- deltas85*(1-ARRoce)
		tsms26_acc <- dat$tsm_favorableGHCND95[i] - deltas26_acc
		tsms85_acc <- dat$tsm_favorableGHCND95[i] - deltas85_acc

		# TSM in 2081-2100
		dat$tsm_2081_2100_rcp26[i] <- mean(tsms26[names(tsms26) %in% 2081:2100])
		dat$tsm_2081_2100_rcp85[i] <- mean(tsms85[names(tsms85) %in% 2081:2100])

		# TSM in 2081-2100 with acclimation
		dat$tsm_2081_2100_acc_rcp26[i] <- mean(tsms26_acc[names(tsms26_acc) %in% 2081:2100])
		dat$tsm_2081_2100_acc_rcp85[i] <- mean(tsms85_acc[names(tsms85_acc) %in% 2081:2100])

		# account for species-specific acclimation if available
		if(!is.na(dat$ctmax_ARR_GS[i])){
			deltas26_accbyspp <- deltas26*(1-dat$ctmax_ARR_GS[i])
			deltas85_accbyspp <- deltas85*(1-dat$ctmax_ARR_GS[i])
			tsms26_accbyspp <- dat$tsm_favorableGHCND95[i] - deltas26_accbyspp
			tsms85_accbyspp <- dat$tsm_favorableGHCND95[i] - deltas85_accbyspp
			dat$tsm_2081_2100_accbyspp_rcp26[i] <- mean(tsms26_accbyspp[names(tsms26_accbyspp) %in% 2081:2100])
			dat$tsm_2081_2100_accbyspp_rcp85[i] <- mean(tsms85_accbyspp[names(tsms85_accbyspp) %in% 2081:2100])
		}

	}

}

# write out
write.csv(dat, 'temp/warmingtolerance_byspecies_to2100.csv', row.names=FALSE)

###############
## calculations
###############
dat <- fread('temp/warmingtolerance_byspecies_to2100.csv')

# how much better is current than rcp85?
	# histogram by habitat
	par(mfrow=c(1,2))
	dat[Realm=='Terrestrial', hist(tsm_favorableGHCND95-tsm_2081_2100_rcp85, plot=TRUE)]
	dat[Realm=='Marine', hist(tsm_favorableGHCND95-tsm_2081_2100_rcp85, plot=TRUE)]

	# average
dat[!is.na(tsm_favorableGHCND95) & !is.na(tsm_2081_2100_rcp85), .(mean_diff_now_85=mean(tsm_favorableGHCND95-tsm_2081_2100_rcp85), se_diff=sd(tsm_favorableGHCND95-tsm_2081_2100_rcp85)/sqrt(.N), mean_ratio_now_85=mean(tsm_favorableGHCND95/tsm_2081_2100_rcp85), se_ratio=sd(tsm_favorableGHCND95/tsm_2081_2100_rcp85)/sqrt(.N))]

	# by habitat
dat[!is.na(tsm_favorableGHCND95) & !is.na(tsm_2081_2100_rcp85), .(mean_diff_now_85=mean(tsm_favorableGHCND95-tsm_2081_2100_rcp85), se_diff=sd(tsm_favorableGHCND95-tsm_2081_2100_rcp85)/sqrt(.N), mean_ratio_now_85=mean(tsm_favorableGHCND95/tsm_2081_2100_rcp85), se_ratio=sd(tsm_favorableGHCND95/tsm_2081_2100_rcp85)/sqrt(.N)), by=Realm]

# how much better is rcp26 than rcp85?
	# average
dat[!is.na(tsm_2081_2100_rcp26) & !is.na(tsm_2081_2100_rcp85), .(mean_diff_26_85=mean(tsm_2081_2100_rcp26-tsm_2081_2100_rcp85), se_diff=sd(tsm_2081_2100_rcp26-tsm_2081_2100_rcp85)/sqrt(.N), mean_ratio_26_85=mean(tsm_2081_2100_rcp26/tsm_2081_2100_rcp85), se_ratio=sd(tsm_2081_2100_rcp26/tsm_2081_2100_rcp85)/sqrt(.N))]

	# by habitat
dat[!is.na(tsm_2081_2100_rcp26) & !is.na(tsm_2081_2100_rcp85), .(mean_diff_26_85=mean(tsm_2081_2100_rcp26-tsm_2081_2100_rcp85), se_diff=sd(tsm_2081_2100_rcp26-tsm_2081_2100_rcp85)/sqrt(.N), mean_ratio_26_85=mean(tsm_2081_2100_rcp26/tsm_2081_2100_rcp85), se_ratio=sd(tsm_2081_2100_rcp26/tsm_2081_2100_rcp85)/sqrt(.N)), by=Realm]

# difference in TSM between average ARR and species-specific ARR
dat[!is.na(tsm_2081_2100_accbyspp_rcp85),.(mean=mean(tsm_2081_2100_acc_rcp85 - tsm_2081_2100_accbyspp_rcp85), se=sd(tsm_2081_2100_acc_rcp85 - tsm_2081_2100_accbyspp_rcp85)/sqrt(.N), N=.N), by=Realm]

dat[!is.na(tsm_2081_2100_accbyspp_rcp85), cor.test(tsm_2081_2100_acc_rcp85, tsm_2081_2100_accbyspp_rcp85)]

###################
# models
###################
dat <- fread('temp/warmingtolerance_byspecies_to2100.csv')
	dat$Realm <- as.factor(dat$Realm)

# data.frame for projection
	newdat <- data.frame(Realm=rep(c('Marine', 'Terrestrial'), c(161,161)), lat=rep(-80:80, 2)) # for projection onto a regular vector of latitudes
		newdat$abslat <- abs(newdat$lat)
		newdat$tmax_metric <- 'ctmax'

#### models (unfolded lat)

	# TSM 2081-2100 by lat rcp26
		# gamm
		i <- complete.cases(dat[,c('Realm', 'lat', 'tsm_2081_2100_rcp26', 'tmax_metric', 'Phylum', 'Class', 'Order', 'Family', 'Genus')]); sum(i); nrow(dat)
	modTSMfut26 <- uGamm(tsm_2081_2100_rcp26 ~ Realm + tmax_metric + s(lat, by=Realm), random=list(Phylum=~1, Class=~1, Order=~1, Family=~1, Genus=~1), data=dat[i,], control=glmerControl(optimizer='Nelder_Mead', optCtrl=list(maxfun=5000))) # use uGamm instead of gamm, since former can be used with dredge. Just a wrapper function for gamm.
#		plot(modTSMfut26$gam, pages=1)
#		summary(modTSMfut26$gam)
#		summary(modTSMfut26$lme)

		## predictions from GAMM
		temp <- predict(modTSMfut26$gam, newdata=newdat, se.fit=TRUE)
		newdat$tsm_2081_2100_rcp26 <- temp$fit
		newdat$tsm_2081_2100_rcp26se <- temp$se.fit

			# plot predictions
			plot(tsm_2081_2100_rcp26 ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], type='l', col='green', ylim=c(-10,30), xlim=c(-80,80))
				lines(tsm_2081_2100_rcp26 + tsm_2081_2100_rcp26se ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], col='green', lty=2)
				lines(tsm_2081_2100_rcp26 - tsm_2081_2100_rcp26se ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], col='green', lty=2)
			lines(tsm_2081_2100_rcp26 ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue')
				lines(tsm_2081_2100_rcp26 - tsm_2081_2100_rcp26se ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue', lty=2)
				lines(tsm_2081_2100_rcp26 + tsm_2081_2100_rcp26se ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue', lty=2)

			points(tsm_2081_2100_rcp26 ~ lat, data=dat[dat$Realm=='Terrestrial',], col='green', cex=0.5)
			points(tsm_2081_2100_rcp26 ~ lat, data=dat[dat$Realm=='Marine',], col='blue', cex=0.5)

		# fit all subsets
#		options(na.action = "na.fail")
#		modTSMfut26s <- dredge(modTSMfut26, beta=FALSE, evaluate=TRUE, rank='AICc', trace=1)
#		subset(modTSMfut26s)
#
#		modavgTSMfut26 <- model.avg(modTSMfut26s)
#		summary(modavgTSMfut26)

	# TSM 2081-2100 by lat rcp85
		# gamm
		i <- complete.cases(dat[,c('Realm', 'lat', 'tsm_2081_2100_rcp85', 'tmax_metric', 'Phylum', 'Class', 'Order', 'Family', 'Genus')]); sum(i); nrow(dat)
	modTSMfut85 <- uGamm(tsm_2081_2100_rcp85 ~ Realm + tmax_metric + s(lat, by=Realm), random=list(Phylum=~1, Class=~1, Order=~1, Family=~1, Genus=~1), data=dat[i,], control=glmerControl(optimizer='Nelder_Mead', optCtrl=list(maxfun=5000))) # use uGamm instead of gamm, since former can be used with dredge. Just a wrapper function for gamm.
#		plot(modTSMfut85$gam, pages=1)
#		summary(modTSMfut85$gam)
#		summary(modTSMfut85$lme)

		## predictions from GAMM
		temp <- predict(modTSMfut85$gam, newdata=newdat, se.fit=TRUE)
		newdat$tsm_2081_2100_rcp85 <- temp$fit
		newdat$tsm_2081_2100_rcp85se <- temp$se.fit

			# plot predictions
#			plot(tsm_2081_2100_rcp85 ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], type='l', col='green', ylim=c(-10,30), xlim=c(-80,80))
#				lines(tsm_2081_2100_rcp85 + tsm_2081_2100_rcp85se ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], col='green', lty=2)
#				lines(tsm_2081_2100_rcp85 - tsm_2081_2100_rcp85se ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], col='green', lty=2)
#			lines(tsm_2081_2100_rcp85 ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue')
#				lines(tsm_2081_2100_rcp85 - tsm_2081_2100_rcp85se ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue', lty=2)
#				lines(tsm_2081_2100_rcp85 + tsm_2081_2100_rcp85se ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue', lty=2)
#
#			points(tsm_2081_2100_rcp85 ~ lat, data=dat[dat$Realm=='Terrestrial',], col='green', cex=0.5)
#			points(tsm_2081_2100_rcp85 ~ lat, data=dat[dat$Realm=='Marine',], col='blue', cex=0.5)

		# fit all subsets
#		options(na.action = "na.fail")
#		modTSMfut85s <- dredge(modTSMfut85, beta=FALSE, evaluate=TRUE, rank='AICc', trace=1)
#		subset(modTSMfut85s)
#
#		modavgTSMfut85 <- model.avg(modTSMfut85s)
#		summary(modavgTSMfut85)

	# TSM 2081-2100 with acclimation by lat RCP2.6
		# gamm
		i <- complete.cases(dat[,c('Realm', 'lat', 'tsm_2081_2100_acc_rcp26', 'tmax_metric', 'Phylum', 'Class', 'Order', 'Family', 'Genus')]); sum(i); nrow(dat)
	modTSMfut_acc26 <- uGamm(tsm_2081_2100_acc_rcp26 ~ Realm + tmax_metric + s(lat, by=Realm), random=list(Phylum=~1, Class=~1, Order=~1, Family=~1, Genus=~1), data=dat[i,])
#		plot(modTSMfut_acc26$gam, pages=1)
#		summary(modTSMfut_acc26$gam)
#		summary(modTSMfut_acc26$lme)

		## predictions from GAMM
		temp <- predict(modTSMfut_acc26$gam, newdata=newdat, se.fit=TRUE)
		newdat$tsm_2081_2100_acc_rcp26 <- temp$fit
		newdat$tsm_2081_2100_acc_rcp26se <- temp$se.fit

			# plot predictions
#			plot(tsm_2081_2100_acc_rcp26 ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], type='l', col='green', ylim=c(-10,30), xlim=c(-80,80))
#			abline(h=0, lty=2, col='grey')
#
#				lines(tsm_2081_2100_acc_rcp26 + tsm_2081_2100_acc_rcp26se ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], col='green', lty=2)
#				lines(tsm_2081_2100_acc_rcp26 - tsm_2081_2100_acc_rcp26se ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], col='green', lty=2)
#			lines(tsm_2081_2100_acc_rcp26 ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue')
#				lines(tsm_2081_2100_acc_rcp26 - tsm_2081_2100_acc_rcp26se ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue', lty=2)
#				lines(tsm_2081_2100_acc_rcp26 + tsm_2081_2100_acc_rcp26se ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue', lty=2)
#
#			points(tsm_2081_2100_acc_rcp26 ~ lat, data=dat[dat$Realm=='Terrestrial',], col='green', cex=0.5)
#			points(tsm_2081_2100_acc_rcp26 ~ lat, data=dat[dat$Realm=='Marine',], col='blue', cex=0.5)

		# fit all subsets
#		options(na.action = "na.fail")
#		modTSMfut_acc85s <- dredge(modTSMfut_acc85, beta=FALSE, evaluate=TRUE, rank='AICc', trace=1)
#		subset(modTSMfut_acc85s)
#
#		modavgTSMfut_acc85 <- model.avg(modTSMfut_acc85s)
#		summary(modavgTSMfut_acc85)

	# TSM 2081-2100 with acclimation by lat RCP8.5
		# gamm
		i <- complete.cases(dat[,c('Realm', 'lat', 'tsm_2081_2100_acc_rcp85', 'tmax_metric', 'Phylum', 'Class', 'Order', 'Family', 'Genus')]); sum(i); nrow(dat)
	modTSMfut_acc85 <- uGamm(tsm_2081_2100_acc_rcp85 ~ Realm + tmax_metric + s(lat, by=Realm), random=list(Phylum=~1, Class=~1, Order=~1, Family=~1, Genus=~1), data=dat[i,])
#		plot(modTSMfut_acc85$gam, pages=1)
#		summary(modTSMfut_acc85$gam)
#		summary(modTSMfut_acc85$lme)

		## predictions from GAMM
		temp <- predict(modTSMfut_acc85$gam, newdata=newdat, se.fit=TRUE)
		newdat$tsm_2081_2100_acc_rcp85 <- temp$fit
		newdat$tsm_2081_2100_acc_rcp85se <- temp$se.fit

			# plot predictions
#			plot(tsm_2081_2100_acc_rcp85 ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], type='l', col='green', ylim=c(-10,30), xlim=c(-80,80))
#			abline(h=0, lty=2, col='grey')
#
#				lines(tsm_2081_2100_acc_rcp85 + tsm_2081_2100_acc_rcp85se ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], col='green', lty=2)
#				lines(tsm_2081_2100_acc_rcp85 - tsm_2081_2100_acc_rcp85se ~ lat, data=newdat[newdat$Realm=='Terrestrial' & newdat$abslat<50,], col='green', lty=2)
#			lines(tsm_2081_2100_acc_rcp85 ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue')
#				lines(tsm_2081_2100_acc_rcp85 - tsm_2081_2100_acc_rcp85se ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue', lty=2)
#				lines(tsm_2081_2100_acc_rcp85 + tsm_2081_2100_acc_rcp85se ~ lat, data=newdat[newdat$Realm=='Marine',], col='blue', lty=2)
#
#			points(tsm_2081_2100_acc_rcp85 ~ lat, data=dat[dat$Realm=='Terrestrial',], col='green', cex=0.5)
#			points(tsm_2081_2100_acc_rcp85 ~ lat, data=dat[dat$Realm=='Marine',], col='blue', cex=0.5)

		# fit all subsets
#		options(na.action = "na.fail")
#		modTSMfut_acc85s <- dredge(modTSMfut_acc85, beta=FALSE, evaluate=TRUE, rank='AICc', trace=1)
#		subset(modTSMfut_acc85s)
#
#		modavgTSMfut_acc85 <- model.avg(modTSMfut_acc85s)
#		summary(modavgTSMfut_acc85)

	# Write out predictions
	write.csv(newdat, file='temp/warmingtolerance_bylat_to2100.csv', row.names=FALSE)


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

source("libs.r")
source("plots.r")
source("read_data.r")

options(mc.cores=12)
options(max.print=10000)

#for reproducibility
set.seed(610981)

# data sets included in each set to be fitted. Only 2 and 4 used for ATTACCC
study_id_set <- list(1,2,c(1,2),3,4)
# input data sets
data_files <- c("ct_dat_refined.csv","20210920_ATACCC_L.csv","20210920_ATACCC_E_L.csv","SG_Ct_GT5.csv")
study_id <- c(1,2,3,4)
data_names <- c("kis","ataN","kis_ata","ataE","sg")
# different grouping types in hierachical model - only voc used here
group_names <- c("_none","_voc","_age","_study")
# parameters (by dataset) for translation of Ct values to ln(VL)
data_scale <- c(1.5677, 1.418, 1.394, 1.418)
data_offset <- c(6.119, 3.435, 3.145, 3.435)
# filename tags for different inclusion criteria for data included in fit. Only F used here
red_names <- c("A","R","G","M","F")
# values of hyperpriors for growth (first entry is "uninformative", second "informative")
hp_v_g <- c(1.0,0.9)
hp_v_sd_g <- c(1.4,0.2)
# file name tags for uninformative vs informative priors on growth
inform_prior_fn=c("t2","p1")

# prams common for all runs
group_by_which_cat <- 1  # 0 for no grouping, 1 for voc
red_to_full_prof <- 4  # see read_data.r - 4 removes subjects without full followup unless they are incident cases
fit_model <- TRUE # set to FALSE to load previous results
inc_vacc <- 2  # 0 for exclude vacc, 1 for include, 2 for include as separate VOC category
t_sd=4.0 # prior on SD of timing of peak VL

# set up vectors to define params which vary between runs
runs=12
ng.runs=c(4,1,4,4,1,1,4,1,4,4,1,1) # number of groups to fit
corr.runs=c(1,1,0,1,0,1,1,1,0,1,0,1) # flag specifying if correlation structure fitted
inform_prior.runs=c(1,1,1,1,0,0,1,1,1,1,0,0) # flag specifying if informative priors on growth to be used
age_slope.runs=c(1,0,0,0,0,0,1,0,0,0,0,0) # flag specifying on whether age dependence of peak VL fitted
data.runs=c(2,2,2,2,2,2,4,4,4,4,4,4) # data set to use - 2=ORF1ab, 4=E

#
# run fits
# much better distributed over multiple servers
# each fit requires ~50GB+ of RAM, takes 4-10h (including loo_cv) on 10 cores
#
for(i in runs) {
  num_groups <- ng.runs[i]
  data_set_num <- data.runs[i] # 1=kis, 2=ata, 3=both, 4=ata_E, 5=Singapore

#file name for outputs
    model_name <- paste0("f_",data_names[data_set_num],"_4",
                       inform_prior_fn[inform_prior.runs[run]+1],
                       red_names[red_to_full_prof+1],
                       "_",num_groups,"group",
                       group_names[group_by_which_cat+1],
                       "_incvacc",inc_vacc,"_tsd",t_sd,
                       "_corr",fit_corr)
  if(age_slope.runs[i]==1) model_name <- paste0(model_name,"_age1")

  data_list=read_data(data_files[study_id_set[[data_set_num]]],red_to_full_prof,inc_vacc,study_id[study_id_set[[data_set_num]]])

  data.stan=list(N=data_list$N,
                 subj_voc=data_list$subjects$voc,
                 subj_age_cat=data_list$subjects$age_cat,
                 subj_age=data_list$subjects$age,
                 NS=4,
                 subj_study=data_list$subjects$study_id,
                 M=data_list$M,
                 obs_id=data_list$data$id,
                 obs_day=data_list$data$TestDateIndex,
                 obs_ct=data_list$data$invCT,
                 pr_v_s=3.0,        # mean of prior for SD of CT measurements
                 pr_v_s_sd=3.0,     # SD of prior for SD of CT measurements
                 pr_fp=5.0,         # mean of prior for error proportion
                 pr_fp_sd=2.0,      # SD of prior of error proportion
                 pr_fp_v=3.0,       # prior for mean of error CT distribution
                 pr_fp_v_s=3.0,     # prior for SD of error CT distribution
                 pr_age_slope=0.5, # width of prior of slope of peak VL with age
                 K=3,
                 v_min=c(0,0,0),
                 hp_v=c(15,hp_v_g[inform_prior.runs[run]+1],0.5), # hyperprior on kinetic parameter group means
                 hp_v_sd=c(15,hp_v_sd_g[inform_prior.runs[run]+1],1.4), # hyperprior on kinetic parameter group SDs
                 hp_v_sd_sd=c(10,1.0,1.0), # hyper prior on within-group variation
                 hp_t_max_sd=t_sd,  # hyperprior for SD of t_max
                 eta=1,
                 ct_to_vl_sc=data_scale,
                 ct_to_vl_offset=data_offset,
                 fit_t_max_sd=0,
                 fit_corr=corr.runs[i],
                 fit_age_slope=age_slope.runs[i],
                 do_simp_err=0,
                 do_simp_vl=0, # if this is set to 1, fit uses piece wise linear log VL model
                 NG=num_groups, # 2 if v[] fitted separately for VOC and non-VOC, 1 otherwise
                 NV=4,  # num of VOC categories
                 group_by_which_cat=group_by_which_cat, # 1 = voc, 2 = age, 3 = study
                 Nsamp=100)

# initial values for stan chains - necessary to constrain some to avoid numerical issues

  initf<- function(chain_id) {
    list(l_fp = 3+(runif(1)-0.5), v_s=3+(runif(1)-0.5), age_slope=0.1+0.3*runif(1),
         fp_ct_sd=3+(runif(1)-0.5), fp_ct_mean=0+(runif(1)-0.5),
         v=array(c(15,1,0.5),dim=c(3,num_groups)),v_sd=c(2,0.5,0.5))
  }

  if(fit_model==TRUE) {

# run stan model - note high adapt_delta, low stepsize, fairly long chains
    fit = stan(file="model.stan", chains=10, cores=10, data=data.stan,
               iter=7000, init=initf, init_r=0.1, warmup=3000, seed=497101, thin=2,
               control = list(adapt_delta = 0.994, max_treedepth = 13, stepsize=0.01))
    saveRDS(fit,paste0(model_name,".rds"))
    check_hmc_diagnostics(fit)
# need to have moment_match=TRUE to get valuely decent loo_cv diagnostics
    loo_res=loo(fit,cores=10,moment_match=TRUE)
    saveRDS(loo_res,paste0(model_name,"_loo.rds"))
    loo_res

  } else {

    fit=readRDS(paste0(model_name,".rds"))
    loo_res=readRDS(paste0(model_name,"_loo.rds"))

  }
# generate plot of fit to data

  plot_graphs(data_list, fit, model_name, num_groups, inc_vacc, group_names=c("pre-Alpha","Alpha","Delta","Delta(vacc)"))
}


#' @title Leave one out cross-validation
#' @description Implementation of leave-one-out cross-validataion. It takes in an entire dataset, with first column the sample IDs, second column the group variable (classificatoin variable/disease type), using "Type" as its colum names, and third column the beginning of count table.
#' @param data A data frame validation set with first column the sample IDs, second column the group variable (classificatoin variable/disease type), and third column the beginning of count table.
#' @param type_col An index indicating at which column is group/type variable. The default is the 3rd column.
#' @param col_start An index indicating at which column is the beginning of bacteria (features) data. Default is the 2nd column.
#' @param Cutoff_mean The minimum average relative abundance allowed in filtering step. Default is 0.0005.
#' @param Cutoff_ratio The non-zero ratio cutoff in filtering features.Default value is 0.1.
#' @param totalReadsCutoff The minimum allowed total reads per sample. Any sample has less than this number of total reads will be removed. Default is 500.
#' @param Cutoff_pvalue The maximal P value allowed for a given feature to be remained in the list of selected features.
#' @export
#' @return A list of CalPrb() results. This output will be further used for Cal_AUC() in order to estimate the final model.
#' @examples
#' data(training)
#' loocv(training)

loocv <- function(data=data, type_col=2, col_start=3,Cutoff_mean=0.001,Cutoff_ratio=0.1,totalReadsCutoff=500, Cutoff_pvalue = 0.10){
  res<- list()
  FS_out_all <- FS(training=data,type_col=type_col,col_start=col_start,Cutoff_mean=Cutoff_mean,Cutoff_ratio=Cutoff_ratio,totalReadsCutoff=totalReadsCutoff, Cutoff_pvalue = Cutoff_pvalue)
  tmpData <- FS_out_all$CountData
  for (i in 1:nrow(tmpData)){
    print(i)
    testSet <- tmpData[i,]
    FS_out <- FS_out_all
    FS_out$CountData <- tmpData[-i,]
    res[[i]] <- CalPrb(FS_out=FS_out,testSet=testSet,col_start=col_start,type_col =type_col,HighestRank=nrow(FS_out$Feature))
  }
  return(res)
}


## !/user/bin/env RStudio 1.1.423
## -*- coding: utf-8 -*-
## 北京历史天气

#清空系统内存
rm(list = ls())
gc()

#加载包
library("dplyr")
library("ggplot2")
library("stringr")
library("lubridate")
library("DT")
library("ggplot2")
library("reshape2")
library("RColorBrewer")
library("scales")
library("showtext")
library("grid")
library("Cairo")

mytable <- read.csv("D:/R/File/beijingtianqi.csv",stringsAsFactors=FALSE,check.names=FALSE)

#作图数据准备
mydata11  <- mytable %>%
  select(date,AQI,Year)  %>%
  arrange(Year,date) %>%
  filter(date!="2016-02-29")

#月份标签及其旋转角度
mydata11$Month     <- month(mydata11$date)
mydata11$Monthdata <- -5
mydata11$Monthjo   <- ifelse(mydata11$Month %% 2==0,"A","B")
circlemonth        <- seq(15,345,length=12)
circlebj           <- rep(c(-circlemonth[1:3],rev(circlemonth[1:3])),2)

#取月度数据子集
mydata11$ID   <- rep(seq(from=1,to=365),3)
mydata11$Year <- factor(mydata11$Year,order=T)
mydata11$Asst <- 5
mydata11$Asst[mydata11$Year==2015] <- 10
mydata11$Asst[mydata11$Year==2016] <- 15
mydata11A<-mydata11[mydata11$Year==2014 & mydata11$Monthjo=="A",]
mydata11B<-mydata11[mydata11$Year==2014 & mydata11$Monthjo=="B",]

#取季度数据子集
mydata11$Quarter     <- quarter(mydata11$date)
mydata11$Quarterdata <- 20
mydata11C<-mydata11 %>% filter(mydata11$Year==2014) %>% filter(Quarter %in% c(1,3))
mydata11D<-mydata11 %>% filter(mydata11$Year==2014) %>% filter(Quarter %in% c(2,4))
circlequarter<-seq(45,315,length=4)
circleqd <- rep(c(-circlequarter[1],circlequarter[1]),2)

#空气质量AQI指标离散化（使用cut函数进行离散等距分箱）
mydata11$FADD<-cut(
	mydata11$AQI,
    breaks=c(0,50,100,150,200,300,500),
    labels=c("0~50","50~100","100~150","150~200","200~300","300~500"),
    order= TRUE
    )

font_add("myfont","msyhl.ttc")

CairoPNG(file="ECOCircle.png",width=1488,height=996)
showtext.begin()
ggplot()+
  geom_bar(data=mydata11A,aes(x=ID,y=Monthdata),stat="identity",width=1,fill="#ECEDD1",col="#ECEDD1")+
  geom_bar(data=mydata11B,aes(x=ID,y=Monthdata),stat="identity",width=1,fill="#DFE0B1",col="#DFE0B1")+
  geom_bar(data=mydata11C,aes(x=ID,y=Quarterdata),stat="identity",width=1,fill="#BDBDBD",col="#BDBDBD")+
  geom_bar(data=mydata11D,aes(x=ID,y=Quarterdata),stat="identity",width=1,fill="#D4D2D3",col="#D4D2D3")+
  geom_bar(data=mydata11[mydata11$Year==2016,],aes(x=ID,y=Asst,fill=FADD),stat="identity",width=1)+
  geom_bar(data=mydata11[mydata11$Year==2015,],aes(x=ID,y=Asst,fill=FADD),stat="identity",width=1)+
  geom_bar(data=mydata11[mydata11$Year==2014,],aes(x=ID,y=Asst,fill=FADD),stat="identity",width=1)+
  geom_text(data=NULL,aes(x=circlemonth,y=-2.5,label=paste0(1:12,"月"),angle=circlebj),family="myfont",size=7,hjust=0.5,vjust=.5)+
  geom_text(data=NULL,aes(x=circlequarter,y=17.5,label=paste0(c("一","二","三","四"),"季度"),angle=circleqd),family="myfont",size=7,hjust=0.5,vjust=.5)+
  scale_fill_brewer(palette="YlOrRd",type="seq",direction=1,guide=guide_legend(reverse=TRUE))+
  scale_x_continuous(expand = c(0,0)) +
  coord_polar(theta="x")+
  ylim(-20,20) +
  guides(colour=guide_legend(reverse=TRUE))+
  annotate("text",x=0,y=-15,label="北京",size=25,hjust=.5,vjust=1,family="myfont") +
  labs(
    title="2014~2016年度北京市空气质量水平可视化",
    subtitle="数据根据AQI指标水平进行分段分割",
    caption="Source：https://www.aqistudy.cn/",
    x="",y="",fill=""
    )+
  theme_void() %+replace%
  theme(
    panel.border=element_blank(),
    legend.key.size=unit(1.2,'cm'),
    legend.key.height=unit(1,'cm'),
    legend.text.align=1,
    legend.position=c(1,0),legend.justification=c(1,0),
    legend.text=element_text(size=20,hjust=3,vjust=3,face="bold"),
    plot.title=element_text(size=50,lineheight=1.5,family="myfont"),
    plot.subtitle=element_text(size=35,lineheight=1.5,family="myfont"),
    plot.caption=element_text(size=25,hjust=0,lineheight=1.2,family="myfont"),
    plot.margin=unit(c(.5,.5,.5,.5),"lines")
  )
showtext.end()
dev.off()

###月份圆环及标签：
ggplot()+
  geom_bar(data=mydata11A,aes(x=ID,y=Monthdata),stat="identity",width=1,fill="#ECEDD1",col="#ECEDD1")+
  geom_bar(data=mydata11B,aes(x=ID,y=Monthdata),stat="identity",width=1,fill="#DFE0B1",col="#DFE0B1")+
  geom_text(data=NULL,aes(x=circlemonth,y=-2.5,label=paste0(1:12,"月"),angle=circlebj),family="myfont",size=7,hjust=0.5,vjust=.5)+
  scale_x_continuous(expand = c(0,0)) +
  coord_polar(theta="x")+
  ylim(-20,20) +
  theme_void()

  ###季度圆环及标签：
  ggplot()+
  geom_bar(data=mydata11C,aes(x=ID,y=Quarterdata),stat="identity",width=1,fill="#BDBDBD",col="#BDBDBD")+
  geom_bar(data=mydata11D,aes(x=ID,y=Quarterdata),stat="identity",width=1,fill="#D4D2D3",col="#D4D2D3")+
  geom_text(data=NULL,aes(x=circlequarter,y=17.5,label=paste0(c("一","二","三","四"),"季度"),angle=circleqd),family="myfont",size=7,hjust=0.5,vjust=.5)+
  scale_x_continuous(expand = c(0,0)) +
  coord_polar(theta="x")+
  ylim(-20,20) +
  theme_void()

  ###中心天气圆环图：
  ggplot()+
  geom_bar(data=mydata11[mydata11$Year==2016,],aes(x=ID,y=Asst,fill=FADD),stat="identity",width=1)+
  geom_bar(data=mydata11[mydata11$Year==2015,],aes(x=ID,y=Asst,fill=FADD),stat="identity",width=1)+
  geom_bar(data=mydata11[mydata11$Year==2014,],aes(x=ID,y=Asst,fill=FADD),stat="identity",width=1)+
  scale_fill_brewer(palette="YlOrRd",type="seq",direction=1,guide=guide_legend(reverse=TRUE))+
  scale_x_continuous(expand = c(0,0)) +
  coord_polar(theta="x")+
  ylim(-20,20) +
  guides(colour=guide_legend(reverse=TRUE))+
  annotate("text",x=0,y=-15,label="北京",size=25,hjust=.5,vjust=1,family="myfont") +
  theme_void()


#install.packages("/nas40t2/egamazon/matrixeqtl/MatrixEQTL_1.6.2.tar.gz", repos = NULL, type="source")
library(MatrixEQTL)

"%&%" = function(a,b) paste(a,b,sep="")

args <- commandArgs(TRUE);

## Settings
chr = as.numeric(args[1]);

#mydir = "/nas40t2/egamazon/PREDIXCAN/";
mydir = "";

# Linear model to use, modelANOVA, modelLINEAR, or modelLINEAR_CROSS
useModel = modelLINEAR ; # modelANOVA, modelLINEAR, or modelLINEAR_CROSS

# Genotype file name
SNP_file_name = mydir %&% "DGN.imputed.SNPxID" %&% chr;
snps_location_file_name = mydir %&% "snp_location_info.MOD";

# Gene expression file name
expression_file_name = mydir %&% "DGN-WB.forMatrixeQTL.GENExID";
gene_location_file_name = mydir %&% "gene_location_info";

# Covariates file name
# Set to character() for no covariates
# covariates_file_name = "covariates_new/lung.txt";
covariates_file_name = character();

# Output file name
output_file_name_cis = "OUTPUT/eQTL_results_R_cis.DGN-WB." %&% chr  %&% ".txt";
output_file_name_tra = "OUTPUT/eQTL_results_R_tra.DGN-WB." %&% chr  %&% ".txt";

# Only associations significant at this level will be saved
pvOutputThreshold_cis = 0.05;
pvOutputThreshold_tra = 1e-5;

# Error covariance matrix
# Set to numeric() for identity.
errorCovariance = numeric();
# errorCovariance = read.table("Sample_Data/errorCovariance.txt");

cisDist = 1e6;

## Load genotype data

snps = SlicedData$new();
snps$fileDelimiter = "\t"; # the TAB character
snps$fileOmitCharacters = "NA"; # denote missing values;
snps$fileSkipRows = 0; # one row of column labels
snps$fileSkipColumns = 1; # one column of row labels
snps$fileSliceSize = 2000; # read file in pieces of 2,000 rows
snps$LoadFile(SNP_file_name);

## Load gene expression data

gene = SlicedData$new();
gene$fileDelimiter = "\t"; # the TAB character
gene$fileOmitCharacters = "NA"; # denote missing values;
gene$fileSkipRows = 0; # one row of column labels
gene$fileSkipColumns = 1; # one column of row labels
gene$fileSliceSize = 2000; # read file in pieces of 2,000 rows
gene$LoadFile(expression_file_name);

## Load covariates

cvrt = SlicedData$new();
cvrt$fileDelimiter = "\t"; # the TAB character
cvrt$fileOmitCharacters = "NA"; # denote missing values;
cvrt$fileSkipRows = 0; # one row of column labels
cvrt$fileSkipColumns = 0; # one column of row labels
cvrt$fileSliceSize = 2000; # read file in one piece
if(length(covariates_file_name)>0) {
    cvrt$LoadFile(covariates_file_name);
}

## Run the analysis
snpspos = read.table(snps_location_file_name, header = FALSE, stringsAsFactors = FALSE);
genepos = read.table(gene_location_file_name, header = FALSE, stringsAsFactors = FALSE);

me = Matrix_eQTL_main(
        snps = snps,
        gene = gene,
        cvrt = cvrt,
        output_file_name = output_file_name_tra,
        pvOutputThreshold = pvOutputThreshold_tra,
        useModel = useModel,
        errorCovariance = errorCovariance,
        verbose = TRUE,
        output_file_name.cis = output_file_name_cis,
        pvOutputThreshold.cis = pvOutputThreshold_cis,
        snpspos = snpspos,
        genepos = genepos,
        cisDist = cisDist,
        pvalue.hist = "qqplot");

## Plot the Q-Q plot of local and distant p-values
pdf('DGN-WB.' %&% chr  %&% '.pdf')
plot(me)
dev.off()


setwd("C:/Users/DELL/OneDrive/CodeLibrary/R/ZMVM_Urbanizacion") #Working directory

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

# Cargar librerias que se van a utilizar

library("leaflet") #Paquete para usar cosas de mapas
library("rgdal") #Paquete para leer archivos shapefiles .shp
library("dplyr") #Paquete para filtrar datos de dataframes
library("fontawesome") #Paquete para íconos de marcadores
library("htmlwidgets") #Paquete para salvar mapa en html
library("leaflet.extras") #Paquete para poder buscar en los mapas
library("sf") #Paquete de herramientas para mapas
library("tidyr")

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

ubicacion_dist <- paste0("C:/Users/DELL/OneDrive/CodeLibrary/R/ZMVM_Urbanizacion/DistritosEODHogaresZMVM2017/DistritosEODHogaresZMVM2017.shp") #Ubicación del archivo shapefile
dist <- ubicacion_dist %>% readOGR(layer = paste0("DistritosEODHogaresZMVM2017"), verbose = FALSE, GDAL1_integer64_policy=TRUE) #Leer shapefile
dist <- dist %>% spTransform(CRS("+proj=longlat +ellps=WGS84 +no_defs"))

ubicacion_ageb_u_cdmx <- paste0("C:/Users/DELL/OneDrive/CodeLibrary/R/ZMVM_Urbanizacion/df/df_ageb_urbana.shp") #Ubicación del archivo shapefile
ageb_u_cdmx <- ubicacion_ageb_u_cdmx %>% readOGR(layer = paste0("df_ageb_urbana"), verbose = FALSE, GDAL1_integer64_policy=TRUE) #Leer shapefile
ageb_u_cdmx <- ageb_u_cdmx %>% spTransform(CRS("+proj=longlat +ellps=WGS84 +no_defs"))

ubicacion_ageb_r_cdmx <- paste0("C:/Users/DELL/OneDrive/CodeLibrary/R/ZMVM_Urbanizacion/df/df_ageb_rural.shp") #Ubicación del archivo shapefile
ageb_r_cdmx <- ubicacion_ageb_r_cdmx %>% readOGR(layer = paste0("df_ageb_rural"), verbose = FALSE, GDAL1_integer64_policy=TRUE) #Leer shapefile
ageb_r_cdmx <- ageb_r_cdmx %>% spTransform(CRS("+proj=longlat +ellps=WGS84 +no_defs"))

ubicacion_manzana_cdmx <- paste0("C:/Users/DELL/OneDrive/CodeLibrary/R/ZMVM_Urbanizacion/df/df_manzana.shp") #Ubicación del archivo shapefile
manzana_cdmx <- ubicacion_manzana_cdmx %>% readOGR(layer = paste0("df_manzana"), verbose = FALSE, GDAL1_integer64_policy=TRUE) #Leer shapefile
manzana_cdmx <- manzana_cdmx %>% spTransform(CRS("+proj=longlat +ellps=WGS84 +no_defs"))

ageb_cdmx_u_sf <- st_as_sf(ageb_u_cdmx)
ageb_cdmx_u_cent <- st_centroid(ageb_cdmx_u_sf)

ageb_cdmx_r_sf <- st_as_sf(ageb_r_cdmx)
ageb_cdmx_r_cent <- st_centroid(ageb_cdmx_r_sf)

testpoints_ageb_u_cdmx <- matrix(nrow = nrow(ageb_cdmx_u_cent), ncol = 3) #Iniciar lista vacia para determinar la Clave INEGI de cada Oxxo
testpoints_ageb_r_cdmx <- matrix(nrow = nrow(ageb_cdmx_r_cent), ncol = 3) #Iniciar lista vacia para determinar la Clave INEGI de cada Oxxo

pb <- txtProgressBar(min = 0, max = nrow(ageb_cdmx_u_cent), style = 3)
for (i in 1:nrow(ageb_cdmx_u_cent)){
  if (sample(1:40, 1)==sample(1:40, 1) || i==nrow(ageb_cdmx_u_cent)){
  setTxtProgressBar(pb, i)
  }
  point <- SpatialPoints(cbind(as.numeric(unlist(ageb_cdmx_u_cent$geometry[i]))[1],as.numeric(unlist(ageb_cdmx_u_cent$geometry[i]))[2]),proj4string=CRS(as.character("+proj=longlat +ellps=WGS84 +no_defs")))
  testpoints_ageb_u_cdmx[i,] <- cbind(as.character(unlist(ageb_cdmx_u_cent$CVEGEO[i]))[1],as.character(unlist(over(point,dist,returnList = FALSE)$Distrito)),"urbana")
}

pb <- txtProgressBar(min = 0, max = nrow(ageb_cdmx_r_cent), style = 3)
for (i in 1:nrow(ageb_cdmx_r_cent)){
  if (sample(1:40, 1)==sample(1:40, 1) || i==nrow(ageb_cdmx_r_cent)){
  setTxtProgressBar(pb, i)
  }
  point <- SpatialPoints(cbind(as.numeric(unlist(ageb_cdmx_r_cent$geometry[i]))[1],as.numeric(unlist(ageb_cdmx_r_cent$geometry[i]))[2]),proj4string=CRS(as.character("+proj=longlat +ellps=WGS84 +no_defs")))
  testpoints_ageb_r_cdmx[i,] <- cbind(as.character(unlist(ageb_cdmx_r_cent$CVEGEO[i]))[1],as.character(unlist(over(point,dist,returnList = FALSE)$Distrito)),"rural")
}

map <- leaflet() #Crear mapa en blanco

k <- 0
  ###############################################################################

map <- map %>% #Agregar al mapa shapefile con datos del nuevo municipio

    addPolygons(data= dist,
                stroke = TRUE,
                color='black',
                opacity=1,
                smoothFactor = 0.5,
                weight = 4,
                fillColor = "#26b8e8",
                fillOpacity = 0,
                popup = paste(
                    '
Clave distrito: ', paste(dist$Distrito)
                ))

map <- map %>% #Agregar al mapa shapefile con datos del nuevo municipio

    addPolygons(data= ageb_u_cdmx,
                stroke = TRUE,
                color = 'blue',
                opacity=1,
                smoothFactor = 0.5,
                weight = 7,
                fillColor = "#2062e6",
                fillOpacity = 0.1,
                popup = paste(
                    '
Clave municipio/alcaldía: ', paste(ageb_u_cdmx$CVEGEO)
                ))

map <- map %>% #Agregar al mapa shapefile con datos del nuevo municipio

    addPolygons(data= ageb_r_cdmx,
                stroke = TRUE,
                color = 'red',
                opacity=1,
                smoothFactor = 0.5,
                weight = 7,
                fillColor = "#2062e6",
                fillOpacity = 0.1,
                popup = paste(
                    '
Clave municipio/alcaldía: ', paste(ageb_r_cdmx$CVEGEO)
                ))

map <- addTiles(map)

setwd(paste0("C:/Users/DELL/OneDrive/CodeLibrary/R/ZMVM_Urbanizacion/")) #Working directory: cambiar según computadora

saveWidget(map, file=paste0("distritos_ageb_cdmx_map.html"))


require(ggplot2)
require(xtable)
require(doBy)

#Arbeitspfad setzen
setwd("/Volumes/cracker/data/nfs/thomas/experiments/indoor-noise-17.07.2011-nosync-noise0-cca62-ofdm1-ch6/data/")

histogram <- read.csv(file="merged-trace/aggregation/tel-16-1-1-sec-histogram.csv", header=F, sep = ",")

#read histogramm summary file
histogram_all <- read.csv(file="merged-trace/aggregation/all-node-histogram.csv", header=TRUE, sep = " ")

#exclude en because 12 is a nicer grid than 13 nodes
histogram <- subset(histogram_all, noise>-120 & !as.character(node) %in% as.character("en"))

#extend the statistics per node
sumfun <- function(x, ...){
  c(mean=mean(x, ...), median=median(x, ...), sd=sd(x, ...), var=var(x, ...), length=length(x))
}
count_sum_per_node <- summaryBy(data=histogram, count ~ node, FUN=sum, na.rm=T)
noise_stats_per_node <- summaryBy(data=histogram, noise ~ node, FUN=sumfun, na.rm=T)

histogram <- merge(histogram,count_sum_per_node)

#test for a single node tel-16-1
ggplot(histogram, aes(x = V1, weight = V2, y = ..density..)) +
      geom_histogram(binwidth=1, colour = "black",) +
      geom_density(aes(y=..scaled..), colour="darkred", legend=FALSE, adjust=1/3) +
      scale_y_continuous(breaks = seq(0, 1, by = 0.1)) +
      scale_x_continuous(breaks = seq(-110, -60, by = 10)) +
      labs(x = "measured noisefloor in 1dB bins [dB]",
           y = "density (kernel density estimator)") +
      coord_cartesian(xlim = c(min(histogram$V1),max(histogram$V1))) +
      coord_cartesian(ylim = c(0,1)) +
        opts(axis.text.y = theme_text(hjust = 1, size = 8, colour = "black"),
              axis.text.x = theme_text(hjust = 0.5, size = 8, colour = "black"),
              axis.title.y = theme_text(angle = 90, vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              axis.title.x = theme_text(vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              legend.position="none",
              title ="Noisefloor density per node at channel 6",
              plot.title=theme_text(colour="black", size=12, vjust = 1.5, hjust = 0.5),
              strip.text.x = theme_text(size=10, face='bold'),
              strip.background = theme_rect(colour='darkgray', fill='lightgray'))

# PRINT EPS DENSTITY GRID PLOT
postscript(file="plots/noise-density-facetwrap-all-nodes-24h-ch6.eps", horizontal=F, onefile=F, height=5, width=5)
  print(
    ggplot(histogram, aes(x = noise, weight = count/count.sum, y = ..density.., fill = node)) +
      geom_histogram(binwidth=1, colour = "black",) +
      scale_y_continuous(breaks = seq(0, 1, by = 0.1)) +
      scale_x_continuous(limits=c(-105,-70), breaks = seq(-110, -60, by = 10)) +
      labs(x = "measured noisefloor in 1dB bins [dB]",
           y = "density (kernel density estimator)") +
        opts(axis.text.y = theme_text(hjust = 1, size = 8, colour = "black"),
              axis.text.x = theme_text(hjust = 0.5, size = 8, colour = "black"),
              axis.title.y = theme_text(angle = 90, vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              axis.title.x = theme_text(vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              legend.position="none",
              title ="Noisefloor density per node at channel 6",
              plot.title=theme_text(colour="black", size=12, vjust = 1.5, hjust = 0.5),
              strip.text.x = theme_text(size=10, face='bold'),
              strip.background = theme_rect(colour='darkgray', fill='lightgray')) +
      facet_wrap(~ node, ncol=3, scales = "free_y")
  )
dev.off()

#histogramm ueber alle nodes in FARBE
postscript(file="plots/noise-density-all-nodes-24h-ch6-color.eps", horizontal=F, onefile=F, height=5, width=5)
  print(
    ggplot(histogram, aes(x = noise)) +
      geom_histogram(aes(weight = count/sum(as.numeric(count)), y = ..density.., fill = node), binwidth = 1) +
      geom_histogram(aes(weight = count/sum(as.numeric(count)), y = ..density.., fill = node),
                     colour = "black", binwidth = 1, legend=FALSE) +
      geom_density(aes(weight = count/sum(as.numeric(count)), y=..scaled..), colour="darkred", legend=FALSE, adjust=1/3) +
      scale_y_continuous(breaks = seq(0, 1.8, by = 0.1)) +
      scale_x_continuous(limits=c(-105,-70), breaks = seq(-110, -60, by = 5)) +
      labs(x = "measured noisefloor in 1dB bins [dB]",
           y = "density (kernel density estimator)") +
      geom_text(aes(x = -101, y=1.45, label = "*kernel density estimator"), size = 2, colour = "darkred") +
        opts(axis.text.y = theme_text(hjust = 1, size = 8, colour = "black"),
              axis.text.x = theme_text(hjust = 0.5, size = 8, colour = "black"),
              axis.title.y = theme_text(angle = 90, vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              axis.title.x = theme_text(vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              title ="Noisefloor density including all nodes at channel 6",
              plot.title=theme_text(colour="black", size=12, vjust = 1.5, hjust = 0.5),
              strip.text.x = theme_text(size=10, face='bold'),
              strip.background = theme_rect(colour='darkgray', fill='lightgray'))
  )
dev.off()

#histogramm ueber alle nodes IN BLACK&WHITE
postscript(file="plots/noise-density-all-nodes-24h-ch6-blackwhite.eps", horizontal=F, onefile=F, height=5, width=5)
  print(
    ggplot(histogram, aes(x = noise)) +
      geom_histogram(aes(weight = count/sum(as.numeric(count)), y = ..density.., fill = node), binwidth = 1) +
      geom_histogram(aes(weight = count/sum(as.numeric(count)), y = ..density.., fill = node),
                     colour = "black", binwidth = 1, legend=FALSE) +
      scale_fill_grey() +
      geom_density(aes(weight = count/sum(as.numeric(count)), y=..scaled..), colour="darkred", legend=FALSE, adjust=1/3) +
      scale_y_continuous(breaks = seq(0, 1.8, by = 0.1)) +
      scale_x_continuous(limits=c(-105,-70), breaks = seq(-110, -60, by = 5)) +
      labs(x = "measured noisefloor in 1dB bins [dB]",
           y = "density (kernel density estimator)") +
      geom_text(aes(x = -101, y=1.45, label = "*kernel density estimator"), size = 2, colour = "darkred") +
        opts(axis.text.y = theme_text(hjust = 1, size = 8, colour = "black"),
              axis.text.x = theme_text(hjust = 0.5, size = 8, colour = "black"),
              axis.title.y = theme_text(angle = 90, vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              axis.title.x = theme_text(vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              title ="Noisefloor density including all nodes at channel 6",
              plot.title=theme_text(colour="black", size=12, vjust = 1.5, hjust = 0.5),
              strip.text.x = theme_text(size=10, face='bold'),
              strip.background = theme_rect(colour='darkgray', fill='lightgray'))
  )
dev.off()

#areaplots ueber alle nodes IN COLOR oder BLACK&WHITE
postscript(file="plots/noise-density-area-all-nodes-24h-ch6-color.eps", horizontal=F, onefile=F, height=5, width=5)
  print(
    ggplot(histogram, aes(noise, weight = count/sum(as.numeric(count)), fill = node)) +
      #scale_fill_grey() +
      geom_density(aes(y = ..density..), binwidth=1, alpha=1, position = "stack", adjust=1/5, ) +
      scale_y_continuous(breaks = seq(0, 1.8, by = 0.025)) +
      scale_x_continuous(limits=c(-105,-70), breaks = seq(-110, -60, by = 5)) +
      #geom_text(aes(x = -101, y=0.12, label = "*density shown as stacked"), size = 2, colour = "black") +
      labs(x = "measured noisefloor [dB]",
           y = "density (kernel density estimator)") +
         opts(axis.text.y = theme_text(hjust = 1, size = 8, colour = "black"),
              axis.text.x = theme_text(hjust = 0.5, size = 8, colour = "black"),
              axis.title.y = theme_text(angle = 90, vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              axis.title.x = theme_text(vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              title ="Noisefloor density about all node at channel 6",
              plot.title=theme_text(colour="black", size=12, vjust = 1.5, hjust = 0.7),
              strip.text.x = theme_text(size=10, face='bold'),
              strip.background = theme_rect(colour='darkgray', fill='lightgray'))
  )
dev.off()

# wieviele node haben gleiche noise werte
equal_noise <- ddply(histogram, .(noise), summarise, freq=length(noise))
postscript(file="plots/equal-noise-at-nodes-24h-ch6-blackwhite.eps", horizontal=F, onefile=F, height=5, width=5)
  print(
    ggplot(equal_noise, aes(x=noise, weight=freq)) +
      scale_fill_grey() +
      geom_bar(binwidth=1,alpha=0.9) +
          scale_y_continuous(breaks = seq(0, 1.8, by = 0.1)) +
      scale_x_continuous(limits=c(-105,-70), breaks = seq(-110, -60, by = 5)) +
      labs(x = "measured noisefloor [dB]",
           y = "density (kernel density estimator)") +
        opts(axis.text.y = theme_text(hjust = 1, size = 8, colour = "black"),
              axis.text.x = theme_text(hjust = 0.5, size = 8, colour = "black"),
              axis.title.y = theme_text(angle = 90, vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              axis.title.x = theme_text(vjust = 0.2, hjust = 0.5, size = 10, colour = "black"),
              title ="Noisefloor density about all node at channel 6",
              plot.title=theme_text(colour="black", size=12, vjust = 1.5, hjust = 0.5),
              strip.text.x = theme_text(size=10, face='bold'),
              strip.background = theme_rect(colour='darkgray', fill='lightgray'))
  )
dev.off()


#!/usr/bin/Rscript --vanilla

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

label_wrap <- function(variable, value) {
    laply(strwrap(as.character(value), width=5, simplify=FALSE), paste, collapse="\n")
}

all_mac <- read.csv(file="stdin",header = T, sep = " ", dec='.')
all_mac <- melt(all_mac, id=c("ktime"), measure=c("d_tx","d_rx","d_idle","d_others"),variable_name = "mac_states")

max_x <- max(all_mac$ktime/1000000000)

p1 = ggplot(data=all_mac, aes (x=ktime/1000000000)) +
    geom_histogram(aes(fill=factor(variable), weight=abs(value)), position="fill", binwidth = 1) +
    geom_hline(yintercept = seq(0,1,0.25), color="grey50", linetype="dashed", size=0.3) +
    geom_hline(yintercept = seq(0.125,1,0.25), color="grey50", linetype="dotted", size=0.3) +
    geom_vline(xintercept = seq(0,max_x, by = round(max_x/5)), color="grey50", linetype="dashed", size=0.3) +
    geom_vline(xintercept = seq(max_x/10,max_x, by = round(max_x/5)), color="grey50", linetype="dotted", size=0.3) +
    scale_y_continuous(labels = percent_format()) +
    scale_x_continuous(limits=c(0, max_x), breaks = seq(0, max_x, by = round(max_x/5)), minor_breaks = seq(0, max_x, by = round(max_x/10))) +
    labs(x = "Time [s]", y = "relative dwell time [%]") +
    theme_bw() +
    labs(title = "Distribution of MAC-States over Time") +
    theme(strip.text.x = element_text(size=12),
        strip.text.y = element_text(size=9),
        axis.text.x = element_text(size = 15, colour = "black"),
        axis.text.y = element_text(size = 15, colour = "black"),
        plot.title=element_text(colour="black", face="plain", size=20, vjust = 1.5, hjust = 0.5),
        plot.title = element_text(size = 14),
        strip.background = element_rect(colour='grey30', fill='grey80'),
        legend.title=element_text(colour="black", size=16, hjust=-.1, face="plain"),
        legend.text=element_text(colour="black", size=15, face="plain"),
        legend.background = element_rect(),
        axis.title.y = element_text(angle = 90, vjust = 0.2, hjust = 0.5, size = 18, colour = "black", face="plain"),
        axis.title.x = element_text(vjust = 0.2, hjust = 0.5, size = 18, colour = "black", face="plain")
    ) +
    scale_fill_manual(values=c("#F55A5A", "#32B2FF", "#F5DA81", "#DA81F5"),name="MAC-\nStates",labels=c("TX-busy", "RX-busy", "IDLE", "Interference"))

ggsave(p1, file="RegMon.png", width=11, height=8, dpi=600)


## R CODE FOR ANALYSIS OF RESULTING CONTIG/UCE COVERAGE FILES ##

library(hexbin)
library(data.table)
library(doBy)
library(lattice)
library(gridExtra)
#load appropriate libraries.

temp_data <- function(file) {
  temp_dataset <- read.table(file, header=F, sep="\t")
  #Imports the data
  temp_dataset <- temp_dataset[ which(temp_dataset$V1!='genome'), ]
  #remove anything in the file where 'genome' is in column V1
  temp_dataset$loc = as.character(lapply(strsplit(as.character(temp_dataset$V1), split="_"), "[", -2))
  #split each line using '_' as the split variable. assign the second part of the split to loc (locus)
  temp_dataset$taxon = as.character(lapply(strsplit(as.character(temp_dataset$V1), split="_"), "[", -1))
  #split each line using '_' as the split variable. assign the second part of the split to taxon
  temp_dataset$pos = temp_dataset$V2
  #set V2 to column pos (position)
  temp_dataset$exactloc = as.character(lapply(strsplit(as.character(temp_dataset$loc), split="uce"), "[", 2))
  #split loc (locus) on 'uce' to get the exact locus name and assign that to exactloc
  dt <- data.table(temp_dataset)
  #turn the temp_dataset into a data.table
  setkey(dt, "exactloc")
  #set exactloc as a sorting key
  X <- dt[, list(MED=max(pos)), by=key(dt)]
  #using the exactloc key, loop over the data.table dt and find the maxiumum value of position.
  temp_dataset <- dt[X, list(taxon, V1, pos, V3, loc, trPos=floor(V2-(MED/2)))]
  #using the max length define the distance from the midpoint (-/+) for each locus position and assign that to trpos
  return(temp_dataset)
  #return the dataset
}
#The above is a function that opens each file sent to it and cleans up the data a bit.

make_dataset <- function(working_dir) {
  #a function to generate the dataset.
  setwd(working_dir)
  files <- list.files(pattern = 'smds.per.base.coverage')
  #set working directory and get files.

  for (file in files){
  #simple for loop traversing all files the loop picked up earlier.
    if (exists("dataset")){
      #if the dataset already exists, this will start the append process.
      Sys.sleep(0.1)
      print(file)
      flush.console()
      #provides a way to see what files are being worked on.

      temp_dataset <- temp_data(file)
      #run the function setup above on the file.

      dataset<-rbind(dataset, temp_dataset)
      #join the new data to the old dataset.

      rm(temp_dataset)
      #as a precaution, remove the temp_dataset from memory.

    } else {
      #if dataset does not exist, we need to make it.
      Sys.sleep(0.1)
      print(file)
      flush.console()
      #provides a way to see what files are being worked on.

      dataset <- temp_data(file)
      #this runs the function on the file and generates 'dataset'
    }
  }
new_data <- dataset
rm(dataset)
#this is a precaution against if you run the function twice. It will remove 'dataset' so that if the loop is run again, a new dataset will be made.
return(new_data)
}
#The above is a function loops over files in the directory provided to the function.

new_data <- make_dataset("/directory/path/to/your/files")
#make the dataset using the functions 'make_dataset' and 'temp_data'.
#to get this statement to work properly, you will need to execute the code for the functions into active memory (similar to loading a pacakge)

#########
# now that you have the data, the statements below, summarize that data in various ways.

summary_all_loci <- summaryBy(V3 ~ trPos+loc, data = new_data, FUN = function(x) { c(m = mean(x)) } )

summary_avg_loci <- summaryBy(V3 ~ trPos, data = new_data, FUN = function(x) { c(m = mean(x), n = length(x)) } )

summary_avg <- summaryBy(V3.m ~ loc, data = summary_all_loci, FUN = function(x) { c(m = mean(x), n = length(x), min=min(x), max=max(x)) } )

summary_avg <- summaryBy(V3 ~ taxon, data = new_data, FUN = function(x) { c(m = mean(x), n = length(x), min=min(x), max=max(x)) } )

##Hexbin plots for the coverages (might need to be tweaked).
plot1 <- xyplot(summary_avg_loci$V3.m~summary_avg_loci$trPos, xlim=c(-600,600), ylim=c(-10,200), xlab='Position From Center', ylab='Average Depth (x)', aspect=1, main="All Loci")
plot2 <- xyplot(summary_avg_loci$V3.n~summary_avg_loci$trPos, xlim=c(-600,600), ylim=c(-10,500), xlab='Position From Center', ylab='', aspect=1)
plot3 <- hexbinplot(summary_all_loci$V3.m ~ summary_all_loci$trPos, style = "nested.lattice", xbins=75, xlab='Position From Center', ylab='Depth (x)', ylim=c(0,500), xlim=c(-550,550), legend.width=1, aspect=1, colorkey=F, colorcut=seq(0, 1, length = 21))
### THE BINS HAVE HUGE NUMBERS BECUASE THEY ARE CAPTURING MANY POINTS IN THEM. It is the number of lines + the size of the bin...so you capture more then 1 line/locus per point(grouping). IF YOU PLOT EVERYTHING TOGETHER, WITHOUT BINNING YOU GET INDIVIDUAL LINES.

grid.arrange(plot1, plot2, plot3, ncol=2)

grid.arrange(plot1, plot3, ncol=2)


rm(list=ls())
library(dplyr)
library(ggplot2)
library(tidyr)
library(ggpubr)

# set dataset

dataset1 <- "Singhal"
dataset2 <- "SinghalOG"
dataset <- "SinghalOG"

h <- "TvS"

setwd(paste("/Users/ChatNoir/Projects/Squam/Graphs/",dataset, sep=''))

# Read in data and rename data
load(paste("/Users/ChatNoir/Projects/Squam/Graphs/",dataset1,"/Calcs_",dataset1,".RData", sep=''))
mLBF1 <- mLBF
mLGL1 <- mLGL
rm(mLBF,mLGL)

load(paste("/Users/ChatNoir/Projects/Squam/Graphs/",dataset2,"/Calcs_",dataset2,".RData", sep=''))
mLBF2 <- mLBF
mLGL2 <- mLGL
rm(mLBF,mLGL)

## Number of overlapping
length(intersect(mLBF1$Locus,mLBF2$Locus))

# Remove any other from the larger dataset
mLBF1 <- mLBF1[mLBF1$Locus %in% intersect(mLBF1$Locus,mLBF2$Locus),]
mLBF2 <- mLBF2[mLBF2$Locus %in% intersect(mLBF2$Locus,mLBF1$Locus),]

mLGL1 <- mLGL1[mLGL1$Locus %in% intersect(mLGL1$Locus,mLGL2$Locus),]
mLGL2 <- mLGL2[mLGL2$Locus %in% intersect(mLGL2$Locus,mLGL1$Locus),]

# Colors
# https://www.w3schools.com/colors/colors_picker.asp
color_S <- "orange"
color_TP <- "springgreen4"
color_AI <- "#2BB07FFF"
color_SA <- "#38598CFF"
color_SI <- "yellow4" # 8b8b00

# Add column to name type of support
mLGL1 <- mutate(mLGL1, dataset = case_when(TvS != 'a' ~ "Singhal")) %>%
  select('Locus','TvS','dataset') %>% rename(TvS.g1 =  TvS)
mLGL2 <- mutate(mLGL2, dataset = case_when(TvS != 'a' ~ "SinghalOG")) %>%
  select('Locus','TvS','dataset') %>% rename(TvS.g2 =  TvS)

mLBF1 <- mutate(mLBF1, dataset = case_when(TvS != 'a' ~ "Singhal")) %>%
  select('Locus','TvS','dataset') %>% rename(TvS.b1 =  TvS)
mLBF2 <- mutate(mLBF2, dataset = case_when(TvS != 'a' ~ "SinghalOG")) %>%
  select('Locus','TvS','dataset') %>% rename(TvS.b2 =  TvS)

mLGL <- merge(mLGL1, mLGL2, by = c("Locus"))
mLBF <- merge(mLBF1, mLBF2, by = c("Locus"))

## Scatter graph

S <- function(df,xcol,ycol,x.tic,y.tic,cc,xl,yl){
  scat <- ggplot(df, aes(x=df[[xcol]],y=df[[ycol]])) +
    geom_point(alpha=1, color=cc, size=0.5) + theme_bw() + theme(panel.border = element_blank()) +
    theme_classic() +
    theme(
      axis.text = element_text(size=14, color="black"),
      text = element_text(size=14),
      panel.border = element_blank(),
      panel.background = element_rect(fill = "transparent"), # bg of the panel
      plot.background = element_rect(fill = "transparent", color = NA), # bg of the plot
      panel.grid = element_blank(), # get rid of major grid
      plot.title = element_text(hjust = 0.5)
    ) +
    coord_cartesian(ylim=y.tic,xlim = x.tic) +
    scale_y_continuous(breaks = y.tic) +
    scale_x_continuous(breaks = x.tic) +
    labs(x=xl,y=yl)

  return(scat)
}

limit <- 90
tic <- seq(-limit,limit,10)
cc <- color_TP
xl <- 'Singhal - data added - dGLS'
yl <- 'Singhal - original data - dGLS'
#quartz()
g <- S(mLGL,2,4,tic,tic,cc,xl,yl) +geom_abline(color=c("black"), size=0.4, linetype="dashed")
g

limit <- 200
tic <- seq(-limit,limit,50)
cc <- color_TP
xl <- 'Singhal - data added - 2ln(BF)'
yl <- 'Singhal - original data - 2ln(BF)'
#quartz()
b <- S(mLBF,2,4,tic,tic,cc,xl,yl) +geom_abline(color=c("black"), size=0.4, linetype="dashed")

a <- ggarrange(g,b, ncol=1, nrow=2, align="v")
a

ggsave(paste(dataset,"_scatter_",h,".pdf",sep=""), plot=a,width = 6, height = 12, units = "in", device = 'pdf',bg = "transparent")