p <- ggplot(ledger_data, aes(date, amount)) + geom_linerange(aes(ymin = 0, ymax = amount)) +
            scale_x_date(breaks = "1 month", minor_breaks = "1 week", labels = date_format("%b")) +
            scale_y_continuous(name = commodity) +
            facet_wrap(~year) +
            theme(axis.title.x = element_blank()) # No title on the x-axis

suppressMessages(ggsave(file="linerange-amount-vs-date-facet-year.svg", plot=p, width=12, height=3))


myTestRule {
#Input parameters are:
#  CPU weight
#  Memory weight
#  Swap weight
#  Run queue weight
#  Disk weight
#  Network transfer in weight
#  Network transfer out weight
#Output from running the example is:
#  CPU weight is 1, Memory weight is 1, Swap weight is 0, Run queue weight is 0
#  Disk weight is 0, Network transfer in rate is 1, Network transfer out rate is 1
#  List of resources and the computed load factor digest
  msiDigestMonStat(*Cpuw, *Memw, *Swapw, *Runw, *Diskw, *Netinw, *Netow);
  writeLine("stdout","CPU weight is *Cpuw, Memory weight is *Memw, Swap weight is *Swapw, Run queue weight is *Runw");
  writeLine("stdout","Disk weight is *Diskw, Network transfer in rate is *Netinw, Network transfer out rate is *Netow");
  msiExecStrCondQuery("SELECT SLD_RESC_NAME,SLD_LOAD_FACTOR",*QOut);
  foreach(*QOut) { msiPrintKeyValPair("stdout",*QOut) }
}
INPUT *Cpuw="1", *Memw="1", *Swapw="0", *Runw="0", *Diskw="0", *Netinw="1", *Netow="1"
OUTPUT ruleExecOut


shinyCompare <- function(...,d_t=NULL,type=NULL,min.coverage=0.5){
	require(shiny)
	cat("\nThis might take a while!!!\n")
	dots <- list(...)
	nms0 <- names(dots)
	data <- dots[[1]]
	if(!is.null(d_t)){
		data <- pool(data,d_t)
	}
	if(length(dots)>1){
		data2 <- dots[[2]]
		# warning("argument 'data2' is merged to 'data' might have differing values from the original input!")
		data <- merge(data[,1],data2[,1])
	} else {
		data2 <- data[,2]
	}
	data2 <- data2[,1]
	dta <- data[,1:2] %>=c% min.coverage
	data <- data[,1]
	nms <- names(dta)
	if(!is.null(nms0)){
		nms[nms0!=""] <- nms0[nms0!=""]
	}
	dffs <- as.numeric(diff(st(dta)),units="secs")
	d_t <- median(dffs)
	# cols <- c("indianred","lightblue")
	cols <- c("#023FA5","#8E063B")
	runApp(list(
		ui={
			fluidPage(
				fluidRow(
					column(width = 6, class = "well",
						h4("Time series"),
						plotOutput("plot1",
							height = 300,
							brush = brushOpts(
								id = "plot1_brush"
								# ,resetOnNew = TRUE
							)
						)
					),
					column(width = 6, class = "well",
						h4("Time series Zoom"),
						plotOutput("plot2",
							height = 300
						)
					)
				),
				fluidRow(
					column(width = 3, class = "well",
						h4("Diff vs. Avg (Altman & Bland)"),
						plotOutput("plot3"
							,height = 300
							# ,height = 400
							# ,width = 400
						)
					),
					column(width = 3, class = "well",
						h4("relative Diff vs. Avg"),
						plotOutput("plot4"
							,height = 300
							# ,height = 400
							# ,width = 400
						)
					),
					column(width = 3, class = "well",
						h4("Scatterplot"),
						plotOutput("plot5"
							,height = 300
							# ,height = 400
							# ,width = 400
						)
					),
					column(width = 3, class = "well",
						h4("Control")
						,uiOutput("ui_timeShift")
						# ,numericInput("time.shift",
						# 	label = "Time shift (secs):",
						# 	value = 0L,
						# 	step = d_t,
						# 	min = -1000*d_t,
						# 	max = 1000*d_t
						# )
						,selectInput("regression.type",
							label = "Regression type:",
							choices = c("none", "cor", "lm", "rlm", "lmrob", "loess", "deming", "pbreg", "thielsen"),
							selected = "none"
						)
						,numericInput("time.avg",
							label = "Averaging (secs):",
							value = d_t,
							step = d_t,
							min = -1000*d_t,
							max = 1000*d_t
						)
						,numericInput("offset.dta",
							label = "Offset (y):",
							value = 0
						)
						,numericInput("span.dta",
							label = "Span (y):",
							value = 1
						)
						,checkboxInput("is_light"
							,label = "use exact time values?"
							,value = FALSE
						)
						,checkboxInput("switch_xy"
							,label = "y as x?"
							,value = FALSE
						)
						,checkboxInput("add_loess"
							,label = "add local trend?"
							,value = FALSE
						)
					)
				)
			)
		},
		server = function(input, output){
			# main plot
			output$plot1 <- renderPlot({
				plot(isolate(ranges2$dta_x),min.coverage=min.coverage,col=cols[1],type=type,ylim=range(isolate(ranges2$dta),na.rm=TRUE),ylab=paste(isolate(ranges2$nms),collapse=" / "))
				lines(ranges2$dta_y,min.coverage=min.coverage,col=cols[2],type=type)
				legend("topleft",legend=paste0(isolate(ranges2$nms),c(" (ref.)","")),lty=1,col=c(cols[1],cols[2]),bty="n")
			})
			# zoom plot
			output$plot2 <- renderPlot({
				plot(isolate(ranges2$dta2_x),min.coverage=min.coverage,col=cols[1],ylim=ranges2$y,xlim=ranges2$xlim,type=ranges2$type2,ylab=paste(isolate(ranges2$nms),collapse=" / "))
				lines(ranges2$dta2_y,min.coverage=min.coverage,col=cols[2],type=ranges2$type2)
			})
			# zoom plot
			ranges2 <- reactiveValues(x = NULL, y = NULL, dta_x = dta[,1], dta_y = dta[,2], dta2_x=dta[,1], dta2_y =dta[,2]
				, xlim = NULL, tshift = 0,type2 = type ,is_light = FALSE, time.avg = d_t, switch_xy = FALSE, tShft = 0
				, nms = nms, data = data, data2 = data2, dta = dta, tshift.trigger = FALSE, offset = 0, span = 1)

			output$ui_timeShift <- renderUI({
				tagList(
					numericInput("time.shift",
						label = "Time shift (secs):",
						value = ranges2$tShft,
						step = d_t,
						min = -1000*d_t,
						max = 1000*d_t
					)
				)
			})

			observe({
				if(is.null(input$time.shift)){
					time.shift <- isolate(ranges2$tshift)
				} else {
					time.shift <- input$time.shift
				}
				isolate({
					if(ranges2$tshift!=time.shift){
						ranges2$tshift.trigger <- !ranges2$tshift.trigger
					}
				})
			})

			observe({
				trigOn <- ranges2$tshift.trigger
				if(is.null(isolate(input$time.shift))){
					time.shift <- isolate(ranges2$tshift)
				} else {
					time.shift <- isolate(input$time.shift)
				}
				time.avg <- input$time.avg
				span <- input$span.dta
				offset <- input$offset.dta
				dta_y <- isolate(ranges2$dta_y)
				dta2_y <- isolate(ranges2$dta2_y)
				if(isolate(ranges2$switch_xy)!=input$switch_xy){
					isolate(ranges2$nms <- ranges2$nms[c(2,1)])
					# change original
					dummy1 <- isolate(ranges2$data2)
					isolate(ranges2$data2 <- ranges2$data)
					isolate(ranges2$data <- dummy1)
					# change dta:
					if(!input$is_light){
						isolate(ranges2$dta <- merge(ranges2$data,ranges2$data2)  %>=c% min.coverage)
						isolate(ranges2$dta_x <- ranges2$dta[,1])
						dta_y <- isolate(ranges2$dta[,2])
						# update timeshift and time.avg:
						isolate(ranges2$tshift <- 0)
						isolate(ranges2$time.avg <- d_t)
						isolate(ranges2$is_light <- TRUE)
					} else {
						# change dta_x/dta_y
						dummy1 <- isolate(ranges2$dta_x)
						isolate(ranges2$dta_x <- dta_y)
						dta_y <- dummy1
					}
					# change dta2_x/dta2_y
					# further down...
					# update ranges2 and tAvg
					isolate(ranges2$switch_xy <- input$switch_xy)
					ranges2$tshift <- -ranges2$tshift
					isolate(ranges2$tshift <- -ranges2$tshift)
				}
				brush <- input$plot1_brush
				if(time.shift!=isolate(ranges2$tshift) | input$is_light!=isolate(ranges2$is_light)){
					if(time.shift!=isolate(ranges2$tshift)){
						isolate(ranges2$time.avg <- d_t)
					}
					if(input$is_light){
						dta_y <- isolate(ranges2$data2[,1])
						st(dta_y) <- st(isolate(ranges2$data2)) + time.shift
						et(dta_y) <- et(isolate(ranges2$data2)) + time.shift
						isolate(ranges2$tshift <- time.shift)
						isolate(ranges2$is_light <- input$is_light)
					} else {
						dta_y <- isolate(ranges2$dta[,2])
						st(dta_y) <- st(isolate(ranges2$dta)) + time.shift
						et(dta_y) <- et(isolate(ranges2$dta)) + time.shift
						dta_y <- pool(dta_y,st.to=st(isolate(ranges2$dta)),et.to=et(isolate(ranges2$dta)))
						isolate(ranges2$tshift <- time.shift)
						isolate(ranges2$is_light <- input$is_light)
						isolate(ranges2$offset <- 0)
						isolate(ranges2$span <- 1)
					}
				}
				if(isolate(ranges2$time.avg)!=time.avg){
					trange_x <- timerange(isolate(ranges2$dta_x))
					trange_y <- timerange(dta_y)
					isolate(ranges2$dta_x <- pool(ranges2$dta_x,granularity=time.avg,st.to=trange_x[1],et.to=trange_x[2]))
					dta_y <- pool(dta_y,granularity=time.avg,st.to=trange_y[1],et.to=trange_y[2])
					isolate(ranges2$time.avg <- time.avg)
					# isolate(ranges2$offset <- 0)
					# isolate(ranges2$span <- 1)
				}
				if (!is.null(brush)) {
					tzn <- isolate(tzone(ranges2$dta))
					isolate(ranges2$xlim <- c(format(as.POSIXct(brush$xmin,origin="1970-01-01 00:00.00 UTC",tz=tzn),tz=tzn)
						,format(as.POSIXct(brush$xmax,origin="1970-01-01 00:00.00 UTC",tz=tzn),tz=tzn)))
					isolate(ranges2$x <- paste(ranges2$xlim,collapse=" to "))
					isolate(ranges2$y <- c(brush$ymin, brush$ymax))
					isolate(ranges2$dta2_x <- ranges2$dta_x[ranges2$x])
					dta2_y <- dta_y[isolate(ranges2$x)]
					isolate(ranges2$type2 <- type)
				} else {
					isolate(ranges2$x <- NULL)
					isolate(ranges2$xlim <- NULL)
					isolate(ranges2$y <- NULL)
					isolate(ranges2$dta2_x <- ranges2$dta_x)
					dta2_y <- dta_y
					isolate(ranges2$type2 <- "n")
				}
				# Offset + Span
				if(isolate(ranges2$offset != offset)){
					isolate(dta_y <- dta_y + offset - ranges2$offset)
					isolate(dta2_y <- dta2_y + offset - ranges2$offset)
					isolate(ranges2$offset <- offset)
				}
				if(isolate(ranges2$span != span)){
					if(span != 0){
						isolate(dta_y <- dta_y * span / ranges2$span)
						isolate(dta2_y <- dta2_y * span / ranges2$span)
						isolate(ranges2$span <- span)
					}
				}
				### call reactive:
				if(!identical(dta_y,isolate(ranges2$dta_y))){
					isolate(ranges2$dta_y <- dta_y)
				}
				if(!identical(dta2_y,isolate(ranges2$dta2_y))){
					isolate(ranges2$dta2_y <- dta2_y)
				}
				isolate(if(ranges2$tshift!=ranges2$tShft)ranges2$tShft <- ranges2$tshift)
			})

			# B & A
			output$plot3 <- renderPlot({
				if(!input$is_light){
					y <- ranges2$dta2_y - isolate(ranges2$dta2_x)
					my <- mean(y[[1]],na.rm=TRUE)
					sdy <- sd(y[[1]],na.rm=TRUE)
					qy <- qt(0.975,sum(!is.na(y[[1]])))
					ylim <- c(-1,1)*max(abs(y),na.rm=TRUE)
					if(input$add_loess){
						plot((isolate(ranges2$dta2_x) + ranges2$dta2_y)/2,y,min.coverage=min.coverage
							,ylab=paste0("Difference: ",isolate(ranges2$nms[2])," - ",isolate(ranges2$nms[1])),xlab=paste0("Average: (",isolate(ranges2$nms[1])," + ",isolate(ranges2$nms[2]),")/2")
							,panel.first={grid();abline(h=0,col="darkgrey");abline(h=my + c(0,-qy,qy)*sdy,col="orange",lty=c(1,3,3))}
							,ylim=ylim,xlim=NULL,stats="loess",stats.plot.CI95=TRUE,stats.Args=list(family="symmetric",degree=1))
					} else {
						plot((isolate(ranges2$dta2_x) + ranges2$dta2_y)/2,y,min.coverage=min.coverage
							,ylab=paste0("Difference: ",isolate(ranges2$nms[2])," - ",isolate(ranges2$nms[1])),xlab=paste0("Average: (",isolate(ranges2$nms[1])," + ",isolate(ranges2$nms[2]),")/2")
							,panel.first={grid();abline(h=0,col="darkgrey");abline(h=my + c(0,-qy,qy)*sdy,col="orange",lty=c(1,3,3))}
							,ylim=ylim,xlim=NULL)
					}
				}
			})
			# B & A, relative
			output$plot4 <- renderPlot({
				if(!input$is_light){
					x <- (isolate(ranges2$dta2_x) + ranges2$dta2_y)/2
					y <- (ranges2$dta2_y - isolate(ranges2$dta2_x))/x*100
					my <- mean(y[[1]],na.rm=TRUE)
					sdy <- sd(y[[1]],na.rm=TRUE)
					qy <- qt(0.975,sum(!is.na(y[[1]])))
					ylim <- c(-1,1)*max(abs(y),na.rm=TRUE)
					xlim <- range(x,na.rm=TRUE)
					if(xlim[1] <= 0){
						xlim[1] <- min(x[x[[1]]>0],na.rm=TRUE)
					}
					plot(x,y,min.coverage=min.coverage,log="x"
						# ,ylab=paste0("Difference: 100*(",nms[2]," - ",nms[1],")/(",nms[1]," + ",nms[2],")*2"),xlab=paste0("Average: (",nms[1]," + ",nms[2],")/2")
						,ylab=paste0("relative Difference: 100*(",isolate(ranges2$nms[2])," - ",isolate(ranges2$nms[1]),")/Average"),xlab=paste0("Average: (",isolate(ranges2$nms[1])," + ",isolate(ranges2$nms[2]),")/2")
						,panel.first={grid(equilogs=FALSE);abline(h=0,col="darkgrey");abline(h=my + c(0,-qy,qy)*sdy,col="orange",lty=c(1,3,3))}
						,ylim=ylim,xlim=xlim)
					if(input$add_loess){
						logx <- log(x[[1]])
						y <- y[[1]]
						mod <- loess(y~logx,family="symmetric",degree=1)
						xseq <- seq(min(logx,na.rm=TRUE),max(logx,na.rm=TRUE),length.out=100)
						pmod <- predict(mod,newdata=data.frame(logx=xseq),se=TRUE)
						xseq <- exp(xseq)
						lines(xseq,pmod$fit,col="blue",lwd=2)
						lines(xseq,pmod$fit + pmod$se.fit*qnorm(0.975),col="blue",lty=3)
						lines(xseq,pmod$fit + pmod$se.fit*qnorm(0.025),col="blue",lty=3)
					}
				}
			})
			# scatter
			output$plot5 <- renderPlot({
				if(!input$is_light){
					if(input$regression.type!="none"){
						plot(isolate(ranges2$dta2_x),ranges2$dta2_y,min.coverage=min.coverage,stats=input$regression.type,eq.xlab=isolate(ranges2$nms[1]),eq.ylab=isolate(ranges2$nms[2])
							,panel.first={grid();abline(0,1,col="darkgrey")},xlim=ranges2$y,ylim=ranges2$y,xlab=isolate(ranges2$nms[1]),ylab=isolate(ranges2$nms[2]))
					} else {
						plot(isolate(ranges2$dta2_x),ranges2$dta2_y,min.coverage=min.coverage,eq.xlab=isolate(ranges2$nms[1]),eq.ylab=isolate(ranges2$nms[2])
							,panel.first={grid();abline(0,1,col="darkgrey")},xlim=ranges2$y,ylim=ranges2$y,xlab=isolate(ranges2$nms[1]),ylab=isolate(ranges2$nms[2]))
					}
				}
			})
		}
		))
}


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

