# compare the ant host tree to each of the blochmannia gene trees

library(ape)
library(phytools)
library(seqinr)
options(scipen=999)

# read in species tree
species_tree <- read.nexus("camp_summed.tre")
species_tree <- midpoint.root(species_tree)
# remove single quotes from tip labels
species_tree$tip.label <- gsub("'", "", species_tree$tip.label)
# remove furthest outgroup
species_tree  <- drop.tip(species_tree, "SRX5650044")
# rename tips to coincide with blochmannia trees
species_tree$tip.label[species_tree$tip.label == "C-028"] <- "28_vicinus"
species_tree$tip.label[species_tree$tip.label == "C-005"] <- "5_vicinus"
species_tree$tip.label[species_tree$tip.label == "C-029"] <- "29_vicinusunk"
species_tree$tip.label[species_tree$tip.label == "C-024"] <- "24_vicinusunk"
species_tree$tip.label[species_tree$tip.label == "C-056"] <- "56_herculeanus"
species_tree$tip.label[species_tree$tip.label == "C-049"] <- "49_herculeanus"
species_tree$tip.label[species_tree$tip.label == "C-050"] <- "50_herculeanus"
species_tree$tip.label[species_tree$tip.label == "C-019"] <- "19_modoc"
species_tree$tip.label[species_tree$tip.label == "C-002"] <- "2_modoc"
species_tree$tip.label[species_tree$tip.label == "C-036"] <- "36_modoc"
species_tree$tip.label[species_tree$tip.label == "C-010"] <- "10_pennunk"
species_tree$tip.label[species_tree$tip.label == "C-016"] <- "16_pennunk"
species_tree$tip.label[species_tree$tip.label == "C-018"] <- "18_pennunk"
species_tree$tip.label[species_tree$tip.label == "C-003"] <- "3_laevigatus"
species_tree$tip.label[species_tree$tip.label == "C-046"] <- "46_laevigatus"
species_tree$tip.label[species_tree$tip.label == "SRX022802"] <- "floridanus"
species_tree$tip.label[species_tree$tip.label == "C-006"] <- "6_ocreatus"
species_tree$tip.label[species_tree$tip.label == "C-039"] <- "39_vicinus"
plot(species_tree)

# identify the trees to read in and then parse out their names
all_trees <- list.files("bloch_fasta_trees", pattern="RAxML*", full.names=T)
tree_names <- substr(all_trees, 55, nchar(all_trees))
tree_names <- sapply(strsplit(tree_names, "\\.1_"), "[[", 2)
tree_names <- sapply(strsplit(tree_names, "\\.tre"), "[[", 1)

# calculate the Kuhner and Felsenstein (1994) branch length score differences between blochmannia
# genes and the ant species tree
kf94 <- c()
for(a in 1:length(all_trees)) {
	a_rep <- read.tree(all_trees[a])
	a_rep <- midpoint.root(a_rep)
	# measure the Kuhner and Felsenstein (1994) branch length score
	kf94 <- c(kf94, dist.topo(species_tree, a_rep, method="score")[1])
}

# define the species for measuring phylogenetic distance
species_names <- c("tanaemyrmex", "camponotus")
groups <- list()
groups[[1]] <- c("28_vicinus", "5_vicinus", "39_vicinus", "29_vicinusunk", "24_vicinusunk")
groups[[2]] <- c("3_laevigatus", "46_laevigatus", "56_herculeanus", "49_herculeanus", "50_herculeanus", "19_modoc", "2_modoc", "36_modoc", "10_pennunk", "16_pennunk", "18_pennunk")
groups[[3]] <- c(groups[[1]], groups[[2]])

# loop for each tree
output <- c()
host_distances <- c()
for(a in 1:length(all_trees)) {
	a_rep <- read.tree(all_trees[a])
	a_rep <- midpoint.root(a_rep)
	# loop for each species
	tree_distances <- c()
	for(g in 1:length(groups)) {
		group_of_interest <- groups[[g]]
		# calculate MRCA distance for each species (for the ant species tree)
		if(a == 1) {
			# calculate MRCA of entire group
			total_mrca <- getMRCA(species_tree, tip = group_of_interest)
			# calculate length of edges to reach common ancestor for each individual in group
			# and then average
			edge_lengths <- list()
			group_edge_lengths <- c()
			for(b in 1:length(group_of_interest)) {
				# set edge length as zero to add to
				edge_lengths[[b]] <- 0
				# what is the number of this individual?
				b_number <- match(group_of_interest[b], species_tree$tip.label)

				# loop throup edge table until reaching MRCA
				while_loop <- 0
				while(while_loop != total_mrca) {
					# add edge length
					edge_lengths[[b]] <- edge_lengths[[b]] + species_tree$edge.length[species_tree$edge[,2]==b_number]

					# change new number to that node and update the while_loop object to the node
					b_number <- species_tree$edge[species_tree$edge[,2]==b_number,1]
					while_loop <- b_number
				}
				# add the MRCA to the nodes_needed object
				group_edge_lengths <- c(group_edge_lengths, edge_lengths[[b]])
			}

			# calc the mean of the group edge lengths
			group_edge_lengths <- mean(group_edge_lengths)
			# add to vector
			host_distances <- c(host_distances, group_edge_lengths)
		}

		# calculate for the blochmannia tree
		# calculate MRCA of entire group
		total_mrca <- getMRCA(a_rep, tip = group_of_interest)
		# calculate length of edges to reach common ancestor for each individual in group
		# and then average
		edge_lengths <- list()
		group_edge_lengths <- c()
		for(b in 1:length(group_of_interest)) {
			# set edge length as zero to add to
			edge_lengths[[b]] <- 0
			# what is the number of this individual?
			b_number <- match(group_of_interest[b], a_rep$tip.label)

			# loop throup edge table until reaching MRCA
			while_loop <- 0
			while(while_loop != total_mrca) {
				# add edge length
				edge_lengths[[b]] <- edge_lengths[[b]] + a_rep$edge.length[a_rep$edge[,2]==b_number]

				# change new number to that node and update the while_loop object to the node
				b_number <- a_rep$edge[a_rep$edge[,2]==b_number,1]
				while_loop <- b_number
			}
			# add the MRCA to the nodes_needed object
			group_edge_lengths <- c(group_edge_lengths, edge_lengths[[b]])
		}

		# calc the mean of the group edge lengths
		group_edge_lengths <- mean(group_edge_lengths)
		# add to vector
		tree_distances <- c(tree_distances, group_edge_lengths)
	}
	output <- rbind(output, tree_distances)
}

# mean blochmannia edge lengths / host phylogeny edge lengths
output[,1] <- output[,1] / host_distances[1]
output[,2] <- output[,2] / host_distances[2]
output[,3] <- output[,3] / host_distances[3]

# add all outputs into a data frame
output2 <- data.frame(gene_number = as.numeric(sapply(strsplit(tree_names, "_"), "[[", 1)), gene_name = as.character(sapply(strsplit(tree_names, "-"), "[[", 2)), kf94 = kf94, bloch_tanaemyrmex_edge_length = output[,1], bloch_camponotus_edge_length = output[,2], edge_length = output[,3])

# write output
write.table(output2, file="blochmannia_tree_characteristics.txt", sep="\t", quote=F, row.names=F, col.names=T)

# read in output
x <- read.table("blochmannia_tree_characteristics.txt", stringsAsFactors=F, header=T)
# order by gene number
x <- x[order(x[,1]),]
# get absolute rate estimates from Camponotus molecular evolution rate
summary(x$edge_length) * 1.983877e-09

# read in outgroup annotations
flor <- read.table("BX248583_floridanus_annotations.tsv", stringsAsFactors=F, header=T, fill=T, row.names=NULL)
# keep only annotations that are for "CDS"
flor <- flor[flor[,2] == "CDS",]
# sort
flor <- flor[order(as.numeric(flor[,4])),]
# redo row names
rownames(flor) <- seq(from=1, to=nrow(flor), by=1)

# check that gene IDs in object x match those in the floridanus annotations
test <- c()
for(a in 1:nrow(x)) {
	if(x[a,2] == flor[x[a,1],1]) {
		test <- c(test, TRUE)
	} else {
		print(a)
		test <- c(test, FALSE)
	}
}

# if the above test matched everything, continue

# extract locations for each gene (outgroup genome coordinates)
coords <- c()
for(a in 1:nrow(x)) {
	coords <- c(coords, (as.numeric(flor[x[a,1],5]) + as.numeric(flor[x[a,1],4])) / 2)
}
# add to table
x <- cbind(x[,1:2], coords, x[,3:6])

### read in alignments to obtain sequence identity for each gene in the ingroup (excluding indels)
x_files <- list.files("bloch_fasta_trees", pattern="*_aligned_trimmed.fasta$", full.names=T)
x_files_numbers <- as.numeric(sapply(strsplit(x_files, "_"), "[[", 5))

# percent identity for ingroup for each gene
pid <- list()
for(a in 1:nrow(x)) {
	# read in fasta alignment
	a_name <- x_files[match(x[a,1], x_files_numbers)]
	a_rep <- read.fasta(a_name)
	# remove outgroups
	a_rep <- a_rep[2:17]
	# pid
	pid_rep <- list()
	for(b in 1:length(a_rep[[1]])) {
		if(length(unique(as.character(lapply(a_rep, "[[", b)))) == 1) {
			pid_rep[[b]] <- 1
		} else {
			pid_rep[[b]] <- 0
		}
	}
	pid[[a]] <- sum(unlist(pid_rep)) / length(a_rep[[1]])
}
PID <- unlist(pid)
# add to data frame
x <- cbind(x, PID)

# percent identity for tanaemyrmex for each gene
pid <- list()
for(a in 1:nrow(x)) {
	# read in fasta alignment
	a_name <- x_files[match(x[a,1], x_files_numbers)]
	a_rep <- read.fasta(a_name)
	# keep only tanaemyrmex
	a_rep <- a_rep[names(a_rep) %in% groups[[1]]]
	# pid
	pid_rep <- list()
	for(b in 1:length(a_rep[[1]])) {
		if(length(unique(as.character(lapply(a_rep, "[[", b)))) == 1) {
			pid_rep[[b]] <- 1
		} else {
			pid_rep[[b]] <- 0
		}
	}
	pid[[a]] <- sum(unlist(pid_rep)) / length(a_rep[[1]])
}
PID_tanaemyrmex <- unlist(pid)
# add to data frame
x <- cbind(x, PID_tanaemyrmex)

# percent identity for camponotus for each gene
pid <- list()
for(a in 1:nrow(x)) {
	# read in fasta alignment
	a_name <- x_files[match(x[a,1], x_files_numbers)]
	a_rep <- read.fasta(a_name)
	# keep only camponotus
	a_rep <- a_rep[names(a_rep) %in% groups[[2]]]
	# pid
	pid_rep <- list()
	for(b in 1:length(a_rep[[1]])) {
		if(length(unique(as.character(lapply(a_rep, "[[", b)))) == 1) {
			pid_rep[[b]] <- 1
		} else {
			pid_rep[[b]] <- 0
		}
	}
	pid[[a]] <- sum(unlist(pid_rep)) / length(a_rep[[1]])
}
PID_camponotus <- unlist(pid)
# add to data frame
x <- cbind(x, PID_camponotus)

# write table output
write.table(x, file="blochmannia_tree_characteristics2.txt", sep="\t", quote=F, row.names=F, col.names=T)

# 20kbp means for each stat
window_coords <- seq(from=0, to=700000, by=20000)
for(a in 1:length(window_coords)) {
	# skip the last row
	if(a != length(window_coords)) {
		a_start <- window_coords[a]
		a_end <- window_coords[a+1]
		a_middle <- mean(c(window_coords[a+1], window_coords[a]))
		a_rep <- x[x$coords >= a_start & x$coords <= a_end,]
		a_rep <- c(a_middle, apply(a_rep[,4:ncol(a_rep)], 2, mean))
		if(a == 1) {
			x_windows <- a_rep
		} else {
			x_windows <- rbind(x_windows, a_rep)
		}
	}
}
x_windows <- as.data.frame(x_windows)

#plot
par(mar=c(2,5,1,1))
par(mfrow=c(3,1))
plot(x$coords, x$kf94, pch=19, cex=0.3, xaxt="n", xlab="", col="gray70", ylab="KF94 Distance")
lines(x_windows$V1, x_windows$kf94, lty=2, lwd=2)
plot(x$coords, x$bloch_tanaemyrmex_edge_length, pch=19, cex=0.3, ylim=c(0,50), xaxt="n", xlab="", col="lightblue", ylab="Relative Evolution Rate")
points(x$coords, x$bloch_camponotus_edge_length, pch=19, cex=0.3, col="lightcoral")
points(x$coords, x$edge_length, pch=19, cex=0.3, col="gray70")
lines(x_windows$V1, x_windows$bloch_tanaemyrmex_edge_length, col="navyblue", lwd=2)
lines(x_windows$V1, x_windows$bloch_camponotus_edge_length, col="red3", lwd=2)
lines(x_windows$V1, x_windows$edge_length, lty=2, lwd=2)
plot(x$coords, x$PID_tanaemyrmex*100, pch=19, cex=0.3, col="lightblue", ylim=c(60, 100), ylab="Gene % Identity")
points(x$coords, x$PID_camponotus*100, pch=19, cex=0.3, col="lightcoral")
points(x$coords, x$PID*100, pch=19, cex=0.3, col="gray70")
lines(x_windows$V1, x_windows$PID_tanaemyrmex*100, col="navyblue", lwd=2)
lines(x_windows$V1, x_windows$PID_camponotus*100, col="red3", lwd=2)
lines(x_windows$V1, x_windows$PID*100, lty=2, lwd=2)


