##  Create QQ plots, Volcano Plots, HeatMap of sign of logFC,
##  tSNPE or PCA Cluster based on sign of log FC
##  SHARED SIGNIFICANT GSs
library(qvalue)
library(ggpubr)
library(annotables)

source("/gpfs/data/stranger-lab/askol/TCGA2/DiffExpression/Code/Summary_funcs.r")

GSEADir <- "/gpfs/data/stranger-lab/askol/TCGA2/DiffExpression/Results/GSEA/"
GSEADirGTEx <- "/gpfs/data/stranger-lab/askol/GTEx/DiffExpression/Results/GSEA/"
ResultDir <- "/gpfs/data/stranger-lab/askol/TCGA2/DiffExpression/Results/"
SummaryDir <- "/gpfs/data/stranger-lab/askol/TCGA2/DiffExpression/Summary/"
PlotDir <- paste0(ResultDir,"Plots/")

GSEAOutDir <- paste0(ResultDir,"GSEA/")
GSEAGSFiles <- c("/home/askol/bin/GSEA_genesets/Custom/Hormone_Immune_Custom.gmt",
                "/home/askol/bin/GSEA_genesets/msigdb_v6.2_GMTs/msigdb.v6.2.symbols.gmt")

setwd(SummaryDir)

## projects <- c("TCGA-SKCM", "TCGA-THCA", "TCGA-LIHC", "TCGA-LUAD", "TCGA-LAML")
projects = read.table(file = "/gpfs/data/stranger-lab/askol/TCGA/TCGA_Target_projects.txt",
    header=TRUE, as.is=TRUE, sep="\t")
projects = projects[grep("TCGA",projects[,1]),1]

skip.cancers <- c("TCGA-BRCA","TCGA-OV", "TCGA-CESC", "TCGA-PRAD", "TCGA-TGCT",
                  "TCGA-UCS", "TCGA-UCEC")
projects <- projects[!projects %in% skip.cancers]

proj.tis.match <- rbind(c("TCGA-SKCM", "Skin_Not_Sun_Exposed_Suprapubic"),
                        c("TCGA-SKCM", "Skin_Sun_Exposed_Lower_leg"),
                        c("TCGA-THCA", "Thyroid"),
                        c("TCGA-LIHC", "Liver"),
                        c("TCGA-LUAD", "Lung"),
                        c("TCGA-LAML", "Cells_EBV-transformed_lymphocytes"),
                        c("TCGA-LIHC", "Skin_Not_Sun_Exposed_Suprapubic"),
                        c("TCGA-LUAD", "Thyroid"))

tmp <- collect.results(projects, ResultDir)

logFC.tcga <- tmp$logFC
logPs.tcga <- tmp$logPs
Qs.tcga <- tmp$Qs
geneInfo.tcga <- tmp$GeneInfo

geneInfo <- grch38
geneInfo <- select(geneInfo, -end, -description)
## REMOVE GENES THAT MAP TO MULTIPLE CHROMOSOMES ##
geneInfo <- removeMultiMapGenes(geneInfo)

## ####################### ##
##
## BRING IN GTEX TISSUES
##
## ####################### ##

GSEADirGtex <- "/gpfs/data/stranger-lab/askol/GTEx/DiffExpression/Results/GSEA/"

tissues <- read.table(file = paste0("/gpfs/data/gtex-group/sex_biased_regulation_v8/",
                          "data/support_files/all_v8_tissues_both_sexes.txt"), as.is=T)
tissues <- unlist(tissues)
ResultDirGtex <- "/gpfs/data/stranger-lab/askol/GTEx/DiffExpression/Results/"

tmp <- collect.results.gtex(tissues, ResultDirGtex)

logFC.gtex <- tmp$logFC
logPs.gtex <- tmp$logPs
Qs.gtex <- tmp$Qs
geneInfo.gtex <- tmp$GeneInfo

saveRDS(list(logFC.tcga = logFC.tcga, logPs.tcga = logPs.tcga,
             Qs.tcga = Qs.tcga, logFC.gtex = logFC.gtex, logPs.gtex = logPs.gtex,
             Qs.gtex = Qs.gtex), file = "Summary.RDS")
if (0){
    tmp <- loadRDS("Summary.RDS")
    logFC.tcga = tmp$logFC.tcga;  logPs.tcga = tmp$logPs.tcga;
    Qs.tcga = tmp$Qs.tcga logFC.gtex = tmp$logFC.gtex; logPs.gtex = tmp$logPs.gtex;
    Qs.gtex = tmp$Qs.gtex
}

#####  PLOT 1: NUMBER OF DE GENES ######
## GET DISTRIBUTION OF THE NUMBER OF DE GENES ##
get.noDE.genes(Qs.tcga, Qs.gtex,  project, tissues, PlotDir)

## WHICH GENES ARE COMMONLY DE BETWEEN GTEX AND TCGA ##

## ## WHICH GENES ARE SHARED ACROSS CANCER
## META ANALYSIS AND FDR > .10
## PLOT NUMBER OF CANCERS/TISSUES SHARED PER GENE
## AND
## PLOT NUMBER GENES FROM EACH CHROMOSOME WITH MULTIPLE CANCERS/TISSUES/GENE

file.pre = "tcga"

tmp <- get.noDE.cancers.for.gene(Qs.tcga, qthresh= .1, geneInfo,
                                       Ntrunc = 5, min.studies = 5,
                                       ResultDir, PlotDir, file.pre)
noDE.tcga <- tmp$NoDE
t <- tmp$t; t.nox <- tmp$t.nox
t
## mean number of genes different between obs and expected ##
x.ind = c(21,22)
## mean absolute differences in observered relative to expected ##
mean(abs(t$obs[,1]-t$exp[,1])/abs(t$exp[,1])) * 100
## mean absolute difference in observed relative to expected in X & Y
mean(abs(t$obs[x.ind,1] - t$exp[x.ind,1])/abs(t$exp[x.ind,1])) * 100
## mean absolute difference in observed relative to expected in autosome
mean(abs(t$obs[-x.ind,1] - t$exp[-x.ind,1])/abs(t$exp[-x.ind,1])) * 100

t.nox

file.pre = "tcga_all"
tmp <- get.noDE.cancers.for.gene(Qs.tcga, qthresh= .1, geneInfo,
                                       Ntrunc = 5, min.studies = 1,
                                 ResultDir, PlotDir, file.pre)
noDE.tcga <- tmp$NoDE
t1 <- tmp$t
## mean number of genes different between obs and expected ##
mean(abs(t1$obs[,1]-t1$exp[,1])/abs(t1$exp))
t1.nox <- tmp$t.nox
t1
t1.nox
x.ind = c(23,24)
## mean absolute differences in observered relative to expected ##
mean(abs(t1$obs[,1]-t1$exp[,1])/abs(t1$exp[,1])) * 100
## mean absolute difference in observed relative to expected in X & Y
mean(abs(t1$obs[x.ind,1] - t1$exp[x.ind,1])/abs(t1$exp[x.ind,1])) * 100
## mean absolute difference in observed relative to expected in autosome
mean(abs(t1$obs[-x.ind,1] - t1$exp[-x.ind,1])/abs(t1$exp[-x.ind,1])) * 100

## total number of DE genes ##
t <- table(noDE.tcga$n)
tot = sum(t[names(t)!="0"])
## NUMBER OF SEX DE GENES IN MORE THAN 1 CANCER ##
gt1 = sum(t[names(t)%in%c("0","1") == FALSE])
gt1/tot

gt12 <- sum(t[as.numeric(names(t)) > 12])
gt12/tot

file.pre = "gtex"
tmp <- get.noDE.cancers.for.gene(Qs.gtex, qthresh= .1, geneInfo,
                                       Ntrunc = 5, min.studies = 10,
                                       ResultDir, PlotDir, file.pre)
noDE.gtex <- tmp$NoDE
t <- tmp$t.gtex; t.nox <- tmp$t.gtex.nox

## PLOT THE DISTRIBUTION OF DE GENES ON THE X CHROMOSOME ##
x.tcga <- plot.de.on.x(logPs.tcga, logFC.tcga, geneInfo.tcga, PlotDir, file.pre="tcga")
x.gtex <- plot.de.on.x(logPs.gtex, logFC.gtex, geneInfo.gtex, PlotDir, file.pre="gtex")

## FIND OUT WHICH GENES ARE COMMONLY DE IN BOTH CANCER AND NORMAL TISSUE ##
tmp <- get.common.common.DE.genes(noDE.gtex, noDE.tcga,
                                  Qs.tcga,  Qs.gtex,
                                  thresh.gtex = 10, thresh.tcga=5,
                                  ResultDir, PlotDir)
Ns <- tmp$N; Qs <- tmp$Qs

## REMOVE GENES NOT OBSERVED IN AT LEAST 50% OF EACH POPULATION ##
N.max.gtex <- max(Ns$N.gtex)
N.max.tcga <- max(Ns$N.tcga)
Ns <- filter(Ns, N.gtex >= floor(N.max.gtex/2) &
                  N.tcga >= floor(N.max.tcga/2))
Ns.dist <- get.n.dist(Ns)

## INTERESTING GENES ##
ind <- which(Ns.dist$interest.gt == 1| Ns.dist$interest.gt2 == 1 |
             Ns.dist$interest.lt == 1| Ns.dist$interest.lt2 == 1)
out <- Ns.dist[ind,]
out <- select(out, symbol, chr, start, n.tcga, n.tcga.imp, N.tcga, n.gtex, n.gtex.imp, N.gtex, prob.g.g.t.ge, prob.t.g.g.ge)

## WRITE OUT GENES THAT ARE OUTLIERS WITH RESPECT TO BE FOUND MORE OR LESS IN TCGA
## THAN IN GTEX
file <- paste0(ResultDir, "DiscordantNoDE_TCGA.v.GTEX.txt")
write.table(file = file, out, quote=FALSE, row.names=F, col.names=T)

file <- paste0(PlotDir,"Dist_DE_Conditional.pdf")

plot.cond.de.distribution(Ns.dist, file=file)

## PLOT PCA BASED ON DE IN TCGA ##
file <- paste0(PlotDir,"TCGA_DE_PCA.pdf")
plot.PCA(logPs.tcga, file, geneInfo.tcga)
plot.PCA(logPs.tcga, file, geneInfo.tcga, exclX=T)

## PLOT PCA BASED ON DE IN GTEX ##
file <- paste0(PlotDir,"GTEx_DE_PCA.pdf")
plot.PCA(logPs.gtex, file, geneInfo.gtex)
plot.PCA(logPs.gtex, file, geneInfo.gtex, exclX=T)

## ############################################################ ##
##                 GSEA ANALYSIS SUMMARY                        ##
## ############################################################ ##

## BRING IN RESULTS OF GSEA ANALYSIS ##
gsea <- get.fgsea.results(projects, GSEADir)

make.cytoscape.out(gsea)

## HOW MANY GENE SETS HAVE Q-VALUES LESS THAN 0.05 using ALL CHROMOSOMES ##
t <- gsea %>% filter(padj <= 0.05, nox==0) %>% select(pathway, proj) %>% table()
sum(t)
mean(t)
colSums(t)
median(colSums(t))
dim(t)
sort(table(rowSums(t)), decreasing=T)

## HOW MANY GENE SETS HAVE Q-VALUES LESS THAN 0.05 using AUTOSOMES ONLY ##
t <- gsea %>% filter(padj <= 0.05, nox==1) %>% select(pathway, proj) %>% table()
sum(t)
colSums(t)
median(colSums(t))
dim(t)
sort(table(rowSums(t)), decreasing=T)

##
## DETERMINE OVERLAP OF CONTRIBUTING GENES
plot.file <- paste0(PlotDir, "GSEA_gene_geneset_OL.pdf")
tmp <- gsea.OL(gsea, plot.file = plot.file, topN=100, LEcutoff=3, NoX=0)
gsea.OL.X <- tmp$gseaOL
genesContrib <- tmp$genesContrib

## MEAN NUMBER OF CONTRIBUTING GENES IN TOP 100 GENES SETS WITH AND WITHOUT DUPES
sol <- summarize.OL(genesContrib)

## DETERMINE OVERLAP OF CONTRIBUTING GENES WHEN NOT INCLUDING X ##
plot.file <- paste0(PlotDir, "GSEA_gene_geneset_OL_NoX.pdf")
tmp <- gsea.OL(gsea, plot.file = plot.file, topN=100, LEcutoff=3, NoX=1)
gsea.OL.noX.out <- tmp$gsea.OL
genesContrib.noX <- tmp$genesContrib

## MEAN NUMBER OF CONTRIBUTING GENES IN TOP 100 GENES SETS WITH AND WITHOUT DUPES
sol.nox <- summarize.OL(genesContrib.noX)

##### REPORT THE TOP 10 GENE SETS IN EACH CANCER WITH AND WITHOUT X GENES #####
file <- paste0(ResultDir,"/Tables/Top10GSEA_X.txt")
gseaTbl <- reportTop10(gsea, NoX = 0, TopRank=10, maxlogP = 39.99, file = file)

file <- paste0(ResultDir,"/Tables/Top10GSEA_NoX.txt")
gseaTblX <-reportTop10(gsea, NoX = 1, TopRank=10, maxlogP = 39.99, file = file)

## CREATE OUTPUT FOR CYTOSCAPE ##
outDir <- paste0(ResultDir, "GSEA/CytoscapeInFiles/")
make.cytoscape.out(gsea, outDir)

#### REPORT THE OVERLAP OF GENESETS ACROSS CANCERS ##
## ALSO CREATES FILE TO USE IN CYTOSCAPE TO EXPLORE CONNECTION BETWEEN
## MOST SHARED GENESETS
gs.ol <- genesetOL(gsea, NoLE=5, qThresh=0.05, maxGS=500, ResultDir)

## BRING GENE SET CLUSTER MEMBERSHIP OF MAJOR CLUSTERS BACK IN ##
## THESE WERE CREATED IN CYTOSCAPE
file <- "../Results/GSEA/Shared_NoX_gt6shared default node.csv"
gsclust <- read.table(file = file, as.is=T, header=T, sep=",")
cl.genes <- clust.genes(gsclust)
cl.genesets <- cl.genes$cluster.genesets
cl.genes <- cl.genes$cluster.genes

out.file <- paste0(ResultDir,"GSEA_Cluster_GeneSets_NoX_gt6shared.txt")
write.table(file = out.file, cl.genesets, quote=F, row.names=F,
            col.names=T)

out.file <- paste0(ResultDir,"GSEA_Cluster_Genes_NoX_gt6shared.txt")
## keep only those genes that are present in 1/4 or more gene sets in cluster ##
cl.genes.25 <- filter(cl.genes, count > ceiling(.25*NGeneSets))
write.table(file = out.file, cl.genes.25, quote=F, row.names=F, col.names=T)