# Set random number generator seed to make results reproducible

set.seed(123)

## load phenotype data

load("/dcl01/lieber/ajaffe/lab/brain-epigenomics/bumphunting/BSobj_bsseqSmooth_Neuron_minCov_3_prenatal.Rdata")

pd = pData(BSobj)

pd$avg.Cov
#[1]  9.73  9.87 11.40 10.48 11.45 10.31 11.07  9.54 10.48 11.64 11.16 12.97
#[13] 12.14 13.02 15.04 16.28 16.59 12.54 11.15 15.82
# seems high enough to me (10 minimum for this program)

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

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

## Format info for methylseekR

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

save(CGPrenlist, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/methylSeekR_objects_prenatal.rda")

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

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

## Identify partially methylated domains (PMDs)

sLengths = seqlengths(Hsapiens)

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/PMDsegments_methylSeekR_CG_prenatal.pdf")
PMDsegments.CGpren = lapply(CGPrenlist, function(x) segmentPMDs(m = x, chr.sel="chr22", seqLengths=sLengths, num.cores=3))
dev.off()
save(PMDsegments.CGpren, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/PMDs_methylSeekR_prenatal.rda")

## Identify CpG Islands

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

## Calculate FDR threshold for calling UMRs and LMRs

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

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

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

save(stats.CGpren, n.sel.CGpren, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/setting_n_methylSeekR_prenatal.rda")

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

names(total) = gsub("Prenatal-","", names(total))
pmds = total[names(total) %in% names(CGPrenlist)]
identical(names(pmds), names(CGPrenlist))

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

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

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

## Calculate UMRs and LMRs

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/UMRs_LMRs_methylSeekR_prenatal.pdf")
UMRLMRsegments.CGpren <- mapply(function(CG,n,PMD) segmentUMRsLMRs(m = CG, meth.cutoff = m.sel, nCpG.cutoff= n,
					 PMDs = PMD, num.cores=1, myGenomeSeq = Hsapiens, seqLengths = sLengths), CGPrenlist, n.sel.CGpren, PMDsegments.CGpren)
dev.off()

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

pdf("/dcl01/lieber/ajaffe/lab/brain-epigenomics/CREs/figures/UMRs_LMRs_methylSeekR.100kb_prenatal.pdf")
UMRLMRsegments.CG.100kb.pren <- mapply(function(CG,n,PMD) segmentUMRsLMRs(m = CG, meth.cutoff = m.sel, nCpG.cutoff= n,
                                                                   PMDs = PMD, num.cores=2, myGenomeSeq = Hsapiens, seqLengths = sLengths), CGPrenlist, n.sel.CG.100kb.pren, pmds)
dev.off()

save(UMRLMRsegments.CGpren,UMRLMRsegments.CG.100kb.pren, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/UMRs_LMRs_methylSeekR_prenatal.rda")

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

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

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

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

## Call large hypo-DMRs

gr2 <- lapply(lapply(UMRLMRsegments.CGpren, sortSeqlevels), sort)
for (i in 1:length(gr2)) {
  write.table(gr2[[i]], file=paste0("/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/hypoDMRspren_",names(UMRLMRsegments.CGpren)[i],".tab"),
              sep="\t", row.names = F,quote = F,col.names = F) }
write.table(data.frame(names(UMRLMRsegments.CGpren)),
            file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/hypoDMR_prenatal_IDs.txt",
            sep="\t", row.names = F,quote = F,col.names = F)

# run merge_hypoDMRspren.sh

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

save(hypoDMRspren, DMVs_pren, DMVs_100kb.pren, file="/dcl01/lieber/ajaffe/lab/brain-epigenomics/rdas/CREs/DMVs_hypoDMRs_methylSeekR_prenatal.rda")


# comparison of australia's GSOD democratic performance subattributes to the
# rest of asia-pacific in 2020

# james goldie, 360info, nov-dec 2021

library(tidyverse)
# remotes::install_github("360-info/themes360info")
library(themes360info)
library(ggforce)
library(ragg)
library(grid)
library(png)
library(svglite)
library(here)

# data adictionary available at:
# https://www.idea.int/gsod-indices/sites/default/files/
#   global-state-of-democracy-indices-codebook-v4.pdf

# load the data
read_csv(here("data", "idea-gsod-all.csv")) %>%
  select(
    country = ID_country_name,
    year = ID_year,
    everything(),
    -regime_status_name, -starts_with("democratic_performance")) ->
gsod

# scope down to asia-pacific (inc. australia) for 2020
gsod %>%
  rename(region = ID_region_name) %>%
  select(-starts_with("ID_")) %>%
  filter(region == "Asia/Pacific", year == 2020) %>%
  pivot_longer(
    cols = -c(country, region, year),
    names_to = "subattribute",
    values_to = "score") %>%
  # focus on subattributes, not attributes or individual indicators
  filter(str_ends(subattribute, "SD[0-9][0-9]")) %>%
  # pivot wider by statistic (central/upper/lower)
  separate(subattribute, into = c("statistic", "subattribute"), sep = "_") %>%
  mutate(
    statistic = recode(statistic, C = "central", U = "upper", L = "lower")) %>%
  pivot_wider(
    id_cols = c(country, year, subattribute),
    names_from = statistic,
    values_from = score) %>%
  # recode attributes and subattributes
  mutate(
    attribute = case_when(
      str_starts(subattribute, "SD1") ~ "Representative government",
      str_starts(subattribute, "SD2") ~ "Fundamental rights",
      str_starts(subattribute, "SD3") ~ "Checks on government",
      str_starts(subattribute, "SD4") ~ "Impartial administration",
      str_starts(subattribute, "SD5") ~ "Participatory engagement",
      TRUE ~ NA_character_),
    subattribute_long = recode(subattribute,
      # representative government: A1
      SD11 = "Clean elections",
      SD12 = "Inclusive suffrage",
      SD13 = "Free political parties",
      SD14 = "Elected government",
      # fundamental rights: A2
      SD21 = "Access to justice",
      SD22 = "Civil liberties",
      SD23 = "Social rights and equality",
      # checks on gov: A3
      SD31 = "Effective parliament",
      SD32 = "Judicial independence",
      SD33 = "Media integrity",
      # impartial administration: A4
      SD41 = "Absence of corruption",
      SD42 = "Predictable enforcement",
      # # participatory engagement: A5
      SD51 = "Civil society participation",
      SD52 = "Electoral participation",
      SD53 = "Direct democracy",
      SD54 = "Local democracy")) ->
gsod_ap

# break off australian data
gsod_ap %>%
  filter(country == "Australia") %>%
  select(-subattribute) %>%
  group_by(attribute) %>%
  mutate(central_colour = case_when(
    central >= 0.7  ~ "High",
    central >= 0.4  ~ "Medium",
    !is.na(central) ~ "Low")) ->
gsod_aus_tidy

# now summary data across asia-pacific
gsod_ap %>%
  group_by(subattribute_long, attribute) %>%
  summarise(
    central = mean(central, na.rm = TRUE)) %>%
  mutate(central_colour = case_when(
    central >= 0.7  ~ "High",
    central >= 0.4  ~ "Medium",
    !is.na(central) ~ "Low"))  ->
gsod_ap_avg

# plot the barchart
gsod_aus_tidy %>%
  {
    ggplot(.) +
      aes(x = subattribute_long, y = central) +
      geom_col(aes(fill = central_colour)) +
      # points for asia-pacific averages
      # geom_point(data = gsod_ap_avg) +
      geom_col(data = gsod_ap_avg, aes(fill = "black"), alpha = 0.3,
        position = "identity", show.legend = TRUE) +
      # break it up by attribute
      facet_col(vars(attribute), scales = "free_y", space = "free") +
      coord_flip() +
      scale_y_continuous(
        expand = expansion(0.01),
        labels = scales::percent) +
      scale_fill_manual(
        name = NULL,
        values = c(
          "High" = "#96ca4f",
          "Medium" = "#ffd000",
          "Low" = "#c00808")) +
      theme_360() +
      theme(
        legend.position = "top",
        legend.direction = "horizontal",
        legend.justification = "left",
        legend.text = element_text(face = "bold"),
        panel.grid = element_blank(),
        strip.text = element_text(face = "bold", hjust = 0, size = rel(1)),
        plot.subtitle = element_text(family = "Subhead 360info",
            size = rel(1.1), margin = margin(b = 14 * 1.25))
      ) +
      labs(
        x = NULL, y = NULL,
        title = toupper("Australia"),
        subtitle = toupper(
          "Democratic performance 2020 compared to Asia-Pacific"),
        caption = "**Source:** IDEA, The Global State of Democracy Indices 1975–2020,<br>v5.1 (2021)[idea.int/gsod-indices]. Accessed 2021-12-01."
      )
  } -> gsod_aus_barchart

dir.create(here("out"))
register_360fonts("itc")
save_360plot(gsod_aus_barchart, here("out", "aus-barchart.png"),
  shape = "sdtv-portrait")
register_360fonts("libre")
save_360plot(gsod_aus_barchart, here("out", "aus-barchart.svg"),
  shape = "sdtv-portrait")


#Usage:
#Rscript ~/RNASeqPipeline/RScripts/manual_classification.r label_list
library("monocle")
library("reshape")
args <- commandArgs(trailingOnly=TRUE)
if(length(args)!=1)
{
	print("Usage: Rscript manual_classification.r label_list")
}
HSMM <- readRDS('post_quality_control_data.rds')
print(args[1])
pData(HSMM)$CellType <- unlist(strsplit(args[1],","))
print(plot_cell_trajectory(HSMM, color="CellType"))
ggsave("cell_classify_plot.png")
ggsave("cell_classify_plot.tiff", width = 7, height = 7,dpi=600)
saveRDS(HSMM,"classified_cells.rds")
pData(HSMM)$Size_Factor <- NULL
rownames(pData(HSMM)) <- NULL
pData(HSMM)$Total_mRNAs <- Matrix::colSums(exprs(HSMM))
write.table(pData(HSMM), 'manual_classification_table_after.txt', sep="\t",quote=FALSE)


suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(cowplot))

count_gmt <- function(gmt_name) {
    # Count the number of genesets in a collection
    xcell_file <- file.path("..", "3.build-hetnets", "data", gmt_name)

    con <- file(xcell_file, open = "r")

    genesets <- c()
    while (length(geneset <- readLines(con, n = 1, warn = FALSE)) > 0) {
      geneset <- unlist(strsplit(geneset, "\t"))[1]
      genesets <- unique(c(geneset, genesets))
    }
    close(con)
    return(length(genesets))
}

# Set ggplot theme
coverage_theme <- theme_bw() +
  theme(axis.text.x = element_text(angle = 90, size = 3.5),
        axis.text.y = element_text(size = 6),
        axis.title = element_text(size = 7),
        plot.title = element_text(hjust = 0.5, size = 8),
        legend.text = element_text(size = 7),
        legend.title = element_text(size = 8),
        legend.key.size = unit(1, "lines"))

# Load Constants
algorithm_plot_labels <- c("pca" = "PCA",
                           "ica" = "ICA",
                           "nmf" = "NMF",
                           "dae" = "DAE",
                           "vae" = "VAE")
algorithm_colors <- c("#e41a1c",
                      "#377eb8",
                      "#4daf4a",
                      "#984ea3",
                      "#ff7f00")
algorithms <- names(algorithm_plot_labels)

plot_info_list <- list(
    c("TCGA", "GpH"),
    c("TCGA", "GpXCELL"),
    c("TCGA", "GpC4CM"),
    c("TCGA", "GpC2CPREACTOME"),
    c("TCGA", "GpC3TFT"),
    c("TARGET", "GpH"),
    c("TARGET", "GpXCELL"),
    c("TARGET", "GpC4CM"),
    c("GTEX", "GpXCELL")
)

gmt_file_list = list(
    "gpc1" = "c1.all.v6.1.entrez.gmt",
    "gpc2cpg" = "c2.cgp.v6.1.entrez.gmt",
    "gpc2cpreactome" = "c2.cp.reactome.v6.1.entrez.gmt",
    "gpc3mir" = "c3.mir.v6.1.entrez.gmt",
    "gpc3tft" = "c3.tft.v6.1.entrez.gmt",
    "gpc4cgn" = "c4.cgn.v6.1.entrez.gmt",
    "gpc4cm" = "c4.cm.v6.1.entrez.gmt",
    "gpc5bp" = "c5.bp.v6.1.entrez.gmt",
    "gpc5cc" = "c5.cc.v6.1.entrez.gmt",
    "gpc5mf" = "c5.mf.v6.1.entrez.gmt",
    "gpc6" = "c6.all.v6.1.entrez.gmt",
    "gpc7" = "c7.all.v6.1.entrez.gmt",
    "gph" = "h.all.v6.1.entrez.gmt",
    "gpxcell" = "xcell_all_entrez.gmt"
)

plot_list <- list()
plot_results <- list()

for (plot_info in plot_info_list) {
    dataset <- plot_info[1]
    metaedge <- plot_info[2]

    plot_identifier <- paste0(dataset, metaedge)
    plot_list[[plot_identifier]] <- list()

    # Load the number of genes in the collection
    gmt_name <- gmt_file_list[[tolower(metaedge)]]
    gmt_count <- count_gmt(gmt_name)

    # Setup file names
    base_file <- paste0(tolower(dataset), "_", tolower(metaedge), ".tsv")

    model_results <- file.path("results", paste0("model_results_", base_file))
    ensemble_results <- file.path("results", paste0("ensemble_results_", base_file))
    all_results <- file.path("results", paste0("all_results_", base_file))
    top_results <- file.path('results', paste0('top_results_', base_file, '.gz'))

    # Load data
    model_df <- readr::read_tsv(model_results,
                                col_types = readr::cols(
                                    .default = readr::col_integer(),
                                    algorithm = readr::col_character(),
                                    model_type = readr::col_character(),
                                    geneset_coverage = readr::col_double(),
                                    abs_top_z_score = readr::col_double(),
                                    dataset = readr::col_character(),
                                    geneset_name = readr::col_character()
                                )) %>%
        dplyr::mutate(p_val = 2 * pnorm(-abs_top_z_score)) %>%
        dplyr::group_by(z_dim) %>%
        dplyr::mutate(bon_alpha = 0.05 / z_dim) %>%
        dplyr::ungroup() %>%
        dplyr::mutate(is_bon_filtered = bon_alpha < p_val) %>%
        dplyr::filter(!is_bon_filtered)

    model_df$algorithm <- factor(model_df$algorithm, levels = algorithms)
    model_df$z_dim <-
      factor(model_df$z_dim,
             levels = sort(as.numeric(paste(unique(model_df$z_dim)))))

    ensemble_df <- readr::read_tsv(ensemble_results,
                                   col_types = readr::cols(
                                       .default = readr::col_integer(),
                                       algorithm = readr::col_character(),
                                       model_type = readr::col_character(),
                                       geneset_coverage = readr::col_double(),
                                       abs_top_z_score = readr::col_double(),
                                       dataset = readr::col_character(),
                                       geneset_name = readr::col_character()
                                    )) %>%
        dplyr::mutate(p_val = 2 * pnorm(-abs_top_z_score)) %>%
        dplyr::group_by(z_dim) %>%
        dplyr::mutate(bon_alpha = 0.05 / z_dim) %>%
        dplyr::ungroup() %>%
        dplyr::mutate(is_bon_filtered = bon_alpha < p_val) %>%
        dplyr::filter(!is_bon_filtered)

    ensemble_df$algorithm <- factor(ensemble_df$algorithm, levels = algorithms)
    ensemble_df$z_dim <-
      factor(ensemble_df$z_dim,
             levels = sort(as.numeric(paste(unique(ensemble_df$z_dim)))))

    ensemble_df$abs_top_z_score[is.infinite(ensemble_df$abs_top_z_score)] <-
        max(ensemble_df$abs_top_z_score[is.finite(ensemble_df$abs_top_z_score)])

    all_df <- readr::read_tsv(all_results,
                              col_types = readr::cols(
                                  .default = readr::col_integer(),
                                  model_type = readr::col_character(),
                                  geneset_coverage = readr::col_double(),
                                  abs_top_z_score = readr::col_double(),
                                  dataset = readr::col_character(),
                                  geneset_name = readr::col_character()
                              )) %>%
        dplyr::mutate(p_val = 2 * pnorm(-abs_top_z_score)) %>%
        dplyr::group_by(z_dim) %>%
        dplyr::mutate(bon_alpha = 0.05 / z_dim) %>%
        dplyr::ungroup() %>%
        dplyr::mutate(is_bon_filtered = bon_alpha < p_val) %>%
        dplyr::filter(!is_bon_filtered)

    all_df$z_dim <- factor(all_df$z_dim,
                           levels = sort(as.numeric(paste(unique(all_df$z_dim)))))

    top_results_df <- readr::read_tsv(top_results,
                                      col_types = readr::cols(
                                          .default = readr::col_integer(),
                                          algorithm = readr::col_character(),
                                          model_type = readr::col_character(),
                                          top_z_score = readr::col_double(),
                                          geneset = readr::col_character(),
                                          abs_top_z_score = readr::col_double(),
                                          dataset = readr::col_character(),
                                          geneset_name = readr::col_character()
                                      ))

    top_results_df$algorithm <- factor(top_results_df$algorithm, levels = algorithms)
    top_results_df$z_dim <-
      factor(top_results_df$z_dim,
             levels = sort(as.numeric(paste(unique(ensemble_df$z_dim)))))

    # Create a new dataframe to display all models
    unique_results_df <- top_results_df %>%
        dplyr::group_by(z_dim) %>%
        dplyr::filter(!(duplicated(geneset) | duplicated(geneset, fromLast = TRUE))) %>%
        dplyr::group_by(algorithm, z_dim) %>%
        dplyr::summarize(number_unique = dplyr::n_distinct(geneset))

    unique_results_df <- all_df %>% dplyr::full_join(unique_results_df, by = 'z_dim')

    # Generate Plots
    plot_list[[plot_identifier]][['model_gg']] <-
        ggplot(model_df, aes(x = z_dim,
                             y = geneset_coverage * 100)) +
            geom_boxplot(aes(color = algorithm),
                         outlier.size = 0.05,
                         lwd = 0.23) +
            coverage_theme +
            scale_color_manual(name = "Algorithm",
                               values = algorithm_colors,
                               labels = algorithm_plot_labels) +
            xlab("k Dimension") +
            ylab("Coverage (%)") +
            ggtitle("Individual Models")

    plot_list[[plot_identifier]][['ensemble_gg']] <-
        ggplot(ensemble_df, aes(x = z_dim,
                                y = geneset_coverage * 100)) +
            geom_point(aes(color = algorithm,
                           size = log10(abs_top_z_score)),
                       alpha = 0.25) +
            geom_point(aes(color = algorithm),
                       size = 0.15) +
            coverage_theme +
            scale_color_manual(name = "Algorithm",
                               values = algorithm_colors,
                               labels = algorithm_plot_labels) +
            xlab("k Dimension") +
            ylab("Coverage (%)") +
            ggtitle("Ensemble Models")

    all_k_coverage <- length(unique(top_results_df$geneset)) / gmt_count * 100

    plot_list[[plot_identifier]][['all_gg']] <-
        ggplot(data = unique_results_df) +
            geom_bar(mapping = aes(x = z_dim,
                                   y = number_unique,
                                   fill = algorithm),
                     alpha = 0.5,
                     position = 'stack',
                     stat = 'identity') +
            geom_hline(yintercept = all_k_coverage,
                       color = 'navy',
                       linetype = 'dashed',
                       size = 0.4) +
            coverage_theme +
            xlab("k Dimension") +
            ggtitle("All Models") +
            scale_fill_manual(name = "Algorithm",
                               values = algorithm_colors,
                               labels = algorithm_plot_labels)

    # Add specific scale to certain plots
    if (metaedge != "GpH") {
    plot_list[[plot_identifier]][['all_gg']] <-
        plot_list[[plot_identifier]][['all_gg']] +
            geom_point(data = unique_results_df,
                       mapping = aes(x = z_dim,
                                     y = geneset_coverage * 100),
                       size = 0.5) +
            scale_y_continuous(name = 'Unique Genesets',
                               sec.axis = sec_axis(trans = ~./1,
                                                   name = "Coverage (%)"),
                               limits = c(0, 100))
    }

    # Track the total coverage of all models across all k dimensions
    plot_results[[plot_identifier]] <- c(dataset, metaedge, all_k_coverage)

}

all_k_results_table <- t(dplyr::bind_rows(plot_results))
colnames(all_k_results_table) <- c("Dataset", "Metaedge", "BioBombe_Coverage")
rownames(all_k_results_table) <- 1:nrow(all_k_results_table)

out_file <- file.path("biobombe_coverage_results.tsv")
readr::write_tsv(as.data.frame(all_k_results_table), out_file)

all_k_results_table

legend <- get_legend(plot_list[['TCGAGpXCELL']][['all_gg']] +
                     theme(legend.position = "bottom"))

tcga_x_label <- cowplot::ggdraw() +
    cowplot::draw_label(label = 'TCGA\n(xCell Cell Types)',
                        size = 8,
                        angle = 90)
gtex_x_label <- cowplot::ggdraw() +
    cowplot::draw_label(label = 'GTEx\n(xCell Cell Types)',
                        size = 8,
                        angle = 90)
target_x_label <- cowplot::ggdraw() +
    cowplot::draw_label(label = 'TARGET\n(xCell Cell Types)',
                        size= 8,
                        angle = 90)
tcga_h_label <- cowplot::ggdraw() +
    cowplot::draw_label(label = 'TCGA\n(Hallmarks)',
                        size = 8,
                        angle = 90)
target_h_label <- cowplot::ggdraw() +
    cowplot::draw_label(label = 'TARGET\n(Hallmarks)',
                        size = 8,
                        angle = 90)
label_sup <- cowplot::plot_grid(tcga_x_label,
                                gtex_x_label,
                                target_x_label,
                                tcga_h_label,
                                target_h_label,
                                nrow = 5)

sup_plot <- (
    cowplot::plot_grid(
        plot_list[["TCGAGpXCELL"]][['model_gg']] +
            xlab('') +
            theme(legend.position = "none"),
        plot_list[['TCGAGpXCELL']][['ensemble_gg']] +
            xlab('') +
            theme(legend.position = "none"),
        plot_list[['TCGAGpXCELL']][['all_gg']] +
            xlab('') +
            theme(legend.position = "none"),
        plot_list[["GTEXGpXCELL"]][['model_gg']] +
            xlab('') +
            theme(legend.position = "none") +
            ggtitle(""),
        plot_list[['GTEXGpXCELL']][['ensemble_gg']] +
            xlab('') +
            theme(legend.position = "none") +
            ggtitle(""),
        plot_list[['GTEXGpXCELL']][['all_gg']] +
            xlab('') +
            theme(legend.position = "none") +
            ggtitle(""),
        plot_list[["TARGETGpXCELL"]][['model_gg']] +
            theme(legend.position = "none") +
            xlab("") +
            ggtitle(""),
        plot_list[['TARGETGpXCELL']][['ensemble_gg']] +
            theme(legend.position = "none") +
            xlab("") +
            ggtitle(""),
        plot_list[['TARGETGpXCELL']][['all_gg']] +
            theme(legend.position = "none") +
            xlab("") +
            ggtitle(""),
        plot_list[["TCGAGpH"]][['model_gg']] +
            xlab('') +
            ggtitle("") +
            theme(legend.position = "none"),
        plot_list[['TCGAGpH']][['ensemble_gg']] +
            xlab('') +
            ggtitle("") +
            theme(legend.position = "none"),
        plot_list[['TCGAGpH']][['all_gg']] +
            xlab('') +
            ggtitle("") +
            geom_point(mapping = aes(x = z_dim,
                                     y = geneset_coverage * 8),
                       size = 0.5) +
            scale_y_continuous(name = 'Unique Genesets',
                               sec.axis = sec_axis(trans = ~.*12.5,
                                                   name = "Coverage (%)"),
                               limits = c(0, 8)) +
            theme(legend.position = "none"),
        plot_list[["TARGETGpH"]][['model_gg']] +
            theme(legend.position = "none") +
            ggtitle(""),
        plot_list[['TARGETGpH']][['ensemble_gg']] +
            theme(legend.position = "none") +
            ggtitle(""),
        plot_list[['TARGETGpH']][['all_gg']] +
            geom_point(mapping = aes(x = z_dim,
                                     y = geneset_coverage * 8),
                       size = 0.5) +
            scale_y_continuous(name = 'Unique Genesets',
                               sec.axis = sec_axis(trans = ~.*12.5,
                                                   name = "Coverage (%)"),
                               limits = c(0, 8)) +
            ggtitle("") +
            theme(legend.position = "none"),
        labels = c("a", "b", "c", "", "", "", "", "", "", "", "", "", ""),
        ncol = 3,
        nrow = 5
    )
)

sup_plot <- cowplot::plot_grid(label_sup,
                               sup_plot,
                               ncol = 2,
                               rel_widths = c(0.04, 1))

sup_plot <- cowplot::plot_grid(sup_plot,
                               legend,
                               rel_heights = c(1, 0.08),
                               nrow = 2)

sup_plot

for(extension in c('.png', '.pdf')) {
    fig_file <- paste0("supplemental_coverage", extension)
    fig_file <- file.path("figures", fig_file)
    cowplot::save_plot(filename = fig_file,
                       plot = sup_plot,
                       base_height = 200,
                       base_width = 170,
                       units = "mm")
}

legend <- get_legend(plot_list[['TCGAGpC2CPREACTOME']][['all_gg']] +
                     theme(legend.position = "bottom"))

tcga_tf_label <- cowplot::ggdraw() +
    cowplot::draw_label(label = 'TCGA\n(TF Targets)',
                        size= 8,
                        angle = 90)
tcga_react_label <- cowplot::ggdraw() +
    cowplot::draw_label(label = 'TCGA\n(REACTOME)',
                        size = 8,
                        angle = 90)
tcga_cm_label <- cowplot::ggdraw() +
    cowplot::draw_label(label = 'TCGA\n(Cancer Modules)',
                        size = 8,
                        angle = 90)

label_main <- cowplot::plot_grid(tcga_tf_label,
                                 tcga_react_label,
                                 tcga_cm_label,
                                 nrow = 3)

main_plot <- (
    cowplot::plot_grid(
        plot_list[["TCGAGpC3TFT"]][['model_gg']] +
            xlab('') +
            theme(legend.position = "none"),
        plot_list[['TCGAGpC3TFT']][['ensemble_gg']] +
            xlab('') +
            theme(legend.position = "none"),
        plot_list[['TCGAGpC3TFT']][['all_gg']] +
             xlab('') +
            theme(legend.position = "none"),
        plot_list[["TCGAGpC2CPREACTOME"]][['model_gg']] +
            xlab('') +
            theme(legend.position = "none") +
            ggtitle(""),
        plot_list[['TCGAGpC2CPREACTOME']][['ensemble_gg']] +
            xlab('') +
            theme(legend.position = "none") +
            ggtitle(""),
        plot_list[['TCGAGpC2CPREACTOME']][['all_gg']] +
            xlab('') +
            theme(legend.position = "none") +
            ggtitle(""),
        plot_list[["TCGAGpC4CM"]][['model_gg']] +
            theme(legend.position = "none") +
            ggtitle(""),
        plot_list[['TCGAGpC4CM']][['ensemble_gg']] +
            theme(legend.position = "none") +
            ggtitle(""),
        plot_list[['TCGAGpC4CM']][['all_gg']] +
            theme(legend.position = "none") +
            ggtitle(""),
        labels = c("a", "b", "c", "", "", "", "", "", ""),
        ncol = 3,
        nrow = 3
    )
)

main_plot <- cowplot::plot_grid(label_main,
                                main_plot,
                                ncol = 2,
                                rel_widths = c(0.04, 1))

main_plot <- cowplot::plot_grid(main_plot,
                                legend,
                                rel_heights = c(1, 0.08),
                                nrow = 2)

main_plot

for(extension in c('.png', '.pdf')) {
    fig_file <- paste0("main_coverage", extension)
    fig_file <- file.path("figures", fig_file)
    cowplot::save_plot(filename = fig_file,
                       plot = main_plot,
                       base_height = 150,
                       base_width = 170,
                       units = "mm")
}


make_three_panel_plots <- function(data_state, covariates_long,
                                   jobid, state, label = "", ext = ".png"){
  nam <- read.csv("usa/data/states.csv")
  full_name <- (nam$State[which(nam$Abbreviation == state)])

  data_cases_95 <- data.frame(data_state$date, data_state$cases_min,
                              data_state$cases_max)
  names(data_cases_95) <- c("date", "cases_min", "cases_max")
  data_cases_95$key <- rep("nintyfive", length(data_cases_95$date))
  data_cases_50 <- data.frame(data_state$date, data_state$cases_min2,
                              data_state$cases_max2)
  names(data_cases_50) <- c("date", "cases_min", "cases_max")
  data_cases_50$key <- rep("fifty", length(data_cases_50$date))
  data_cases <- rbind(data_cases_95, data_cases_50)
  levels(data_cases$key) <- c("ninetyfive", "fifty")

  p1 <- ggplot(data_state) +
    geom_bar(data = data_state, aes(x = date, y = reported_cases),
             fill = "coral4", stat='identity', alpha=0.5) +
    geom_ribbon(data = data_cases,
                aes(x = date, ymin = cases_min, ymax = cases_max, fill = key)) +
    xlab("") +
    ylab("Daily number of infections") +
    scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"),
                 limits = c(as.Date("2020-02-29"), max(data_state$date))) +
    scale_y_continuous(labels = comma, expand=expansion(mult=c(0,0.1))) +
    scale_fill_manual(name = "", labels = c("50%", "95%"),
                      values = c(alpha("deepskyblue4", 0.55),
                                 alpha("deepskyblue4", 0.45))) +
    theme_bw() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1),
          legend.position = "None",
          axis.text = element_text(size = 12),
          axis.title = element_text(size = 12)) +
          #panel.grid.minor = element_blank()) +
    guides(fill=guide_legend(ncol=1)) +
    ggtitle("")

  data_deaths_95 <- data.frame(data_state$date, data_state$deaths_min,
                               data_state$deaths_max)
  names(data_deaths_95) <- c("date", "death_min", "death_max")
  data_deaths_95$key <- rep("nintyfive", length(data_deaths_95$date))
  data_deaths_50 <- data.frame(data_state$date, data_state$deaths_min2,
                               data_state$deaths_max2)
  names(data_deaths_50) <- c("date", "death_min", "death_max")
  data_deaths_50$key <- rep("fifty", length(data_deaths_50$date))
  data_deaths <- rbind(data_deaths_95, data_deaths_50)
  levels(data_deaths$key) <- c("ninetyfive", "fifty")

  if (state == "AK"){
    p2 <-   ggplot(data_state, aes(x = date)) +
      geom_bar(data = data_state, aes(y = reported_deaths, fill = "reported"),
               fill = "coral4", stat='identity', alpha=0.5) +
      geom_ribbon(
        data = data_deaths,
        aes(ymin = death_min, ymax = death_max, fill = key)) +
      xlab("") +
      ylab("Daily number of deaths") +
      scale_y_continuous(expand=expansion(mult=c(0,0.1))) +
      scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"),
                   limits = c(as.Date("2020-02-5"), max(data_state$date))) +
      scale_fill_manual(name = "", labels = c("50%", "95%"),
                        values = c(alpha("deepskyblue4", 0.55),
                                   alpha("deepskyblue4", 0.45))) +
      theme_bw() +
      theme(axis.text.x = element_text(angle = 45, hjust = 1),
            legend.position = "None",
            axis.text = element_text(size = 12),
            axis.title = element_text(size = 12)) +
      #panel.grid.minor = element_blank()) +
      guides(fill=guide_legend(ncol=1)) +
      ggtitle(full_name[[1]])
  } else {
    p2 <-   ggplot(data_state, aes(x = date)) +
      geom_bar(data = data_state, aes(y = reported_deaths, fill = "reported"),
               fill = "coral4", stat='identity', alpha=0.5) +
      geom_ribbon(
        data = data_deaths,
        aes(ymin = death_min, ymax = death_max, fill = key)) +
      xlab("") +
      ylab("Daily number of deaths") +
      scale_y_continuous(labels = comma, expand=expansion(mult=c(0,0.1))) +
      scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"),
                   limits = c(as.Date("2020-02-5"), max(data_state$date))) +
      scale_fill_manual(name = "", labels = c("50%", "95%"),
                        values = c(alpha("deepskyblue4", 0.55),
                                   alpha("deepskyblue4", 0.45))) +
      theme_bw() +
      theme(axis.text.x = element_text(angle = 45, hjust = 1),
            legend.position = "None",
            axis.text = element_text(size = 12),
            axis.title = element_text(size = 12)) +
      #panel.grid.minor = element_blank()) +
      guides(fill=guide_legend(ncol=1)) +
      ggtitle(full_name[[1]])
  }

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

  # Plotting interventions
  data_rt_95 <- data.frame(data_state$date,
                           data_state$rt_min, data_state$rt_max)
  names(data_rt_95) <- c("date", "rt_min", "rt_max")
  data_rt_95$key <- rep("nintyfive", length(data_rt_95$date))
  data_rt_50 <- data.frame(data_state$date, data_state$rt_min2,
                           data_state$rt_max2)
  names(data_rt_50) <- c("date", "rt_min", "rt_max")
  data_rt_50$key <- rep("fifty", length(data_rt_50$date))
  data_rt <- rbind(data_rt_95, data_rt_50)
  levels(data_rt$key) <- c("ninetyfive", "fifth")

  dat_emerg_dec <- covariates_long$value[which(covariates_long$key == "EmergDec" & covariates_long$time == "start")]
  data_state_cut <- data_state[which(data_state$date >= dat_emerg_dec),]
  data_rt_cut <- data_rt[which(data_rt$date >= dat_emerg_dec),]

  p3 <- ggplot(data_state_cut) +
    geom_ribbon(data = data_rt_cut, aes(x = date, ymin = rt_min, ymax = rt_max,
                                        group = key,
                                        fill = key)) +
    geom_hline(yintercept = 1, color = 'black', size = 0.7) +
    geom_segment(data = covariates_long,
                 aes(x = value, y = 0, xend = value, yend = max(x, na.rm=TRUE)),
                 linetype = "dashed", colour = "grey", alpha = 0.75) +
    geom_point(data = covariates_long, aes(x = value,
                                           y = x,
                                           group = key,
                                           shape = key,
                                           col = time), size = 2) +
    xlab("") +
    ylab(expression(R[t])) +
    scale_fill_manual(name = "Credible intervals", labels = c("50%", "95%"),
                      values = c(alpha("seagreen", 0.75), alpha("seagreen", 0.5))) +
    scale_shape_discrete(name = "Interventions", labels = plot_labels) +
    scale_colour_discrete(name = "Timing", labels = c("Started", "Eased")) +
    guides(shape = guide_legend(order = 2), col = guide_legend(order = 1), fill = guide_legend(order = 0)) +
    scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"),
                 limits = c(as.Date("2020-02-29"), max(data_state$date))) +
    theme_bw() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1),
          axis.text = element_text(size = 12),
          axis.title = element_text(size = 12)) +
    theme(legend.position="right") +
    ggtitle("")

    p <- plot_grid(p2, p1, p3, ncol = 3, rel_widths = c(1.2, 1.2, 2.5))
    save_plot(filename = paste0("usa/figures/", state, "_three_panel_", jobid, "_", label, ext),
              p, base_width = 19, base_height = 4.5)

  return (p)
}