#library(ggplot2)
library(data.table)
library(BiocParallel)
library(limma)
library(edgeR)
library(variancePartition)
library(dplyr)
library(Matrix)
library(cowplot)

pdf(file = "figures.pdf") # The height of the plot in inches

metadata = read.csv('[PATH]/metadata.csv', row.names = 1)

geneExpr = lapply( unique(metadata$celltype), function(ct){
        fn = paste0('[PATH]/knn_diff/gene_10k/gene_expression_smoothed_k30_d50_', ct, '.rds')
        mat = readRDS(fn)
        mat
    })
geneExpr = do.call(rbind, geneExpr)

id2bc = rownames(geneExpr)
geneExpr = as.matrix(geneExpr)

metadata = metadata[id2bc, ]
metadata$is_covid = factor(metadata$is_covid)
metadata$subject_id = factor(metadata$subject_id)
metadata$tissue = factor(metadata$tissue)
metadata$pid = factor(metadata$pid)
metadata$celltype = factor(metadata$celltype)
metadata$Biosample = factor(with(metadata, paste(subject_id, pid, tissue)))
metadata$aggr_unit = factor(with(metadata, paste(subject_id, pid, tissue_id,  celltype))) # tissue_id
metadata$ID = factor(with(metadata, paste(subject_id, pid, tissue, celltype)))

aggregate_counts = function( geneExpr, metadata){
  # aggrecate gene counts
  geneCounts = lapply( levels(metadata$aggr_unit), function(id){
      idx = which(metadata$aggr_unit == id)
      colSums(geneExpr[idx,,drop=FALSE])
    })
  geneCounts = do.call(cbind, geneCounts)
  colnames(geneCounts) = levels(metadata$aggr_unit)
  # simplify metadata
  md2 = lapply( levels(metadata$aggr_unit), function(id){
      unique(metadata[metadata$aggr_unit == id,c("subject_id", "Biosample", "clinical",
                                                 "is_covid", "pid", "tissue", "celltype")])
  })
  md2 = do.call(rbind, md2)
  list( geneCounts  = geneCounts,
        metadata    = md2)
}

res = aggregate_counts(geneExpr, metadata)
dge = DGEList( res$geneCounts, samples=res$metadata )
dge = calcNormFactors(dge)

form = ~ (1|tissue) + (1|celltype) + (1|subject_id)
vobj = voomWithDreamWeights(dge, form, dge$samples, plot=TRUE, BPPARAM=SnowParam(24, progressbar=TRUE))
saveRDS(vobj, 'voom_obj.rds')