## DETERMINE THE DISTRIBUTION OF GENES IN LEGENES OF ALL GENE SETS, SIGNIFICANT
## OR NOT
gene.gs.dist <- gs.gene.concat(gsea)

## DETERMINE THE FREQUENCY OF GENES IN THE ENRICHED COMMON GENE SET HIGH-LEVEL
## CLUSTERS
cl.genes <- clust.genes(gsclust)
cl.genes <- cl.genes$cluster.genes %>% filter(cluster != 2)

## DETERMINE IF GENES IN ENRICHED COMMON GENE SET HIGH-LEVEL CLUSTERS ARE
## PRESENT DISPROPORTIONALLY IN THESE GENE-SETS THEN IN OTHERS (E.G. ARE THE
## GENES THAT ARE COMMON AMONGST THESE HIGH GENESETS THERE BECAUSE THEY
## DEFINE THE HIGH-LEVEL FUNCTIONS OR BECAUSE THEY ARE UBIQUITOUS IN ALL
## GENE SETS
gene.dists <- gene.dist.test(gene.gs.dist, cl.genes)

## CREATE A BINARY HEAT MAP FOR EACH HIGH-LEVEL CLUSTER WITH
## PROJECT ON THE X, AND GENE SET ON THE Y
plot.file <- paste0(ResultDir, "Plots/Cluster_genesets_HighLevel.pdf")
plot.cluster.proj.geneset(cl.genesets, gsea, file = plot.file)

## CREATE A BINARY HEAT MAP FOR EACH HIGH-LEVEL CLUSTER WITH
## PROJECT ON X AND GENE ON Y RANKED FROM MOST TO LEAST COMMON (TO GENE
## SETS IN CLUSTER

plot.file <- paste0(ResultDir, "Plots/Cluster_gene_DE_HighLevel.pdf")
cluster.proj.genes.in.gs(cl.genes.25, logPs.tcga, file = plot.file)

## BRING IN RESULTS OF GSEA ANALYSIS FOR GTEX ##
gsea.gtex <- get.fgsea.results(tissues, GSEADirGtex)

file <- paste0(PlotDir, "GTEx_qqplots.pdf")
get.median.p.value(gsea.gtex, file)

## HOW MANY GENE SETS HAVE Q-VALUES LESS THAN 0.05 using ALL CHROMOSOMES ##
t <- gsea.gtex %>% filter(padj <= 0.05, nox==0) %>% select(pathway, proj) %>% table()
sum(t)
mean(t)
tiss.gsea.count <- colSums(t)
median(colSums(t))
dim(t)
sort(table(rowSums(t)), decreasing=T)

## HOW MANY GENE SETS HAVE Q-VALUES LESS THAN 0.05 using AUTOSOMES ONLY ##
t <- gsea.gtex %>% filter(padj <= 0.05, nox==1) %>% select(pathway, proj) %>% table()
sum(t)
tiss.gsea.count.nox <- colSums(t)
median(colSums(t))
dim(t)
sort(table(rowSums(t)), decreasing=T)
t <- gsea.gtex %>% filter(padj <= 0.05, nox==1) %>% select(pathway, proj) %>% table()
sum(t)
colSums(t)
dim(t)

## Preform quantile to quantile comparison ##
## What is the average rank of the genes TCGA in the xth quantile of GTEx ##
## And vice-versa
quants <- c(.001, .01, .05, .10, .15, .20, .25)
QQ.check <- quant.quant.comparo(proj.tis.match, logPs.tcga, logPs.gtex, geneInfo, quants)

QQ.check[QQ.check$quant == 0.001 & QQ.check$x.txt == "inclX",]

file = paste0(PlotDir, "quantile_TCGA_GTEX.pdf")
QQ.plot(QQ.check, file)

## COMPARE TWO BRAIN REGIONS ##
proj.tis.match.gtex <- rbind(c("Brain_Cortex", "Brain_Caudate_basal_ganglia"),
                         c("Brain_Cortex", "Lung"),
                         c("Brain_Caudate_basal_ganglia", "Lung"))

quants <- c(.001, .01, .05, .10, .15, .20, .25)
QQ.check.gtex <- quant.quant.comparo(proj.tis.match.gtex, logPs.gtex, logPs.gtex, geneInfo, quants)

file = paste0(PlotDir, "quantileGTEX_GTEX.pdf")
QQ.plot(QQ.check.gtex, file=file)

QQ.check.brain$label <-  paste(QQ.check.brain$ref, QQ.check.brain$comp, sep=":")

## EXAMINE THE DISTRIBUTION OF SURVIVAL P-VALUES FOR GENES FOUND TO BE DE ##
## 1) IN BOTH CANCER AND GTEX, 2) CANCER ONLY, 3) GTEX ONLY
## ALSO
## 1) PERFORM ABOVE USING ALL DE GENES, 2) GENES UPREGULATED IN MALES, 3) GENE UPREG IN FEMALES
## ALSO
## SURVAL PERFORMED IN 1) FULL SAMPLE, 2) MALES ONLY, 3) FEMALES ONLY
##
RsltDir <- "/gpfs/data/stranger-lab/askol/TCGA2/Survival/Results/"
PlotDir <- paste0(ResultDir, "Plots/")

rslts <- compile.surv.results(projects, RsltDir)

ps  <- rslts[[1]]
qs <- rslts[[2]]
coef <- rslts[[3]]
## remove genes with no symbols
for (i in 1:length(ps)){

    ps[[i]] <- filter(ps[[i]], !is.na(SYMBOL))
    qs[[i]] <- filter(qs[[i]], !is.na(SYMBOL))
    coef[[i]] <- filter(coef[[i]], !is.na(SYMBOL))
}

niter = 500
## DE RANKS BASED ON GTEX DE ANALYSIS ##
## quant = .001 ##
no.x.ind.p <- which(ps[[1]]$chr %in% c(1:22))
no.x.ind.gtex <- which(geneInfo.gtex$chr %in% c(1:22))
no.x.ind.tcga <- which(geneInfo.tcga$chr %in% c(1:22))

##################
##              ##
## quant = 0.001 ##
##              ##
##################
quant = 0.001
file <- paste0(PlotDir,"SurvPvals_gtex.tcga_",quant,".pdf")
surv.summary.001 <- analyze.ranked.survival(tissues, projects,
                                            ps, qs,
                                            logPs.gtex, logFC.gtex,
                                            logPs.tcga, logFC.tcga,
                                            quant=0.001,
                                            niter=niter, both=FALSE,
                                            file)

## no X
file <- paste0(PlotDir,"SurvPvals_gtex.tcga_noX",quant,".pdf")
surv.summary.001 <- analyze.ranked.survival(tissues, projects,
                                            ps, qs,
                                            logPs.gtex[no.x.ind.gtex,], logFC.gtex[no.x.ind.gtex,],
                                            logPs.tcga[no.x.ind.tcga,], logFC.tcga[no.x.ind.tcga,],
                                            quant=0.001,
                                            niter=niter, both=FALSE,
                                            file)

## DE RANKS BASED ON TCGA DE ANALYSIS ##
file <- paste0(PlotDir,"SurvPvals_tcga.tcga_",quant,".pdf")
surv.sum.tcga.tcga.001 <- analyze.ranked.survival(projects, projects,
                                                  ps, qs,
                                                  logPs.tcga, logFC.tcga,
                                                  logPs.tcga, logFC.tcga,
                                                  quant=0.001,
                                                  niter=niter, both = FALSE,
                                                  file)

## no X ##
file <- paste0(PlotDir,"SurvPvals_tcga.tcga_noX_",quant,".pdf")
surv.sum.tcga.tcga.001 <- analyze.ranked.survival(projects, projects,
                                                  ps, qs,
                                                  logPs.tcga[no.x.ind.tcga,], logFC.tcga[no.x.ind.tcga,],
                                                  logPs.tcga[no.x.ind.tcga,], logFC.tcga[no.x.ind.tcga,],
                                                  quant=0.001,
                                                  niter=niter, both = FALSE,
                                                  file)

##################
##              ##
## quant = 0.01 ##
##              ##
##################
quant = .01
## USE GENES THAT ARE ONLY DE IN BOTH GTEX AND TCGA ##
file <- paste0(PlotDir,"SurvPvals_gtex.tcga_",quant,".pdf")
surv.summary.01 <- analyze.ranked.survival(tissues, projects,
                                           ps, qs,
                                           logPs.gtex, logFC.gtex,
                                           logPs.tcga, logFC.tcga,
                                           quant=quant,
                                           niter=niter, both=FALSE,
                                           file)

## NO X ##
file <- paste0(PlotDir,"SurvPvals_gtex.tcga_noX",quant,".pdf")
surv.summary.01 <- analyze.ranked.survival(tissues, projects,
                                           ps, qs,
                                           logPs.gtex[no.x.ind.gtex,], logFC.gtex[no.x.ind.gtex,],
                                           logPs.tcga[no.x.ind.tcga,], logFC.tcga[no.x.ind.tcga,],
                                           quant=quant,
                                           niter=niter, both=FALSE,
                                           file)

file <- paste0(PlotDir,"SurvPvals_tcga.tcga_",quant,".pdf")
surv.sum.tcga.tcga.01 <- analyze.ranked.survival(projects, projects,
                                                 ps, qs,
                                                 logPs.tcga, logFC.tcga,
                                                 logPs.tcga, logFC.tcga,
                                                 quant=quant,
                                                 niter=niter, both=FALSE,
                                                 file)
## NO X##
file <- paste0(PlotDir,"SurvPvals_tcga.tcga_noX_",quant,".pdf")
surv.sum.tcga.tcga.01 <- analyze.ranked.survival(projects, projects,
                                                 ps, qs,
                                                 logPs.tcga[no.x.ind.tcga,], logFC.tcga[no.x.ind.tcga,],
                                                 logPs.tcga[no.x.ind.tcga,], logFC.tcga[no.x.ind.tcga,],
                                                 quant=quant,
                                                 niter=niter, both=FALSE,
                                                 file)

file <- paste0(PlotDir,"SurvPvals_gtex.tcga_inboth_",quant,".pdf")
surv.summary.DE.both.01 <- analyze.ranked.survival(tissues, projects,
                                                   ps, qs,
                                                   logPs.gtex, logFC.gtex,
                                                   logPs.tcga, logFC.tcga,
                                                   quant=quant,
                                                   niter=niter, both=TRUE,
                                                   file)
## NO X ##
file <- paste0(PlotDir,"SurvPvals_gtex.tcga_inboth_noX_",quant,".pdf")
surv.summary.DE.both.01 <- analyze.ranked.survival(tissues, projects,
                                                   ps, qs,
                                                   logPs.gtex[no.x.ind.gtex,], logFC.gtex[no.x.ind.gtex,],
                                                   logPs.tcga[no.x.ind.tcga,], logFC.tcga[no.x.ind.tcga,],
                                                   quant=quant,
                                                   niter=niter, both=TRUE,
                                                   file)


# since March 05
france = c(1,2,2,3,
           5,6,8,10,11,21,35,
           55,71,104,144,177,233,281,
           335)

population = 67000000
data = france
source('./approxnlsLM.r')


#a<-Read.other.predator.prediction()
a<-Read.other.predator()

scenario<-"HCR_1_deter_noadjust_test_01_HCR1_0_Rec0__2030";
usedOther<-"op_other_sp_var.out"
usedOther<-"op_other_sp.out"
scenario<-NA

if ( ! is.na(scenario)) {
 b<- Read.op.other.sp.var(dir=file.path(data.path,scenario),infile=usedOther)
 a$size<-NULL
 a<-rbind(a,b)
}

#hm<-subset(a,Species.n==13)
#nonFish<-c(1:8,13,14)   # North Sea
nonFish<- -99

a$BIO<-a$N*a$west/1000
a[a$Species.n %in% nonFish,'BIO']<- a[a$Species.n %in% nonFish,'N']

a$BIO[a$BIO<=0]<-0
#a$BIO<-a$Other.bio

#write.csv(a, file = file.path(data.path,'Other_predators.csv'),row.names = FALSE)

if (F) {
  a<-subset(a,BIO>0)

  # to get a nice plot for Horse Mackerel
  hm<-subset(a,Species.n==13)
  hm$BIO<-0
  hm<-aggregate(BIO~Predator+Species.n+Year,sum,data=hm)
  hm1<-hm; hm1$Quarter<-1
  hm2<-hm; hm2$Quarter<-2
  hm3<-hm; hm3$Quarter<-3
  hm4<-hm; hm4$Quarter<-4
  hm<-rbind(hm1,hm2,hm3,hm4)
  aa<-subset(a,select=c(Predator,Species.n,Year,Quarter,BIO))
  aa<-rbind(hm,aa)
  a<-aggregate(BIO~Predator+Species.n+Year+Quarter,sum,data=aa)

  #tapply(a$consum,list(a$Year,a$Predator),sum)/tapply(a$BIO,list(a$Year,a$Predator),sum)/1000
}

cleanup()
#dev<-"print"
dev<-"screen"
if (makeAllGraphs) dev<-'png'
nox<-2
noy<-2

i<-0

by(a,list(a$Quarter,a$Species.n),function(x) {
    b<- tapply(x$BIO,list(x$Year),sum)
    b[is.na(b)]<-0
    if ((i %% (nox*noy))==0) {

      filename=file.path

      filename<-paste0("OtherPredators",'_',i)
      if (makeAllGraphs) filename=file.path(otherPred.dir,filename)
      newplot(dev,nox,noy,Portrait=TRUE,filename=filename);
      par(mar=c(3,5,3,2))
    }
    i<<-i+1
   if (x[1,'Species.n'] %in% nonFish) ylab='Abundance' else  ylab='Biomass'
    barplot(b,space=0.0,ylab=ylab)
    title(main=paste(x[1,'Predator']," Q:",x[1,'Quarter'],sep=''))
})

if (dev=='png') cleanup()


#!/usr/bin/env Rscript

# Command line argument processing
args = commandArgs(trailingOnly=TRUE)
if (length(args) < 4) {
  stop("Usage: dupRadar.r <input.bam> <annotation.gtf> <strandedness (0 for unstranded, 1 for stranded and 2 for reverse)>, <paired/single> <R-package-location (optional)>", call.=FALSE)
}
input_bam <- args[1]
annotation_gtf <- args[2]
reads_strandedness <- args[3]
if(isTRUE(args[4])){
paired_end <- args[4]
}else{
paired_end <- if(args[4]=='paired') TRUE else FALSE
}

input_bam_basename <- strsplit(input_bam, "\\.")[[1]][1]

# Load / install packages
if (length(args) > 3) { .libPaths( c( args[4], .libPaths() ) ) }
if (!require("dupRadar")){
  source("http://bioconductor.org/biocLite.R")
  biocLite("dupRadar", suppressUpdates=TRUE)
  library("dupRadar")
}
if (!require("parallel")) {
  install.packages("parallel", dependencies=TRUE, repos='http://cloud.r-project.org/')
  library("parallel")
}