##############################################################################
# Used to assess quality of full data vs. heavily filtered data
# will be modifying to a proper script soon
##############################################################################

rel<-read.table("/net/bipolar/jedidiah/mutation/output/5bp_100k_full/full.summary", header=F, stringsAsFactors=F, skip=1)
names(rel)<-c("CHR", "POS", "REF", "ALT", "DP", "AN", "SEQ", "ALTSEQ", "GC")

strict<-read.table("/net/bipolar/jedidiah/mutation/output/5bp_100k_strict/full.summary", header=F, stringsAsFactors=F, skip=1)
names(strict)<-c("CHR", "POS", "REF", "ALT", "DP", "AN", "SEQ", "ALTSEQ", "GC")

binw<-100000

adj<-2
chr22<-rel
chr22$BIN <- ceiling(chr22$POS/binw)
chr22$CAT <- paste(chr22$REF, chr22$ALT, sep="")
# Manually remove bins near chr20 centromere
# chr22 <- chr22[ which(chr22$BIN<260 | chr22$BIN>300),]
chr22$Category[chr22$CAT=="AC" | chr22$CAT=="TG"] <- "AT_CG"
chr22$Category[chr22$CAT=="AG" | chr22$CAT=="TC"] <- "AT_GC"
chr22$Category[chr22$CAT=="AT" | chr22$CAT=="TA"] <- "AT_TA"
chr22$Category[chr22$CAT=="GA" | chr22$CAT=="CT"] <- "GC_AT"
chr22$Category[chr22$CAT=="GC" | chr22$CAT=="CG"] <- "GC_CG"
chr22$Category[chr22$CAT=="GT" | chr22$CAT=="CA"] <- "GC_TA"
chr22$Sequence <- ifelse(
	substr(chr22$SEQ,adj+1,adj+1) < substr(chr22$ALTSEQ,adj+1,adj+1),
	paste0(chr22$SEQ,"(",chr22$ALTSEQ,")"),
	paste0(chr22$ALTSEQ,"(",chr22$SEQ,")")
)
rel<-chr22