```
########################## ## variancePartition ##########################
## variancePartition
form = ~ (1|tissue) + (1|celltype) + (1|is_covid) + (1|subject_id) + (1|pid)
vp = fitExtractVarPartModel(vobj, form, dge$samples, BPPARAM=SnowParam(24, progressbar=TRUE))
plotVarPart( sortCols(vp) )

## within cell type
#{r vp.aggregate.within}
vpList = lapply( levels(dge$samples$celltype), function(CT){
  idx = which(dge$samples$celltype == CT)
  form = ~ (1|is_covid) + (1|tissue) + (1|subject_id)

  fitExtractVarPartModel(vobj[,idx], form, dge$samples[idx,],BPPARAM=SnowParam(6, progressbar=TRUE))
})
names(vpList) = levels(dge$samples$celltype)

#{r plot.vp.CT.summary.agg, fig.width=8, fig.height=20}
figList = lapply( names(vpList), function(ID){
  plotVarPart( vpList[[ID]] ) + ggtitle(ID)
  })
pdf('var_par_celltype.pdf')
plot_grid(plotlist=figList[1:6], ncol=3)
plot_grid(plotlist=figList[7:12], ncol=3)
plot_grid(plotlist=figList[13:15], ncol=3)

########################## ## variancePartition ##########################

## dream
fitList = lapply( levels(dge$samples$celltype), function(CT){
  idx = which(dge$samples$celltype == CT)
  form = ~ 0 + is_covid:tissue + (1|tissue) + (1|subject_id)

  L1  = getContrast(vobj[,idx], form, dge$samples[idx,],
    c("is_covid1:tissuePFC",'is_covid0:tissuePFC'))
  L2  = getContrast(vobj[,idx], form, dge$samples[idx,],
    c("is_covid1:tissuemedulla",'is_covid0:tissuemedulla'))
  L3  = getContrast(vobj[,idx], form, dge$samples[idx,],
    c("is_covid1:tissuechoroidplexus",'is_covid0:tissuechoroidplexus'))
  L = data.frame(PFC = L1, medulla = L2, choroidplexus = L3)
  fit = dream(vobj[,idx], form, dge$samples[idx,], L = L, BPPARAM=SnowParam(24, progressbar=TRUE))
  fit
})
names(fitList) = levels(dge$samples$celltype)

resTab = lapply( names(fitList), function(CT){
  fit = fitList[[CT]]
  tabList = lapply( colnames(coef(fit))[1:3], function(tissue){
    tab = topTable(fit, coef=tissue, number=Inf)

    data.frame( Gene      = rownames(tab),
                Tissue    = tissue,
                CellType  = CT,
                logFC     = tab$logFC,
                P.Value   = tab$P.Value,
                z.std     = tab$z.std)
  })
  do.call(rbind, tabList)
})
resTab = data.table(do.call(rbind, resTab))
write.csv(resTab, 'dream_degs.csv', row.names = F)

countUP  = resTab[,data.frame(nDE = sum((p.adjust(P.Value, 'fdr')  < 0.05) & (logFC > 0))), by=c('Tissue', 'CellType')]
countDN  = resTab[,data.frame(nDE = sum((p.adjust(P.Value, 'fdr')  < 0.05) & (logFC < 0))), by=c('Tissue', 'CellType')]
countDE = data.frame(CellType = countUP$CellType, Tissue = countUP$Tissue, UP = countUP$nDE, DOWN=countDN$nDE)

## plot DEs ##
ymax = max(countUP$nDE)*1.05
ggplot(countUP, aes(CellType, nDE, fill=Tissue)) + geom_bar(stat="identity", position = "dodge") + theme_bw() + theme(aspect.ratio=2, plot.title = element_text(hjust = 0.5)) + ggtitle("Number of UP DE genes") + coord_flip() + scale_y_continuous(expand=c(0,0), limits=c(0, ymax))

ymax = max(countDN$nDE)*1.05
ggplot(countDN, aes(CellType, nDE, fill=Tissue)) + geom_bar(stat="identity", position = "dodge") + theme_bw() + theme(aspect.ratio=2, plot.title = element_text(hjust = 0.5)) + ggtitle("Number of UP DE genes") + coord_flip() + scale_y_continuous(expand=c(0,0), limits=c(0, ymax))

## plot DEs ##
dev.off()


# Title: retrieveAnalyzeAlert.r
# Objective: gather data, analyze, and alert to points of interest
# Created by: NR
# Additional editors:

########################################################################
# Preamble
########################################################################

# Set options
options(stringsAsFactors=F)

# Script parameters
block <- 250 # target for each investment size while cash to invest is 'small'

# libraries
library(lattice)
library(quantmod)
library(optparse)

# Structure/document how arguments are to be passed to this script
option_list = list(
  make_option(c("-w", "--working_directory"), type="character", default=NULL,
              help="Path to the base level of the local repository instance", metavar="character"),
  make_option(c("-s", "--sim_directory"), type="character", default=NULL,
              help="Path to the simulation directory", metavar="character"),
  make_option(c("-p", "--position_file"), type="character", default=NULL,
              help="Path to the simulation directory", metavar="character"),
  make_option(c("--sell_threshold"), type="numeric", default=1,
              help="Path to the simulation directory", metavar="character")
)

opt_parser = OptionParser(option_list=option_list)
opt = parse_args(opt_parser)

working.dir <- opt$working_directory
sim.dir <- file.path(working.dir,opt$sim_directory)
tmp.positions <- file.path(sim.dir,opt$position_file)
tmp.sThreshold <- opt$sell_threshold
setwd(working.dir)
getwd()

# Source common Fns
source('tickerFns.r')
source("tactFns.r")

# Identify known stocks of interest
pre.tickers <- read.csv(file="activeTickers.csv",header=T) # c("AMZN","GOOG", "MYGN")
tickers <- unique(pre.tickers$ticker)
end <- Sys.time()
begin <- Sys.time()-60*60*24*21

# Retrieve information on known stocks of interest:

# Note, should you desire, you can set different defaults for where ticker info is pulled from:
# setSymbolLookup(QQQ='yahoo',SPY='google') # If run, getSymbols will get QQQ from yahoo and SPY from google

# For when you want to manually pull from a given source w/o using defaults, use the src arg:
# Current ‘src’ methods available are: yahoo, google, MySQL, FRED, csv, RData, oanda, and av.

tmp.summ <- benchmark(tickers=tickers, from=begin,to=end)

# Import data on positions
simPos <- read.csv(file=tmp.positions,header=T)

# Pull current quotes

tmp.id <- identify(tickers=tickers, position=simPos, baseline=tmp.summ$baseline, tactAcqFn=tactAcq01, tactTurnFn=tactTurn01, sThreshold=tmp.sThreshold)

tmp.acq <- proposeAcq(position=simPos, eval=tmp.id$flagged.acq, block.size=250)

# Look for price decreases on low volume days.

tmp.id2 <- identify(tickers=unique(na.omit(tmp.acq$position)), position=tmp.acq, baseline=tmp.summ$baseline, tactAcqFn=tactAcq01, tactTurnFn=tactTurn01, sThreshold=tmp.sThreshold)

tmp.turn <- proposeTurn(position=tmp.acq, flagged=tmp.id2$flagged.turn)

# Repeat the buy operation, then write simPos to file

tmp.id3 <- identify(tickers=unique(na.omit(tmp.turn$position)), position=tmp.turn, baseline=tmp.summ$baseline, tactAcqFn=tactAcq01, tactTurnFn=tactTurn01, sThreshold=tmp.sThreshold)

tmp.acq2 <- proposeAcq(position=tmp.turn, eval=tmp.id3$flagged.acq, block.size=250)

write.csv(x=tmp.acq2, file=tmp.positions,row.names=F)

# Consider backing up simPos occasionally

# Make a fn to take obj's from proposeTurn and proposeAcq and write them to
# simPos

# In the next iteration, have benchmark fn exclude large change days, but collect stats on how often they occur

# Also in next iteration, consider training models for each stock and
# outputing parameters to sep file for trending

# Once we're to this point, run this script regularly so that we can start
# to evaluate simPos as it changes

# Write a separate script to gather stats based on all simPos files to evaluate strategies

# Define low volume as
# Look at decreases > 1 std dev and less than 5% or less than 2 std deviations
# Look at scatter of hi v lows and superpose lineplot of last 5 days
# Avoid holding anything on special event days such as end of quarter

# smod <- lm(Close ~ -1 + ticker + Open, data=summ)
# Plot candidate for purchase against scatter for that ticker, lmline, for
# for all data from yesterday to beginning of window.
# Plot line chart of yesterday to a week previous
# plot todays open on open axis to current quote on close axis

# consider restricting trades for single day movement only
# consider restricting trades for multi-day trends only

# Identify candidate for sell
# Look for increase > threshold

# Make trades

# Monitor trade by strategy/threshold and when net gain becomes neg or successes are less than 60%, retire methods

# LOok at distn of prices on low volume days as opposed to high volume days

# Set up simulation to mock trade at several different thresholds.  Pick threshold for 1-3 trades a day or fewer if more profitable
# Project trades out at assumed frequency close to current frequency, a 10 day, 30 day etc to compare
# Simulate lags in trading and grab prices at those times to anticipate effectiveness of targeted trades
# Because processes tend to regresss to a mean, look at a window for mean that you expect pricess to regress to absent special cause
# getQuote() should give a closer to real-time estimate
# Track the proportion of times trades result in profits
# Track the profit/loss of each trade
# Plot stock price timeline and superpose points on buy and sell dates for visual of how close to local minima/maxima you are

# For positions sold on a stop loss, watch the slope of the position over time to determine when motion is flat-ish for re-making position.


code 'sce_interest'
name '利息收入'
dimensions {
	accbook null
	monthEnd name:'cfDate'
}
dataRequest {
	table 'sceMcf',{
		allDimensions (['accbook','cfDate'])
	}
	fields 'accbook,cfDate,sum(interest) value'
    groupFields 'accbook,cfDate'
	contextParams (['scene','foreignToHome'])
}
derivedHeads{
    accbook ([new Head(name:'净利息收入',aggregate:true,formula:{
        def grids=thisColGrids({parent==null})
        def a=grids.find{it.rowHeadGrid.model?.alType=='A'}
        def l=grids.find{it.rowHeadGrid.model?.alType=='L'}
        if(a && l){
            a-l
         }
    })])
}
dataGrids {
	apply selectRows({children!=null}),{
		formula {sumChildren()}
	}
}


# function to get the most common value in a vector
commonval <- function(x){
  tr = as.data.frame(unclass(rle(sort(x))))[,2:1]
  tr$values[tr$lengths == max(tr$lengths)][1]
}

#' Read Water Level Data
#'
#' Read water level data from Largier Lab Matlab file
#'
#' @param fpath Path to input data.
#' @param quiet Suppress messages during data processing.
#' @return A dataframe with named columns. Additional elements (e.g. note) are
#'   added as attributes.
#'
#' @details Largier Lab Matlab data is typically formatted as a Matlab
#'   structure with multiple equal-length data columns and an optional note.
#'
#' @importFrom R.matlab readMat
#' @export
read_rrewll = function(fpath, quiet = FALSE){
  if(!quiet)
    message("Reading '", fpath, "'")
  # read the file
  mobj = readMat(fpath)
  mobjn = names(mobj)
  if(!quiet)
    message("Found variables: ", paste(mobjn, collapse = ", "))
  ret = vector("list", length = length(mobjn))
  names(ret) = mobjn
  # loop through variables in file
  for(n in mobjn){
    if(!quiet)
      message("Extracting ", n, "...")
    obj = mobj[[n]][,1,1]
    it = sapply(obj, length)
    if(!quiet)
      message("...contains entries: ", paste(names(it), collapse = ", "))
    # coerce to dataframe
    dlength = commonval(it)
    dcols = names(it[it == dlength])
    if(!quiet)
      message("...data columns are: ", paste(dcols, collapse = ", "))
    dlist = lapply(obj[dcols], as.vector)
    dobj = as.data.frame(dlist)
    # add attributes
    if(all(names(it) %in% dcols)){
      if(!quiet)
        message("...no additional attributes")
    } else{
    acols = names(obj[!(names(obj) %in% dcols)])
      if(!quiet)
        message("...attributes are: ", paste(acols, collapse = ", "))
      for(acol in acols)
        attr(dobj, acol) <- obj[[acol]]
    }
    ret[[n]] = dobj
  }
  attr(ret, "sourcefile") = fpath
  if(!quiet){
    message("Output list contains: ", paste("'", names(ret), "'",
      sep = "", collapse = ", "))
    message("Attribute 'sourcefile' is ", '"', attr(ret, "sourcefile"), '"')
    message("DONE")
  }
  return(ret)
}

#' Read CTD Data
#'
#' Read CTD transect data from Largier Lab Matlab file.
#'
#' @param fpath Path to input data.
#' @param quiet Suppress messages during data processing.
#' @param distcol Column name containing distance upstream for each cast
#'   location.
#' @param surfdistcol Column name containing water surface elevation for each
#'   cast location.
#' @return A dataframe with named columns. Additional elements (e.g. note) are
#'   added as attributes.
#'
#' @details Largier Lab Matlab data is typically formatted as a Matlab
#'   structure with multiple equal-length data columns and two columns
#'   'surfdist' and 'surfelev' with surface information for each cast location.
#'   'Surfdist' and 'surfelev' are used to populate an expanded 'surfelev'
#'   column corresponding to data column 'elev'.
#'
#' @importFrom R.matlab readMat
#' @export
read_rrectd = function(fpath, quiet = FALSE, distcol = "dist",
  surfdistcol = "surfdist"){
  if(!quiet)
  message("Reading '", fpath, "'")
  mobj = readMat(fpath)
  mobjn = names(mobj)
  if(!quiet)
    message("Found variables: ", paste(mobjn, collapse = ", "))
  ret = vector("list", length = length(mobjn))
  names(ret) = mobjn
  # loop through variables in file
  for(n in mobjn){
    if(!quiet)
      message("Extracting ", n, "...")
    obj = mobj[[n]][,1,1]
    it = sapply(obj, length)
    if(!quiet)
      message("...contains entries: ", paste(names(it), collapse = ", "))
    # coerce to dataframe
    dlength = commonval(it)
    dcols = names(it[it == dlength])
    if(!quiet)
      message("...data columns are: ", paste(dcols, collapse = ", "))
    dlist = lapply(obj[dcols], as.vector)
    dobj = as.data.frame(dlist)
    # add location data
    llength = it[[surfdistcol]]
    lcols = names(it[it == llength])
    if(!quiet)
      message("...location columns are: ", paste(lcols, collapse = ", "))
    lobj = lapply(obj[lcols], as.vector)
    dobj[lcols[lcols != surfdistcol]] = NA
    if(!quiet)
      message("...pairing: ", paste(distcol, surfdistcol, sep = " <=> "))
    for(i in seq(length(lobj[[surfdistcol]]))){
      for(lcol in lcols[lcols != surfdistcol])
        dobj[which(dobj[[distcol]] == lobj[[surfdistcol]][i]),
             lcol] = lobj[[lcol]][i]
    }
    # add attributes
    if(all(names(it) %in% c(dcols, lcols))){
      if(!quiet)
        message("...no additional attributes")
    } else{
      acols = names(it)[!(names(it) %in% c(dcols, lcols))]
      if(!quiet)
        message("...attributes are: ", paste(acols, collapse = ", "))
      for(acol in acols)
        attr(dobj, acol) <- obj[[acol]]
    }
    ret[[n]] = dobj
  }
  attr(ret, "sourcefile") = fpath
  if(!quiet){
    message("Output list contains: ", paste("'", names(ret), "'",
      sep = "", collapse = ", "))
    message("Attribute 'sourcefile' is ", '"', attr(ret, "sourcefile"), '"')
    message("DONE")
  }
  return(ret)
}

#' Read interpolated CTD grid
#'
#' Read interpolated grid of CTD data from Largier Lab Matlab file.
#'
#' @param fpath Path to input data.
#' @param quiet Suppress messages during data processing.
#' @return A dataframe with named columns. Additional elements (e.g. note) are
#'   added as attributes.
#'
#' @details Largier Lab Matlab data is typically formatted as a Matlab
#'   structure with multiple equal-size matrices.
#'
#' @importFrom R.matlab readMat
#' @export
read_rrectdgrid = function(fpath, quiet = FALSE){
  if(!quiet)
  message("Reading '", fpath, "'")
  mobj = readMat(fpath)
  mobjn = names(mobj)
  if(!quiet)
    message("Found variables: ", paste(mobjn, collapse = ", "))
  ret = vector("list", length = length(mobjn))
  names(ret) = mobjn
  # loop through variables in file
  for(n in mobjn){
    if(!quiet)
      message("Extracting ", n, "...")
    obj = mobj[[n]][,1,1]
    it = sapply(obj, length)
    if(!quiet)
      message("...contains entries: ", paste(names(it), collapse = ", "))
    # coerce to dataframe
    dlength = max(unique(it))
    dcols = names(it[it == dlength])
    if(!quiet)
      message("...data columns are: ", paste(dcols, collapse = ", "))
    dlist = lapply(obj[dcols], as.vector)
    dobj = as.data.frame(dlist)
    # add attributes
    if(all(names(it) %in% dcols)){
      if(!quiet)
        message("...no additional attributes")
    } else{
      acols = names(it)[!(names(it) %in% dcols)]
      if(!quiet)
        message("...attributes are: ", paste(acols, collapse = ", "))
      for(acol in acols)
        attr(dobj, acol) <- obj[[acol]]
    }
    ret[[n]] = dobj
  }
  attr(ret, "sourcefile") = fpath
  if(!quiet){
    message("Output list contains: ", paste("'", names(ret), "'",
      sep = "", collapse = ", "))
    message("Attribute 'sourcefile' is ", '"', attr(ret, "sourcefile"), '"')
    message("DONE")
  }
  return(ret)
}

#' Download NOAA tide data
#'
#' Download data from NOAA Tides & Currents web API.
#'
#' @param f Destination file.
#' @param begin_date Character or integer start date of date request in format
#'   YYYYMMDD.
#' @param end_date Character or integer end date of date request in format
#'   YYYYMMDD. must be no more than 365 days later than \code{start_date}.
#' @param product Data product, default is hourly ocean water height.
#' @param station Data station to download data from. Default is Point Reyes
#'   Buoy.
#' @param datum Vertical datum that data product is references to. Default
#'   is mean lower low water (MLLW).
#' @param units units used for data product. Default is metric units.
#' @param time_zone Time zone used in data product. Default is GMT.
#' @param ... Other arguments to pass to \code{download.file()}.
#' @return The destination file path.
#'
#' @details The NOAA Tides & Currents web API limits data requests to 365 days
#'   or less.
#'
#' @export
download_tides = function(f = tempfile(), begin_date, end_date,
  product = "hourly_height", station = "9415020", datum = "MLLW",
  units = "metric", time_zone = "GMT", ...){
  if(as.Date(paste(end_date), format = "%Y%m%d") -
    as.Date(paste(begin_date), format = "%Y%m%d") > 365)
    stop("'begin_date' and 'end_date' must be less than 365 days apart.")
  noaaurl = paste0("http://tidesandcurrents.noaa.gov/api/datagetter?product=",
    product, "&application=NOS.COOPS.TAC.WL&station=", station, "&begin_date=",
    begin_date, "&end_date=", end_date, "&datum=", datum, "&units=", units,
    "&time_zone=", time_zone,"&format=csv")
  download.file(noaaurl, f, ...)
  return(f)
}

#' Download USGS streamflow data
#'
#' Download data from USGS web API.
#'
#' @param f Destination file.
#' @param begin_date Character start date of date request in format
#'   "YYYY-MM-DD".
#' @param end_date Character end date of date request in format
#'   "YYYY-MM-DD".
#' @param product Data product, default is streamflow.
#' @param station Data station to download data from. Default is Guerneville.
#'   Austin Creek station is second element of default value.
#' @param ... Other arguments to pass to \code{download.file()}.
#' @return The destination file path.
#'
#' @details The NOAA Tides & Currents web API limits data requests to 365 days
#'   or less.
#'
#' @export
download_streamflow = function(f = tempfile(), begin_date, end_date,
  product = "00060", station = c("11467000","11467200"), ...){
  usgsurl = paste0("http://nwis.waterdata.usgs.gov/usa/nwis/uv/?cb_", product,
    "=on&format=rdb&site_no=", station[1], "&period=&begin_date=", begin_date,
    "&end_date=", end_date)
  download.file(usgsurl, f, ...)
  return(f)
}

#' Read Bathymetry Tables
#'
#' Read and combine the bathymetry tables.
#'
#' @param files A list of files containing bathymetry data. Each file is
#'   expected to have columns \code{OID}, \code{dist}, \code{count},
#'   \code{area}, \code{sum}, and \code{bedelev}.
#' @return A data frame with columns, \code{bedelev}, \code{dist}, \code{area},
#'   \code{count}, and \code{sum}.
#'
#' @export
read_bathymetry_tables = function(files){
  d = do.call(rbind.data.frame, lapply(files, read.csv))
  names(d) = c("OID", "dist", "count", "area", "sum", "bedelev")
  d[c("bedelev", "dist", "area", "count", "sum")]
}


dps = c("tidyverse","dabestr","UpSetR","RColorBrewer","ggbeeswarm","ggpmisc","xtable","foreach","BBmisc","EnvStats")
sapply(dps,function(x){if(!require(x,character.only = T)){install.packages(x);library(x,character.only = T)}else{library(x,character.only = T)}})

## load output file from alignment analyis
### order assemblers for ggplot
res <- read_tsv("results/res_runs_clean.tsv",col_names=c("dataset","assembler","ref_tot","ref_cov","ref_cov_frac","qry_tot","qry_cov","qry_cov_frac","contig_num")) %>% replace(is.na(.), 0)

## simulated data
res_sim  <- read_tsv("results/res_sim_clean.tsv",col_names=c("dataset","assembler","ref_tot","ref_cov","ref_cov_frac","qry_tot","qry_cov","qry_cov_frac","contig_num"))

res_novel <- read_tsv("res_novel.tsv",col_names=c("dataset","assembler","ref_tot","ref_cov","ref_cov_frac","qry_tot","qry_cov","qry_cov_frac","contig_num"))

## calculate the score for each assembly for real data
out_tibble <- res %>% mutate(rep_res = exp(-abs(log(qry_cov/ref_cov)))) %>%
    mutate(score =  (1 - ((abs(1-ref_cov_frac)/4) + (abs(1-qry_cov_frac)/4) + (abs(1-rep_res)/4) + (abs(1-(1/contig_num))/4)))*100) %>% replace(is.na(.), 0)

ds_o = out_tibble %>% distinct(dataset)  %>% pull
ass_o = out_tibble %>% distinct(assembler)  %>% pull

dummy_o = foreach(i = ds_o,.combine="rbind") %do% {
    foreach(j = ass_o,.combine="rbind") %do% {
         c(i,j,NA)
    } } %>% setColNames(c("dataset","assembler","score"))

out_tibble = right_join(out_tibble,as.tibble(dummy_o),by = c("dataset","assembler")) %>%
    mutate(score = score.x)

## order the assemblers for ggplot
out_tibble$assembler_f <- factor(out_tibble$assembler, levels=c("CAP","CE","Fast-Plast","GetOrganelle","IOGA","NOVOPlasty","org.ASM"))

## calculate the score for each assembly for simulated  data
out_tibble_sim <- res_sim %>% mutate(rep_res = exp(-abs(log(qry_cov/ref_cov)))) %>%
    mutate(score =  (1 - ((abs(1-ref_cov_frac)/4) + (abs(1-qry_cov_frac)/4) + (abs(1-rep_res)/4) + (abs(1-(1/contig_num))/4)))*100)

ds = out_tibble_sim %>% distinct(dataset)  %>% pull
ds = unique(c(ds, "sim_250bp.0-1.2M", "sim_150bp.0-1.2M"))
ass = out_tibble_sim %>% distinct(assembler)  %>% pull

dummy = foreach(i = ds,.combine="rbind") %do% {
    foreach(j = ass,.combine="rbind") %do% {
         c(i,j,NA)
} } %>% setColNames(c("dataset","assembler","score"))

out_tibble_sim = right_join(out_tibble_sim,as.tibble(dummy),by = c("dataset","assembler")) %>%
    mutate(score = score.x)

## order the assemblers for ggplot
out_tibble_sim$assembler_f <- factor(out_tibble_sim$assembler,
                                 levels=c("CAP","CE","Fast-Plast","GetOrganelle","IOGA","NOVOPlasty","org.ASM"))

## select colour pallette for plots
my_col=brewer.pal(7,"Set2")

split_tab =  out_tibble_sim %>% pull(dataset) %>% strsplit("_") %>% lapply("[[",2)  %>% unlist  %>% strsplit("[.]")  %>% do.call(what="rbind")

sim_p <- out_tibble_sim %>% add_column(read_len = split_tab[,1]) %>%
    add_column(ratio = split_tab[,2]) %>%
    add_column(n_reads = split_tab[,3]) %>%
    mutate(n_reads = str_replace_all(n_reads,"150bp","full")) %>% mutate(n_reads= str_replace_all(n_reads,"250bp","full"))

## create the tile plot for simulated data
sim_p %>% ggplot(aes(x=assembler,y=dataset,fill=score)) + geom_tile() + theme_bw()+
    scale_fill_continuous(low = my_col[2] ,high = my_col[1]) +
    theme(axis.title.y = element_blank(),axis.title.x=element_blank(),text = element_text(size=15)) +facet_grid(n_reads ~ read_len)

sim_p %>% ggplot(aes(x=assembler,y=ratio,fill=score)) + geom_tile() + theme_bw()+
    scale_fill_continuous(low = my_col[2] ,high = my_col[1]) +
    theme(axis.title.y = element_blank(),axis.title.x=element_blank(),text = element_text(size=15)) +facet_grid(n_reads ~ read_len)
ggsave("plots/sim_tiles.pdf")

## swarm plot for real datasets
out_tibble %>% replace(is.na(.), 0) %>%  ggplot(aes(y=score,x=assembler_f,color=assembler_f)) +
    geom_quasirandom(size=1.9 ) + theme_bw()  + scale_color_manual(values=my_col) +
    geom_boxplot(notch=F,alpha=0.3,width=0.2,color="black",fill="#c0c0c0",outlier.shape=NA) +
    theme(axis.title.x = element_blank(),text = element_text(size=15), legend.title=element_blank())
ggsave("plots/swarm.pdf")

### count the number of runs with output
n_obs = paste0("n=", out_tibble %>% drop_na %>% group_by(assembler) %>%  tally() %>% select(n) %>% unlist)
n_obs

## create upsetplot
pdf("plots/upset.pdf")
UL  = out_tibble %>% filter(score>99)  %>% select(dataset,assembler) %>% split(.$assembler) %>% lapply("[[",1)
upset(fromList(UL), order.by = "freq",sets.bar.color=my_col[c(4,3,6,7,2)],
      point.size=5,matrix.color = my_col[3],
      shade.alpha = 0.5, text.scale = 1.5,nsets = 7)

dev.off()

## plot resources meassures
## load log file
run_log <- read_tsv("results/log_clean.tsv")

## convert bytes to GB in log file

run_log[,14:15] <- run_log[,14:15]  / 10^9

run_log_mem <- run_log %>%  filter(exit_code==0) %>%
    gather(key="usage",value="mag", cpu_usage_percent, peak_cpu_usage_percent, peak_memory_bytes,peak_disk_usage_bytes)
run_log_mem$amount_f <- factor(run_log_mem$amount, levels=c("25K","250K","2.5M"))

run_log_mem %>% group_by(program) %>% summarize(bla=mean(run_time_sec))

## plot boxplots for computataion times
run_log_mem %>% filter(exit_code==0) %>%
    ggplot(aes(y=run_time_sec,x=as.factor(program), fill=as.factor(threads))) +
    geom_boxplot() +
    theme_bw() + scale_fill_manual(values=my_col) +
    theme(text = element_text(size=15),legend.position = c(0.65,0.3)) +
    guides(fill=guide_legend(title="Number of threads")) +
    xlab("Assembler") + ylab("Run time (s)") + facet_wrap(amount_f~.,ncol=2) +
    scale_y_log10()

ggsave("plots/comp_time_log.pdf")

##plot memory and cpu usage
## convert tibble to long format for ggplot

##rename usage parameters in tibble for ggplot
new_usages = c("CPU usage (%)" , "Peak CPU usage (%)"," Peak memory (GB)", "Peak disk usage (GB)")
unique(run_log_mem$usage)
for( i in 1:4){
    run_log_mem$usage[run_log_mem$usage == unique(run_log_mem$usage)[i]] <-  new_usages[i]
}

## adjust order of input data size

## plot disk and memeory usage vs number of threads
run_log_mem %>% ggplot(aes(y=mag,x=as.factor(threads), fill=program)) + geom_boxplot()  + theme_bw() +
    scale_fill_manual(values=my_col) + facet_grid(usage~. ,scales = "free_y")  + scale_color_manual(values=my_col) +
    theme(text = element_text(size=15), legend.title=element_blank(),axis.title.y=element_blank()) +
    xlab("Number of threads") + scale_y_log10()
ggsave("plots/cpu_mem_disk_usage.pdf")

## plot disk usage and memory vs input size and number of threads
run_log_mem %>%   ggplot(aes(y=mag,x=as.factor(threads), fill=program)) + geom_boxplot()  +
    theme_bw() +scale_fill_manual(values=my_col) + facet_grid(usage~amount_f ,scales = "free_y")  +
    scale_color_manual(values=my_col) +
    theme(text = element_text(size=15), legend.title=element_blank(),axis.title.y=element_blank()) +
    xlab("Number of threads") + scale_y_log10()
ggsave("plots/usage_amount_threads.pdf")

### Analyze re runs

res_re  <- read_tsv("results/res_reruns_clean.tsv",
                    col_names=c("dataset","assembler","ref_tot","ref_cov",
                                "ref_cov_frac","qry_tot","qry_cov","qry_cov_frac","contig_num")) %>%
    replace(is.na(.), 0)

out_tibble_re <- res_re %>% mutate(rep_res = exp(-abs(log(qry_cov/ref_cov)))) %>%
    mutate(score =  (1 - ((abs(1-ref_cov_frac)/4) +
                          (abs(1-qry_cov_frac)/4) +
                          (abs(1-rep_res)/4) +
                          (abs(1-(1/contig_num))/4)))*100) %>% replace(is.na(.), 0)

## order the assemblers for ggplot
out_tibble_re$assembler_f <- factor(out_tibble_re$assembler,
                                    levels=c("CAP","CE","Fast-Plast",
                                             "GetOrganelle","IOGA","NOVOPlasty","org.ASM"))

full_join(select(out_tibble,dataset,assembler,score1=score),select(out_tibble,dataset,assembler,score2=score))

##filter out_tibble with re run datasets

out_re <- out_tibble[paste0(unlist(out_tibble[,1]),unlist(out_tibble[,2])) %in%
                     paste0(unlist(out_tibble_re[,1]),unlist(out_tibble_re[,2])),]

out_re2 <- out_tibble_re[paste0(unlist(out_tibble_re[,1]),unlist(out_tibble_re[,2])) %in%
                         paste0(unlist(out_re[,1]),unlist(out_re[,2])),]

out_j <- out_re %>% add_column(score_rerun=out_re2$score)
out_j <- out_j %>%   replace(is.na(.), 0)

full_join(select(out_tibble,dataset,assembler,score=score),
          select(out_tibble_re,dataset,assembler,score_rerun=score)) %>% replace(is.na(.),0) %>%
    ggplot(aes(x=score,y=score_rerun,col=assembler)) +
#out_j %>%  ggplot(aes(x=score,y=score_rerun,col=assembler)) +
    geom_jitter(width=0.1,height = 0.1)  + theme_bw() +
    facet_wrap(~assembler,ncol=3) +
    stat_poly_eq(formula = x ~ y,parse=T) +
    guides(col=guide_legend(ncol=2)) +
    theme(legend.title = element_blank(),
          legend.position = c(0.5,0.2),
          text=element_text(size=15)) +
    xlab("Score 1. run ") + ylab("Score 2. run")

ggsave("plots/repro.pdf")

score_summary <- out_tibble %>% drop_na(score) %>%
    select(assembler, score) %>% group_by(assembler) %>%
    summarize(Median=median(score), IQR = iqr((score)), N_perfect = length(which(score > 99)),
              N_tot = length(score))

xtable(score_summary)

out_tibble_sim %>% select(assembler,score,dataset) %>% spread(assembler,score)  %>% xtable

sra <- read.delim("SRA/my_accs",header =F )
re_run <- read.delim("re_runs.txt",header =F )

sra_re <- sra %>% add_column("Re-eval" =
            foreach(i = 1:nrow(sra),.combine = "c") %do%
            ifelse(sra[i,1] %in% re_run[,1], "Yes","NO"))

print.xtable(sra_re %>% xtable,file="sets_re_runs.tex",type="latex")

colnames(sra_re)[1] <- "data set"

write.csv(sra_re,"sets_re_runs.csv")


allmtd = list.files('/home/wucheng/imputation/deg/10x_5cl/Method/')
mtd = allmtd[5]
allf = list.files(paste0('/home/wucheng/imputation/deg/10x_5cl/Method/',mtd,'/MAST/'))
#raw = readloom("/home/yuanhao/github_repositories/DISC/reproducibility/data/10X_5CL/imputation/raw_mc_10_mce_1.loom")
#metadata <-as.matrix(read.table("/home/wucheng/imputation/DEG/sc_10x_5cl.metadata.csv",header=T,row.names=1,sep=","))
#ct <-matrix(metadata[,29])[,1]
f=allf[1]
ove <- sapply(allmtd, function(mtd){
  print(mtd)
  t(sapply(allf,function(f) {
    print(f)
    if (file.exists(paste0('/home/wucheng/imputation/deg/10x_5cl/Method/',mtd,'/MAST/',f))){
      res = readRDS(paste0('/home/wucheng/imputation/deg/10x_5cl/Method/',mtd,'/MAST/',f))
      res = res[order(res[,'p_val_adj']),]
      ct1 <- sub('_.*','',f)
      ct2 <- sub('.*_','',sub('_diffgene.rds','',f))
	  raw_res = readRDS(paste0('/home/wucheng/imputation/deg/10x_5cl/Method/',"Raw",'/MAST/',f))
      fc <- sort(abs(as.matrix(raw_res)[,2]),decreasing=T)
      highid1= names(which(fc>quantile(fc,0.9)))## express in more cells
	  highid2 = intersect(names(which(fc<quantile(fc,0.9))),names(which(fc>quantile(fc,0.8))))## express in more cells
      highid3 = intersect(names(which(fc>quantile(fc,0.8))),names(which(fc>quantile(fc,0.7))))## express in more cells
      highid4 = intersect(names(which(fc>quantile(fc,0.7))),names(which(fc>quantile(fc,0.6))))## express in more cells
      highid5 = intersect(names(which(fc>quantile(fc,0.6))),names(which(fc>quantile(fc,0.5))))## express in more cells
      highid6 = intersect(names(which(fc>quantile(fc,0.5))),names(which(fc>quantile(fc,0.4))))## express in more cells
      highid7 = intersect(names(which(fc>quantile(fc,0.4))),names(which(fc>quantile(fc,0.3))))## express in more cells
      highid8 = intersect(names(which(fc>quantile(fc,0.3))),names(which(fc>quantile(fc,0.2))))## express in more cells
      highid9 = intersect(names(which(fc>quantile(fc,0.2))),names(which(fc>quantile(fc,0.1))))## express in more cells
      lowid = names(which(fc<quantile(fc,0.1)))## less
      gs = readRDS(paste0('/home/wucheng/imputation/deg/10x_5cl/bulk1/',f))
      tmpres <- res[rownames(res) %in% highid1,]
      tmp1 <- mean(sapply(c(1:10)*10,function(i) {
        mean(rownames(tmpres[1:i,]) %in% gs)  ## discuss
      }))
	  tmpres <- res[rownames(res) %in% highid2,]
      tmp2 <- mean(sapply(c(1:10)*10,function(i) {
        mean(rownames(tmpres[1:i,]) %in% gs)  ## discuss
      }))
      tmpres <- res[rownames(res) %in% highid3,]
      tmp3 <- mean(sapply(c(1:10)*10,function(i) {
        mean(rownames(tmpres[1:i,]) %in% gs)  ## discuss
      }))
      tmpres <- res[rownames(res) %in% highid4,]
      tmp4 <- mean(sapply(c(1:10)*10,function(i) {
        mean(rownames(tmpres[1:i,]) %in% gs)  ## discuss
      }))
      tmpres <- res[rownames(res) %in% highid5,]
      tmp5 <- mean(sapply(c(1:10)*10,function(i) {
        mean(rownames(tmpres[1:i,]) %in% gs)  ## discuss
      }))
      tmpres <- res[rownames(res) %in% highid6,]
      tmp6 <- mean(sapply(c(1:100)*10,function(i) {
        mean(rownames(tmpres[1:i,]) %in% gs)  ## discuss
      }))
      tmpres <- res[rownames(res) %in% highid7,]
      tmp7 <- mean(sapply(c(1:100)*10,function(i) {
        mean(rownames(tmpres[1:i,]) %in% gs)  ## discuss
      }))
      tmpres <- res[rownames(res) %in% highid8,]
      tmp8 <- mean(sapply(c(1:10)*10,function(i) {
        mean(rownames(tmpres[1:i,]) %in% gs)  ## discuss
      }))
	  tmpres <- res[rownames(res) %in% highid9,]
      tmp9 <- mean(sapply(c(1:10)*10,function(i) {
        mean(rownames(tmpres[1:i,]) %in% gs)  ## discuss
      }))
      tmpres <- res[rownames(res) %in% lowid,]
      tmp10 <- mean(sapply(c(1:10)*10,function(i) {
        mean(rownames(tmpres[1:i,]) %in% gs)  ## discuss
      }),na.rm=T)
      c(tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9,tmp10)
    } else {
      return(c(NA,NA,NA,NA,NA,NA,NA,NA,NA,NA))
    }
  }))
}) ## first 10 high, last 10 low
ove_high1 = t(ove[1:10,])
ove_high2 = t(ove[11:20,])
ove_high3 = t(ove[21:30,])
ove_high4 = t(ove[31:40,])
ove_high5 = t(ove[41:50,])
ove_high6 = t(ove[51:60,])
ove_high7 = t(ove[61:70,])
ove_high8 = t(ove[71:80,])
ove_high9 = t(ove[81:90,])
ove_high10 = t(ove[91:100,])
colnames(ove_high1) <- colnames(ove_high2)<-colnames(ove_high3) <- colnames(ove_high4) <-colnames(ove_high5) <- colnames(ove_high6)<-colnames(ove_high7) <- colnames(ove_high8) <-colnames(ove_high9) <- colnames(ove_high10) <- sub('.rds','', allf)
library(reshape2)
high1 <-melt(ove_high1)
high1$V1 <-"top1"
high2 <-melt(ove_high2)
high2$V1 <-"top2"
high3 <-melt(ove_high3)
high3$V1 <-"top3"
high4 <-melt(ove_high4)
high4$V1 <-"top4"
high5 <-melt(ove_high5)
high5$V1 <-"top5"
high6 <-melt(ove_high6)
high6$V1 <-"top6"
high7 <-melt(ove_high7)
high7$V1 <-"top7"
high8 <-melt(ove_high8)
high8$V1 <-"top8"
high9 <-melt(ove_high9)
high9$V1 <-"top9"
high10 <-melt(ove_high10)
high10$V1 <-"top10"
high <-rbind(high1,high2,high3,high4,high5,high6,high7,high8,high9,high10)
saveRDS(high, "/home/wucheng/imputation/deg/10x_5cl/high_low1.5/MAST/high.rds")

high <-readRDS("C:/Users/ADMIN/Desktop/imputation/DEG/high.rds")
index <-which(high[,1]=="Raw")
index1 <-which(high[,1]=="DISC")
high <-high[c(index,index1),]
levels <-c("top1","top2","top3","top4","top5","top6","top7","top8","top9","top10")
dodge <- position_dodge(width = 0.4)
ggplot(high, aes(x=factor(V1,levels=levels), y=value,fill = Var1))  + stat_boxplot(geom="errorbar",width=0.15,position = dodge)+geom_boxplot(width=0.4)+
ylim(0,1)+theme(legend.title=element_blank())+theme(axis.text.x = element_text(size = 12,angle = 45, hjust = 1, vjust = 1, face = "bold"))+
labs(x="foldchange interval", y = "overlap")+theme_classic()+ scale_fill_manual(values = brewer.pal(3,"Set1")[c(1,2)])


palindroi <- function(p) {
  for(i in 1:floor(nchar(p)/2) ) {
    r <- nchar(p) - i + 1
    if ( substr(p, i, i) != substr(p, r, r) ) return(FALSE)
  }
  TRUE
}

executeTask <- function(i) {

	palindroi("saippuakivikauppias")
	return(i)
}

r = 0

for (i in 0:2000000000) {
	r = executeTask(i)
}


  observer.compute.fisheries.exploitation = function(a) {

		## USED ??

    a$dummy= 1
    a$hardness = ifelse(a$durometre>=68, 1, 0)

  # calculate counts of hard and total crab for each trip set

    b = xtabs( as.integer(a$hardness) ~ as.factor(a$tripset) )
    b = as.data.frame(b)
    names(b) = c("tripset", "no.hard")

    c = xtabs( as.integer(a$dummy) ~ as.factor(a$tripset))
    c = as.data.frame(c)
    names(c)= c("tripset", "total")

  # merge two new data frames

    d = merge( x=b, y=c, by="tripset", all.x=F, all.y=T, sort=F )
    d$percenthard = (d$no.hard/d$total)*100
    d$percentsoft = 100 - d$percenthard

  # import catch rate from a

    e = tapply( X=a$kgpertrap, INDEX=a$tripset, FUN=function(q){unique(q)[1]})
    e = as.data.frame(e)
    f = data.frame(kgpertrap=as.vector(e$e), tripset=dimnames(e)[[1]] )
    f$tripset = as.character( f$tripset )

    g=merge(x=d, y=f, by="tripset", all.x=F, all.y=T, sort=F)

  # import latitude from a

    h = tapply(X=a$lat, INDEX= a$tripset, FUN= function(q){unique(q)[1]})
    h = as.data.frame(h)
    i = data.frame(lat=as.vector(h$h), tripset=dimnames(h)[[1]] )
    i$tripset = as.character(i$tripset)

    j = merge(x=g, y=i, by="tripset", all.x=F, all.y=T, sort=F)

  # import longitude from a

    k = tapply(X=a$lon, INDEX= a$tripset, FUN= function(q){unique(q)[1]})
    k = as.data.frame(k)
    l = data.frame(lon=as.vector(k$k), tripset=dimnames(k)[[1]] )
    l$tripset =  as.character(l$tripset)

    m = merge(x=j, y=l, by="tripset", all.x=F, all.y=T, sort=F)

  # import estimated catch from a

    n = tapply(X=a$EST_CATCH, INDEX= a$tripset, FUN= function(q){unique(q)[1]})
    n = as.data.frame(n)
    p = data.frame(EST_CATCH=as.vector(n$n), tripset=dimnames(n)[[1]] )
    p$tripset = as.character(p$tripset)

    q = merge(x=m, y=p, by="tripset", all.x=F, all.y=T, sort=F)

    q$discardkg = (q$EST_CATCH*1000)*(q$percentsoft/100)

  # divide into north, south, and 4X by positions

    source("C:/Scripts/geo.filter.r")
    northdata= q[polygon_inside(q,aegis.polygons::polygon_internal_code("cfanorth")),]
    nens=northdata
    southdata= q[polygon_inside(q,aegis.polygons::polygon_internal_code("cfasouth")),]
    sens=southdata
    cfa23data= q[polygon_inside(q,aegis.polygons::polygon_internal_code("cfa23")),]
    cfa23=cfa23data
    cfa24data= q[polygon_inside(q,aegis.polygons::polygon_internal_code("cfa24")),]
    cfa24=cfa24data
    cfa4xdata= q[polygon_inside(q,aegis.polygons::polygon_internal_code("cfa4x")),]
    cfa4x=cfa4xdata
  }


seq = import('../../seq')
.sys = import('../../sys')

`.seqinfo<-` = function(x, value) {
    idx = unique(as.character(GenomeInfoDb::seqnames(x)))
    x@seqinfo = value[idx]
    if (inherits(x, "GRanges"))
        x@seqnames = droplevels(x@seqnames)
    x
}

#' Run chromstar in univariate mode
#'
#' @param binned_reads  A list of GRanges objects represnting binned reads
#' @param exp_tabl      Experiment table as required by chromstar
#' @param assembly      Character vector describing assembly
#' @return              A list of univariate Chromstar model objects
univ = function(binned_reads, exp_table, assembly) {
    # make sure all binned_reads have the same genome
    sinfo = unique(lapply(binned_reads, seq$info))
    if (length(sinfo) != 1)
        stop("models must all have same seqinfo: ", paste(sinfo, collapse=", "))

    exp_table$ID = sprintf("%s-%s-rep%s", exp_table$mark,
                           exp_table$condition, exp_table$replicate)
    univ = split(exp_table, seq_len(nrow(exp_table)))
    lapply(univ, function(exp) {
        m = chromstaR::callPeaksUnivariate(
            binned.data = binned_reads[[exp$file]],
            input.data = binned_reads[[exp$controlFiles]],
            keep.posteriors = FALSE)
        .seqinfo(m$bins) = sinfo[[1]]
        .seqinfo(m$peaks) = sinfo[[1]]
        m$info = exp
        m
    })
}

.sys$run({
    io = import('../../io')
    import('.', attach=TRUE)

    args = .sys$cmd$parse(
        opt('d', 'directory', 'directory containing source files', '.'),
        opt('s', 'samples', 'file containing sample table', 'SBT003.yaml'),
        opt('o', 'outfile', 'file to save univariate model to', '/dev/null'),
        opt('r', 'readfile', 'file to save reads to', '/dev/null'),
        opt('b', 'beddir', 'dir to save tracks to', '/dev/null'),
        opt('p', 'plotfile', 'file to save plots to', '/dev/null'))

    print(args)

    config = io$read_yaml(args$samples)
    exp_table = parse_spec(config)
    print(exp_table)

    reads = read_files(exp_table, config$assembly)
    if (args$readfile != "/dev/null")
        save(reads, file=args$readfile)
    binned = bin_reads(reads)
    rm(reads)

    univ = univ(binned, exp_table)
    if (args$outfile != "/dev/null")
        save(univ, file=args$outfile)

    if (!is.null(args$beddir)) {
        dir.create(args$beddir)
        for (i in seq_along(univ)) {
            message(i,"/",length(univ))
            try(chromstaR:::exportUnivariateCounts(univ[[i]],
                filename=file.path(args$beddir, names(univ)[i]),
                separate.files=FALSE))
        }
    }

    if (!is.null(args$plotfile)) {
        pdf(args$plotfile)
        message("read count cor")
        print(plot$cor(univ))
        for (i in seq_along(univ)) {
            message(sprintf("univariate fits (%i/%i)", i, length(univ)))
            print(chromstaR::plotHistogram(univ[[i]]))
        }
        dev.off()
    }
})


##Setup
###Packages

library(rmarkdown)
library(NanoStringNorm)

###Data Import
#We will look at our whole dataset: 108 RNA samples from 3 separate periods.

###Raw

setwd("~/Documents/nstringnov17")

gm <- read.csv("gmark.csv")

setwd("~/Documents/nstringnov17/ctg5and6")
ct5and6.raw <- read.markup.RCC()

setwd("~/Documents/nstringnov17/ctg5hi")
ct5and6hi.raw <- read.markup.RCC()

setwd("~/Documents/nstringnov17/ctg7and8")
ct7and8.raw <- read.markup.RCC()

setwd("~/Documents/nstringnov17/ctg7and8hi")
ct7and8hi.raw <- read.markup.RCC()

setwd("~/Documents/nstringnov17/ctg3and4")

ct3and4.raw <- read.markup.RCC()

setwd("~/Documents/nstringnov17/ctg1and2")

ct1and2.raw <- read.markup.RCC()

setwd("~/Documents/nstringnov17/ctg9")

ct9.raw <- read.markup.RCC()

###Normalised fully

codeset <- read.table("CodeSet.txt")
codeset$shortname <- substr(codeset$Customer_Identifier, 1,2)
Cht <- read.table("CodeSetCountdata.txt")

ctg1and2.norm <- NanoStringNorm(x = ct1and2.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg3and4.norm <- NanoStringNorm(x = ct3and4.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg5and6.norm <- NanoStringNorm(x = ct5and6.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg5and6hi.norm <- NanoStringNorm(x = ct5and6hi.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg7and8.norm <- NanoStringNorm(x = ct7and8.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg7and8hi.norm <- NanoStringNorm(x = ct7and8hi.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg9.norm <- NanoStringNorm(x = ct9.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

#Internal controls only

ctg5and6.intonly <- NanoStringNorm(x = ct5and6.raw, anno = NA, CodeCount ='sum', Background ="mean",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg5and6hi.intonly <- NanoStringNorm(x = ct5and6hi.raw, anno = NA, CodeCount ='sum', Background ="mean",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg7and8.intonly <- NanoStringNorm(x = ct7and8.raw, anno = NA, CodeCount ='sum', Background ="mean",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg7and8hi.intonly <- NanoStringNorm(x = ct7and8hi.raw, anno = NA, CodeCount ='sum', Background ="mean",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg3and4.intonly <- NanoStringNorm(x = ct3and4.raw, anno = NA, CodeCount ='sum', Background ="mean",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg1and2.intonly <- NanoStringNorm(x = ct1and2.raw, anno = NA, CodeCount ='sum', Background ="mean",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg9.intonly <- NanoStringNorm(x = ct9.raw, anno = NA, CodeCount ='sum', Background ="mean",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg1to9intonly <- cbind(ctg1and2.intonly,ctg3and4.intonly, ctg5and6hi.intonly, ctg7and8hi.intonly, ctg9.intonly)

ctg5and6.unnorm <- NanoStringNorm(x = ct5and6.raw, anno = NA, CodeCount ='none', Background ="none",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg5and6hi.unnorm <- NanoStringNorm(x = ct5and6hi.raw, anno = NA, CodeCount ='none', Background ="none",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg7and8.unnorm <- NanoStringNorm(x = ct7and8.raw, anno = NA, CodeCount ='none', Background ="none",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg7and8hi.unnorm <- NanoStringNorm(x = ct7and8hi.raw, anno = NA, CodeCount ='none', Background ="none",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg3and4.unnorm <- NanoStringNorm(x = ct3and4.raw, anno = NA, CodeCount ='none', Background ="none",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg1and2.unnorm <- NanoStringNorm(x = ct1and2.raw, anno = NA, CodeCount ='none', Background ="none",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg9.unnorm <- NanoStringNorm(x = ct9.raw, anno = NA, CodeCount ='none', Background ="none",OtherNorm = "none", round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = TRUE);

ctg1to9un <- cbind(ctg1and2.unnorm,ctg3and4.unnorm, ctg5and6hi.unnorm, ctg7and8hi.unnorm, ctg9.unnorm)

#Column data

colnames(ctg1and2.norm) <- c("C200", "C100", "C50", "C25", "C12", "C6", "CIA", "CIB", "FYA", "FOA", "MYA", "MOA","FYB",	"FOB",	"MYB",	"MOB",	"MOIA",	"MOIB","MOIC",	"MOID",	"CS1X",	"CS0.5X",	"CS0.25XA",	"CS0.25XB")
colnames(ctg1and2.unnorm) <- colnames(ctg1and2.norm)

colnames(ctg3and4.norm) <- c("O1a", "O2a", "Y1a", "Y2a", "OR1a", "OR2a", "YR1a", "YR2a", "FY5a", "FY6a", "FO5a", "FO7a", "O1b", "O2b", "Y1b", "Y2b", "OR1b", "OR2b", "YR1b", "YR2b", "FY7", "FY8", "FO8", "FO9")
colnames(ctg3and4.unnorm) <- colnames(ctg3and4.norm)

colnames(ctg5and6.norm) <- c("SFPA", "SFPB", "LFPA", "LFPB", "SMPA", "SMPB", "LMPA", "LMPB", "LMIA", "LMIB", "LMIC", "LMID", "Abef", "Aun", "Areg", "Bbef", "Bun", "Breg", "Cbef", "Cun", "Creg", "Dbef", "Dun", "Dreg")
colnames(ctg5and6.unnorm) <- colnames(ctg5and6.norm)

colnames(ctg5and6hi.norm) <-  c("SFPA", "SFPB", "LFPA", "LFPB", "SMPA", "SMPB", "LMPA", "LMPB", "LMIA", "LMIB", "LMIC", "LMID", "Abef", "Aun", "Areg", "Bbef", "Bun", "Breg", "Cbef", "Cun", "Creg", "Dbef", "Dun", "Dreg")
colnames(ctg5and6hi.unnorm) <- colnames(ctg5and6hi.norm)

colnames(ctg7and8.norm) <- c("SFPC","SFPD", "LFPC", "LFPD", "SMPC", "SMPD","LMPC", "LMPD", "0mPA", "0mPB", "10mPA", "20mPA", "Ebef", "Eun", "Ereg", "Fbef", "Fun", "Freg", "Gbef", "Gun", "Greg", "LFIA", "LFIB", "20mPB")
colnames(ctg7and8.unnorm) <- colnames(ctg7and8.norm)

colnames(ctg7and8hi.norm) <-c("SFPC","SFPD", "LFPC", "LFPD", "SMPC", "SMPD","LMPC", "LMPD", "0mPA", "0mPB", "10mPA", "20mPA", "Ebef", "Eun", "Ereg", "Fbef", "Fun", "Freg", "Gbef", "Gun", "Greg", "LFIA", "LFIB", "20mPB")
colnames(ctg7and8hi.unnorm) <- colnames(ctg7and8hi.norm)

colnames(ctg9.norm) <- c("LFIC", "LFID", "OmID", "10mIA", "n", "20mIC", "Ibef", "Iun", "Ireg", "Kbef", "Kun", "Kreg")
colnames(ctg9.unnorm) <- colnames(ctg9.norm)

ctg3to9 <- cbind(ctg3and4.norm, ctg5and6hi.norm, ctg7and8hi.norm, ctg9.norm)

ctg1to9 <- cbind(ctg1and2.norm,ctg3and4.norm, ctg5and6hi.norm, ctg7and8hi.norm, ctg9.norm)

colnames(ctg1to9un) <- colnames(ctg1to9)

colnames(ctg1to9intonly) <- colnames(ctg1to9)
sampleinfo <- data.frame(

  sample=colnames(ctg1to9),

  sex=c(rep("M", 8), rep(c("F", "F", "M", "M"), 2), rep("M", 8), rep("F", 28), rep("M", 8), rep("F", 16), rep("M", 4), rep("F", 28)),

  age=c(rep("O",8), rep(c("Y","O","Y","O"),2),rep("O",8),  rep(c("O", "O", "Y", "Y", "O", "O", "Y", "Y","Y", "Y", "O", "O"), 2), c("Y", "Y", "O", "O", "Y", "Y", "O", "O", "O", "O", "O", "O", rep("O", 12)), c("Y", "Y", "O", "O", "Y", "Y", "O", "O", "N", "N", "N", "N"), rep("O", 11), c("N", "O", "O",  "N", "N", "N", "N", "O", "O", "O", "O", "O", "O")),

  reg=c(rep("",24), rep(c(rep("", 4), rep("R", 4), rep("", 4)), 2), c(rep("", 12), rep(c("", "", "R"),4 )   ), c(rep("", 12), rep(c("", "", "R"),3 )   ), rep("",11 ), "R", "", "", "R") ,

  ctg=c(rep(1, 12), rep(2, 12),rep(3, 12), rep(4, 12), rep(5, 12), rep(6, 12), rep(7, 12), rep(8, 12), rep(9, 12)),

  size= c(rep("P",6), "I", "I", rep("P",8),rep("I",4), rep("I",4), rep("P", 32), rep("I", 4), rep("P",27), rep("I", 8), "P", rep("I", 4), rep("I", 8)),

  moult = c(rep("", 80), 0,0,10,20,rep("", 11),20,"","", 0,10,"", 20,rep("", 6) ),

  exp= c(rep("conc",8), rep("OvY", 12), rep("cut", 4), rep("OvY",4), rep("regen", 4), rep("OvY",8), rep("regen", 4), rep("OvY",4), rep("OvY", 12), rep("regen", 12), rep("OvY", 8), rep("moult", 4),rep("regen", 9), "OvY", "OvY", "moult",  "OvY", "OvY", "moult", "moult", "moult", "moult", rep("regen", 6) ),

  prep = c(rep("Luke", 24), rep("Nikos", 8), rep("Luke", 4), rep("Nikos", 8), rep("Luke", 4), rep("Luke", 60))

)

sampleinfo$flag <- FALSE
sampleinfo$flag[c(5,6,7,8,25,31,32, 54, 59, 66,67, 78,90, 97,101)] <- TRUE

#c(23,24,37,43,44, 54, 59, 66,67, 78,90, 97,101)

sampleinfo$type <- paste(sampleinfo$age, sampleinfo$reg, sep="")
sampleinfo$qual <- "ok"
sampleinfo$qual[c(25 , 31 , 32 , 49,  54 , 67  ,76,  90, 101, 104, 107)] <- "bad"
#sampleinfo$moult <- c(rep(NA, 80), 0,0,10,20,rep(NA, 11),20,NA,NA, 0,10,NA, 20,rep(NA, 6) )

#print("Samples as follows (all experiments)")
#print(paste("males: " sum()))

#Housekeeping genes

ctg1and2.whk <- NanoStringNorm(x = ct1and2.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = FALSE);
ctg1and2.whk.norm <- ctg1and2.whk$normalized.data
ctg1and2.whk.raw <- ctg1and2.whk$raw.data

ctg3and4.whk <- NanoStringNorm(x = ct3and4.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = FALSE);
ctg3and4.whk.norm <- ctg3and4.whk$normalized.data
ctg3and4.whk.raw <- ctg3and4.whk$raw.data

ctg5and6.whk <- NanoStringNorm(x = ct5and6.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = FALSE);
ctg5and6.whk.norm <- ctg5and6.whk$normalized.data
ctg5and6.whk.raw <- ctg5and6.whk$raw.data

ctg5and6hi.whk <- NanoStringNorm(x = ct5and6hi.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = FALSE);
ctg5and6hi.whk.norm <- ctg5and6hi.whk$normalized.data
ctg5and6hi.whk.raw <- ctg5and6hi.whk$raw.data

ctg7and8.whk <- NanoStringNorm(x = ct7and8.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = FALSE);
ctg7and8.whk.norm <- ctg7and8.whk$normalized.data
ctg7and8.whk.raw <- ctg7and8.whk$raw.data

ctg7and8hi.whk <- NanoStringNorm(x = ct7and8hi.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = FALSE);
ctg7and8hi.whk.norm <- ctg7and8hi.whk$normalized.data
ctg7and8hi.whk.raw <- ctg7and8hi.whk$raw.data

ctg9.whk <- NanoStringNorm(x = ct9.raw, anno = NA, CodeCount ='sum', Background ="mean", SampleContent ='housekeeping.sum', round.values = FALSE, take.log = FALSE,return.matrix.of.endogenous.probes = FALSE);
ctg9.whk.norm <- ctg9.whk$normalized.data
ctg9.whk.raw <- ctg9.whk$raw.data

ctg1to9.whk.norm <- cbind(ctg1and2.whk.norm,ctg3and4.whk.norm[,4:27], ctg5and6hi.whk.norm[,4:27], ctg7and8hi.whk.norm[,4:27], ctg9.whk.norm[,4:15])

colnames(ctg1to9.whk.norm) <- c(colnames(ctg1and2.whk.norm[,1:3]), colnames(ctg1to9))

ctg1to9.whk.raw <- cbind(ctg1and2.whk.raw,ctg3and4.whk.raw[,4:27], ctg5and6hi.whk.raw[,4:27], ctg7and8hi.whk.raw[,4:27], ctg9.whk.raw[,4:15])

colnames(ctg1to9.whk.raw) <- c(colnames(ctg1and2.whk.raw[,1:3]), colnames(ctg1to9))

hk.norm <- subset(ctg1to9.whk.norm, ctg1to9.whk.norm[,1] == "Housekeeping")

hk.raw <- subset(ctg1to9.whk.raw, ctg1to9.whk.raw[,1] == "Housekeeping")

geneinf <- data.frame(name=codeset$Customer_Identifier,transl2fc=codeset$log2FoldChange,  dir = ifelse(codeset$log2FoldChange> 0, "downregulated with age", "upregulated with age"))

geneinf$in61 <- geneinf$name %in% gm$marker[gm$dir != "housekeeping"]

##Saving
save(sampleinfo,ctg1to9,ctg1to9intonly,ctg1to9un, codeset,geneinf, hk.norm, hk.raw, file="nov17main_data.rdata")


parse.rush <- function(pbp, play) {
    play$rush <- FALSE
    play$kneeldown <- FALSE

    # regular expresions to identify rushing plays
    rush_regex1 <- paste0("(?<player>", name.pattern, ") (run|rush) [\\s\\w]*for ((?<gain>\\d+) ",
                         "(yd|yard)s?|(a )?loss of (?<loss>\\d+) (yd|yard)s?|(?<nogain>no gain))")
    rush_regex2 <- paste0("(?<player>", name.pattern, ") (?<gain>\\d+) (yd|yard)s? (run|rush)")

    if (grepl(rush_regex1, pbp, perl=TRUE, fixed=FALSE, ignore.case=TRUE)) {
        match <- regex(rush_regex1, pbp, perl=TRUE, fixed=FALSE, ignore.case=TRUE)

        play$rush <- TRUE
        play$carrier <- format.name(match[1,'player'])

        if (!is.na(match[1,'gain'])) {play$gain <- as.numeric(match[1,'gain'])}
        else if (!is.na(match[1,'loss'])) {play$gain <- -as.numeric(match[1,'loss'])}
        else if (!is.na(match[1,'nogain'])) {play$gain <- 0}
    } else if (grepl(rush_regex2, pbp, perl=TRUE, fixed=FALSE, ignore.case=TRUE)) {
        match <- regex(rush_regex2, pbp, perl=TRUE, fixed=FALSE, ignore.case=TRUE)

        play$rush <- TRUE
        play$carrier <- format.name(match[1,'player'])

        if (!is.na(match[1,'gain'])) {play$gain <- as.numeric(match[1,'gain'])}
    }

    # kneeldowns are coded as "team rush"
    if (play$rush && play$carrier %in% c('TEAM', 'team', 'Team')) {
      play$rush <- FALSE
      play$kneeldown <- TRUE
    }

    return(play)
}


library(dplyr)
library(data.table)
library(ggplot2)
library(stringr)
library(glue)
library(parallel)
home_dir = '/home/tenggao'
devtools::load_all(glue('{home_dir}/numbat'))

run_bench = function(df, cell_annot, segs_dna, sample, n_cells, ratios, ls, seed = 0, gamma = 20, ncores = 10, replace = FALSE) {

    ### simulate cell mixtures ###
    message('Simulating mixture pseudobulks .. ')

    set.seed(seed)
    nodes = list()

    for (n in n_cells) {
        for (r in ratios) {
            for (s in 1:5) {

                set.seed(s)

                cells_tumor = cell_annot %>%
                    filter(annot == 'T') %>%
                    pull(cell) %>% sample(n * r, replace = replace)

                cells_normal = cell_annot %>%
                    filter(annot == 'N') %>%
                    pull(cell) %>% sample(n * (1-r), replace = replace)

                nodes[[paste0(n, '_', r, '_', s)]] = list(cells = c(cells_tumor, cells_normal), members = s, label = r, n_cells = n)

            }
        }
    }

    bulks_mixture = mclapply(
        nodes,
        mc.cores = ncores,
        function(g) {
            get_allele_bulk(
                df_allele = df %>% filter(cell %in% g$cells),
                genetic_map = genetic_map_hg38,
                lambda = 1
            ) %>%
            mutate(
                seed = g$members,
                ratio = g$label,
                n_cells = g$n_cells
            )
    })

    # saveRDS(bulks_mixture, glue('~/paper_data/phasing_benchmark/bulks_mixture_{sample}.rds'))
    fwrite(
        bind_rows(bulks_mixture),
        glue('~/paper_data/phasing_benchmark/bulks_mixture_{sample}.tsv.gz'),
        sep = '\t', nThread = min(10, ncores)
    )

    ### simulate CNV segments ###
    message('Simulating CNV segments .. ')

    # function to get random segments from the profile
    sample_segs = function(bulk, l = 500, n = 10) {

        if (nrow(bulk) < l + n) {
            print(unname(unique(bulk$CHROM)))
            stop('not enough SNPs')
        }

        starts = sample(1:(nrow(bulk)-l), n)

        bulk_segs = lapply(
            1:length(starts),
            function(i) {
                start = starts[i]
                bulk[start:(start+l),] %>% mutate(start_random = start, end_random = start+l, id_random = i)
            }
        ) %>%
        bind_rows()

        return(bulk_segs)

    }

    sample_segs_loc = function(bulk, l = 10e6, n = 10) {

        region_size = max(bulk$POS) - min(bulk$POS)

        if (region_size < l) {
            print(unname(unique(bulk$CHROM)))
            stop('not enough SNPs')
        }

        starts = bulk$POS[sample(1:nrow(bulk[bulk$POS < max(bulk$POS) - l,]), n)]

        bulk_segs = lapply(
            1:length(starts),
            function(i) {
                start = starts[i]
                end = start + l

                bulk %>% filter(POS >= start & POS < end) %>%
                    mutate(start_random = start, end_random = end, id_random = i, n_snps = n())
            }
        ) %>%
        bind_rows()

        return(bulk_segs)

    }

    set.seed(seed)
    # different cell mixtures
    segs_mixture = mclapply(
        mc.cores = ncores,
        bulks_mixture,
        function(bulk) {
            # different segs
            lapply(
                unique(segs_dna$seg),
                function(seg) {
                    # different segment lengths
                    lapply(
                        ls,
                        function(l) {

                            tryCatch(expr = {

                                n_cells = unique(bulk$n_cells)
                                seed = unique(bulk$seed)

                                segs_mixture = bulk %>%
                                    annot_consensus(segs_dna) %>%
                                    filter(seg == UQ(seg)) %>%
                                    filter(!is.na(AD)) %>%
                                    sample_segs_loc(n = 10, l = l)

                                segs_normal = bulks_mixture[[paste0(n_cells, '_0_', seed)]] %>%
                                    annot_consensus(segs_dna) %>%
                                    filter(seg == UQ(seg)) %>%
                                    filter(!is.na(AD)) %>%
                                    sample_segs_loc(n = 10, l = l) %>%
                                    mutate(ratio = unique(bulk$ratio)) # don't change

                                segs = bind_rows(
                                        segs_mixture %>% mutate(label = 1),
                                        segs_normal %>% mutate(label = 0)
                                    ) %>%
                                    mutate(MAD = ifelse(AD >= DP - AD, AD, DP-AD))

                                segs = segs %>% mutate(seg = seg, l = l)

                                return(segs)

                            },
                            error = function(e) {
                                return(data.frame())
                            })

                        }
                    ) %>%
                    bind_rows()
                }
            ) %>%
            bind_rows()
        }
    ) %>% bind_rows()

    fwrite(
        segs_mixture,
        glue('~/paper_data/phasing_benchmark/segs_mixture_{sample}.tsv.gz'),
        sep = '\t', nThread = min(10, ncores)
    )

    ### Scoring segments ###
    message('Scoring segments .. ')

    theta_neu = segs_mixture %>%
        filter(ratio == 0 & id_random == 1) %>%
        group_by(n_cells) %>%
        summarise(
            theta_mle_naive(MAD, DP),
            .groups = 'drop'
        ) %>%
        {setNames(.$theta_mle, .$n_cells)}

    message(paste0('Using baseline theta = ', signif(theta_neu,2)))

    segs_mixture = segs_mixture %>% mutate(theta_neu = theta_neu[as.character(n_cells)])

    scores = segs_mixture %>%
        mutate(seg = factor(seg)) %>%
        split(list(.$id_random, .$seg, .$seed)) %>%
        mclapply(
            mc.cores = ncores,
            function(bulk_seg) {

                scores_phasing = bulk_seg %>%
                    group_by(
                        CHROM, seg, cnv_state,
                        id_random, ratio, n_cells, seed, l, label
                    ) %>%
                    summarise(
                        approx_theta_post(pAD, DP, p_s, gamma = gamma),
                        LLR = calc_allele_LLR(
                            pAD[!is.na(pAD)], DP[!is.na(pAD)], p_s[!is.na(pAD)], theta_mle, theta_0 = theta_0, gamma = unique(gamma)
                        ),
                        start_random = unique(start_random),
                        end_random = unique(end_random),
                        .groups = 'drop'
                    )

                scores_naive = bulk_seg %>%
                    group_by(
                        CHROM, seg, cnv_state,
                        id_random, ratio, n_cells, seed, l, label
                    ) %>%
                    summarise(
                        theta_mle_naive(MAD, DP),
                        LLR = l_bbinom(MAD, DP, gamma*(0.5+theta_mle), gamma*(0.5-theta_mle)) -
                            l_bbinom(
                                MAD, DP, gamma*(0.5+unique(theta_neu)),
                                gamma*(0.5-unique(theta_neu))
                            ),
                        start_random = unique(start_random),
                        end_random = unique(end_random),
                        .groups = 'drop'
                    )

                scores = bind_rows(
                    scores_phasing %>% mutate(method = 'phasing'),
                    scores_naive %>% mutate(method = 'naive')
                )
            }
        ) %>%
        bind_rows()

    fwrite(
        scores,
        glue('~/paper_data/phasing_benchmark/scores_{sample}.tsv.gz'),
        sep = '\t', nThread = min(10, ncores)
    )

    message('Done!')
}

####### run ########

## TNBC4 ##
cell_annot = fread('~/paper_data/cell_annotations/cell_annot_MDA.tsv', sep = ',') %>%
    mutate(annot = copykat.pred) %>%
    filter(sample == 'TNBC4')

segs_dna = fread('~/paper_data/phasing_benchmark/segs_truth_TNBC4.tsv') %>%
    mutate(CHROM = factor(CHROM, 1:22)) %>%
    mutate(seg_length = seg_end - seg_start) %>%
    filter(seg_length > 10e6)

samples = c(
    'TNBC4', 'TNBC4_1000G',
    'TNBC4_0.25', 'TNBC4_0.5'
)

for (sample in samples) {

    df = fread(glue('~/paper_data/processed/{sample}_N_allele_counts.tsv.gz'), nThread = 4)

    message(sample)

    run_bench(
        df,
        cell_annot,
        segs_dna,
        sample,
        n_cells = 500,
        ratios = c(seq(0, 0.09, 0.01), seq(0.1, 0.5, 0.02)),
        ls = 10e6,
        ncores = 20,
        replace = FALSE
    )

}

# ##MM dataset ##
# samples = c('47491_Primary', '27522_Relapse_2', '59114_Relapse_1', '37692_Primary', '58408_Primary')

# cell_annot = fread('~/paper_data/cell_annotations/cell_annot_WASHU_march.tsv') %>%
#         split(.$sample)

# for (sample in samples) {

#     for (ratio in c(0.25, 0.5, 1)) {

#         df = fread(glue('~/paper_data/processed/{sample}_{ratio}_allele_counts.tsv.gz'), nThread = 4)

#         segs_dna = fread(glue('~/paper_data/purple_out/{sample}/segs_consensus_dna.tsv')) %>%
#             filter(cnv_state_post %in% c('amp', 'loh', 'del')) %>%
#             mutate(cnv_state = cnv_state_post) %>%
#             mutate(CHROM = factor(CHROM, 1:22)) %>%
#             as.data.frame() %>%
#             filter(seg_length > 10e6)

#         run_bench(
#             df,
#             cell_annot[[sample]],
#             segs_dna,
#             paste0(sample, '_', ratio),
#             n_cells = 500,
#             ratios = seq(0, 1, 0.05),
#             ls = 10e6,
#             ncores = 20,
#             replace = TRUE
#         )

#     }

# }


#' @export
#' @title colour.scale
#' @description This functions return a vector of length \code{x} KML (Google Earth) colour codes using a pre-defined palettes ('seis').
#' @param \code{type} = default is \code{seis}
#' @param \code{nlevels} = the number of unique colours to generate (default is 10)
#' @param \code{x} = a vector
#' @param \code{transparency} = the transparency of the resultant colours (default is 0.9)
#' @return list of 2: \code{$y} is a vector of \code{x-1} length, which can used to assign the colours of \code{$cols} to the original vector \code{x}; \code{$cols} is a vector of KML colours of length \code{nlevels}
#' @family poorly documented
#' @author  unknown, \email{<unknown>@@dfo-mpo.gc.ca}
#' @examples
#' colour.scale(nlevels=3,x=seq(1:6))
#' $y
#' [1] 1 1 2 2 3 3
#'
#' $cols
#' code
#' 1 e68B0000
#' 2 e600008B
#' @note not totally sure if this function works as intended.  It seems as though \code{nlevels} should return the number of colours specified - not one less.  Jae or Adam might have more information about this.
#' @export
colour.scale = function( type="seis", nlevels=10, x=NULL, transparency=0.9 ) {
    # if (length( type) > 1 ) {
    #   colours = colorRampPalette( type, space = "rgb") (nlevels)
    # } else {
      colours = color.code( type, n=nlevels-1 )
    # }

    cols = data.frame( code=as.character(colours) )

    cols$code = sapply( cols$code, rbg2bgr )
    transp.hex = as.hexmode( round(transparency * 255 ) )
    cols$code = gsub( "#", transp.hex, cols$code )
    er = range ( x, na.rm=T )
    upperbounds = seq( er[1], er[2], length.out=nlevels+1 ) [2:(nlevels+1)]
    y = findInterval( x, upperbounds ) + 1
    y[ which( y > nlevels) ] = nlevels
    return( list(y=y, cols=cols ) )
  }


  exploitationrates = function( p, areas, labels=NULL, CFA4X.exclude.year.assessment=FALSE  ){

    if ( is.null(labels)) labels = areas

    # ------------ fisheries data
    la = landings.aggregate()

    # -----------  biomass data
    p$vars.to.model ="R0.mass"

    p = parallel_run( p=p, runindex=list(y=p$yrs, v=p$vars.to.model ) )

    td = interpolation.db( DS="interpolation.simulation", p=p )
    td = td[ which(td$region %in% areas ), ]
    td$id = paste(td$yr, td$region, sep=".")
    td$biomass = td$total / 1000
    td$lbound =  td$total.ub / 1000
    td$ubound =  td$total.lb / 1000

    td$total = NA

    X = merge( td, la, by="id", all.x=T, all.y=F, sort=F)
    td = X[ which(is.finite( X$biomass)) ,]

    years= sort(unique(td$yr))

    for (rs in areas) {
    for (ys in years) {

      i = which(td$yr == ys & as.character(td$region) == rs )
      j = which(td$yr == (ys-1) & as.character(td$region) == rs )

      # post-2002 surveys have surveys in autumn
        if (ys >= 2002) {
          td$total[i] = td$landings.kt[i] / (td$biomass[i] + td$landings.kt[i])
          td$lb[i] = td$landings.kt[i] / (td$ubound[i] + td$landings.kt[i])
          td$ub[i] = td$landings.kt[i] / (td$lbound[i] + td$landings.kt[i])
        } else if (ys <= 2001 ) {
          td$total[i] = td$landings.kt[i] / td$biomass[i]
          td$lb[i] = td$landings.kt[i] / td$ubound[i]
          td$ub[i] = td$landings.kt[i] / td$lbound[i]
        }
    }}

    td$region = factor(as.character(td$region), levels=areas, labels=labels)

    eps = 1e-6

    varstocheck = c("total", "ubound", "lbound")

    for (vs in varstocheck) {
      td[,vs] = td[,vs]
      kk = which(td[,vs] <= eps)
      if (length(kk)>0) td[kk,vs] = 0
    }

    td = td[is.finite(td$total) ,]
    td = td[order(td$region,td$yr),]

    if (CFA4X.exclude.year.assessment) {
        td$total[ which( td$region=="4X" & td$yr==p$year.assessment) ] = NA  # the fishery is ongoing
        td$ub[ which(td$region=="4X" & td$yr==p$year.assessment) ] = NA  # the fishery is ongoing
        td$lb[ which(td$region=="4X" & td$yr==p$year.assessment) ] = NA  # the fishery is ongoing
    }

    ii = which(td$region=="4X" & td$yr<2004)
    td$total[ ii ] = NA
    td$ub[ ii ] = NA
    td$lb[ ii ] = NA

    return(td)

  }


# This is a helper function for merging MS2 ions into hyperMS2
merge.spectra.group <- function(spectra, eppm, eabs, int.threshold) {
  if(is.na(spectra) || length(spectra) == 0) return(NULL)
  max.precursor.int <- -1
  rt.at.max.int <- NA
  start.rt <- attributes(spectra[[1]])$rt
  end.rt <- attributes(spectra[[1]])$rt
  mean.precursor.mz <- 0
  max.tic <- -1
  tandemms <- lapply(1:length(spectra), function(index) {
    # print(index)
    x<-spectra[[index]]
    # assign local variables
    cur.rt <- attributes(x)$rt
    cur.precursor.int <- attributes(x)$precursorIntensity
    cur.tic <- attributes(x)$tic
    cur.precursor.mz <- attributes(x)$precursorMz
    # assign global variables
    mean.precursor.mz <<- mean.precursor.mz + cur.precursor.mz
    max.tic <<- if(max.tic < cur.tic) cur.tic else max.tic
    if(max.precursor.int < cur.precursor.int) {
      max.precursor.int <<- cur.precursor.int
      rt.at.max.int <<- cur.rt
    }
    start.rt <<- if(start.rt > cur.rt) cur.rt else start.rt
    end.rt <<- if(end.rt < cur.rt) cur.rt else end.rt
    # start merging ms2 data
    a <- cbind(attributes(x)$mz, attributes(x)$intensity)
    colnames(a) <- c("mz", "intensity")
    return(a)
  })
  mean.precursor.mz <- mean.precursor.mz / length(spectra)

  # Filter intensity
  tandemms <- lapply(tandemms, function(spec) spec[spec[,"intensity"]>=int.threshold,])
  tandemrm <- sapply(1:length(tandemms), function(x) { if ( (dim(tandemms[[x]])[1] == 0) || is.null(dim(tandemms[[x]])[1]) ) x <- TRUE else x <- FALSE } )

  if ( (all(as.logical(tandemrm)) == TRUE) | (is.na(all(as.logical(tandemrm)))) )
    return(NULL)
  else
    tandemms <- tandemms[!tandemrm]

  # Process spectra
  peaks <- do.call(rbind, tandemms)
  g <- xcms:::mzClust_hclust(peaks[,"mz"], eppm=eppm, eabs=eabs)

  mz <- tapply (peaks[,"mz"], as.factor(g), mean)
  intensity <- tapply (peaks[,"intensity"], as.factor(g), max)

  if(length(mz) == 0)return(NULL);

  intensity <- intensity[order(mz)]
  mz <- mz[order(mz)]

  res <- .Call("Spectrum2_constructor_mz_sorted",
         attributes(spectra[[1]])$msLevel, length(mz), rt.at.max.int,
         attributes(spectra[[1]])$acquisitionNum,
         attributes(spectra[[1]])$scanIndex, max.tic, mz,
         intensity, attributes(spectra[[1]])$fromFile, attributes(spectra[[1]])$centroided,
         attributes(spectra[[1]])$smoothed, attributes(spectra[[1]])$polarity,
         attributes(spectra[[1]])$merged, attributes(spectra[[1]])$precScanNum,
         mean.precursor.mz, max.precursor.int, attributes(spectra[[1]])$precursorCharge, attributes(spectra[[1]])$collisionEnergy,
         TRUE, attributes(spectra[[1]])$.__classVersion__,
         PACKAGE = "MSnbase")
  attributes(res)$start.rt <- start.rt
  attributes(res)$end.rt <- end.rt
  return(res)
}

grouped.list.to.matrix <- function(grouped.spectra) {
  data.mat <- matrix(0, ncol=3, nrow=0)
  colnames(data.mat) <- c("mz", "rt", "gid")
  for (i in 1:length(grouped.spectra)) {
    for(j in 1:length(grouped.spectra[[i]])) {
      data.mat <- rbind(data.mat,
                        c(grouped.spectra[[i]][[j]]@precursorMz, grouped.spectra[[i]][[j]]@rt, i))
    }
  }
  return(data.mat)
}

get.ppm.from.abs <- function(peak, ppm) {
  return ((peak / 1000000.0) * ppm)
}

collect.spectra.lists <- function(spectra, mzabs, mzppm, rtabs) {
  a<-t(sapply(1:length(spectra), function(spectrum.id) {
    return(c(attributes(spectra[[spectrum.id]])$rt, attributes(spectra[[spectrum.id]])$precursorMz, spectrum.id))
  }))
  a <- a[order(a[,2], a[,1]),]
  index <- 1
  grouped.spectra.tmp <- list()
  while(index <= dim(a)[1]) {
    spectra.list <- list()
    spectra.list[[1]] <- spectra[[a[index,3]]]
    cur.abs <- get.ppm.from.abs(a[index, 2], mzppm * 0.5) + mzabs
    index <- index + 1
    while(index <= dim(a)[1]) {
      diff.mz <- abs(a[index - 1, 2] - a[index, 2])
      if(diff.mz <= cur.abs) {
        spectra.list[[length(spectra.list) + 1]] <- spectra[[a[index,3]]]
        index <- index + 1
      } else break
    }
    grouped.spectra.tmp[[length(grouped.spectra.tmp) + 1]] <- spectra.list
  }
  grouped.spectra <- list()
  for(spectrum.group.index in 1:length(grouped.spectra.tmp)) {
    spectrum.group <- grouped.spectra.tmp[[spectrum.group.index]]
    a<-t(sapply(1:length(spectrum.group), function(spectrum.index) {
      c(attributes(spectrum.group[[spectrum.index]])$rt, attributes(spectrum.group[[spectrum.index]])$precursorMz, spectrum.index)
    }))
    a <- matrix(a[order(a[,1], a[,2]),], ncol=3)
    index <- 1
    while(index <= dim(a)[1]) {
      spectra.list <- list()
      spectra.list[[1]] <- spectrum.group[[a[index,3]]]
      index <- index + 1
      while(index <= dim(a)[1]) {
        diff.rt <- abs(a[index - 1, 1] - a[index, 1])
        if(diff.rt <= rtabs) {
          spectra.list[[length(spectra.list) + 1]] <- spectrum.group[[a[index,3]]]
          index <- index + 1
        } else break
      }
      grouped.spectra[[length(grouped.spectra) + 1]] <- spectra.list
    }
  }
  return(grouped.spectra)
}

plot.grouped.spectra <- function(grouped.spectra) {
  if(class(grouped.spectra)=="list" & length(grouped.spectra) > 0) {
    set.seed(100)
    cols <- sample(rainbow(length(grouped.spectra)))
    data.mat <- grouped.list.to.matrix(grouped.spectra)
    plot(data.mat[,2], data.mat[,1], col=cols[data.mat[,3]], xlab="RT", ylab="m/z")
    sapply(unique(data.mat[,3]), function(x) {
      a <- data.mat[data.mat[,3]==x,]
      if(class(a)=="numeric") a <- matrix(a, ncol=3)
      text(min(a[,2]), min(a[,1]), labels = x, col=cols[cols[x]], srt=45, cex=0.5)
    })
  }
}

save.plot.grouped.spectra <- function(grouped.spectra, file.name) {
  pdf(file.name, width=20, height=15)
  plot.grouped.spectra(grouped.spectra)
  dev.off()
}

filter.grouped.spectra <- function(grouped.spectra, max.rt.range, max.mz.range, min.rt, max.rt, min.mz, max.mz) {
  filtered.grouped.spectra <- list()
  sapply(grouped.spectra, function(grouped.spectrum) {
    mzs<-sapply(grouped.spectrum, function(x) attributes(x)$precursorMz)
    rts<-sapply(grouped.spectrum, function(x) attributes(x)$rt)
    mean.mzs <- mean(mzs)
    mean.rts <- mean(rts)
    max.number.peaks <- max(sapply(grouped.spectrum, function(x) attributes(x)$peaksCount))
    if((max(mzs)-min(mzs)) <= max.mz.range & (max(rts)-min(rts)) <= max.rt.range & mean.rts < max.rt & mean.mzs < max.mz
       & mean.rts > min.rt & mean.mzs > min.mz & max.number.peaks > 0) {
      filtered.grouped.spectra[[length(filtered.grouped.spectra) + 1]] <<- grouped.spectrum
    }
  })
  return(filtered.grouped.spectra)
}

merge.spectra <- function(spectra, mzabs, mzppm, rtabs, max.rt.range, max.mz.range, min.rt, max.rt, min.mz, max.mz, output.pdf = NA, int.threshold = 0) {
  a <- collect.spectra.lists(spectra, mzabs, mzppm, rtabs)
  if(length(a) != 0 & !is.na(output.pdf)) {save.plot.grouped.spectra(a, output.pdf)}
  print(paste("Collected",length(a),"spectrum groups"))
  b <- filter.grouped.spectra(a, max.rt.range, max.mz.range, min.rt, max.rt, min.mz, max.mz)
  print(paste("Filtered",length(b),"spectrum groups"))
  merged.spectra <- sapply(1:length(b), function(x) {
    merge.spectra.group(b[[x]], mzppm * 10e-6, mzabs, int.threshold)
  })
  b<-Filter(Negate(is.null), merged.spectra)
  print(paste("Filtered",length(b),"spectrum groups with peak information"))
  return(b)
}


rm(list = ls())
source("functions.r")
args = commandArgs(trailingOnly = TRUE)
train = args[1]
task = args[2]
pred_risk = args[3]
pred_days = args[4]
seed = 1 # Seed is set for replication of results. Set this to NA if you want greater randomness.

train = as.matrix(read.csv(train))
task = as.matrix(read.csv(task))

if(sum(is.na(train[, 3:ncol(train)]))){
  train = MIwithOutcome(train, seed = seed)
}
if(sum(is.na(rbind(task, train)[, 3:ncol(train)]))){
  temp = MIwithoutOutcome(rbind(task, train), seed = seed)
  task = temp[1:nrow(task), ]
}

pred_gen(train, task, pred_risk, pred_days, reweigh = F)