# Duplicate stats
stranded <- as.numeric(reads_strandedness)
threads <- detectCores()
dm <- analyzeDuprates(input_bam, annotation_gtf, stranded, paired_end, threads)
write.table(dm, file=paste(input_bam_basename, "_dupMatrix.txt", sep=""), quote=F, row.name=F, sep="\t")

# 2D density scatter plot
pdf(paste0(input_bam, "_duprateExpDens.pdf"))
duprateExpDensPlot(DupMat=dm)
title("Density scatter plot")
mtext(input_bam_basename, side=3)
dev.off()
fit <- duprateExpFit(DupMat=dm)
cat(
  paste("- dupRadar Int (duprate at low read counts):", fit$intercept),
  paste("- dupRadar Sl (progression of the duplication rate):", fit$slope),
  fill=TRUE, labels=input_bam_basename,
  file=paste0(input_bam_basename, "_intercept_slope.txt"), append=FALSE
)

# Get numbers from dupRadar GLM
curve_x <- sort(log10(dm$RPK))
curve_y = 100*predict(fit$glm, data.frame(x=curve_x), type="response")
# Remove all of the infinite values
infs = which(curve_x %in% c(-Inf,Inf))
curve_x = curve_x[-infs]
curve_y = curve_y[-infs]
# Reduce number of data points
curve_x <- curve_x[seq(1, length(curve_x), 10)]
curve_y <- curve_y[seq(1, length(curve_y), 10)]
# Convert x values back to real counts
curve_x = 10^curve_x
# Write to file
write.table(
  cbind(curve_x, curve_y),
  file=paste0(input_bam_basename, "_duprateExpDensCurve.txt"),
  quote=FALSE, row.names=FALSE
)

# Distribution of expression box plot
pdf(paste0(input_bam_basename, "_duprateExpBoxplot.pdf"))
duprateExpBoxplot(DupMat=dm)
title("Percent Duplication by Expression")
mtext(input_bam_basename, side=3)
dev.off()

# Distribution of RPK values per gene
pdf(paste0(input_bam_basename, "_expressionHist.pdf"))
expressionHist(DupMat=dm)
title("Distribution of RPK values per gene")
mtext(input_bam_basename, side=3)
dev.off()

# Print sessioninfo to standard out
print(input_bam_basename)
citation("dupRadar")
sessionInfo()


library(ggplot2)
library(tidyr)
library(plyr)
library(yaml)
library(XML)
library(gridSVG)
library(rjson)
library(minpack.lm)
library(LifeTables)
conf <- yaml.load_file('chartgen.yaml')
infs <- '\u221e'
agralias <- 'Åldersgrupp'
percalias <- '%'

comma.lab <- function(x){format(x, decimal.mark = ',')}

sexratio.trends.plot <- function(country, cause, sex1, sex2, startyear, endyear, startage,
			       endage, type, ageformat)
{
	sex1alias <- conf[['sexes']][[sprintf('%d', sex1)]][['alias']]
	sex2alias <- conf[['sexes']][[sprintf('%d', sex2)]][['alias']]
	sex1 <- agetrends.plot(country, cause, sex1, startyear, endyear,
			       startage, endage, type, ageformat)
	sex2 <- agetrends.plot(country, cause, sex2, startyear, endyear,
			       startage, endage, type, ageformat)
	title <- gsub(sex1alias, sprintf('%s/%s', sex1alias, sex2alias), sex1$labels$title)
	df <- sex1$data
	df$ratio <- sex1$data$mort/sex2$data$mort
	df.plot <- ggplot(data = df, aes(x = Year, y = ratio, group = agealias,
					 colour = agealias)) +
		xlab('År') + ylab('Kvot') +
		ggtitle(title) + geom_point() + geom_smooth() +
		scale_colour_discrete(name = agralias) +
		scale_y_continuous(label = comma.lab) +
		theme(axis.text.x = element_text(angle = 45))
	return(df.plot)
}

agetrends.plot <- function(country, cause, sex, startyear, endyear,
			   startage, endage, type, ageformat, apctype = 'pa')
{
	csvname <- sprintf('csv/%s%d%s%d.csv', cause, country, type, sex)
	df <- read.csv(csvname, header = TRUE)
	caalias <- conf[['causes']][[cause]][['alias']]
	ctryalias <- conf[['countries']][[sprintf('%d', country)]][['alias']]
	sexalias <- conf[['sexes']][[sprintf('%d', sex)]][['alias']]
	if (ageformat == 0)
	{
		oneseq <- seq(0, 4)
		fiveseqs <- seq(5, 95, by = 5)
		fiveseqe <- seq(9, 94, by = 5)
		age <- c(oneseq, fiveseqs)
		agealias <- c(oneseq, sprintf('%d\u2013%s', fiveseqs, c(fiveseqe, infs)))
		ageorig <- sprintf('Pop%s', seq(2, 25))
	}
	else if (ageformat == 1)
	{
		oneseq <- seq(0, 4)
		fiveseqs <- seq(5, 85, by = 5)
		fiveseqe <- seq(9, 84, by = 5)
		age <- c(oneseq, fiveseq)
		agealias <- c(oneseq, sprintf('%d\u2013%s', fiveseqs, c(fiveseqe, infs)))
		ageorig <- sprintf('Pop%s', c(seq(2, 22), '2325sum'))
	}
	else if (ageformat == 2)
	{
		fiveseqs <- seq(5, 85, by = 5)
		fiveseqe <- seq(9, 84, by = 5)
		age <- c(0, 1, fiveseqs)
		agealias <- c(0, sprintf('%d\u2013%s', c(1, fiveseqs), c(4, fiveseqe, infs)))
		ageorig <- sprintf('Pop%s', c(2, '36sum', seq(7, 22), '2325sum'))
	}
	ages <- data.frame(age, agealias, ageorig)

	if (type == 'rate')
	{
	       	typealias <- 'Dödstal'
		yl <- 'log(dödstal)'
		yfunc <- quote(log(mort))
	}
	else if (type == 'perc')
	{
		typealias <- 'Andel dödsfall'
	       	yl <- percalias
		yfunc <- quote(100*mort)
	}
	title <- sprintf('%s %s %s %s', typealias, caalias, sexalias, ctryalias)

	if (ageformat == 0)
		df.long <- gather(df, ageorig, mort, Pop2:Pop25)
	else if (ageformat == 1)
		df.long <- gather(subset(df,
			select = c(Year, Pop2:Pop22, Pop2325sum)),
			ageorig, mort, Pop2:Pop2325sum)
	else if (ageformat == 2)
		df.long <- gather(subset(df,
			select = c(Year, Pop2, Pop36sum, Pop7:Pop22, Pop2325sum)),
			ageorig, mort, Pop2:Pop2325sum)
	df.long <- merge(df.long, ages, 'ageorig')
	df.long.sub <- subset(df.long, Year >= startyear & Year <= endyear &
			      age >= startage & age <= endage)
	df.long.sub$agealias <- factor(df.long.sub$agealias,
				       levels = unique(df.long.sub$agealias[order(df.long.sub$age)]))
	df.long.sub$cohort <- df.long.sub$Year - df.long.sub$age
	yrlab <- 'År'
	cohlab <- 'Kohort'
	yrq <- quote(Year)
	cq <- quote(cohort)
	agrq <- quote(agealias)
	agq <- quote(age)
	agrscale <- quote(scale_colour_discrete(name = agralias))
	yrscale <- quote(scale_colour_gradient(name = yrlab))
	cohscale <- quote(scale_colour_gradient(name = cohlab))
	ycont <- quote(scale_y_continuous(label = comma.lab))

	if (apctype == 'pa')
	{
		xfunc <- yrq
		xl <- yrlab
	       	grouper <- agrq
		scalefunc <- agrscale
		plotsmooth <- TRUE
	        plotfunc <- quote(geom_point())
		yscfunc <- ycont
	}
	else if (apctype == 'ca')
	{
		xfunc <- cq
		xl <- cohlab
	       	grouper <- agrq
		scalefunc <- agrscale
		plotsmooth <- TRUE
	        plotfunc <- quote(geom_point())
		yscfunc <- ycont
	}
	else if (apctype == 'ap')
	{
		xfunc <- agrq
		xl <- agralias
	       	grouper <- yrq
		scalefunc <- yrscale
		plotsmooth <- FALSE
	        plotfunc <- quote(geom_line())
		yscfunc <- ycont
	}
	else if (apctype == 'ac')
	{
		xfunc <- agrq
		xl <- agralias
	       	grouper <- cq
		scalefunc <- cohscale
		plotsmooth <- FALSE
	        plotfunc <- quote(geom_line())
		yscfunc <- ycont
	}

	env <- environment()

	df.plot <- ggplot(data = df.long.sub, aes(x = eval(xfunc), y = eval(yfunc),
	           group = eval(grouper), colour = eval(grouper)),
			  environment = env) +
		xlab(xl) + ylab(yl) +
		ggtitle(title) +
		eval(yscfunc) +
		eval(plotfunc) +
		eval(scalefunc) +
		theme(axis.text.x = element_text(angle = 45))

	if (plotsmooth)
		df.plot <- df.plot + geom_smooth(method = 'loess')

	return(df.plot)
}

ctriesyr.batchplot <- function(compyrseq = seq(1952, 2012, by = 10))
{
	causenames <- names(conf[['causes']])
	agenames <- names(conf[['ages']])
	svgdir <- 'mortchart-site/charts/ctriesyr'
	xmlprefix <- '<?xml version = "1.0" encoding = "UTF-8"?>\n'
	dir.create(svgdir, showWarnings = FALSE)

	for (year in compyrseq)
	{
		for (cause in causenames)
		{
			causeconf <- conf[['causes']][[cause]]
			if (!(year %in% causeconf[['skipyrs']])){
			for (age in agenames)
			{

				if (!(age %in% causeconf[['skip']]))
				   {
					   type <- conf[['ages']][[age]][['ptype']]
					   if (!(cause == 'all' & type == 'perc')){
					   svgpath <- sprintf('%s/%s%s%scomp%d.svg',
							      svgdir, cause, type, age, year)
					   curgrid <- ctriesyr.plot(cause, year, age, type)
					   print(curgrid)
					   if (causeconf[['sex']] == 0)
					   {
					   curgrid.svg <- grid.export(addClasses = TRUE)
					   cat(xmlprefix, gsub('</svg>$', '',
							       saveXML(curgrid.svg$svg)),
					       svgscript(curgrid$data), file = svgpath)
					   }
					   else grid.export(svgpath)
					   dev.off()

					   }
				   }
			}}
		}
	}

}

svgscript <- function(graphdata)
{
	notice <- '<!-- Adapted from http://timelyportfolio.github.io/gridSVG_intro/ -->'
	d3.script <- '<script xlink:href = "http://d3js.org/d3.v3.js"></script>'
	jsonarr <- rjson::toJSON(apply(graphdata, MARGIN = 1, FUN = function(x)return(list(x))))
	dataarr.script <- sprintf('var dataarr = %s;', jsonarr)
	datamap.script <- 'var dataToBind  =  d3.entries(dataarr.map(function(d, i) {return d[0]}));'
	databind.script <- 'var scatterPoints  =  d3.select(".points").selectAll("use");\nscatterPoints.data(dataToBind);'
	tool.script <- 'scatterPoints
    .on("mouseover",  function(d) {
      //Create the tooltip label
      var tooltip  =  d3.select(this.parentNode).append("g");
      tooltip
        .attr("id", "tooltip")
       tooltip.append("text")
        .attr("transform", "scale(1, -1)")
        .attr("x", 100)
        .attr("y", -590)
        .attr("text-anchor", "start")
        .attr("stroke", "gray")
        .attr("fill", "gray")
        .attr("fill-opacity", 1)
        .attr("opacity", 1)
        .text(d.value.countryalias  +  ":");
      tooltip.append("text")
        .attr("transform", "scale(1, -1)")
        .attr("x", 100)
        .attr("y", -570)
        .attr("text-anchor", "start")
        .attr("stroke", "gray")
        .attr("fill", "gray")
        .attr("fill-opacity", 1)
        .attr("opacity", 1)
        .text("kv: "  +  d.value.femmort.replace(".", ","));
      tooltip.append("text")
        .attr("transform", "scale(1, -1)")
        .attr("x", 100)
        .attr("y", -550)
        .attr("text-anchor", "start")
        .attr("stroke", "gray")
        .attr("fill", "gray")
        .attr("fill-opacity", 1)
        .attr("opacity", 1)
        .text("m: "  +  d.value.malemort.replace(".", ","));
    })
    .on("mouseout",  function(d) {
        d3.select("#tooltip").remove();
    });'
   return(sprintf('%s\n%s\n<script>\n%s\n%s\n%s\n%s\n</script>\n</svg>', notice,
		  d3.script, dataarr.script, datamap.script, databind.script, tool.script))

}

ctriesyr.plot <- function(cause, compyear, ageorig, type)
{
	ctrynames <- names(conf[['countries']])
	sex <- as.numeric(conf[['causes']][[cause]][['sex']])
	caalias <- conf[['causes']][[cause]][['alias']]
	agealias <- conf[['ages']][[ageorig]][['alias']]
	if ('note' %in% names(conf[['ages']][[ageorig]]))
		agealias <- sprintf('%s (%s)', agealias, conf[['ages']][[ageorig]][['note']])

	typealias <- conf[['ptypes']][[type]][['alias']]
	sexalias <- conf[['sexes']][[sprintf('%d', sex)]][['alias']]

	df <- data.frame()
	for (country in ctrynames)
	{
		if (sex == 0)
		{
			csvname.country.male <- sprintf('csv/%s%s%s1.csv', cause, country, type)
			csvname.country.fem <- sprintf('csv/%s%s%s2.csv', cause, country, type)
			df.country.male <- read.csv(csvname.country.male, header = TRUE)
			df.country.fem <- read.csv(csvname.country.fem, header = TRUE)
			df.country <- data.frame(Year = df.country.male$Year)
			df.country['malemort'] <- df.country.male[ageorig]
			df.country['femmort'] <- df.country.fem[ageorig]
		}
		else
		{
			csvname.country <- sprintf('csv/%s%s%s%d.csv', cause, country, type, sex)
			df.country.0 <- read.csv(csvname.country, header = TRUE)
			df.country <- data.frame(Year = df.country.0$Year)
			df.country['mort'] <- df.country.0[ageorig]
		}
		df.country$country <- country
		df.country$countryalias <- conf[['countries']][[country]][['alias']]
		df.country$countryiso <- conf[['countries']][[country]][['iso3166']]
		df <- rbind(df, df.country)
	}
	df.sub <- subset(df, Year == compyear)
	rownames(df.sub) <- NULL

	if (sex == 0)
	{
		title <- sprintf('%s %s\n%s %d', typealias, caalias, agealias, compyear)
		df.plot <- ggplot(data = df.sub, aes(x = femmort, y = malemort)) +
			xlab(sprintf('%s kvinnor', typealias)) +
			ylab(sprintf('%s män', typealias)) +
				scale_x_continuous(label = comma.lab) +
			scale_y_continuous(label = comma.lab) +
			ggtitle(title) +
			geom_text(aes(label = countryiso), size = 3.5, alpha = 1/2) +
			geom_point(alpha = 1/8, size = 4)
	}
	else
	{
		title <- sprintf('%s %s\n%s %s %d', typealias, caalias, sexalias,
				 agealias, compyear)
		df.plot <- ggplot(data = df.sub, aes(x = countryalias, y = mort)) +
			xlab('Befolkning') +
			ylab(typealias) +
			scale_y_continuous(label = comma.lab) +
			ggtitle(title) +
			geom_bar(stat = 'identity') +
			theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
	}

	return(df.plot)

}