chr22<-strict
chr22$BIN <- ceiling(chr22$POS/binw)
chr22$CAT <- paste(chr22$REF, chr22$ALT, sep="")
# Manually remove bins near chr20 centromere
# chr22 <- chr22[ which(chr22$BIN<260 | chr22$BIN>300),]
chr22$Category[chr22$CAT=="AC" | chr22$CAT=="TG"] <- "AT_CG"
chr22$Category[chr22$CAT=="AG" | chr22$CAT=="TC"] <- "AT_GC"
chr22$Category[chr22$CAT=="AT" | chr22$CAT=="TA"] <- "AT_TA"
chr22$Category[chr22$CAT=="GA" | chr22$CAT=="CT"] <- "GC_AT"
chr22$Category[chr22$CAT=="GC" | chr22$CAT=="CG"] <- "GC_CG"
chr22$Category[chr22$CAT=="GT" | chr22$CAT=="CA"] <- "GC_TA"
chr22$Sequence <- ifelse(
	substr(chr22$SEQ,adj+1,adj+1) < substr(chr22$ALTSEQ,adj+1,adj+1),
	paste0(chr22$SEQ,"(",chr22$ALTSEQ,")"),
	paste0(chr22$ALTSEQ,"(",chr22$SEQ,")")
)
strict<-chr22