causedist.plot <- function(country, sex, year, startage, endage, ageformat,
			   causelist = conf[['causedist']])
{
	df <- data.frame()
	ctryalias <- conf[['countries']][[sprintf('%d', country)]][['alias']]
	sexalias <- conf[['sexes']][[sprintf('%d', sex)]][['alias']]
	casexlist <- Filter(function(x) conf[['causes']][[x]][['sex']] == 0 ||
			 conf[['causes']][[x]][['sex']] == sex, causelist)
	for (cause in casexlist)
	{
		catrend <- agetrends.plot(country, cause, sex, year, year,
					  startage, endage, 'perc', ageformat)
		df.catrend <- catrend$data
		df.catrend$cause <- cause
		df.catrend$caalias <- conf[['causes']][[cause]][['alias']]
		df <- rbind(df, df.catrend)
	}

	for (cause in casexlist)
	{
		causeconf = conf[['causes']][[cause]]
		if (causeconf[['classtot']])
		{
			for (subcause in casexlist)
			{
				subconf = conf[['causes']][[subcause]]
				if (!subconf[['classtot']] &&
				   subconf[['causeclass']] == causeconf[['causeclass']])
				{
					df$mort[df$cause == cause] <-
						df$mort[df$cause == cause] -
							df$mort[df$cause == subcause]
					df$caalias[df$cause == cause] <-
						sprintf('%s övrigt', causeconf[['alias']])
				}
			}
		}

	}

	title <- sprintf('Fördelning dödsorsaker %s %s %d', sexalias, ctryalias, year)
	df.plot <- ggplot(data = df, aes(x = agealias, y = 100*mort,
					 fill = caalias, group = caalias)) +
		geom_area(alpha = 0.7, colour = 'black') +
		xlab(agralias) +
		ylab(percalias) +
		scale_fill_hue(name = 'Orsak') +
		scale_y_continuous(label = comma.lab) +
		ggtitle(title) +
		theme(axis.text.x = element_text(angle = 45),
		      legend.position = 'bottom') +
                guides(fill = guide_legend(nrow = 3, byrow = TRUE))

	return(df.plot)
}

lmortfunc.test <- function(country, cause, sex, startyear, endyear, startage,
			   endage, ageformat, type = 'rate', pc = 'p', mortfunc = 'gompertz',
			   alphastart = 0.14, r0start = exp(-18), astart = 10, taustart = 80,
			   normrate = FALSE)
{
	if (mortfunc == 'gompertz')
	{
		nlsformula <- c(rate = 'yr ~ r0 * exp(alpha * age)',
				surv = 'yr ~ exp(-(r0/alpha) * (exp(alpha*age)-1))')
		lmformula <- c(rate = 'log_r0 ~ alpha', surv = 'log_r0alpha ~ alpha')
		startvec <- c(alpha = alphastart, r0 = r0start)
		transy.col <- c(rate = 'log_r0', surv = 'log_r0alpha')
		transy.func <- c(rate = quote(log(r0)), surv = quote(log(r0/alpha)))
	}
	else if (mortfunc == 'weibull')
	{
		nlsformula <- c(rate = 'yr ~ (a / tau) * (age / tau)^(a-1)',
				surv = 'yr ~ exp(-(age / tau)^a)')
		lmformula <- c(rate = 'trans_atau ~ I(a - 1)',
			       surv = 'minalog_tau ~ a')
		startvec <- c(a = astart, tau = taustart)
		transy.col <- c(rate = 'trans_atau', surv = 'minalog_tau')
		transy.func <- c(rate = quote(log(a / tau) - (a - 1) * log(tau)),
				 surv = quote(-a * log(tau)))
	}
	if (pc == 'p')
	{
		yearcol = 'Year'
		yrseq <- sprintf('%d', seq(startyear, endyear))
	}
	else if (pc == 'c')
	{
		yearcol = 'cohort'
		yrseq <- sprintf('%d', seq(startyear - endage + 5,
					   endyear - startage - 5))
	}

	col.mortfunc.nlslm <- function(x)
	{
		yr <- df.catrend.wide.yrs[[x]]
		age <- df.catrend.wide[['age']]
		wgths <- sqrt(dno.wide[yrseq][[x]])
		nlsLM(as.formula(nlsformula[[type]]),
		   start = startvec,
		   control = nls.lm.control(maxiter = 100),
		   weights = wgths)
	}

	if (type == 'rate' && !normrate)
	{
		datacol <- 'mort'
		catrend <- agetrends.plot(country, cause, sex, startyear, endyear,
			   startage, endage, 'rate', ageformat)$data
	}
	else
	{
		if (type == 'rate')
			datacol <- 'mx'
		else if (type == 'surv')
			datacol <- 'lx'
		catrend <- data.frame()
		for (yr in yrseq)
		{
			catrend.yr <- cause.life(country, cause, sex, as.numeric(yr), startage,
						 endage, ageformat)
			catrend.yr$Year <- yr
			catrend <- rbind(catrend, catrend.yr)
		}
	}

	dno <- read.csv(sprintf('csv/%s%dno%d.csv', cause, country, sex))
	dno$Pop36sum <- rowSums(dno[sprintf('Pop%d', seq(3, 6))])
	dno$Pop2325sum <- rowSums(dno[sprintf('Pop%d', seq(23, 25))])
	popcols <- sprintf('Pop%s', c(seq(2, 25), '2325sum', '36sum'))
	dno.long <- gather(dno[c('Year', popcols)], ageorig, no, Pop2:Pop36sum)
	dno.merge <- merge(dno.long, catrend, c('Year', 'ageorig'))
	dno.wide <- spread_(dno.merge[c(yearcol, 'no', 'age')], yearcol, 'no')

	df.catrend <- catrend[c(yearcol, datacol, 'age')]
	df.catrend.wide <- spread_(df.catrend, yearcol, datacol)
	df.catrend.wide.yrs <- df.catrend.wide[yrseq]

	list.mortfunc <- sapply(colnames(df.catrend.wide.yrs),
		col.mortfunc.nlslm, simplify = FALSE)
	list.mortfunc.coefs <- lapply(list.mortfunc, function(x) coef(x))
	df.mortfunc.coefs <- ldply(list.mortfunc.coefs)
	rownames(df.mortfunc.coefs) <- df.mortfunc.coefs$Year
	df.mortfunc.coefs[[transy.col[[type]]]] <- eval(transy.func[[type]], envir = df.mortfunc.coefs)

	long.mortfunc <- lm(as.formula(lmformula[[type]]), data = df.mortfunc.coefs)

	return(list(fit = long.mortfunc, obs = df.catrend.wide, no = dno.wide,
		    yrseq = yrseq, sourcefit = list.mortfunc))
}

cause.life <- function(country, cause, sex, year, startage, endage, ageformat)
{
	if(sex == 1)
		ltsex <- 'male'
	else if(sex == 2)
		ltsex <- 'female'

	allmort <- agetrends.plot(country, 'all', sex, year, year, startage,
				  endage, 'rate', ageformat)
	allmort.frame <- allmort$data[order(allmort$data$age),]
	allmort.lt <- lt.mx(allmort.frame$mort, sex = ltsex, age = allmort.frame$age)
	causeprop <- agetrends.plot(country, cause, sex, year, year, startage,
				  endage, 'perc', ageformat)
	causeprop.frame <- causeprop$data[order(causeprop$data$age),]
	cause.dx <- causeprop.frame$mort * allmort.lt$lt[, 'ndx']
	cause.lx0 <- rev(cumsum(rev(cause.dx)))
	cause.freq <- cause.lx0 / allmort.lt$lt[, 'lx']
	cause.lx <- cause.lx0 / cause.lx0[1]
	cause.mx <- (allmort.lt$lt[, 'nmx'] * causeprop.frame$mort) / cause.freq

	return(data.frame(age = causeprop.frame$age, ageorig = causeprop.frame$ageorig,
		    freq = cause.freq, lx = cause.lx, mx = cause.mx))

}


library(dplyr)
library(lubridate)
library(denstrip)
library(geofacet)

source("usa/code/plotting/format-data-plotting.r")

colours_set <- c("pink", "gold", "skyblue")

make_scenario_comparison_plots_mobility_deaths <- function(JOBID, StanModel, len_forecast, last_date_data,
                                                           mobility_increases = 20, ext = ".png"){
  print(sprintf("Plotting scenario comparison plots for deaths for mobility increase: %s", paste(mobility_increases, collapse=" ")))
  lab <- paste(mobility_increases, collapse="_")
  codes <- read.csv("usa/data/states.csv", stringsAsFactors = FALSE)
  names(codes) <- c("full_state", "state")

  mob_data <- NULL

  for (mobility_increase in mobility_increases){
    print(paste0("Loading:",  paste0('usa/results/sim-', StanModel, '-', len_forecast, '-', mobility_increase, '-', JOBID, '-stanfit.Rdata')))
    load(paste0('usa/results/sim-', StanModel, '-', len_forecast, '-', mobility_increase, '-', JOBID, '-stanfit.Rdata'))
    out <- rstan::extract(fit)

    for (i in 1:length(states)){
      data_state_plot <- format_data(i = i, dates = dates, states = states,
                                     estimated_cases_raw = estimated_cases_raw,
                                     estimated_deaths_raw = estimated_deaths_raw,
                                     reported_cases = reported_cases,
                                     reported_deaths = reported_deaths,
                                     out = out, forecast = 0)
      # Cuts data on last_data_date
      data_state_plot <- data_state_plot[which(data_state_plot$date <= last_date_data),]
      subset_data <- select(data_state_plot, state, date, reported_deaths, estimated_deaths,
                            deaths_min, deaths_max)
      if (mobility_increase == 0){
        subset_data$key <- rep(paste0("Constant mobility"), length(subset_data$state))
      } else {
        subset_data$key <- rep(paste0("Increased mobility ", mobility_increase, "%"), length(subset_data$state))
      }
      mob_data <- rbind(mob_data, subset_data)
    }
  }

  mob_data <- left_join(mob_data, codes, by = "state")
  saveRDS(mob_data, paste0('usa/results/deaths-scenario-out-',JOBID,'.RDS'))
  one_key <- unique(mob_data$key)
  data_half <- mob_data[which(mob_data$key == one_key[1]),]
  mob_data$key <- factor(mob_data$key, levels = sort(one_key, decreasing = TRUE))

  for (i in 1:length(states)){
    mob_data_subset <- mob_data[which(mob_data$state == states[i]),]
    data_half_subset <- data_half[which(data_half$state == states[i]),]
    p <- ggplot(mob_data_subset) +
      geom_bar(data = data_half_subset, aes(x = date, y = reported_deaths), stat='identity') +
      geom_ribbon(aes(x = date, ymin = deaths_min, ymax = deaths_max, group = key, fill = key), alpha = 0.5) +
      geom_line(aes(x = date, y = estimated_deaths, group = key, col = key), lwd = 1.5) +
      scale_fill_manual(name = "Scenarios", values = colours_set) +
      scale_colour_manual(name = "Scenarios", values = colours_set) +
      scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"), limits = c(as.Date("2020-02-24"), last_date_data)) +
      scale_y_continuous(labels = comma, expand=expansion(mult=c(0,0.1))) +
      xlab("") + ylab("Daily number of deaths") +
      theme_bw() +
      theme(axis.text.x = element_text(angle = 45, hjust = 1),
            legend.position = "right",
            strip.background = element_rect(colour="black", fill="white"))

    ggsave(paste0("usa/figures/", states[[i]], "_scenarios_", len_forecast, '_', lab, '_', JOBID, "_deaths", ext),
           p, height = 5, width = 7)
  }
}

make_scenario_comparison_plots_mobility_cases <- function(JOBID, StanModel, len_forecast, last_date_data,
                                                    mobility_increases = c(0, 20), ext = ".png", individual = FALSE){
  print(sprintf("Plotting scenario comparison plots for cases for mobility increase: %s", paste(mobility_increases, collapse=" ")))
  codes <- read.csv("usa/data/states.csv", stringsAsFactors = FALSE)
  names(codes) <- c("full_state", "state")

  lab <- paste(mobility_increases, collapse="_")

  mob_data <- NULL

  for (mobility_increase in mobility_increases){
    load(paste0('usa/results/sim-', StanModel, '-', len_forecast, '-', mobility_increase, '-', JOBID, '-stanfit.Rdata'))
    out <- rstan::extract(fit)

    for (i in 1:length(states)){
      data_state_plot <- format_data(i = i, dates = dates, states = states,
                                     estimated_cases_raw = estimated_cases_raw,
                                     estimated_deaths_raw = estimated_deaths_raw,
                                     reported_cases = reported_cases,
                                     reported_deaths = reported_deaths,
                                     out = out, forecast = 0)
      # Cuts data on last_data_date
      data_state_plot <- data_state_plot[which(data_state_plot$date <= last_date_data),]
      subset_data <- select(data_state_plot, state, date, reported_cases, predicted_cases,
                            cases_min, cases_max)
      if (mobility_increase == 0){
        subset_data$key <- rep(paste0("Constant mobility"), length(subset_data$state))
      } else {
        subset_data$key <- rep(paste0("Increased mobility ", mobility_increase, "%"), length(subset_data$state))
      }
      mob_data <- rbind(mob_data, subset_data)
    }
  }

  mob_data <- left_join(mob_data, codes, by = "state")
  saveRDS(mob_data, paste0('usa/results/cases-scenario-out-',JOBID,'.RDS'))
  one_key <- unique(mob_data$key)
  data_half <- mob_data[which(mob_data$key == one_key[1]),]

  mob_data$key <- factor(mob_data$key, levels = sort(one_key, decreasing = TRUE))

  for (i in 1:length(states)){
    mob_data_subset <- mob_data[which(mob_data$state == states[i]),]
    data_half_subset <- data_half[which(data_half$state == states[i]),]
    p <- ggplot(mob_data_subset) +
      geom_bar(data = data_half_subset, aes(x = date, y = reported_cases), stat='identity') +
      geom_ribbon(aes(x = date, ymin = cases_min, ymax = cases_max, group = key, fill = key), alpha = 0.5) +
      geom_line(aes(x = date, y = predicted_cases, group = key, col = key), lwd = 1.5) +
      scale_fill_manual(name = "Scenarios", values = colours_set) +
      scale_colour_manual(name = "Scenarios", values = colours_set) +
      scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"), limits = c(as.Date("2020-02-24"), last_date_data)) +
      scale_y_continuous(labels = comma, expand=expansion(mult=c(0,0.1))) +
      xlab("") + ylab("Daily number of new infections") +
      theme_bw() +
      theme(axis.text.x = element_text(angle = 45, hjust = 1),
            legend.position = "right",
            strip.background = element_rect(colour="black", fill="white")) #+
    #ggtitle(states[i])

    ggsave(paste0("usa/figures/", states[[i]], "_scenarios_", len_forecast, '_',
                  lab, '_', JOBID, "_cases", ext), p, height = 5, width = 7)

  }
}

make_scenario_comparison_plots_mobility_rt <- function(JOBID, StanModel, len_forecast, last_date_data,
                                                       mobility_increase, ext = ".png", individual = FALSE){
  codes <- read.csv("usa/data/states.csv", stringsAsFactors = FALSE)
  names(codes) <- c("full_state", "state")

  print(sprintf("Making rt scenario comparision plots for mobilities: %s", paste(mobility_increase, collapse=" ")))

  mob_data <- NULL

  # Read in covariates
  covariates <- readRDS("usa/data/covariates.RDS")
  covariates$Quarantine = NULL
  covariates$GathRecomAny = NULL
  covariates_ended <- readRDS("usa/data/covariates_ended.RDS")
  covariates_ended$Quarantine = NULL
  covariates_ended$GathRecomAny = NULL

  covariates_all <- NULL

  for (mob in mobility_increase){
    load(paste0('usa/results/sim-', StanModel, '-', len_forecast, '-', mob, '-',
                JOBID, '-stanfit.Rdata'))
    out <- rstan::extract(fit)

    for (i in 1:length(states)){
      data_state_plot <- format_data(i = i, dates = dates, states = states,
                                     estimated_cases_raw = estimated_cases_raw,
                                     estimated_deaths_raw = estimated_deaths_raw,
                                     reported_cases = reported_cases,
                                     reported_deaths = reported_deaths,
                                     out = out, forecast = 0)
      # Cuts data on last_data_date
      data_state_plot <- data_state_plot[which(data_state_plot$date <= last_date_data),]
      subset_data <- select(data_state_plot, state, date, rt, rt_max, rt_min,
                            rt_max2, rt_min2)
      if (mob == 0){
        subset_data$key <- rep(paste0("Constant mobility"), length(subset_data$state))
      } else {
        subset_data$key <- rep(paste0("Increased mobility ", mob, "%"), length(subset_data$state))
      }
      mob_data <- rbind(mob_data, subset_data)

      if (mob == mobility_increase[length(mobility_increase)]){
        covariates_long <- gather(covariates[which(covariates$StatePostal == states[i]),
                                             2:ncol(covariates)],
                                  key = "key", value = "value")
        covariates_long$x <- rep(NA, length(covariates_long$key))
        covariates_long$time <- rep("start", length(covariates_long$key))

        covariates_ended_long <- gather(covariates_ended[which(covariates_ended$StatePostal == states[i]),
                                                         2:ncol(covariates_ended)],
                                        key = "key", value = "value")
        covariates_ended_long$x <- rep(NA, length(covariates_ended_long$key))
        covariates_ended_long$time <- rep("ease", length(covariates_ended_long$key))

        covariates_long <- rbind(covariates_long, covariates_ended_long)
        covariates_long$time <- factor(covariates_long$time, levels = c("start", "ease"))

        un_dates <- unique(covariates_long$value)
        for (k in 1:length(un_dates)){
          idxs <- which(covariates_long$value == un_dates[k])
          max_val <- ceiling(max(data_state_plot$rt_max)) + 0.3
          for (k in idxs){
            covariates_long$x[k] <- max_val
            max_val <- max_val - 0.3
          }
        }

        covariates_long$state <- rep(states[[i]], length(covariates_long$key))

        covariates_all <- bind_rows(covariates_all,
                                    covariates_long)
      }
    }
  }

  mob_data <- left_join(mob_data, codes, by = "state")
  saveRDS(mob_data, paste0('usa/results/rt-scenario-out-',JOBID,'.RDS'))
  covariates_all <- left_join(covariates_all, codes, by = "state")

  one_key <- unique(mob_data$key)
  mob_data$key <- factor(mob_data$key, levels = sort(one_key, decreasing = TRUE))

  plot_labels <- c("Emergency decree",
                   "Restrict public events",
                   "Business closure",
                   "Restaurant closure",
                   "School closure",
                   "Stay at home mandate")

  for (i in 1:length(states)){
    subset_data <- mob_data[which(mob_data$state == states[i]),]
    subset_covariates_long <- covariates_all[which(covariates_all$state == states[i]),]

    p <- ggplot(subset_data) +
      geom_ribbon(aes(x = date, ymin = rt_min, ymax = rt_max, group = key, fill = key), alpha = 0.5) +
      geom_line(aes(x = date, y = rt, group = key, col = key), lwd = 1.5) +
      geom_hline(yintercept = 1, color = 'black', size = 0.7) +
      scale_colour_manual(name = "Scenarios", values = colours_set) +
      scale_fill_manual(name = "Scenarios", values = colours_set) +
      scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"),  lim = c(as.Date("2020-02-24"), last_date_data)) +
      scale_y_continuous(expand=expansion(mult=c(0,0.1))) +
      xlab("") +
      ylab(expression(R[t])) +
      guides(shape = guide_legend(order = 2), col = guide_legend(order = 1), fill = guide_legend(order = 0)) +
      theme_bw() +
      theme(axis.text.x = element_text(angle = 45, hjust = 1),
            panel.grid.minor = element_blank(),
            legend.position = "right")

      ggsave(paste0("usa/figures/",  states[i], "_scenarios_", len_forecast, '_', JOBID, "_rt", ext),
             p, height = 5, width = 7)
  }
}


# Load opal and datashield libraries
library(opal)
library(opaladmin)
library(dsBaseClient)
library(dsStatsClient)
library(dsGraphicsClient)
library(dsModellingClient)

# Login to VMs

# To understand why these variables are assigned this way, see the
# documentation for the datashield.login function (part of the opal
# package)

# login details
begin = as.numeric(Sys.time())
server <- c("datashield_opal")
# note the datashield_opal only works from inside this docker container
#url <- c("http://localhost:8880")
url <- c("https://localhost:8843")
# ^^^ Note this specifies the port number
user <- "test"
password <- "test123"
table <- c("test.LifeLines")
# ^^^ note that this reflects the folder hierarchy that can be seen via the OPAL web interface

# Create a dataframe with all these details
logindata <- data.frame(server,url,user,password,table)

# Create an 'opals' object by passing the 'logindata' data frame to the
# datashield.login function
opals <- datashield.login(logins=logindata, assign = TRUE)

ds.glm(formula='D$SMK31~D$GESLACHT+D$LENGTE', family='binomial', datasources = opals)

datashield.logout(opals)
timeTaken = as.numeric(Sys.time()) - begin
print(paste(c("time taken = ", timeTaken)))

print("Congratualations!!! - a basic glm model was successfully generated")


library(foreach)
library(doParallel)

#pdf("~/Documents/Models/variant-filtering/tests/model_comp.pdf",8,5)

for(type in list("snv",c("ins","del"))){
  train_table="tables/K2H_AllVariants_All_Lib_NoMinAF_noequal_GOF_addVCFfeatures_illuminaBED_WES_samples_annotated_with_coverage_INFO_GENO_status_supp_features.txt"
  train_table = read.table(train_table, quote="\"", stringsAsFactors=F, sep="\t", header=T)
  train_table$IoD = 1 + train_table$SIG * 10^(train_table$ERR)
  train_table[which(is.infinite(train_table$MIN_DIST)),"MIN_DIST"] = 1000000000
  train_table[which(is.infinite(train_table$MaxRatioWin)),"MaxRatioWin"] = 1000000000

  train_table = train_table[which(train_table$TYPE_INFO %in% type),]

  kfold_auc_rf = c()
  kfold_auc_mlp = c()
  kfold_auc_svm = c()

  folds <- createFolds(train_table$status, 10)

  cores=detectCores()
  cl <- makeCluster(cores/2) #not to overload your computer
  registerDoParallel(cl)

  res = foreach(i=1:10, .combine=cbind, .packages = c("randomForest","monmlp","e1071","ROCR")) %dopar% {
    print(paste("fold: ",i,sep=""))
    test = train_table[folds[[i]],]
    train = train_table[-folds[[i]],]

    train$target = 0 ; train[which(train$status=="TP"),"target"] = 1
    test$target = 0 ; test[which(test$status=="TP"),"target"] = 1

    my_features=c("status","RVSB", "QVAL","AF","ERR_INFO","DP", "medianDP_INFO",
                  "FS", "MIN_DIST", "AO", "QUAL", "MaxRatioWin", "NbVarWin", "IoD", "HpLength")

    # random forest
    print("PERFORMING RANDOM FORESTS")
    rf_fold = randomForest(target ~ ., data = train[,my_features], importance = TRUE,
                           ntree = 500, sampsize = as.numeric(table(train$status)["TP"]))
    test$prediction = predict(rf_fold, test)
    auc_rf = performance( prediction(test$prediction, test$target), "auc" )@y.values[[1]]
    #plot(performance(prediction(test$prediction, test$target), "prec","rec" ), colorize=T, xlim=c(1,0.95), colorize.palette="darkred")

    # support vector machine
    print("PERFORMING SVMs")
    svm_fold = svm(target ~ . , data=train[,my_features])
    test$prediction = predict(svm_fold, test[,my_features])
    auc_svm = performance( prediction(test$prediction, test$target), "auc" )@y.values[[1]]
    #plot(performance(prediction(test$prediction, test$target), "prec","rec" ), colorize=T, xlim=c(1,0.95), add=T, colorize.palette="darkgreen")

    # multilayers perceptron
    print("PERFORMING MLPs")
    x = data.matrix(train[,my_features[my_features!="target"]])
    y = data.matrix(train$target)
    model_mlp <- monmlp.fit(x, y, hidden1=5, n.ensemble=10, monotone=1, bag=TRUE)
    test$prediction = monmlp.predict(x = data.matrix(test[,my_features[my_features!="target"]]), weights = model_mlp)
    auc_mlp = performance( prediction(test$prediction, test$target), "auc" )@y.values[[1]]
    #plot(performance(prediction(test$prediction, test$target), "prec","rec" ), colorize=T, xlim=c(1,0.95), add=T, colorize.palette="darkblue")

    c(auc_rf, auc_mlp, auc_svm)
  }
  stopCluster(cl)
  if(!type[1]=="snv") type="indels"
  #boxplot(data.frame("RF"=res[1,], "SVM"=res[2,], "MLP"=res[3,]), col="lightgrey", ylim=c(0.95,1), main=paste("AUC 10-fold - ",type,sep=""))
  d = data.frame(auc=c(res[1,], res[2,], res[3,]), algorithm=c(rep("RF",10),rep("SVM",10),rep("MLP",10)))
  ggplot(d, aes(x=algorithm, y=auc)) + geom_violin(fill="lightgrey") + theme_bw() + ggtitle(paste("AUC 10-fold - ",type,sep=""))
}

dev.off()


#Lectura de archivo csv del monitoreo

#librerías requeridas
require(tidyverse)
require(dplyr)
require(lubridate)
require(stringr)
require(ggplot2)

#leer datos
data <- read_csv("monitoreo.csv")
#modificar formatos de fecha
data$ini_monit <- str_replace(data$ini_monit," 2019","")
data$ini_monit <- str_replace(data$ini_monit,"Mon ","2019 ")
data$ini_monit <- str_replace(data$ini_monit,"Tue ","2019 ")
data$ini_monit <- str_replace(data$ini_monit,"Wed ","2019 ")
data$ini_monit <- str_replace(data$ini_monit,"Thu ","2019 ")
data$ini_monit <- str_replace(data$ini_monit,"Fri ","2019 ")
data$ini_monit <- str_replace(data$ini_monit,"Sat ","2019 ")
data$ini_monit <- str_replace(data$ini_monit,"Sun ","2019 ")
data$ini_monit <- ymd_hms(data$ini_monit)

#agregar tiempo en segundos
data <- data %>%
  mutate(tiempo = as.integer(as.POSIXct(ini_monit)))

#resumen de los datos
summary(data)
total_desc = sum(data$desconexion)
print(paste("Número de desconexiones totales: ",total_desc))

write.table(data, file = "datosWSN.csv",row.names=FALSE, na="",col.names=TRUE, sep=",")

#agrupar tabla por nodo y ordenar por latencia (ascendente)
data_monitor_nodo <- data %>%
  group_by(mac_local,mac_destino) %>%
  summarise(latencia_prom= mean(latencia), latencia_var = var(latencia),
            min_lat = min(latencia), max_lat = max(latencia),
            rssi_prom = mean(rssi),rssi_var = var(rssi),
            rssi_min = min(rssi), rssi_max = max(rssi),
            lqi_prom = mean(lqi), lqi_var = var(lqi),
            lqi_min = min(lqi), lqi_max = max(lqi)) %>%
  arrange(mac_destino, mac_local)

write.table(data_monitor_nodo, file = "stats_WSN.csv",row.names=FALSE, na="",col.names=TRUE, sep=",")

print("Latencia promedio por radio [ms]")
print(data_monitor_nodo)

#agrupar por nodo
data_monitor_desc <- data %>%
  filter(desconexion > 0) %>%
  group_by(mac_local,mac_destino) %>%
  arrange(ini_monit)

write.table(data_monitor_desc, file = "desconexiones_WSN_raw.csv",row.names=FALSE, na="",col.names=TRUE, sep=",")
print("datos agrupados por nodo")
head(data_monitor_desc)

#obtener mac y numero de desconexiones de los nodos
desconectados <-data_monitor_desc %>%
  group_by(mac_local,mac_destino) %>%
  summarise(num_desc = sum(desconexion))

aux_desc <-data %>%
  group_by(mac_local,mac_destino) %>%
  summarise(n=n())

desconectados <- inner_join(desconectados,aux_desc)

desconectados <- desconectados %>%
  mutate(proporcion_desc = num_desc/n)

write.table(desconectados, file = "datos_desconexion.csv",row.names=FALSE, na="",col.names=TRUE, sep=",")

print("Estadísticas de desconexión")
desconectados

#graficar rssi a lo a lo largo del tiempo
ggplot(data,aes(x=ini_monit,y=rssi,color=mac_destino)) +
  geom_line() +
  labs(x="tiempo", y="rssi") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))+
  ggtitle("RSSI a lo largo del tiempo de monitoreo por MAC de destino")