rel$Seq3<-substring(rel$Sequence,2,4)
strict$Seq3<-substring(strict$Sequence,2,4)

relct<-count(rel, Seq3)
strictct<-count(strict, Seq3)

relct$sum<-sum(relct$freq)
strictct$sum<-sum(strictct$freq)

z2<-merge(relct, strictct, by=c("Seq3"))
z2$prop.x<-z2$freq.x/z2$sum.x
z2$prop.y<-z2$freq.y/z2$sum.y

z2<-z2[,c(1,6,7)]
names(z2)<-c("Motif", "None", "Strict")

z2m<-melt(z2, id=c("Motif"))
names(z2m)<-c("Motif", "Filter", "value")
z2m$cum.perc<-(1:nrow(z2m))/nrow(z2m)

require(plyr)
df<-ddply(z2m, .(Filter), transform, cum.perc=Reduce('+', list(value/2,cumsum(c(0,head(value,-1))))))

ggplot(df, aes(Filter, value, fill=Motif, label=Motif))+
	geom_bar(stat="identity")+
	geom_text(aes(x=Filter, y=cum.perc, size=value, ymax=cum.perc))+
	scale_fill_manual(values=myPaletteCat(32), guide=F)+
	theme_bw()+
	theme(legend.position="none")+
	ylab("Relative Proportion")

ggsave("/net/bipolar/jedidiah/mutation/images/motif_props.png")

count<-0

for(i in 1:32){
	counts<-as.numeric(z2[i,c(2,4)])
	trials<-as.numeric(z2[i,c(3,5)])

	z<-prop.test(counts, trials)

	if(z$p.value<0.05/32){
		sequence<-z2[i,1]
		pval<-z$p.value
		cat(sequence, pval, "\n")
		# count<-count+1
	}
}

chr20b<-count(chr20, BIN)
hqb<-count(hq, BIN)
bins<-merge(chr20b, hqb, by="BIN")
bins$prop<-bins$freq.y/bins$freq.x
bins$threshold<-bins$prop<0.45

strb<-count(strict, c("CHR", "BIN"))
relb<-count(rel, c("CHR", "BIN"))

dim(strb[strb$freq<50,])
dim(relb[relb$freq<50,])

relb$dat<-"full"
strb$dat<-"strict"

datm<-merge(relb[,1:3], strb[,1:3], by=c("CHR", "BIN"), all=T)

datm[is.na(datm)]<-0

names(datm)<-c("CHR", "BIN", "full data", "filtered data")
datm2<-melt(datm, id=c("CHR", "BIN"))

ggplot(datm2, aes(value, fill=variable))+
	geom_histogram(binwidth=50, position="identity", alpha=0.5)+
	coord_cartesian(xlim=c(-100, 3000))+
	xlab("# Singletons")+
	ylab("# 100kb windows")
ggsave("/net/bipolar/jedidiah/mutation/images/countdist.png")

strict$TS<-ifelse(((strict$REF=="A" | strict$REF=="G") & (strict$ALT=="A" | strict$ALT=="G")) | ((strict$REF=="C" | strict$REF=="T") & (strict$ALT=="C" | strict$ALT=="T")), "TS", "TV")
rel$TS<-ifelse(((rel$REF=="A" | rel$REF=="G") & (rel$ALT=="A" | rel$ALT=="G")) | ((rel$REF=="C" | rel$REF=="T") & (rel$ALT=="C" | rel$ALT=="T")), "TS", "TV")

tstv.str<-count(strict, c("CHR", "BIN", "TS"))
tstv.str2<-dcast(tstv.str, CHR+BIN~TS, value.var="freq")
tstv.str2$TOT<-tstv.str2$TS+tstv.str2$TV
tstv.str2$TSTV<-tstv.str2$TS/tstv.str2$TV
tstv.str2$BINCAT<-ceiling(tstv.str2$TOT/50)*50
tstv.str2$filter<-"strict"

tstv.rel<-count(rel, c("CHR", "BIN", "TS"))
tstv.rel2<-dcast(tstv.rel, CHR+BIN~TS, value.var="freq")
tstv.rel2$TOT<-tstv.rel2$TS+tstv.rel2$TV
tstv.rel2$TSTV<-tstv.rel2$TS/tstv.rel2$TV
tstv.rel2$BINCAT<-ceiling(tstv.rel2$TOT/50)*50
tstv.rel2$filter<-"none"

tstv.full<-rbind(tstv.str2, tstv.rel2)
# tstv.full<-tstv.full[tstv.full$BINCAT<=60,]
tstv.full<-tstv.full[tstv.full$TSTV<=8,]
# tstv.full<-tstv.full[complete.cases(tstv.full),]