#graficar lqi a lo a lo largo del tiempo
ggplot(data,aes(x=ini_monit,y=lqi,color=mac_destino)) +
  geom_line() +
  labs(x="Tiempo", y="lqi") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  ggtitle("LQI a lo largo del tiempo de monitoreo por MAC de destino")

#histograma de desconexiones:
ggplot(data_monitor_desc,aes(x=mac_local,y=desconexion)) +
  geom_bar(stat = "identity") +
  labs(x="MAC de radio", y="# desconexiones") +
  ggtitle("Número de desconexiones por mac local")

Tareas NTI/Tarea Monitoreo red/monitoring.r


# Copyright (C) 2016 Electronic Arts Inc.  All rights reserved.
str(mtcars)

print("Sleeping for 15 seconds")
Sys.sleep(15)

print("Saving RData file")
dir.create("/var/www/html/RServer/reports/mtcars")
save(mtcars, file = "/var/www/html/RServer/reports/mtcars/mtcars.RData")

fit <- lm(mpg~am + wt + hp, data = mtcars)
summary(fit)

print("Saving Model")
Sys.sleep(10)
save(fit, file = "/var/www/html/RServer/reports/mtcars/Model.RData")


{{rimport}}('__init__.r')
{% assign default_inopts = {'delimit': '\t', 'rnames': False, 'cnames': True, 'check.names': False} %}
{% python default_inopts.update(args.inopts) %}
{% python default_inopts['sep'] = default_inopts['delimit'] %}
{% python default_inopts['row.names'] = default_inopts['rnames'] or None %}
{% python default_inopts['header'] = default_inopts['cnames'] %}
{% python del default_inopts['delimit'] %}
{% python del default_inopts['rnames'] %}
{% python del default_inopts['cnames'] %}
{% assign default_binopts = {'nbin': None, 'step': None, 'nan': 'skip', 'out': 'lower'} %}
{% python default_binopts.update(args.binopts) %}

infile  = {{i.infile | quote}}
outfile = {{o.outfile | quote}}
inopts  = {{default_inopts | R}}
binopts = {{default_binopts | R}}
cols    = {{args.cols | R: False}}

inopts = c(infile, inopts)
data   = do.call(read.table, inopts)
cnames = colnames(data)

newcols = list()
if (is.null(cols)) {
	for (col in cnames) {
		newcols[[col]] = binopts
	}
} else if (is.list(cols)) {
	for (col in names(cols)) {
		cname = as.integer(col)
		if (is.na(cname))
			cname = col
		else
			cname = cnames[cname]
		newcols[[cname]] = update.list(binopts, cols[[col]])
	}
} else {
	for (col in cols) {
		cname = as.integer(col)
		if (is.na(cname))
			cname = col
		else
			cname = cnames[cname]
		newcols[[cname]] = binopts
	}
}

ret = NULL
for (i in 1:ncol(data)) {
	cname = cnames[i]
	dcol  = data[, i, drop = F]
	if (cname %in% names(newcols)) {
		attach (newcols[[cname]])
		if (nan == 'as0') {
			dcol[is.na(dcol)] = 0
			dcol2 = dcol
		} else {
			dcol2 = dcol[!is.na(dcol)]
		}

		cmax = max(dcol2)
		cmin = min(dcol2)
		probs = NULL
		if (!is.null(nbin)) {
			breaks = quantile(dcol2, probs = seq(0, 1, 1/nbin))
		} else if (!is.null(step)) {
			breaks = seq(cmin, cmax + 1, step)
		} else {
			stop('One of `nbin` and `step` is required for binning.')
		}
		cuts = cut(dcol2, breaks = breaks, include.lowest = T)
		ucuts = levels(factor(cuts))
		for (j in 1:length(ucuts)) {
			idx = which(cuts == ucuts[j])
			if (out == 'step') {
				dcol2[idx] = unlist(strsplit(substring(ucuts[j], 2), ',', fixed=T))[1]
			} else if (out == 'lower' || out == 'min') {
				dcol2[idx] = min(dcol2[idx])
			} else if (out == 'upper' || out == 'max') {
				dcol2[idx] = max(dcol2[idx])
			} else if (out == 'mean') {
				dcol2[idx] = mean(dcol2[idx])
			} else if (out == 'median') {
				dcol2[idx] = median(dcol2[idx])
			} else {
				dcol2[idx] = j
			}
		}
		dcol[!is.na(dcol)] = dcol2
	}
	if (is.null(ret)) {
		ret = dcol
	} else {
		ret = cbind(ret, dcol)
	}
}

write.table(ret, outfile, sep = inopts$sep, col.names = inopts$header, row.names = if (is.null(inopts$row.names)) F else T, quote = F)


#` A fast version of row scaling of sparse TF matrix by IDF vector, this function wiil be invoked by function tfidf
#` @param tf   (sparse matrix)   A saparse matrix of term frequency matrix
#` @param idf  (vector)          A vector of inverse document frequency
#` @return     (sparse matrix)   A sparse matrix of TF-IDF
fast_tfidf = function(tf, idf) {
   tf <- t(tf)
   tf@x <- tf@x * rep.int(idf, diff(tf@p))
   tf <- t(tf)
   return(tf)
}


# author: Gurdeepak Sidhu
# date: 2020-11-25

"Creates eda plots for the pre-processed/cleaned training data from the Diabetes data set(from https://archive.ics.uci.edu/ml/machine-learning-databases/00529/diabetes_data_upload.csv).
Saves the figure as a pdf and png file.

Usage: src/eda_diab.r --train=<train> --out_dir=<out_dir>

Options:
--train=<train>                   Path (including filename) to preprocessed data (which needs to be saved as a csv file)
--out_dir=<out_dir>               Path to directory where the plots should be saved
" -> doc

library(tidyverse)
library(docopt)
library(ggthemes)
library(ggridges)
theme_set(theme_minimal())

opt <- docopt(doc)

main <- function(train, out_dir) {

  #Checking if the file path exists or not
  if (file.exists(train) ==TRUE){
    # Reading the train data
    train_data <- read.csv(train)
  } else {
    print("No such file exist, please check whether correct file path is entered")
  }

  # visualize  age predictor distribution by class
  age_plot <- train_data %>%
    select(age,class) %>%
    gather(key = predictor, value = value, -class) %>%
    mutate( predictor = str_to_title(predictor))  %>%
    ggplot(aes(x = value, y = class, colour = class, fill = class)) +
    geom_density_ridges(alpha = 0.8) +
    ggtitle("Age") +
    scale_fill_tableau() +
    scale_colour_tableau() +
    guides(fill = FALSE, color = FALSE) +
    theme(axis.title.x = element_blank(),
          axis.title.y = element_blank(),
          plot.title = element_text(hjust = 0.5))
    ggsave(paste0(out_dir, "age_distributions.png"),
         age_plot,
         width = 8,
         height = 10)

  # visualize categorical predictor distributions by class
    categorical_plot <-  train_data %>%
    select(-age) %>%
    gather(key = predictor, value = value, -class) %>%
    mutate(predictor = str_replace_all(predictor, "_", " "),
           predictor = str_to_title(predictor)) %>%
    ggplot(aes(x = value, colour = class, fill = class)) +
    facet_wrap(. ~ predictor, scale = "free", ncol = 5) +
    geom_bar(position = "dodge") +
    labs(color ="Class", fill = "Class") +
    scale_fill_tableau() +
    scale_colour_tableau() +
    theme(axis.title.x = element_blank(),
          axis.title.y = element_blank())
    ggsave(paste0(out_dir, "categorical_distributions.png"),
           categorical_plot,
           width = 8,
           height = 10)
}

main(opt[["--train"]], opt[["--out_dir"]])


#installation, running this code will use renv if you are using R 3.6.1 (i.e download the dependencies as they were during software testing) or install packages in your normal environment if using a new version of R.

### old dependencies, no need to get it anymore, kept here for putative debug.
### devtools::install_github('jcolomb/osfr')

vers=R.Version()
if (vers$major =="3"){
  renv::restore()
} else {
  print("renv set for R 3.6.1, trying to install new packages version from CRAN, it will probably work, but was not tested.")
  install.packages(c(
    "randomForest",
    "ica",
    "e1071", #svm
    "Hmisc",   #binomial confidence
    "rstatix",
    "coin",
    #normal libraries:
    "tidyverse",
    "stringr",
    #for plotting
    "gridExtra",
    "RGraphics",
    "shinyFiles",
    "devtools",
    "plotly",
    "glmpath",
    "pander",
    "DT",
    "beepr",
    "osfr"))
}


##cibersort
library(pheatmap)
library(data.table)
library(edgeR)
library("tools")

source(parFile1)

data_df<-read.table(parSampleFile1, sep="\t", header=F, stringsAsFactor=F)

ref_data<-readRDS(parFile2)

geneMap<-read.table(parFile3, sep="\t", header=T)
geneMap<-geneMap[geneMap$gene_biotype == "protein_coding",]
geneMap$gene_id_2<-gsub("\\.\\d+","", geneMap$gene_id)
geneSymbolMap<-split(geneMap$gene_name, geneMap$gene_id_2)

idx=1
for(idx in c(1:nrow(data_df))){
  df_name=data_df[idx, 2]
  count_file=data_df[idx, 1]
  cat(df_name, " : ", count_file, "\n")

  if(file_ext(count_file) == "csv"){
    count <- read.csv(count_file,row.names = 1)
  }else{
    count <- read.table(count_file,row.names = 1, sep="\t", header=T)
  }

  if ("geneName" %in% colnames(count)){
    library(dplyr)
    geneName=unlist(count$geneName)
    count<-count[,!(colnames(count) %in% c("geneName", "geneDescription"))]
    count2<-aggregate(count, by=list(geneName=geneName), FUN=sum)
    rownames(count2)<-count2$geneName
    count<-count2[,-1]
  }else{
    if(any(rownames(count) %in% geneMap$gene_id_2)){
      #merge gene_symbol
      count<-count[rownames(count) %in% geneMap$gene_id_2,]
      count$geneName<-geneSymbolMap[rownames(count)]
      count<-count[!duplicated(count$geneName),]
      rownames(count)<-count$geneName
      count<-count[,colnames(count) != "geneName"]
    }
  }

  #normalization by CPM
  dge <- DGEList(counts = count,remove.zeros = T)
  tmm_counts <- calcNormFactors(dge)
  #drop <- which(apply(cpm(tmm_counts), 1, max) < 1)
  CPM <- cpm(tmm_counts,prior.count=10)
  data <- CPM

  sdata<-cbind(data.frame(Gene=rownames(data)), data)
  write.table(sdata, file=paste0(df_name, ".txt"), sep="\t", row.names=F, quote=F)

  height=max(10, ceiling(ncol(data) / 5))

  cp <- CIBERSORT(ref_data,data,perm = 1000,absolute = T,QN=F)##absolute
  write.csv(cp, file=paste0(df_name, "_CIBERSORTx_absolute.cpm.csv"))

  pvalue_index<-which(colnames(cp) == "P-value")
  cpv<-cp[,c(1:(pvalue_index-1))]
  pdf(paste0(df_name, "_CIBERSORTx_absolute.cpm.pdf"), width=10, height=height)
  pheatmap(cpv,cluster_cols = F,cluster_rows = F)
  dev.off()

  cp <- CIBERSORT(ref_data,data,perm = 1000,absolute = F,QN=F)##relative
  write.csv(cp, file=paste0(df_name,"_CIBERSORTx_relative.cpm.csv"))

  pvalue_index<-which(colnames(cp) == "P-value")
  cpv<-cp[,c(1:(pvalue_index-1))]
  pdf(paste0(df_name, "_CIBERSORTx_relative.cpm.pdf"), width=10, height=height)
  pheatmap(cpv,cluster_cols = F,cluster_rows = F)
  dev.off()
}


rebol [
	title: "SWF morphing shapes related parse functions"
	purpose: "Functions for parsing morphing shape tags in SWF files"
]

	readMORPHFILLSTYLEARRAY: has[FillStyles][
		;print ["FSA:" mold copy/part inBuffer 10]
		byteAlign
		FillStyles: copy []
		loop readCount [ ;FillStyleCount
			append/only FillStyles readMORHFILLSTYLE

		]
		;print ["readMFILLSTYLEARRAY" mold FillStyles]
		FillStyles
	]
	readMORPHLINESTYLEARRAY: has[LineStyles][
		LineStyles: copy []
		;byteAlign
		loop readCount [ ;LineStyleCount
			append/only LineStyles either tagId = 46 [
				reduce [
					readUI16 ;StartWidth
					readUI16 ;EndWidth
					readRGBA
					readRGBA
				] ;<= readMORPHLINESTYLE
			][ readMORPHLINESTYLE2 ]
		]
		;print ["readMLINESTYLEARRAY" mold LineStyles]
		LineStyles
	]
	readMORPHLINESTYLE2: has [joinStyle hasFill?][
		reduce [
			readUI16 ;StartWidth
			readUI16 ;EndWidth
			reduce [
				readUB 2 ;f_start_cap_style
				joinStyle: readUB 2 ;f_join_style
				hasFill?:  readBitLogic ;f_has_fill
				readBitLogic ;f_no_hscale
				readBitLogic ;f_no_vscale
				readBitLogic ;f_pixel_hinting
				(
					skipBits 5   ;f_reserved
					readBitLogic ;f_no_close
				)
				readUB 2 ;f_end_cap_style
			]
			either joinStyle = 2 [readUI16][none] ;miterLimit
			either hasFill? [readFILLSTYLE][reduce [readRGBA readRGBA]]
		]
	]

	readMORHFILLSTYLE: has[type][
		;print ["fillstyle" mold copy/part inBuffer 10]
		byteAlign
		reduce [
			type: readUI8 ;FillStyleType
			reduce case [
				type = 0 [;solid fill
					[readRGBA readRGBA]
				]
				any [
					type = 16 ;linear gradient fill
					type = 18 ;radial gradient fill
					type = 19 ;focal gradient fill (swf8)
				][;gradient
					[readMATRIX readMATRIX readMORPHGRADIENT type ]
				]
				type >= 64 [;bitmap
					[readUsedID readMATRIX readMATRIX]
				]
			]
		]
	]

	readMORPHGRADIENT: func[type /local gradients][
		byteAlign
		;print ["readMORPHGRADIENT" mold copy/part inBuffer 30 ]
		gradients: copy []
		loop readUI8 [
			insert/only tail gradients reduce [;readMORPHGRADRECORD
				readUI8  ;Start ratio
				readRGBA ;Start color
				readUI8  ;End ratio
				readRGBA ;End color
			]
		]
		gradients
	]

	parse-DefineMorphShape:  does [
		reduce [
			readID
			readRECT ;StartBounds
			readRECT ;EndBounds
			readUI32 ;Offset
			readMORPHFILLSTYLEARRAY
			readMORPHLINESTYLEARRAY
			readSHAPE ;StartEdges
			readSHAPE ;EndEdges
		]
	]
	parse-DefineMorphShape2:  does [
		reduce [
			readID
			readRECT ;StartBounds
			readRECT ;EndBounds
			readRECT ;StartEdgeBounds
			readRECT ;EndEdgeBounds
			(
				readUB 6     ;reserved
				readBitLogic ;usesNonScalingStrokes
			)
			readBitLogic ;usesScalingStrokes
			readUI32 ;Offset
			readMORPHFILLSTYLEARRAY
			readMORPHLINESTYLEARRAY
			readSHAPE ;StartEdges
			readSHAPE ;EndEdges
		]
	]