update_geom_defaults("point", list(colour = NULL))
ggplot(tstv.full, aes(x=factor(BINCAT), y=TSTV, colour=filter))+
	geom_boxplot(outlier.colour=NULL)+
	scale_y_continuous(breaks=1:8)+
	geom_hline(aes(yintercept=2), colour="red")+
	# facet_wrap(~filter)+
	xlab("Singletons per bin")+
	theme_bw()+
	theme(axis.text.x=element_text(angle=90, hjust=1))
ggsave("/net/bipolar/jedidiah/mutation/images/strict_tstv.png", width=14, height=7)

tstv.full2<-aggregate(TSTV~filter+CHR+BIN, data=tstv.full, FUN=mean)
	ggplot(tstv.full2, aes(x=factor(BINCAT), y=TSTV, fill=filter))+
	geom_bar(stat="identity", position="dodge")+
	scale_y_continuous(breaks=seq(0, 2.5, by=0.1))+
	geom_hline(aes(yintercept=2), colour="red")+
	# facet_wrap(~filter)+
	xlab("Singletons per bin")+
	theme_bw()+
	theme(axis.text.x=element_text(angle=90, hjust=1))
ggsave("/net/bipolar/jedidiah/mutation/images/strict_tstv_bar.png", width=14, height=7)

tstv.full2<-aggregate(TSTV~filter+CHR+BIN, data=tstv.full, FUN=mean)
ggplot(tstv.full2[tstv.full2$CHR==2,], aes(x=BIN, y=TSTV, group=filter, colour=filter))+
	geom_point(alpha=0.5)+
	# geom_line()+
	scale_y_continuous(breaks=seq(0, 10, by=0.5))+
	geom_hline(aes(yintercept=2), colour="red")+
	# facet_wrap(~CHR)+
	xlab("Bin")+
	theme_bw()+
	theme(axis.text.x=element_text(angle=90, hjust=1))
ggsave("/net/bipolar/jedidiah/mutation/images/strict_tstv_chr.png", width=14, height=7)

grouped <- group_by(tstv.full, filter, BINCAT)
gpsum<-ddply(tstv.full, c("filter", "BINCAT"), mean=mean(TSTV), sd=sd(TSTV))

nrow(tstv.full[(tstv.full$filter=="strict" & tstv.full$TSTV<1),])/27001
nrow(tstv.full[(tstv.full$filter=="none" & tstv.full$TSTV<1),])/27001

d1<-tstv.full[(tstv.full$filter=="strict" & tstv.full$TSTV<1),]
d2<-tstv.full[(tstv.full$filter=="none" & tstv.full$TSTV<1),]

prop.test(c(nrow(tstv.full[(tstv.full$filter=="strict" & tstv.full$TSTV<1.5),]), nrow(tstv.full[(tstv.full$filter=="none" & tstv.full$TSTV<1.5),])), c(27001, 27001))


# Congressional Grade Level Plotting
# Mark Delcambre
#
#

# Import the necessary libraries.
# RgoogleMaps is imported for the plotting of the map on google maps
# RColorBrewer is used for the coloring of the heat map.
library(RgoogleMaps)
library(RColorBrewer)
library(scales)

# Download the relevant Sunlight CongressionalPublic Data into the data directory
if(!file.exists("data")){
    dir.create("data")
}
file_url <- "https://data.sunlightlabs.com/api/views/iwhe-qaqu/rows.csv?accessType=DOWNLOAD"
file_loc <- "./data/Members_And_Grade_Level.csv"
if(!file.exists(file_loc)){
    download.file(file_url,destfile=file_loc,method="curl")
    cat("## Date Downloaded", as.character(Sys.Date()),'\n',file=file_loc,append=T)
}

# Setup the output folder for the images we are plotting
if(!file.exists("output")){
    dir.create("output")
}

# Read the file into memory, last I checked this file is about 200 MB. May need to start subsampling
# Then remove the NA columns for lat lon.
#data <- read.csv(file=file_loc, header=T, comment.char="#")


library(GenomicRanges)
library(rtracklayer)

check_coverage_argument <- function(cvg, regions=NULL) {
  if(class(cvg) == "character") {
    stopifnot(file.exists(cvg))
    if(is.null(regions)) {
      cvg <- import(cvg, as="RleList")
    } else {
      cvg <- import(cvg, which=regions, as="RleList")
    }
  }
  stopifnot(is(cvg, "RleList"))
  cvg
}

grangesApply <- function(regions, cvg, func, ...) {
  stopifnot(class(regions) == "GRanges")
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(viewApply(
           X        = Views(cvg, as(regions, "RangesList")),
           FUN      = func, ...,
           simplify = FALSE
         ))
  ans[oo] <- ans  # restore original order
  ans
}

grangesBuiltinViewHelper <- function(regions, cvg, func) {
  stopifnot(class(regions) == "GRanges")
  cvg <- check_coverage_argument(cvg, regions)
  seqlevels(regions) <- names(cvg)
  oo <- order(regions)
  regions <- regions[oo]
  ans <- unlist(func(Views(cvg, as(regions, "RangesList"))))
  ans[oo] <- ans  # restore original order
  ans
}

grangesSums <- function(regions, cvg) {
  grangesBuiltinViewHelper(regions, cvg, viewSums)
}

grangesMeans <- function(regions, cvg) {
  grangesBuiltinViewHelper(regions, cvg, viewMeans)
}

grangesWhichMaxs <- function(regions, cvg) {
  grangesBuiltinViewHelper(regions, cvg, viewWhichMaxs)
}

grangesWhichMins <- function(regions, cvg) {
  grangesBuiltinViewHelper(regions, cvg, viewWhichMins)
}

grangesMaxs <- function(regions, cvg) {
  grangesBuiltinViewHelper(regions, cvg, viewMaxs)
}

grangesMins <- function(regions, cvg) {
  grangesBuiltinViewHelper(regions, cvg, viewMins)
}

grangesMatrix <- function(regions, cvg) {
  stopifnot(class(regions) == "GRanges")
  stopifnot(length(unique(width(regions))) == 1)

  reads.list <- grangesApply(regions, cvg, as.numeric)
  reads.m <- matrix(unlist(reads.list), nrow=length(regions), byrow=TRUE)

  neg_i <- which(strand(regions) == "-")
  if(length(neg_i) > 0) {
    reads.m[neg_i, ] <- reads.m[neg_i, ncol(reads.m):1]
  }
  reads.m
}

total_signal_rlelist <- function(cvg) {
  stopifnot(is(cvg, "RleList"))
  sum(as.numeric(sum(cvg)))
}

delete_if_older_than <- function(file, timestamp) {
  stopifnot(length(file) == 1)
  if(file.info(file)$mtime < timestamp) {
    if(!file.remove(file)) {
      stop("Could not delete out-of-date cache file: ", file)
    }
  }
}

totalSignal <- function(cvg) {
  if(class(cvg) == "character") {
    stopifnot(length(cvg) == 1 & file.exists(cvg))
    cache.file <- paste0(cvg, ".ts.rds")
    delete_if_older_than(cache.file, file.info(cvg)$mtime)
    if(file.exists(cache.file)) {
      return(readRDS(cache.file))
    } else {
      cvg <- check_coverage_argument(cvg)
      ts <- total_signal_rlelist(cvg)
      saveRDS(ts, file=cache.file)
      return(ts)
    }
  } else {
    return(total_signal_rlelist(cvg))
  }
}

load_object <- function(filename) {
  if(length(grep("rdata$", tolower(filename))) > 0) {
    o <- get(load(filename))
  } else {
    o <- readRDS(filename)
  }
  updateObject(o)
}

filter_chrs <- function(gr) {
  exclude.chrs <- grep("H|M|U|_", seqlevels(gr))
  if(length(exclude.chrs) > 0) seqlevels(gr, force=TRUE) <- seqlevels(gr)[-exclude.chrs]
  gr
}


require(abind)
require(data.table)
require(dplyr)
library(plyr)
library(RCurl)

#So the only real difference between this code and that of the fixgop.r file is that there were sources such as Wilson Perkins Allen polling that did not poll for the Democratic party. At the same time, there were alot less candidates for the Democratic party (as is the case much of the time for incumbant parties)

fixday <- function(argDF) {
    modDF<- data.frame(Start.Date=argDF$Start.Date, End.Date=argDF$End.Date, Clinton=argDF$Clinton, Sanders=argDF$Sanders, O.Malley=argDF$O.Malley, Biden=argDF$Biden, Chafee=argDF$Chafee, Lessig=argDF$Lessig, Webb=argDF$Webb, Undecided=argDF$Undecided, stringsAsFactors=FALSE)
    modDF[1:2] <- lapply(modDF[1:2], as.Date)
    returnDF <- setDT(modDF)[, list(dates=seq(Start.Date, End.Date, by = '1 day'),
        Clinton=Clinton, Sanders=Sanders, O.Malley=O.Malley, Biden=Biden, Chafee=Chafee, Lessig, Webb=Webb, Undecided=Undecided),
        by = 1:nrow(modDF)][, nrow:= NULL][]
    return(returnDF[order(dates),])
}

includeNA <- function(argDF) {
    returnDF <- data.frame(stringsAsFactors=FALSE)
    argDF <- as.data.frame(argDF, stringsAsFactors=FALSE)

    dateSeq <- seq(as.Date("2015-01-01"), as.Date("2015-12-31"), by="days")
    count = 1
    for(i in seq_along(dateSeq)){
        if(any(dateSeq[i] %in% argDF$dates)==TRUE){
            returnDF <- rbind(returnDF, argDF[match(dateSeq[i], argDF$dates),])
            colnames(returnDF) <- colnames(argDF)
        }else{
            naList <- data.frame(dateSeq[i], NA, NA, NA, NA, NA, NA, NA, NA, stringsAsFactors=FALSE)
            colnames(naList) <- colnames(argDF)
            returnDF <- rbind(returnDF, naList)
            count <- count + 1}}
    rownames(returnDF) <- as.character(seq(as.Date("2015-01-01"), as.Date("2015-12-31"), by="days"))
    return(returnDF[1:nrow(returnDF), 2:ncol(returnDF)])
}

allArrayMaker <- function(ipsos, quinnipiac, gravis, yougov, abc, fox, ppp, bloomberg, nbcsm, morningconsult, pubrel, mcclatchy, usc, zogby, nbcwsj, ibdtipp, monmouth, emerson, fairleigh, suffolk, cnn, lincolnpark, robertmorris, reasonrupe) {
    xipsos <- includeNA(ipsos)
    xquinnipiac <- includeNA(quinnipiac)
    xgravis <- includeNA(gravis)
    xyougov <- includeNA(yougov)
    xabc <- includeNA(abc)
    xfox <- includeNA(fox)
    xppp <- includeNA(ppp)
    xbloomberg <- includeNA(bloomberg)
    xnbcsm <- includeNA(nbcsm)
    xmorningconsult <- includeNA(morningconsult)
    xpubrel <- includeNA(pubrel)
    xmcclatchy <- includeNA(mcclatchy)
    xusc <- includeNA(usc)
    xzogby <- includeNA(zogby)
    xnbcwsj <- includeNA(nbcwsj)
    xibdtipp <- includeNA(ibdtipp)
    xmonmouth <- includeNA(monmouth)
    xemerson <- includeNA(emerson)
    xfairleigh <- includeNA(fairleigh)
    xsuffolk <- includeNA(suffolk)
    xcnn <- includeNA(cnn)
    xlincolnpark <- includeNA(lincolnpark)
    xrobertmorris <- includeNA(robertmorris)
    xreasonrupe <- includeNA(reasonrupe)
    returnArray <- abind(xipsos, xquinnipiac, xgravis, xyougov, xabc, xfox, xppp, xbloomberg, xnbcsm, xmorningconsult, xpubrel, xmcclatchy, xusc, xzogby, xnbcwsj, xibdtipp, xmonmouth, xemerson, xfairleigh, xsuffolk, xcnn, xlincolnpark, xrobertmorris, xreasonrupe, along=3)
    dimnames(returnArray)[[3]] <- c("Ipsos/Reuters", "Quinnipiac", "Gravis Marketing/One America News", "YouGov/Economist", "ABC/Post", "FOX", "PPP (D)", "Bloomberg/Selzer", "NBC/SurveyMonkey", "Morning Consult", "Public Religion Research Institute", "McClatchy/Marist", "USC/LA Times/SurveyMonkey", "Zogby (Internet)", "NBC/WSJ", "IBD/TIPP", "Monmouth University", "Emerson College Polling Society", "Fairleigh Dickinson", "Suffolk/USA Today", "CNN", "Lincoln Park Strategies (D)", "Robert Morris University", "Reason/Rupe")
    return(returnArray)
}