#Similarity matrix as a single functions
similarity_taxon_predict <- function(S0, S1, wt, similarity.matrix, taxa) {

    # Parameters:
    #   S0                  A large set of species and their preys, with column structure ['taxon', 'taxonomy', 'resource', 'non-resource'] (if blind = TRUE, it )
    #   S1                  The subset of S0 where we want to predict new preys, string vector
    #   wt                  Weight given to traits (including phylogeny) when computing similarities.
    #   similarity.matrix   Similarity.matrix for interaction catalogue (measured by function: similarity_taxon)
    #   taxa                Either resource or consumer

    #
    # Output
    #   A matrix of dimensions S x S with similarity measurements for all combinations of S[i,j]

    # Note: the similarity on the diagonal has to be set to 1 since it's all the same species.

    to.recalculate <- which(S0[, 'taxon'] %in% S1)
    similarity.matrix[, to.recalculate] <- similarity.matrix[to.recalculate, ] <- 0

    taxonomy <- vector("list",nrow(S0))
    taxon <- vector("list",nrow(S0))
    for(i in 1:nrow(S0)) {
      taxonomy[[i]] <- unlist(strsplit(S0[i, 'taxonomy'], " \\|\\ "))
      if(length(which(taxonomy[[i]] == "NA")) > 0) {
          taxonomy[[i]] <- taxonomy[[i]][-which(taxonomy[[i]] == "NA")]
      }

        if(taxa == 'consumer') {
            taxon[[i]] <- unlist(strsplit(S0[i, 'resource'], " \\|\\ "))
        } else if(taxa == 'resource') {
            taxon[[i]] <- unlist(strsplit(S0[i, 'consumer'], " \\|\\ "))
        }
    }

  # pb <- txtProgressBar(min = (nrow(similarity.matrix) - length(taxa.add)), max = ncol(similarity.matrix), style = 3)

  for(i in to.recalculate){
      for(j in 1:ncol(similarity.matrix)){ #No need to evaluate both side of the matrix diagonal for the similarity matrix
          similarity.matrix[i,j] <- similarity.matrix[j,i] <- tanimoto_traits(resource_x = taxon[[i]],
                                                                              resource_y = taxon[[j]],
                                                                              trait_x = taxonomy[[i]],
                                                                              trait_y = taxonomy[[j]],
                                                                              trait_weight = wt
                                                                              )
      }#j
  # setTxtProgressBar(pb, i)
  }#i
  # close(pb)
  diag(similarity.matrix) <- 1
  return(similarity.matrix)
}#similarity_taxon_predict function


library(lme4)
source("R/functions/get_score.r")

fn.si = file.path(PROJECT_DIR, "generated_data", "SLE", "SLE_sample_info_2_sle.txt")
info = fread(fn.si, data.table = F)

info = info %>%
  mutate(DA=factor(DA, levels=c("low","mid","high")),
         SUBJECT = factor(SUBJECT, levels=
                            unique(SUBJECT[order(as.numeric(sub("SLE-","",SUBJECT)))])))

info = info %>%
  mutate(DA=factor(DA, levels=c("low","mid","high")),
         DAn = as.numeric(DA),
         SUBJECT = factor(SUBJECT, levels=
                            unique(SUBJECT[order(as.numeric(sub("SLE-","",SUBJECT)))])))

info = info %>%
  mutate(DA2 = ifelse(DAn>1, "high", "low")) %>%
  group_by(SUBJECT) %>%
  mutate(DAn.min = min(DAn, na.rm=t), DAn.max = max(DAn, na.rm=t)) %>%
  ungroup()

si = info$DAn.min==1 & info$DAn.max>1 & (info$DAn==info$DAn.min | info$DAn==info$DAn.max)
sum(si)
subj = info$SUBJECT[si] %>% as.character() %>% unique()

treatment.fields = c("STEROID_IV_CATEGORY","CYCLOPHOSPHAMIDE_CATEGORY",
                     "ORAL_STEROIDS_CATEGORY","MYCOPHENOLATE_CATEGORY",
                     "HYDROXYCHLOROQUINE_CATEGORY")
info = info %>% mutate_at(.vars=treatment.fields, .funs = factor)

fn.ge = file.path(PROJECT_DIR, "generated_data", "SLE", "SLE_ge_matrix_gene_sle.txt")
dat = fread(fn.ge, data.table = F) %>%
  tibble::remove_rownames() %>% tibble::column_to_rownames("gene") %>%
  data.matrix()

dat = dat[,si]
info = info[si,]

pb.file = "PB_DC.M4.11_ge_sig.txt"
ppb.label = "PB.DC"

fn.pg = file.path(PROJECT_DIR, "data", "SLE", "phenotypes", "SLE_SUBJECT_PG.txt")
df.pg = read_tsv(fn.pg)

fn.sig = file.path(PROJECT_DIR, "generated_data", "signatures", pb.file)
pb.genes = fread(fn.sig, header = F) %>% unlist(use.names=F)

gi = toupper(rownames(dat)) %in% toupper(pb.genes)
sum(gi)
info = mutate(info, PB=get_score(dat[gi,]))

pbm = info %>%
  group_by(SUBJECT, DA2) %>%
  summarise(PB = mean(PB, na.rm=T)) %>%
  ungroup()
pb.fc = pbm %>%
  spread("DA2","PB") %>%
  mutate(dPB = high-low)

form = paste0("PB"," ~ 1 + RACE + ",
              paste(treatment.fields,sep="",collapse=" + "), " + (SLEDAI|SUBJECT)")
m.lmer = lmer(as.formula(form), data=info)
mre = ranef(m.lmer, condVar=T)
x = mre$SUBJECT
pv = attr(x, "postVar")
se = unlist(lapply(1:ncol(x), function(i) sqrt(pv[i, i, ])))
mre.df = data.frame(y=unlist(x),
                    se=se,
                    ci=1.96*se,
                    nQQ=rep(qnorm(ppoints(nrow(x))), ncol(x)),
                    SUBJECT=factor(rep(rownames(x), ncol(x)), levels=rownames(x)),
                    group=gl(ncol(x), nrow(x), labels=names(x))) %>%
  dplyr::filter(group %in% c("SLEDAI")) %>%
  mutate(z = y/ci)
mre.z = mre.df %>%
  dplyr::select(SUBJECT,group,z) %>%
  spread(group,z) %>%
  dplyr::rename(DaCP=SLEDAI)

df.out = left_join(mre.z, df.pg, by="SUBJECT")

df.out = df.out %>%
  left_join(pb.fc, by="SUBJECT")

PG.group.names = c("SLE patients with plasmablast\nsignature during flare", "Other SLE patients")

df.fig = df.out %>%
  dplyr::filter(!is.na(PG)) %>%
  mutate(PG2 = ifelse(PG %in% 2:3, "2/3", ifelse(PG %in% 4, "4", "other"))) %>%
  mutate(PG.group = ifelse(PG %in% 2:4, PG.group.names[1], PG.group.names[2])) %>%
  mutate(PG = factor(PG), PG.group = factor(PG.group, levels=PG.group.names))
df.cc = df.fig %>% split(.$PG.group) %>%
  map(~cor.test(.$dPB, .$DaCP, method="pearson")) %>%
  map_df(~data.frame(label=sprintf("r = %.3f\np = %.2g",.$estimate,.$p.value),
                     x=-Inf, y=Inf)) %>%
  mutate(PG.group = levels(df.fig$PG.group) %>% factor())

df.fig2 = df.fig %>% dplyr::filter(PG %in% 2:3)
cor.test(~dPB+DaCP, data = df.fig2, method="pearson")

ggplot(df.fig %>% dplyr::filter(PG %in% 2:4), aes(dPB, DaCP)) +
  geom_point(aes(fill=PG), size=3, shape=21, col="white", show.legend = F) +
  scale_fill_manual(values = c("darkblue","darkblue","grey70")) +
  geom_text(data=df.cc[1,], aes(label=label), x=-Inf, y=Inf, vjust=1.5, hjust=-0.1, col="black") +
  geom_hline(yintercept=0) + geom_vline(xintercept=0) + theme_bw() + theme(legend.key = element_blank()) +
  xlab("Delta between mean PB score") +
  ylab("DaCP") +
  theme_bw() +
  theme(strip.background = element_blank(),
        strip.text.x = element_text(size=12),
        panel.spacing = unit(10,"mm") )

fn.fig = file.path(PROJECT_DIR, "figure_generation/SLE_dPB_DaCP_correlation")
ggsave(paste0(fn.fig,".png"), w=4,h=3)
ggsave(paste0(fn.fig,".pdf"), w=4,h=3, useDingbats=F)


rm(list=ls())

get.age <- function(birth.str,today.int=20180401){
    b <- as.character(birth.str)
    b <- gsub("-","",b)
    b <- as.numeric(b)
    return( floor((today.int - b) / 10000) )
}

mold.df <- function(df){
    age.min <- 16
    age.max <- 49
    age <- 16:49
    df.tmp <- data.frame(age=age, freq=0)
    df.tmp <- rbind(df,df.tmp)
    freq <- tapply(df.tmp$freq, df.tmp$age, sum)

    df.new <- data.frame(age=as.numeric(names(freq)),freq=freq)

    freq.u15 <- sum(df.new$freq[df.new$age < 16])
    freq.o80 <- df.new$freq[df.new$age > 49]

    df.new <- df.new[df.new$age %in% 16:49, ]
    df.new <- df.new[order(df.new[,1]),]

    df.new <- rbind(c("15-",freq.u15), df.new)
    df.new <- rbind(df.new, c("50+",freq.o80))

    df.new$freq <- as.numeric(df.new$freq)

    df.new <- na.omit(df.new)
    return(df.new)
}

d <- read.csv("perf.csv")

d$birthday <- as.Date(d$birthday,format="%Y-%m-%d")

## 活動開始年
d$begin <- c()
x <- tapply(d$year,d$name,min)
y <- data.frame(name=names(x),begin=x)

d2 <- merge(d,y,by="name")
d2 <- d2[d2$category=="テレビアニメ",]
## d2 <- d2[d2$category=="ゲーム",]

library(ggplot2)
library(animation)

k <- 2005:2017
## k <- 2017
col <- rep(rainbow(10),8)
i <- length(col) - 36

saveGIF(
## 年ごとのfor
for( y in k ){
    print(y)
    d.this <- na.omit(d2[d2$year==y,])
    today.int <- as.numeric( paste(as.character(y),"0401",sep="") )

    age <- get.age(d.this$birthday,today.int)

    ## 年齢ごとの出演頻度
    freq <- tapply(d.this$num,age,sum)

    ## 年齢,出演頻度 の data.frame
    freq <- data.frame(age=as.numeric(names(freq)),freq=freq)

    ## データフレームの整形
    freq <- mold.df(freq)

    y.str <- as.character(y)
    g <- ggplot(freq,aes(x=age,y=freq, fill=col[i:(i+35)])) + ggtitle(y.str) + ylim(0,240)
    g <- g + geom_bar(stat = "identity") + guides(fill=FALSE) + theme(axis.text.y = element_text(size=13),axis.text.x = element_text(size=13), axis.title.y = element_text(size=13), title = element_text(size=14))
    g <- g + scale_x_discrete(breaks = c("15-",seq(0,50,5),"50+"))
    print(g)
    i <- i-1
}
, movie.name="animation.gif", ani.width=700)
## d.this[age==19&d.this$year==y,]


#phylop_score_variation_1_22_nt.r:
#Calculate average conservation score(PhyloP) in each nucleotide of miRNA(1-22nt)

#library
library(reshape2)
library(ggplot2)

data <- read.table('C:/Users/Naoto/Documents/github/MIRAGE/data/PhyloP/phyloP46way_miRBase_v21_hg38Tohg19_f1_f23.txt', header=F, row.names=1)
colnames(data) <- c('1','2','3','4','5','6','7','8','9','10',
                    '11','12','13','14','15','16','17','18','19',
                    '20','21','22')
df <- melt(data)

p.boxplot <- ggplot(df,aes(x=variable,y=value))
p.boxplot <- p.boxplot + geom_boxplot()
p.boxplot <- p.boxplot + ggtitle("miRNA conservation score[1-22nt] - phyloP")
p.boxplot <- p.boxplot + xlab("nt") + ylab("Conservation score(phyloP)")
p.boxplot <- p.boxplot + theme(plot.title = element_text(size=25),
                               axis.text.x = element_text(size=15),
                               axis.text.y = element_text(size=15),
                               axis.title.x = element_text(size=20),
                               axis.title.y = element_text(size=20))
plot(p1)


# Figure 2 - Present Weather Detector (PWD) at Chilbolton, vs. local Met O station

pwd <- import_pwd_data("data/PWD/2009/09/cfarr-pwd21_chilbolton_20090919.nc")
meto <- import_meto_data("data/MetOffice/MetOData_All.csv")

index(meto) <- as.POSIXct(index(meto))

meto_day <- as.xts(meto)
meto_day <- meto_day["2009-09-19"]
plot(meto_day)

index(pwd) <- as.POSIXct(index(pwd))
pwd <- as.xts(pwd)

merged <- merge(meto_day, pwd, all=F)
plot(merged, xaxt='n', ylab="Visibility (km)", xlab="Hours", main="")
lines(merged[,2], col='blue', lty=2)
legend("topright", c("UKMO Middle Wallop", "CFARR"), col=c("black", "blue"), lty=c(1, 2))
axis(1, at=index(merged), labels=1:23)


#!/usr/bin/env Rscript

# Command line argument processing
args <- commandArgs(trailingOnly=TRUE)

if (!require("stringr")){
    install.packages("stringr", dependencies=TRUE, repos='http://cloud.r-project.org/')
    library("stringr")
}
if (!require("dplyr")){
    install.packages("dplyr", dependencies=TRUE, repos='http://cloud.r-project.org/')
    library("dplyr")
}
if (!require("ggplot2")){
    install.packages("ggplot2", dependencies=TRUE, repos='http://cloud.r-project.org/')
    library("ggplot2")
}

input_totalseq <- args[1]
input_totalread <- args[2]
isPairedEnd <- args[3]

### function ###
totalseqdata = read.table(input_totalseq, sep="", comment.char = "", header=F, check.names=FALSE, stringsAsFactors=F)
totalreaddata = read.table(input_totalread, sep="", comment.char = "", header=F, check.names=FALSE, stringsAsFactors=F)