sourcecsv = read.csv("http://elections.huffingtonpost.com/pollster/2016-national-democratic-primary.csv", header=TRUE, stringsAsFactors=FALSE)
sourcecsv[sourcecsv == "NA"] <- NA
argDF <- sourcecsv

ipsos <- fixday(argDF[argDF$Pollster == "Ipsos/Reuters",])
quinnipiac <- fixday(argDF[argDF$Pollster == "Quinnipiac",])
gravis <- fixday(argDF[argDF$Pollster == "Gravis Marketing/One America News",])
yougov <- fixday(argDF[argDF$Pollster == "YouGov/Economist",])
abc <- fixday(argDF[argDF$Pollster == "ABC/Post",])
fox <- fixday(argDF[argDF$Pollster == "FOX",])
ppp <- fixday(argDF[argDF$Pollster == "PPP (D)",])
bloomberg <- fixday(argDF[argDF$Pollster == "Bloomberg/Selzer",])
nbcsm <- fixday(argDF[argDF$Pollster == "NBC/SurveyMonkey",])
morningconsult <- fixday(argDF[argDF$Pollster == "Morning Consult",])
pubrel <- fixday(argDF[argDF$Pollster == "Public Religion Research Institute",])
mcclatchy <- fixday(argDF[argDF$Pollster == "McClatchy/Marist",])
usc <- fixday(argDF[argDF$Pollster == "USC/LA Times/SurveyMonkey",])
zogby <- fixday(argDF[argDF$Pollster == "Zogby (Internet)",])
nbcwsj <- fixday(argDF[argDF$Pollster == "NBC/WSJ",])
ibdtipp <- fixday(argDF[argDF$Pollster == "IBD/TIPP",])
monmouth <- fixday(argDF[argDF$Pollster == "Monmouth University",])
emerson <- fixday(argDF[argDF$Pollster == "Emerson College Polling Society",])
fairleigh <- fixday(argDF[argDF$Pollster == "Fairleigh Dickinson",])
suffolk <- fixday(argDF[argDF$Pollster == "Suffolk/USA Today",])
cnn <- fixday(argDF[argDF$Pollster == "CNN",])
lincolnpark <- fixday(argDF[argDF$Pollster == "Lincoln Park Strategies (D)",])
robertmorris <- fixday(argDF[argDF$Pollster == "Robert Morris University",])
reasonrupe <- fixday(argDF[argDF$Pollster == "Reason/Rupe",])

allDEM <- allArrayMaker(ipsos, quinnipiac, gravis, yougov, abc, fox, ppp, bloomberg, nbcsm, morningconsult, pubrel, mcclatchy, usc, zogby, nbcwsj, ibdtipp, monmouth, emerson, fairleigh, suffolk, cnn, lincolnpark, robertmorris, reasonrupe)

save(allDEM, file="/Users/andrewlee/Documents/School/CS125/Final Project/DEMArray.RData")


x <- read.table("~/.cache/netloghistory")
x = x * 0.001
png(file="~/RX.png", width=600, height=600)
plot(x$V1, main="wlp3s0 RX: Received data per hour", ylab="Megabytes", xlab="Hours", type="l", col="blue")
dev.off()
png(file="~/TX.png", width=600, height=600)
plot(x$V2, main="wlp3s0 TX: Transmitted data per hour", ylab="Megabytes", xlab="Hours", type="l", col="blue")
dev.off()


ALIGN_BITS <- c (0, 1, 2, 3, 4)
RANDOM_BITS <- c (6, 12)

BENCHMARKS <- c ("400_perlbench", "401_bzip2", "403_gcc", "410_bwaves", "416_gamess", "429_mcf", "433_milc",
                 "434_zeusmp", "435_gromacs", "436_cactusADM", "437_leslie3d", "444_namd", "445_gobmk",
                 "447_dealII", "450_soplex", "453_povray", "454_calculix", "456_hmmer", "458_sjeng",
                 "459_GemsFDTD", "462_libquantum", "464_h264ref", "465_tonto", "470_lbm",
                 "471_omnetpp", "473_astar", "481_wrf", "482_sphinx3", "483_xalancbmk",
                 "998_specrand", "999_specrand")

read_results <- function (name, benchmark)
{
  results <- c ()
  files <- list.files (name, full.names=TRUE)
  for (file in files)
  {
    lines <- readLines (file)
    links <- grep ("format: raw -> [^ ]+\\.rsf", lines, value=TRUE)
    raws <- sub (" *format: raw -> ([^ ]+\\.rsf)", "\\1", links)

    for (raw in raws)
    {
      # Create local copies of the results for archival purposes
      local = paste (name, basename (raw), sep="/")
      if (!file.exists (local)) file.copy (raw, local)

      # Always read the local copies of the results
      lines <- readLines (local)
      key <- paste ("spec", "cpu2006", "results", benchmark, "base", "000", "reported_time", sep=".")
      line <- grep (key, lines, value=TRUE)
      result <- as.numeric (sub (".*\\.reported_time: ([0-9.]+)", "\\1", line))
      if ((length (result) == 1) && (result > 0)) results <- c (results, result)
    }
  }

  return (results)
}

for (benchmark in BENCHMARKS)
{
  # Read input files

  results_vanilla <- read_results ("speccpu-vanilla", benchmark)

  for (align in ALIGN_BITS)
  {
	for (random in RANDOM_BITS)
	{
	  name_directory = paste ("speccpu", "randomized", align, random, sep="-")
	  name_variable = paste ("results", align, random, sep="_")
	  assign (name_variable, read_results (name_directory, benchmark))
	}
  }

  # Plot observations

  plot_graph <- function (name, benchmark, align_list, random)
  {
    variable_list <- c ("results_vanilla", paste ("results", align_list, random, sep="_"))
    length_list <- unlist (lapply (variable_list, function (x) length(get (x))))
    horizontal_limits <- c (1, max (length_list))
    value_list <- unlist (lapply (variable_list, get))
    minimum <- min (c (value_list, Inf))
    maximum <- max (c (value_list, -Inf))
    vertical_limits <- c (minimum, maximum)

    if (length (value_list) > 0)
    {
      postscript (paste (name, benchmark, "ps", sep="."))

      plot (c (), xlim = horizontal_limits, ylim = vertical_limits, ylab="Performance")
      for (variable_index in 1:length (variable_list))
      {
        variable = variable_list [variable_index]
        points (get (variable), pch = variable_index, col = variable_index)
      }

      legend (
        "topright",
        variable_list,
        pch = 1:length (variable_list),
        col = 1:length (variable_list))

      dev.off ()
    }
  }

  plot_graph ("random-cache-line", benchmark, ALIGN_BITS, 6)
  plot_graph ("random-page-frame", benchmark, ALIGN_BITS, 12)
}


library(tidyverse)
library(data.table)
library(maditr)
library(entropy)
library(ggridges)

args <- commandArgs(trailingOnly=TRUE)

## Input args
# args[1] Refined clusters
# args[2] Cluster ids categ
# args[3] Cluster taxonomy results
# args[4] Cluster darkness results
# args[5] DPD info
## Output args
# args[6] Output folder

# Refined cluster with size orf length and partial info
ref_clu <- fread(args[1], stringsAsFactors = F, header = F,
                 colClasses = c(V1="character", V6="character")) %>%
  setNames(c("cl_name","rep","orf","size","length","partial"))

# Join with catgeory info
categ <- fread(args[2], stringsAsFactors = F, header = F,
               colClasses = c(V1="character")) %>%
  setNames(c("cl_name","categ"))

ref_clu <- ref_clu %>% dt_inner_join(categ)

#Start caluclating stats per cluster catgory (or first xcluster and then xcategory????)
# cluster ORF length stats
clu_stats <- ref_clu %>% group_by(cl_name) %>%
  mutate(min_len=min(length),mean_len=mean(length),median_len=median(length),max_len=max(length), sd_len=sd(length))
# Cluster size stats
clu_stats <- clu_stats %>% group_by(cl_name) %>%
  mutate(min_size=min(size),mean_size=mean(size),median_size=median(size),max_size=max(size), sd_size=sd(size))
# Cluster completeness stats (then summarize by cluster category)
clu_compl <- clu_stats %>% group_by(cl_name,partial,size) %>% count() %>%
  mutate(p=n/size) %>% ungroup() %>% dt_select(cl_name,partial,p) %>% spread(partial,p, fill=0) %>%
  rename(p00=`00`,p10=`10`,p01=`01`,p11=`11`)
write.table(clu_compl,paste0(args[6],"/clu_completeness.tsv"), col.names = T, row.names = F, sep = "\t")

# HQ cluster set
# Completeness: Percentage of complete ORFs ("00") (tranformed with sinus function to be between 0-0.5) +
# 0.5 if repres is complete or 0 if it's not

pcompl <- clu_stats  %>%
  select(cl_name, p00, rep_compl) %>% mutate(rep_compl_v=ifelse(rep_compl==T,0.5,0), rep.is.compl=ifelse(rep_compl==T,1,0))

# BrokenStick to p00 distribution (where representative is complete)
brStick <- function (X) {
  x <- X[[2]]
  m <- 0
  out <- matrix(NA, ncol = 2, nrow = length(x))
  colnames(out) <- c("Observed", "BSM")

  #colnames(out) <- c("% of Variability", "B-Stick Threshold")
  for (i in 1:length(x)) {
    for (k in i:length(x)) {
      m <- m + ((1 / length(x)) * (1 / k))
    }
    out[i, ] <- c((x[i] / sum(x)), m)
    m <- 0
  }
  out <- as_tibble(out) %>% mutate(thresh = X[[1]])
  out_w <- out %>% gather(class, value, -thresh) %>%
    mutate(thresh = as.character(thresh),
           class = fct_rev(class))
  plot <- ggplot(out_w, aes(thresh, value, fill = class)) +
    geom_col(position = "dodge", color = "black", alpha = 0.7) +
    geom_line(aes(group = class, color = class), position=position_dodge(width=0.9)) +
    geom_point(position=position_dodge(width=0.9), colour="black",  shape = 21) +
    theme_light() +
    theme(legend.position = "top",
          legend.title = element_blank()) +
    scale_y_continuous(labels = scales::percent) +
    xlab("Filtering threshold") +
    ylab("Variability")

  h_bsm <- out %>% filter(Observed > BSM) %>% .$thresh

  return(list(bsm_table = out, plot = plot, thresh_by_bsm = h_bsm))
}
br_compl_cl <- plyr::ldply(seq(0,1,0.05), function(x) {data.frame(threshold = x, clusters = dim(pcompl %>% filter(p00>=x))[1])})
br_compl <- brStick(br_compl_cl)
br_compl$plot
lag <- br_compl$thresh_by_bsm %>% enframe() %>% mutate(lag = round(value - dplyr::lag(value), 2)) %>%
filter(lag > .01) %>% top_n(1) %>% .$name %>% head(1)
if (length(lag)!=0){
  rej_threshold <- br_compl$thresh_by_bsm[lag - 1]
} else {
  rej_threshold <- br_compl$thresh_by_bsm[length(br_compl$thresh_by_bsm)]
}

# We define as HQ clusters the clusters with a percentage of complete ORFs higher than the identified threshold
# and a complete representative
HQ_clusters <- clu_stats %>% filter(p00>=0.35,rep_compl==T) %>% select(cl_name,categ)
write.table(HQ_clusters,paste0(args[6],"/HQ_clusters_categ.tsv"), col.names = T, row.names = F, sep = "\t")

# Category stats
# category ORF length stats
cat_stats <- ref_clu %>% group_by(categ) %>%
  mutate(min_len=min(length),mean_len=mean(length),median_len=median(length),max_len=max(length), sd_len=sd(length))
# category size stats
cat_stats <- cat_stats %>% group_by(categ) %>%
  mutate(min_size=min(size),mean_size=mean(size),median_size=median(size),max_size=max(size), sd_size=sd(size))
# category completeness stats
cat_compl <- cat_stats %>% group_by(categ,partial) %>% add_count() %>%
  mutate(p=n/sum(size)) %>% ungroup() %>% dt_select(categ,partial,p) %>% distinct() %>% spread(partial,p, fill=0) %>%
  rename(p00=`00`,p10=`10`,p01=`01`,p11=`11`)

# Cluster taxonomy stats
cl_tax <- fread(args[3],
                stringsAsFactors = F, header = F, fill = T) %>%
  setNames(c("orf","cl_name","categ","taxid","rank","classific","lineage"))
# Filter out the unclassified ones and split the taxonomic levels in the lineage
cl_tax <- cl_tax %>% filter(classific!="unclassified") %>%
  mutate(lineage=gsub("-_cellular__organisms;","",lineage)) %>%
  mutate(domain=str_match(lineage,"^d_(.*?);.*")[,2],
         phylum=str_match(lineage,";p_(.*?);.*")[,2],
         class=str_match(lineage,";c_(.*?);.*")[,2],
         order=str_match(lineage,";o_(.*?);.*")[,2],
         family=str_match(lineage,";f_(.*?);.*")[,2],
         genus=str_match(lineage,";g_(.*?);.*")[,2],
         species=str_match(lineage,";s_(.*?)$")[,2])

# Taxonomic homogeneity
homo_tax <- cl_tax %>% select(-orf,-taxid,-classific,-rank,-lineage) %>%
  group_by(cl_name,categ) %>%
  summarise(homo_d=length(unique(domain[!is.na(domain)])),
            homo_p=length(unique(phylum[!is.na(phylum)])),
            homo_o=length(unique(`order`[!is.na(`order`)])),
            homo_c=length(unique(class[!is.na(class)])),
            homo_f=length(unique(family[!is.na(family)])),
            homo_g=length(unique(genus[!is.na(genus)])),
            homo_s=length(unique(species[!is.na(species)])))

### Plot:
plot_tax <- gather(homo_tax,ranks,n,homo_p:homo_s) %>%
  mutate(ranks=case_when(ranks=="homo_p"~"Phylum",
                         ranks=="homo_c"~"Class",
                         ranks=="homo_o"~"Order",
                         ranks=="homo_f"~"Family",
                         ranks=="homo_g"~"Genus",
                         TRUE  ~ "Species")) %>%
  mutate(n=as.numeric(n),ranks=as.factor(ranks)) %>% as_tibble()
plot_tax$categ <- factor(as.factor(plot_tax$categ), levels=c("K","KWP","GU","EU"))
plot_tax$ranks <- factor(as.factor(plot_tax$ranks), levels=c("Phylum","Class","Order","Family","Genus","Species"))
# joy_div plot
taxp <- ggplot(plot_tax %>% filter(n<=50 & n>0),aes(y=categ,x=n, fill=categ)) +
  geom_density_ridges(scale = 4, bandwidth=.3, alpha=.8,size=.3) +
  scale_x_continuous(breaks = c(1,5,10, 15, 20)) +
  coord_cartesian(xlim = c(0, 20)) +
  facet_wrap(.~ ranks) +
  scale_fill_manual(values=c("#233B43","#556c74","#65ADC2","#E84646")) + ##4B636A K
  theme_light() + xlab("Number of different taxonomies inside each cluster") + ylab("") +
  theme(axis.text.x = element_text(size=6),
        axis.text.y = element_text(size=6),
        axis.title.x = element_text(size=7),
        legend.text = element_text(size=6),
        legend.title = element_blank(),
        legend.key.size = unit(.39,"cm"),
        strip.text = element_text(size=7, colour = "white"),
        strip.background = element_rect(fill = "#273133"))
save(taxp , file=paste0(args[6],"/taxonomy/taxonomy_plot.rda"))

# Calculate cluster taxonomic entropy
p <- cl_tax %>% group_by(cl_name, categ,phylum) %>%
  summarise (n=n()) %>%
  mutate(pf = n / sum(n)) %>%
  group_by(cl_name, categ) %>%
  mutate(pe = entropy.empirical(pf, unit="log2")) %>%
  select(1,2,6) %>% distinct()
o <- cl_tax %>% group_by(cl_name, categ,order) %>%
  summarise (n=n()) %>%
  mutate(of = n / sum(n)) %>%
  group_by(cl_name, categ) %>%
  mutate(oe = entropy.empirical(of, unit="log2")) %>%
  select(1,2,6) %>% distinct()
c <- cl_tax %>% group_by(cl_name, categ,class) %>%
  summarise (n=n()) %>%
  mutate(cf = n / sum(n)) %>%
  group_by(cl_name, categ) %>%
  mutate(ce = entropy.empirical(cf, unit="log2")) %>%
  select(1,2,6) %>% distinct()
f <- cl_tax %>% group_by(cl_name, categ,family) %>%
  summarise (n=n()) %>%
  mutate(ff = n / sum(n)) %>%
  group_by(cl_name, categ) %>%
  mutate(fe = entropy.empirical(ff, unit="log2")) %>%
  select(1,2,6) %>% distinct()
g <- cl_tax %>% group_by(cl_name, categ,genus) %>%
  summarise (n=n()) %>%
  mutate(gf = n / sum(n)) %>%
  group_by(cl_name, categ) %>%
  mutate(ge = entropy.empirical(gf, unit="log2")) %>%
  select(1,2,6) %>% distinct()
s <- cl_tax %>% group_by(cl_name, categ,species) %>%
  summarise (n=n()) %>%
  mutate(sf = n / sum(n)) %>%
  group_by(cl_name, categ) %>%
  mutate(se = entropy.empirical(sf, unit="log2")) %>%
  select(1,2,6) %>% distinct()
tax_entropy <- p %>% left_join(c) %>% left_join(o) %>%
  left_join(f) %>% left_join(g) %>% left_join(s)
rm(p,c,o,f,g,s)
write.table(tax_entropy, paste0(args[6],"/cluster_categ_taxonomy_entropy.tsv"), col.names = T, row.names = F, quote =  F, sep = "\t")

## Retrieve the prevalent taxa for each cluster
prev_tax <- cl_tax %>% group_by(cl_name,categ,domain,phylum,class,order,family,genus,species) %>%
  count() %>% ungroup() %>% group_by(cl_name,categ) %>% arrange(desc(n)) %>% slice(1) %>% select(-n)
write.table(prev_tax,paste0(args[6],"/cluster_categ_prevalent_tax.tsv"), col.names = T, row.names = F, quote = F, sep = "\t")

# Cluster darkness stats
dpd_res <- fread(args[4],
                 stringsAsFactors = F, header = F) %>%
  setNames(c("orf","dpd_acc","cl_name","categ"))

dpd_info <- fread(args[5], stringsAsFactors = F, header = T, sep="\t", fill=T) %>%
    mutate(Darkness=Darkness/100,Disorder=Disorder/100,Compositional_Bias=Compositional_Bias/100,Transmembrane=Transmembrane/100)

cl_dark <- dpd_res %>% left_join(dpd_info, by=c("dpd_acc"="Primary_Accession")) %>% group_by(cl_name,categ) %>%
  summarise(mean_darkness=mean(Darkness),median_darkness=median(Darkness),
         mean_disorder=mean(Disorder), median_disorder=median(Disorder))
write.table(cl_dark,paste0(args[6],"/darkness/cluster_dpd_perc.tsv"),
            col.names=T,row.names=F,quote=F,sep="\t")
cat_dark <- dpd_res %>% left_join(dpd_info, by=c("dpd_acc"="Primary_Accession")) %>% group_by(categ) %>%
  replace_na(list(Darkness=0, Disorder=0,Compositional_Bias=0,Transmembrane=0)) %>%
  summarise(mean_darkness=mean(Darkness),median_darkness=median(Darkness),
            mean_disorder=mean(Disorder), median_disorder=median(Disorder))
write.table(cat_dark,paste0(args[6],"/darkness/cluster_category_dpd_perc.tsv"),
            col.names=T,row.names=F,quote=F,sep="\t")

## Cluster general stats
clu_stats <- clu_stats %>% dt_left_join(clu_compl) %>% mutate(rep_compl=ifelse(rep==orf & partial=="00", TRUE,FALSE)) %>%
  dt_left_join(tax_entropy %>% ungroup() %>% mutate(cl_name=as.character(cl_name))) %>%
  dt_left_join(prev_tax %>% ungroup() %>% mutate(cl_name=as.character(cl_name))) %>%
  dt_left_join(cl_dark %>% ungroup() %>% mutate(cl_name=as.character(cl_name))) %>%
  dt_left_join(HQ_clusters %>% mutate(is.HQ=TRUE))
write.table(clu_compl,paste0(args[6],"/cluster_general_stats.tsv"), col.names = T, row.names = F, sep = "\t")

## Category general stats
cat_stats <- cat_stats %>% dt_left_join(cat_compl) %>%
  dt_select(-cl_name,-orf,-rep,-size,-length,-partial) %>% distinct() %>%
  dt_left_join(tax_entropy %>% ungroup() %>% select(-cl_name) %>% group_by(categ) %>% summarise_all(sum)) %>%
  dt_left_join(cat_dark)
write.table(clu_compl,paste0(args[6],"/cluster_categ_stats.tsv"), col.names = T, row.names = F, sep = "\t")


## This is the function to combine the likelihood values from different measurements.

Combination<-function(LikelihoodMatrix)
{

#print(LikelihoodMatrix);
Dimension<-dim(LikelihoodMatrix);
#print(Dimension);

if (Dimension[2]==2)
{
  CombinedLikelihood<-LikelihoodMatrix[2];
} else
{
  CombinedLikelihood<-LikelihoodMatrix[2];

  for (i in 3:Dimension[2])
  {
   CombinedLikelihood<-CombinedLikelihood*LikelihoodMatrix[i];
  }

}

return(CombinedLikelihood);

}


## ---- thing1 ----
a <- rnorm(1000)
hist(a)

## ---- thing2 ----
library(ggplot2)
ggplot(iris, aes(Sepal.Length, Sepal.Width)) +
  geom_point()


\name{vioplotR}
\alias{vioplotR}
\title{violin plot}
\description{
  Produce violin plot(s) of the given (grouped) values.
}
\usage{
vioplotR( x, ..., range=1.5, h = NULL, ylim = NULL, names = NULL, horizontal=FALSE, col="magenta", las=0, main = "", xlab = "", ylab = "",  border="black", lty=1, lwd=1, rectCol="black", colMed="white", pchMed=19, at, add=FALSE, wex=1, drawRect=TRUE)
}
\arguments{
  \item{x}{data vector}
  \item{...}{additional data vectors}
  \item{las}{x labels horizontal when las = 2}
  \item{main}{main title}
  \item{xlab}{label for x axis}
  \item{ylab}{label for y axis}
  \item{range}{a factor to calculate the upper/lower adjacent values}
  \item{h}{the height for the density estimator, if omit as explained in sm.density, h will be set to an optimum}
  \item{ylim}{y limits}
  \item{names}{one label, or a vector of labels for the datas must match the number of datas given}
  \item{col, border, lty, lwd}{Graphical parameters for the violin passed to lines and polygon}
  \item{rectCol, colMed, pchMed}{Graphical parameters to control the look of the box}
  \item{drawRect}{logical. the box is drawn if \code{TRUE}.}
  \item{at}{position of each violin. Default to \code{1:n}}
  \item{add}{logical. if FALSE (default) a new plot is created}
  \item{wex}{relative expansion of the violin. }
  \item{horizontal}{logical. horizontal or vertical violins}
}
\details{
 A violin plot is a combination of a box plot and a kernel density plot.
 Specifically, it starts with a box plot. It then adds a rotated kernel density plot to each side of the box plot.
}
\seealso{
  \code{\link{boxplot}}
  \code{\link[sm]{sm}}
}
\references{
  Hintze, J. L. and R. D. Nelson (1998).  \emph{Violin plots: a box plot-density trace
synergism.}  The American Statistician, 52(2):181-4.
}
\author{Daniel Adler \email{dadler@uni-goettingen.de}

  Romain Francois \email{francoisromain@free.fr} ; \url{http://francoisromain.free.fr} :
  horizontal violins and additionnal graphical parameters }
\keyword{hplot}