plotdata = dplyr::left_join(totalseqdata, totalreaddata, by=c("V1"))
colnames(plotdata) = c("samplename", "totalseq", "totalread")
plotdata[is.na(plotdata)] <- 0

if (isPairedEnd=="True"){
    plotdata$assignedGenomeRate = (plotdata$totalread / (plotdata$totalseq*2)) *100
} else {
    plotdata$assignedGenomeRate = (plotdata$totalread / plotdata$totalseq) *100
}

plotdata = plotdata[order(plotdata$samplename),]

### draw barplot
g = ggplot(plotdata, aes(x=samplename,y=assignedGenomeRate)) +
    geom_bar(alpha=0.7, stat="identity") +
    ylim(0, 100) +
    xlab("Sample")+ylab("Assigned genome rate") +
    #scale_x_discrete(labels=plotdata$x) +
    theme(axis.text.x=element_text(size=6, angle=90, hjust=1), legend.text=element_text(size=8)) +
    ggtitle("Rate of reads assigned to genome")

ggsave(file = "barplot_assignedgenome_rate.pdf", plot=g, dpi=100, width=12, height=5)

# Write rate values to file
outputdata = data.frame(name = plotdata$samplename, assignedGenomeRate=plotdata$assignedGenomeRate)
rownames(outputdata) = outputdata$name
write.csv(outputdata, 'barplot_assignedgenome_rate.csv', quote=FALSE, append=TRUE)

# Printing sessioninfo to standard out
print("Draw plot info:")
sessionInfo()


#' Proportional File Sampler
#'
#' Randomly sample lines from an input text file.
#'
#' @details
#' The sampling is done in one pass of the input file, dumping lines to a
#' temporary file as the input is read.
#'
#' If the output file (the one pointed to by the return of this function) is
#' "large" and to be read into memory (which isn't really appropriate for text
#' files in the first place!), then this strategy is probably not appropriate.
#'
#' @param p
#' Proportion to retain; should be a numeric value between 0 and 1.
#' @param infile
#' Location of the file (as a string) to be subsampled.
#' @param outfile
#' Output file location (as a string).
#' @param header
#' Is a header (line of column names) on the first line of the csv file?
#' @param nskip
#' Number of lines to skip. If \code{header=TRUE}, then this only applies to
#' lines after the header.
#' @param nmax
#' Max number of lines to read.  If \code{nmax==0}, then there is no read cap.
#' @param verbose
#' Should linecounts of the input file and the number of lines sampled be
#' printed?
#'
#' @return
#' \code{NULL}
#'
#' @useDynLib filesampler R_fs_sample_prop
#' @export
file_sample_prop = function(p, infile, outfile=tempfile(), header=TRUE, nskip=0, nmax=0, verbose=FALSE)
{
  check.is.scalar(p)
  check.is.string(infile)
  infile = abspath(infile)
  check.is.string(outfile)
  check.is.flag(header)
  check.is.natnum(nskip)
  check.is.natnum(nmax)
  check.is.flag(verbose)

  if (p == 0)
    stop("no lines available for input")
  if (p < 0 || p > 1)
    stop("Argument 'p' must be between 0 and 1")

  .Call(R_fs_sample_prop, verbose, header, as.integer(nskip), as.integer(nmax), as.double(p), infile, outfile)

  invisible()
}


library(devtools)
# install_github('carjed/bedr')
library(bedr)
library(dplyr)

sites<-read.table(pipe("cut -f1-5,18,19 /net/bipolar/jedidiah/mutation/output/logmod_data/motifs/AT_CG/dp/AT_CG_AAAAACG_dp.txt"), header=F)

# Get recombination rate at each site
rcrCol <- function(sites, file){
  feat_ranges <- bed_to_granges(file, header=T)
  site_ranges <- GRanges(seqnames=paste0("chr",sites$V2),
                         ranges=IRanges(start=sites$V1, end=sites$V1))

  indices <- findOverlaps(site_ranges, feat_ranges, type="within", select="first")
  indices[is.na(indices)]<-0
  ind_df<-data.frame(V1=sites$V1, V2=sites$V2, indices)

  feat_df<-as.data.frame(feat_ranges)
  feat_df$indices<-seq_along(1:nrow(feat_df))
  rate_table <- merge(ind_df, feat_df, by="indices", all.x=T, incomparables=0) %>%
    arrange(V2, V1)

  rates<-rate_table$id
  rates[is.na(rates)]<-0
  return(as.numeric(rates))
}

binaryCol <- function(sites, bedfile){
  feat_ranges <- bed_to_granges(bedfile, header=F)
  site_ranges <- GRanges(seqnames=paste0("chr",sites$V2),
                         ranges=IRanges(start=sites$V1, end=sites$V1))
  return(as.integer(site_ranges %within% feat_ranges))
}

repCol <- function(sites, repfile, binwidth){
  reptime <- read.table(repfile, header=F, stringsAsFactors=F, sep="\t")
  names(reptime) <- c("CHR", "END", "TIME")
  reptime2<-reptime %>%
    group_by(CHR) %>%
    arrange(CHR, END) %>%
    mutate(START=imputeStart(END))

  feat_ranges <- GRanges(seqnames=paste0("chr",reptime2$CHR),
                         ranges=IRanges(start=reptime2$START, end=reptime2$END), id=reptime2$TIME)
  site_ranges <- GRanges(seqnames=paste0("chr",sites$CHR),
                         ranges=IRanges(start=sites$POS, end=sites$POS))

  indices <- findOverlaps(site_ranges, feat_ranges, type="within", select="first")
  indices[is.na(indices)]<-0
  ind_df <- data.frame(POS=sites$POS, CHR=sites$CHR, indices)

  feat_df <- as.data.frame(feat_ranges)
  feat_df$indices <- seq_along(1:nrow(feat_df))
  rate_table <- merge(ind_df, feat_df, by="indices", all.x=T, incomparables=0) %>%
    arrange(CHR, POS)

  rates <- rate_table$id
  rates[is.na(rates)] <- 0
  return(as.numeric(rates))
  # return(as.integer(site_ranges %within% feat_ranges))
}

gcfile<-"/net/bipolar/jedidiah/mutation/output/3bp_10k/full_bin.txt"
gcCol<-function(sites, gcfile){

  incmd <- paste0("cut -f1,4,5 ", gcfile)
  gcbins <- read.table(pipe(incmd), header=T, stringsAsFactors=F)
  gcbins$start <- gcbins$BIN*10000-10000+1
  gcbins$end <- gcbins$start+10000-1

  gcbins<-gcbins %>% arrange(CHR, start)

  feat_ranges <- GRanges(seqnames=gcbins$CHR,
                         ranges=IRanges(start=gcbins$start, end=gcbins$end), id=gcbins$prop_GC)
  site_ranges <- GRanges(seqnames=paste0("chr",sites$CHR),
                         ranges=IRanges(start=sites$POS, end=sites$POS))

  indices <- findOverlaps(site_ranges, feat_ranges, type="within", select="first")
  indices[is.na(indices)]<-0
  ind_df <- data.frame(POS=sites$POS, CHR=sites$CHR, indices)

  feat_df <- as.data.frame(feat_ranges)
  feat_df$indices <- seq_along(1:nrow(feat_df))
  rate_table <- merge(ind_df, feat_df, by="indices", all.x=T, incomparables=0) %>%
    arrange(CHR, POS)

  rates <- rate_table$id
  rates[is.na(rates)] <- 0
  return(as.numeric(rates))
  # return(as.integer(site_ranges %within% feat_ranges))
}

gctest<-gcCol(sites, "/net/bipolar/jedidiah/mutation/output/3bp_10k/full_bin.txt")

# Loop to add histone marks to site data
hists<-c("H3K4me1", "H3K4me3", "H3K9ac", "H3K9me3", "H3K27ac", "H3K27me3", "H3K36me3")

dflist <- list()
for(i in 1:length(hists)){
  mark <- hists[i]
  file <- paste0("/net/bipolar/jedidiah/mutation/reference_data/histone_marks/broad/sort.E062-", mark, ".bed")
  hist <- binaryCol(sites, file)
  dflist[[i]] <- hist
}

df <- as.data.frame(do.call(cbind, dflist))
names(df) <- hists
sites<-cbind(sites, df)

parentdir<-"/net/bipolar/jedidiah/mutation"
repfile <- paste0(parentdir, "/reference_data/lymph_rep_time.txt")
inside<-repCol(sites, repfile)

reptime$START <- c(0, reptime$POS[-(length(reptime$POS))])

# Function determines start of interval from value in previous row
imputeStart<-function(ends){
  starts<-c(0, ends[-(length(ends))])
  return(starts)
}

approxData <- data.frame(
  with(reptime,
       approx(POS, TIME, xout = seq(1, n, by = 10), method = "linear")
  ),
  method = "approx()"
)

sites$CpGI <- binaryCol(sites, "/net/bipolar/jedidiah/mutation/reference_data/cpg_islands_sorted.bed")
sites$RR <- rcrCol(sites, "/net/bipolar/jedidiah/mutation/reference_data/recomb_rate.bed")
sites$LAMIN <- binaryCol(sites, "/net/bipolar/jedidiah/mutation/reference_data/lamin_B1_LADS2.bed")
sites$DHS <- binaryCol(sites, "/net/bipolar/jedidiah/mutation/reference_data/DHS.bed")


# SQL output is imported as a dataframe variable called 'df'
# Use Periscope to visualize a dataframe or show text by passing data to periscope.table() or periscope.text() respectively. Show an image by calling periscope.image() after your plot.

# Use plot.ly for visualziation
library(plotly)

# Assign variables
trace <- df$count
x <- df$week
data <- df[order(df$week),]

# Check out Plot.ly's documentation to find more options! https://plot.ly/r/reference/
# The line paramater inside add_trace contains a shape parameter. Set this to spline for smoothed connectors
p <- plot_ly(data, x = ~x) %>%
  add_trace(y = ~trace, name = 'count', type = 'scatter', mode = 'lines+markers',
            line = list(shape = 'spline', color = 'rgb(205, 12, 24)', width= 4, dash = 'dash'),
            marker = list(symbol = "star-diamond", color = 'rgb(17, 157, 255)',size = 8),
            connectgaps = TRUE) %>%
  layout(xaxis = list(title = 'Week'), yaxis = list(title = 'Count'))  %>% config(displayModeBar = TRUE)

# Output the chart in Periscope
periscope.plotly(p)


library(Cairo)

siRNAs    = c('scramble','Smad4')
datafile  = 'data/TI10_summaryStats.csv'
data       = read.table( datafile, sep=',', header=T, stringsAsFactors=F )
reps       = 3
pValCutoff = 0.05
readouts   = c('Smad23','pSmad158')
colors     = c('blue','darkgreen')
channels   = c(2,2,3)
celltypes  = c('HCEC')
allTreatments = list( Smad23 =c('ctrl+ctrl','ctrl+BMP4','TGFB3+ctrl','TGFB3+BMP4'),
                  pSmad158=c('ctrl+ctrl','TGFB3+ctrl','ctrl+BMP4','TGFB3+BMP4'))

setToOne   = c('TGFB3+ctrl','ctrl+BMP4')
feature    = 'sum_nucleus'
allYlims   = list(Smad23   = c(-.1, 1.2 ),
                  pSmad158 = c(-.1, 2.2) )

CairoSVG( 'bmpTgfbInsulation_siRNA',width=6,height=3)
par(mfrow=c(1,2))

for( rIdx in 1:length(readouts) ){

  readout   = readouts[ rIdx]
  channel   = channels[ rIdx]
  marker    = paste('marker',channel,sep='.')

  treatments = allTreatments[[readout]]

  ylims      = allYlims[[readouts[rIdx]]]
  plot( NA,NA,ylim=ylims, xlim=c(.75,length(treatments)*length(siRNAs)+.25),
        main='',ylab=readouts[rIdx],xaxt='n',xlab='',yaxt='n')
  abline(h=0,col='gray',lty=3)
  abline(h=1,col='gray',lty=3)
  axis(2, at=c(0,1))

  for( rnaIdx in 1:length(siRNAs) ){

    siRNA     = siRNAs[ rnaIdx]

    for( treatIdx in 1:length(treatments)){

      treatment = treatments[treatIdx]

      subdata  = data[data$siRNA==siRNA &
                      data[,marker]==readout  &
                      data$treatment %in% treatments,]

      # Convert to 0-1 scale
      thisFeature = paste(feature,'median',channel,sep='.')
      ctrls   = data[data$siRNA=='scramble' &
                        data[,marker]==readout  &
                        data$treatment == 'ctrl+ctrl',
                        thisFeature]
      subdata[,thisFeature] = subdata[,thisFeature]-mean(ctrls)
      subdata[,thisFeature] = subdata[,thisFeature]/(
                mean(data[data$siRNA=='scramble' &
                            data[,marker]==readout  &
                            data$treatment == setToOne[rIdx],
                            thisFeature]) - mean(ctrls))

      pRef = (data[data$siRNA=='scramble' &
                  data[,marker]==readout  &
                  data$treatment == treatment,
                  thisFeature]- mean(ctrls)) /(
                    mean(data[data$siRNA=='scramble' &
                                data[,marker]==readout  &
                                data$treatment == setToOne[rIdx],
                              thisFeature]) - mean(ctrls))

      isEqScr  = t.test(pRef,
                        subdata[subdata$treatment == treatment,thisFeature])$p.value
      #isEqCtrl = t.test(subdata[subdata$treatment == 'ctrl+ctrl',thisFeature],
      #                  subdata[subdata$treatment == treatment,thisFeature])$p.value
      #isEqOne  = t.test(subdata[subdata$treatment == setToOne[rIdx],thisFeature],
      #                  subdata[subdata$treatment == treatment,thisFeature])$p.value

      if(isEqScr<pValCutoff){
        isEqScr = '*'
      }else{isEqScr = ' '}

      mu = mean(subdata[subdata$treatment == treatment,thisFeature])
      s  = sd(subdata[subdata$treatment == treatment,thisFeature])

      # Plot with first two treatment error bars up, second two down
      x  = (rnaIdx-1)*length(treatments)+treatIdx

      if( siRNA == 'scramble'){
        theCols =c('darkgray',colors[rIdx],'darkgray',colors[rIdx])[treatIdx]
      }
      else{
        theCols = colors[rIdx]
      }

      errorY = mu+s*c(1,-1)
      points( x, mu, pch=16, col=theCols)
      lines( c(x,x), errorY, lwd=1,
             col=c('darkgray',colors[rIdx],'darkgray',colors[rIdx])[treatIdx])
      axis(1,at=x,
           paste(isEqScr, sep=''), tick=F, family='mono',
           las =3, cex.axis=1.5,
           col.axis= theCols )
    }
  }
}

dev.off()