library(MatrixEQTL)

setwd("")
base.dir = find.package("MatrixEQTL")
useModel = modelLINEAR;
pvOutputThreshold = 1;
cisDist<-500000
errorCovariance = numeric();

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

covariates_file_name = "MatrixEQTL/Covariates_Sex_5PCs.txt";

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

for(chr in unique(regions$CHR)){
	SNP_file_name = paste("MatrixEQTL/Genotypes_MinGenoCount5_Chr", chr, ".txt", sep = "")
	snps_location_file_name = paste("MatrixEQTL/Genotypes_MapInfo_Chr", chr, ".txt", sep = "")

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

	snpspos = read.table(snps_location_file_name, header = TRUE, stringsAsFactors = FALSE);
	snpspos[,1]<-rownames(snps)

for(i in which(regions$CHR == chr)){

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

	#gene_location_file_name = paste(base.dir, "/data/geneloc.txt", sep="");
	## if no covariates set to  character()
	output_file_name = paste("MatrixEQTL/Output/AllmQTLsforASDColocAnalysis_mQTL_chr", chr,"_", start, "_", stop, ".txt", sep = "")

	con <- file(expression_file_name)

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

		library(IlluminaHumanMethylation450kanno.ilmn12.hg19)
		data(IlluminaHumanMethylation450kanno.ilmn12.hg19)
		probeAnnot<-as.data.frame(IlluminaHumanMethylation450kanno.ilmn12.hg19@data$Locations)
		probeAnnot<-cbind(rownames(gene), probeAnnot[rownames(gene), c("chr", "pos", "pos")])
		probeAnnot[,4]<-probeAnnot[,4]+1
		genepos<-probeAnnot

			### run eqtls
			me = Matrix_eQTL_main(
				snps = snps,
				gene = gene,
				cvrt = cvrt,
				output_file_name = output_file_name,
				pvOutputThreshold = 1,
				output_file_name.cis = output_file_name,
				pvOutputThreshold.cis = pvOutputThreshold,
				snpspos = snpspos,
				genepos = genepos,
				cisDist = cisDist,
				useModel = useModel,
				errorCovariance = errorCovariance,
				verbose = TRUE,
				pvalue.hist = "qqplot",
				min.pv.by.genesnp = FALSE,
				noFDRsaveMemory = FALSE)

		}
	}
}


probs <- read.table("D:/_tmp/tst_probsconfirmtst.txt", header = F)$V1
plot(probs, type='l'); abline(h=0.004)

tchps = read.table("D:/DATASETS/UKTraffic/TrueChanges.txt", header = F)$V1
#plot(ttt, type = 'l', xlim = c(1, 3000)); abline(v = tchps, col = "red")
#tchps[4]
#plot(ttt, type = 'l', xlim = c(8000, 10000)); abline(v = tchps, col = "red"); abline(h = 0.004);
predicted = read.table("D:/_tmp/tst_predictedtps0.txt", header = F)$V1
detections = read.table("D:/_tmp/tst_detections.txt", header = F)$V1

plot(ttt, type = 'l', xlim = c(1000, 5000)); abline(v = tchps, col = "red"); abline(h = 0.004);
abline(v = detections, col ="green")
abline(v = predicted , col = "blue")


#internal function ripped off from the phangorn package following Yang 1994
#discrete.gamma<-function (alpha, k) {
#    if (k == 1)
#        return(1)
#    quants <- qgamma((1:(k - 1))/k, shape = alpha, rate = alpha)
#    diff(c(0, pgamma(quants * alpha, alpha + 1), 1)) * k
#}
#phangorn:::discrete.gama(0.5,4)
# Why Migrate doesn't do it this way according to Peter Beerli:Yang uses means or medians of categories that have equal probabilities, migrate (and phylip)
#calculate the more sensible Generalized Laguerre quadrature points  (Laguerre quadrature is optimal for the gamma distribution) this leads to means of categories that do have #different probabilities (you see that in the table migrate presents). For small to relatively large alphas migrate uses the generalized Laguerre quadrature and for very large alphas I #use Hermite’s quadrature.
#Felsenstein, J. 2001. Taking variation of evolutionary rates between sites into account in inferring phylogenies. Journal of Molecular Evolution 53: 447-455.

#############SETTINGS#############################

#path
path<-"~/Dropbox/Crandall_tobo"

#Starting values - can also read in matrices
start.theta<-"0.01"
start.migration<-"100000"

#Priors
theta.prior<-" 0.000010 0.010000 10.000000 1.00000 "
mig.prior<-" 0.000100 100000.000000 1000000.000000 100000.000000 "

#Chain-Control
increment<-"500"
chainlength<-"50000"
burnin<-"0"
replicate<-"replicate=YES:3" #or "replicate=NO"

###########READ IN DATA#########################

#read in modeltest output for DNA sequence models
modeltest<-read.delim("~/Dropbox/Crandall_tobo/modeltest_output_table2.txt",as.is=T)

#read in sample size matrix, and edit it a bit to remove certain pops, and lump others
sampleN<-read.csv("~/Dropbox/Crandall_tobo/hawaii_sample_sizes.csv",stringsAsFactors=F)

sampleN[is.na(sampleN)]<-0 #replace NAs with zeros

sampleN<-cbind("filename"=sampleN[,1],"hawanui"=rowSums(sampleN[,2:6]),"mauinui"=rowSums(sampleN[7:9]),"oahu"=sampleN[,10],"kuainui"=rowSums(sampleN[,11:12]),sampleN[,13:31]) #lump big islands sites, Maui Nui = maui+lanaii+molokai, Kauai Nui = kuai+niihau

drops<-c("twin","broo","roga","rait","nort","pion","salm","pearmaze","john")
sampleN<-sampleN[,!(names(sampleN) %in% drops)]

#read in a stepping stone matrix to be edited
matrix<-as.matrix(read.delim(file="~/Dropbox/Crandall_tobo/stepping_stone_matrix.txt",header=F))

#make a matrix denoting which populations will be removed for each species and which will be treated as ghosts
#ghost pops where n=0 in MHI
#ghost pops where 0<n<5 in NWHI
#remove pops where n=0 in NWHI

ghost_test_mhi<-function(x){if(x < 5) "G" else "R"}
ghost_test_nwhi<-function(x){if(x == 0) "X" else if (x < 5) "G" else "R"} #R - population exists and was sampled, G - population exists but wasn't sampled, X - population doesn't exist
popstatus1<-data.frame(matrix(sapply(as.matrix(sampleN[,2:5]),ghost_test_mhi),ncol=4),row.names=sampleN[,1],stringsAsFactors=F)
popstatus2<-data.frame(matrix(sapply(as.matrix(sampleN[,6:15]),ghost_test_nwhi),ncol=10),row.names=sampleN[,1],stringsAsFactors=F)
popstatus<-cbind(popstatus1,popstatus2)
names(popstatus)<-names(sampleN[2:15])

#########MAKE MIGRATION MATRICES###############

for(i in rownames(popstatus)){ #i<-abuvai_CB

	print(paste("Now making matrices for",i))
	npops<-length(which(popstatus[i,]!="X")) #the number of extant populations for this species
	print(paste(npops,"extant populations"))
	nmatrix<-matrix[1:npops,1:npops] #crop the matrix to this size

	gmatrix<-nmatrix

	ghosts<-which(popstatus[i,which(popstatus[i,]!="X")]=="G")	#select the indices of the ghost populations, accounting for populations that have been removed as non-extant.

	print(paste("ghost pop at",names(popstatus)[which(popstatus[i,]=="G")]))

	if(length(ghosts)>0){
		for(j in seq(length(ghosts))){

		gmatrix[ghosts[j],]<-sub("\\*","c",gmatrix[ghosts[j],])
		gmatrix[,ghosts[j]]<-sub("\\*","c",gmatrix[,ghosts[j]])
	} #sub constant parameters in for * the rows and columns of the matrix that are ghost pops, if there are any ghosts pops
	}
	write.table(gmatrix,file=file.path(path,"migration_matrices",paste(i,"stepping.stone.txt",sep="_")),sep="\t",quote=F,row.names=F,col.names=F)

gmatrix[gmatrix=="*"]<-"m" #make the stepping-stone.1param matrix

	write.table(gmatrix,file=file.path(path,"migration_matrices",paste(i,"stepping.stone.1param.txt",sep="_")),sep="\t",quote=F,row.names=F,col.names=F)

if(length(ghosts)>0){
		for(j in seq(length(ghosts))){

		gmatrix[ghosts[j],]<-sub("0","c",gmatrix[ghosts[j],])
		gmatrix[,ghosts[j]]<-sub("0","c",gmatrix[,ghosts[j]])
	} #sub constant parameters in for * the rows and columns of the matrix that are ghost pops, if there are any ghosts pops
	}

gmatrix[gmatrix=="0"]<-"m" #make the n-island matrix

	write.table(gmatrix,file=file.path(path,"migration_matrices",paste(i,"n.island.txt",sep="_")),sep="\t",quote=F,row.names=F,col.names=F)

}

####################MAKE PARMFILES - Panmixia,N.island, Stepping_stone,Stepping_stone_1param#################

for(i in rownames(modeltest)) {#i<-"abuabd_CB_coleman_newH"
	dir.create(file.path(path,"Migrate_runs",i))
	setwd(file.path(path,"Migrate_runs",i))

	#Migration Matrices - read them from the migration matrices folder based on the first two sections of i. Add to these as necessary, and stick them into the for loop below
	stepping.stone<-as.matrix(read.delim(file=file.path("~/Dropbox/Crandall_tobo/migration_matrices",paste(strsplit(i,"_")[[1]][1],strsplit(i,"_")[[1]][2],"stepping.stone.txt",sep="_")),header=F))

	stepping.stone.1param<-as.matrix(read.delim(file=file.path("~/Dropbox/Crandall_tobo/migration_matrices",paste(strsplit(i,"_")[[1]][1],strsplit(i,"_")[[1]][2],"stepping.stone.1param.txt",sep="_")),header=F))

	n.island<-as.matrix(read.delim(file=file.path("~/Dropbox/Crandall_tobo/migration_matrices",paste(strsplit(i,"_")[[1]][1],strsplit(i,"_")[[1]][2],"n.island.txt",sep="_")),header=F))

	panmixia<-"*"

	#Population Lumping - add hypotheses as necessary and stick them into the if/then statements below
	npops<-length(which(popstatus[paste(strsplit(i,"_")[[1]][1],strsplit(i,"_")[[1]][2],sep="_"),]!="X")) #the number of extant populations for this species

	all_pop_relabel<-seq(npops)
	panmixia_pop_relabel<-rep(1,npops)

	for(migration.matrix in c("panmixia","stepping.stone.1param","stepping.stone","n.island")){#migration.matrix<-"stepping.stone"

		dir.create(file.path(path,"Migrate_runs",i,migration.matrix))
		setwd(file.path(path,"Migrate_runs",i,migration.matrix))

#####IF/THEN settings for writing various versions####

	# if the model includes a gamma parameter, then discretize the gamma shape parameter
	model<-modeltest$bestmodel[which(rownames(modeltest)==i)]
	if(grepl("+G",model)){
		numrates<-4
		discretegammas<-c(modeltest$r1[which(rownames(modeltest)==i)],modeltest$r2[which(rownames(modeltest)==i)],modeltest$r3[which(rownames(modeltest)==i)],modeltest$r4[which(rownames(modeltest)==i)])

		discretegammaprobs<-c(modeltest$p1[which(rownames(modeltest)==i)],modeltest$p2[which(rownames(modeltest)==i)],modeltest$p3[which(rownames(modeltest)==i)],modeltest$p4[which(rownames(modeltest)==i)])

		} else {numrates<-1; discretegammas<-1;discretegammaprobs<-1}

	if(migration.matrix=="panmixia"){pop_relabel<-panmixia_pop_relabel} else {pop_relabel<-all_pop_relabel}

	if(migration.matrix=="n.island"){increment<-"500";chainlength<-"10000"} else {increment<-"500"; chainlength<-"50000"}

#####Write the parmfiles################
	parmfile<-file("parmfile",open="w")

	#file header, plus some parameters that don't change for mtDNA
	cat("################################################################################",
"# Parmfile for Migrate 3.6.4 [do not remove these first TWO lines]",sep="\n",file=parmfile)

	#settings that will never change for sequence data
	cat("menu=NO", "nmlength=10","datatype=SequenceData",sep="\n",file=parmfile)

	#sequence model parameters for ttratio and base frequencies
	cat(paste("ttratio=",modeltest$titv[which(rownames(modeltest)==i)]),paste("freqs-from-data=NO:",modeltest$fA[which(rownames(modeltest)==i)],",",modeltest$fC[which(rownames(modeltest)==i)],",",modeltest$fG[which(rownames(modeltest)==i)],",",modeltest$fT[which(rownames(modeltest)==i)],sep=""),"seqerror-rate=0.0","categories=1",sep="\n",file=parmfile)

	#parameters for site rate variation (calculated above)
	cat(paste("rates=",numrates,":",paste(discretegammas,collapse=" "),sep=""),paste("prob-rates=",numrates,":",paste(discretegammaprobs,collapse=" "),sep=""),sep="\n",file=parmfile)

	#parameters that don't need to change among species (will mess with pop-relabel later)
	cat("autocorrelation=NO","weights=NO","interleaved=NO","fast-likelihood=NO","inheritance-scalars={1}",sep="\n",file=parmfile)

	#population re-labeling
	cat(paste("population-relabel={",paste(pop_relabel,collapse=" "),"}",sep=""),sep="\n",file=parmfile)

	#file names etc.
	cat("usertree=RANDOMTREE",paste("infile=../../../Migrate_datafiles_n14/",i,".mig",sep=""),"random-seed=AUTO",paste("title=",i,sep=""),"progress=YES","logfile=NO","print-data=NO",paste("outfile=",i,"_outfile.txt",sep=""),paste("pdf-outfile=",i,"_outfile.pdf",sep=""),sep="\n",file=parmfile)

	#more settings that don't need to change among species
	cat("use-M=YES","plot=NO","mathfile=mathfile","profile=ALL:QUICK","print-tree=NONE","write-summary=NO","aic-modeltest=NO","mig-histogram=NO","skyline=NO",sep="\n",file=parmfile)

	#theta start values. Can be a matrix of values input above.
	cat(paste("theta=own:{",paste(start.theta,sep=",",collapse=","),"}",sep=""),sep="\n",file=parmfile)

	#migration start values. Can be a matrix of values input above.
	cat(paste("migration=own:{",paste(start.migration,sep=",",collapse=","),"}",sep=""),sep="\n",file=parmfile)

	#more settings that don't need to change for species with msat only data
	cat("mutation=CONSTANT","fst-type=THETA",sep="\n",file=parmfile)

	#the migration matrix - input above
	cat(paste("custom-migration={",paste(get(migration.matrix),sep="",collapse=""),"}",sep=""),sep="\n",file=parmfile)

	#more settings that won't change among species
	cat("geo=NO","bayes-update=YES","bayes-updatefreq=0.500000","bayes-posteriorbins=500 500","bayes-posteriormaxtype=ALL","bayes-file=YES:bayesfile","bayes-allfile=YES:1:bayesallfile","bayes-proposals= THETA METROPOLIS Sampler","bayes-proposals= MIG SLICE Sampler",sep="\n",file=parmfile)

	#THETA PRIORS
	cat(paste("bayes-priors= THETA WEXPPRIOR:",paste(theta.prior,collapse=" "),sep=""),sep="\n",file=parmfile)

	#Migration PRIORS
	cat(paste("bayes-priors= MIG WEXPPRIOR:",paste(mig.prior,collapse=" "),sep=""),sep="\n",file=parmfile)

	#Chain Control - may move these settings up to "settings" later
	cat("long-chains=1",paste("long-inc=",increment,sep=""),paste("long-sample=",chainlength,sep=""),"burn-in=0",sep="\n",file=parmfile)

	#Heating
	cat("heating=YES:1:{1,1.5,3,100000}","heated-swap=YES",sep="\n",file=parmfile)

	#More settings having to do with convergence that won't change much, other than replicate, which should maybe be moved up
	cat("moving-steps=NO","long-chain-epsilon=INFINITY","gelman-convergence=No",replicate,"resistance=0.000100","end",sep="\n",file=parmfile)

	close(parmfile)
	}
}

####################MAKE PARMFILES - Regional Structure#################
#first we need to build the popstatus matrix a little differently, replacing ghost pops from the nwhi with regular pops because ghosts will screw things up down the line when they are lumped.
ghost_test_mhi<-function(x){if(x < 5) "G" else "R"}
ghost_test_nwhi<-function(x){if(x == 0) "X" else "R"} #R - population exists and was sampled, G -
popstatus1<-data.frame(matrix(sapply(as.matrix(sampleN[,2:5]),ghost_test_mhi),ncol=4),row.names=sampleN[,1],stringsAsFactors=F)
popstatus2<-data.frame(matrix(sapply(as.matrix(sampleN[,6:15]),ghost_test_nwhi),ncol=10),row.names=sampleN[,1],stringsAsFactors=F)
popstatus<-cbind(popstatus1,popstatus2)
names(popstatus)<-names(sampleN[2:15])

#remove troublesome species
modeltest<-modeltest[-c(6,7,9,14,15),] #acapla, anon2,anon4, carign, carmel(still need to make empirical modle for this one)
############################################

for(i in rownames(modeltest)) {#i<-"abuabd_CB_coleman_newH"
	dir.create(file.path(path,"Migrate_runs_regional",i))
	setwd(file.path(path,"Migrate_runs_regional",i))

	#Population Lumping - add hypotheses as necessary and stick them into the if/then statements below
	structure<-read.table(file="~/Dropbox/Crandall_tobo/regional_structure.txt",header=T,sep="\t",row.names=1)

	extant<-which(popstatus[paste(strsplit(i,"_")[[1]][1],strsplit(i,"_")[[1]][2],sep="_"),]!="X") #identifiers of pops that are extant
	npops<-length(extant) #the number of extant populations for this species

	migration.matrix<-"stepping.stone"

	for(hypothesis in c("hi_lo","1current","2currents","structure_panmixia","structure_currents","empirical")){#"

		dir.create(file.path(path,"Migrate_runs_regional",i,hypothesis))
		setwd(file.path(path,"Migrate_runs_regional",i,hypothesis))

	#Migration Matrices - just the stepping-stone matrix will do here
	stepping.stone<-as.matrix(read.delim(file=file.path("~/Dropbox/Crandall_tobo/migration_matrices",paste(strsplit(i,"_")[[1]][1],strsplit(i,"_")[[1]][2],"stepping.stone.txt",sep="_")),header=F))

	#again, we need to remove constant parameters for ghost populations from the nwhi because they will screw with migration matrices for lumped populations
    if(npops>4){
	stepping.stone[5:npops,][which(stepping.stone[5:npops,]=="c")]<-"*"
	stepping.stone[,5:npops][which(stepping.stone[,5:npops]=="c")]<-"*"
	}
#####IF/THEN settings for writing various versions####

	# if the model includes a gamma parameter, then discretize the gamma shape parameter
	model<-modeltest$bestmodel[which(rownames(modeltest)==i)]
	if(grepl("+G",model)){
		numrates<-4
		discretegammas<-c(modeltest$r1[which(rownames(modeltest)==i)],modeltest$r2[which(rownames(modeltest)==i)],modeltest$r3[which(rownames(modeltest)==i)],modeltest$r4[which(rownames(modeltest)==i)])

		discretegammaprobs<-c(modeltest$p1[which(rownames(modeltest)==i)],modeltest$p2[which(rownames(modeltest)==i)],modeltest$p3[which(rownames(modeltest)==i)],modeltest$p4[which(rownames(modeltest)==i)])

		} else {numrates<-1; discretegammas<-1;discretegammaprobs<-1}

	#if(migration.matrix=="panmixia"){pop_relabel<-panmixia_pop_relabel} else {pop_relabel<-all_pop_relabel}

	#if(migration.matrix=="n.island"){increment<-"500";chainlength<-"10000"} else {increment<-"500"; chainlength<-"50000"}

	clusters<-structure[hypothesis,extant]
	stepping.stone<-stepping.stone[1:max(clusters),1:max(clusters)]
#####Write the parmfiles################
	parmfile<-file("parmfile",open="w")

	#file header, plus some parameters that don't change for mtDNA
	cat("################################################################################",
"# Parmfile for Migrate 3.6.4 [do not remove these first TWO lines]",sep="\n",file=parmfile)

	#settings that will never change for sequence data
	cat("menu=NO", "nmlength=10","datatype=SequenceData",sep="\n",file=parmfile)

	#sequence model parameters for ttratio and base frequencies
	cat(paste("ttratio=",modeltest$titv[which(rownames(modeltest)==i)]),paste("freqs-from-data=NO:",modeltest$fA[which(rownames(modeltest)==i)],",",modeltest$fC[which(rownames(modeltest)==i)],",",modeltest$fG[which(rownames(modeltest)==i)],",",modeltest$fT[which(rownames(modeltest)==i)],sep=""),"seqerror-rate=0.0","categories=1",sep="\n",file=parmfile)

	#parameters for site rate variation (calculated above)
	cat(paste("rates=",numrates,":",paste(discretegammas,collapse=" "),sep=""),paste("prob-rates=",numrates,":",paste(discretegammaprobs,collapse=" "),sep=""),sep="\n",file=parmfile)

	#parameters that don't need to change among species (will mess with pop-relabel later)
	cat("autocorrelation=NO","weights=NO","interleaved=NO","fast-likelihood=NO","inheritance-scalars={1}",sep="\n",file=parmfile)

	#population re-labeling
	cat(paste("population-relabel={",paste(clusters,collapse=" "),"}",sep=""),sep="\n",file=parmfile)

	#file names etc.
	cat("usertree=RANDOMTREE",paste("infile=../../../Migrate_datafiles_n14/",i,".mig",sep=""),"random-seed=AUTO",paste("title=",i,sep=""),"progress=YES","logfile=NO","print-data=NO",paste("outfile=",i,"_outfile.txt",sep=""),paste("pdf-outfile=",i,"_outfile.pdf",sep=""),sep="\n",file=parmfile)

	#more settings that don't need to change among species
	cat("use-M=YES","plot=NO","mathfile=mathfile","profile=ALL:QUICK","print-tree=NONE","write-summary=NO","aic-modeltest=NO","mig-histogram=NO","skyline=NO",sep="\n",file=parmfile)

	#theta start values. Can be a matrix of values input above.
	cat(paste("theta=own:{",paste(start.theta,sep=",",collapse=","),"}",sep=""),sep="\n",file=parmfile)

	#migration start values. Can be a matrix of values input above.
	cat(paste("migration=own:{",paste(start.migration,sep=",",collapse=","),"}",sep=""),sep="\n",file=parmfile)

	#more settings that don't need to change for species with msat only data
	cat("mutation=CONSTANT","fst-type=THETA",sep="\n",file=parmfile)

	#the migration matrix - input above
	cat(paste("custom-migration={",paste(get(migration.matrix),sep="",collapse=""),"}",sep=""),sep="\n",file=parmfile)

	#more settings that won't change among species
	cat("geo=NO","bayes-update=YES","bayes-updatefreq=0.500000","bayes-posteriorbins=500 500","bayes-posteriormaxtype=ALL","bayes-file=YES:bayesfile","bayes-allfile=YES:1:bayesallfile","bayes-proposals= THETA METROPOLIS Sampler","bayes-proposals= MIG SLICE Sampler",sep="\n",file=parmfile)

	#THETA PRIORS
	cat(paste("bayes-priors= THETA WEXPPRIOR:",paste(theta.prior,collapse=" "),sep=""),sep="\n",file=parmfile)

	#Migration PRIORS
	cat(paste("bayes-priors= MIG WEXPPRIOR:",paste(mig.prior,collapse=" "),sep=""),sep="\n",file=parmfile)

	#Chain Control - may move these settings up to "settings" later
	cat("long-chains=1",paste("long-inc=",increment,sep=""),paste("long-sample=",chainlength,sep=""),"burn-in=0",sep="\n",file=parmfile)

	#Heating
	cat("heating=YES:1:{1,1.5,3,100000}","heated-swap=YES",sep="\n",file=parmfile)

	#More settings having to do with convergence that won't change much, other than replicate, which should maybe be moved up
	cat("moving-steps=NO","long-chain-epsilon=INFINITY","gelman-convergence=No",replicate,"resistance=0.000100","end",sep="\n",file=parmfile)

	close(parmfile)
	}
}


### script containing functions essential for metapeak/single-gene plot
library(GenomicRanges)
library(reshape2)
library(lattice)

read_matrix <- function(gr, cov, reverse_reads=FALSE, df=F, nu=25) {
  if(class(cov) == "character") {
    cov <- import.bw(cov, which=gr, as="RleList")
  }
  transform_function <- if(reverse_reads) { rev } else { identity }
  o <- order(gr)
  gr <- gr[o]

  if(df==T){
    reads.list <- regionApply_list(gr,cov, as.numeric )
    reads.list <-lapply(reads.list, function(reads) { approx(reads, n=nu)$y })
    reads.m <- matrix(as.numeric(unlist(reads.list, use.name=F)), nrow=length(reads.list), byrow=T)
    if(reverse_reads == T)reads.m <- reads.m[, ncol(reads.m):1]
  }else{
    reads.list <- regionApply(gr,cov, as.numeric )
    rl <- as(gr, "IntegerRangesList")
    view <- RleViewsList(rleList=cov[names(rl)], rangesList=rl)
    reads.list <- viewApply(view, function(x) { transform_function(as.numeric(x)) })
    reads.m <- matrix(unlist(sapply(reads.list, as.numeric)), nrow=length(gr), byrow=TRUE)
  }
  reads.m[o, ] <- reads.m
  reads.m
}

standard_metapeak_matrix <- function(regions.gr, sample.cov, upstream=100, downstream=100, diff_length = F, approx_nu=25) {
  if(diff_length == F){
    regions.gr <- resize(regions.gr, width=downstream)
    regions.gr <- resize(regions.gr, width=upstream + width(regions.gr), fix="end")

    reads <- matrix(nrow=length(regions.gr), ncol=width(regions.gr)[1])
  }else{
    reads <- matrix(nrow=length(regions.gr), ncol=approx_nu)
  }
  i_p <- which(as.vector(strand(regions.gr) == "+" | strand(regions.gr) == "*"))
  i_n <- which(as.vector(strand(regions.gr) == "-"))

  message("There are ", length(i_p), " positive granges and ", length(i_n), " negative granges")

  if(class(sample.cov) == "character") {
    sample.cov <- import.bw(sample.cov, which=regions.gr, as =  "RleList")
  }
  if(diff_length == F){
    if(length(i_p) > 0) reads[i_p, ] <- read_matrix(regions.gr[i_p], sample.cov)
    if(length(i_n) > 0) reads[i_n, ] <- read_matrix(regions.gr[i_n], sample.cov, reverse_reads=TRUE)
  }else{
    if(length(i_p) > 0)reads[i_p, ] <- read_matrix(regions.gr[i_p], sample.cov, df=diff_length, nu=approx_nu)
    if(length(i_n) > 0)reads[i_n, ]<- read_matrix(regions.gr[i_n], sample.cov, reverse_reads=TRUE, df=diff_length,  nu=approx_nu)
  }
  reads
}

exo_metapeak_matrix <- function(regions.gr, sample, upstream=100, downstream=100) {
  regions.gr <- resize(regions.gr, width=downstream)
  regions.gr <- resize(regions.gr, width=upstream + width(regions.gr), fix="end")
  regions.gr <- regions.gr[width(regions.gr) == upstream+downstream]

  i_p <- which(as.vector(strand(regions.gr) == "+" | strand(regions.gr) == "*"))
  i_n <- which(as.vector(strand(regions.gr) == "-"))

  message("There are ", length(i_p), " positive granges and ", length(i_n), " negative granges")

  reads.p <- matrix(nrow=length(regions.gr), ncol=width(regions.gr)[1])
  reads.n <- reads.p

  if(length(i_p) > 0) {
    reads.p[i_p, ] <- read_matrix(regions.gr[i_p], sample$pos, df=F, nu=NULL)
    reads.n[i_p, ] <- abs(read_matrix(regions.gr[i_p], sample$neg, df=F, nu=NULL))
  }

  if(length(i_n) > 0) {
    reads.p[i_n, ] <- abs(read_matrix(regions.gr[i_n], sample$neg, reverse_reads=TRUE, df=F, nu=NULL))
    reads.n[i_n, ] <- read_matrix(regions.gr[i_n], sample$pos, reverse_reads=TRUE, df=F, nu=NULL)
  }

  list(pos=reads.p, neg=reads.n)
}

standard_metapeak <- function(gr, sample, upstream=100, downstream=100, sample_name=NA, smooth=NA, different_length=F,approx_n=25) {
  message("standard metapeak: ", sample_name)
  if(different_length==F){
    reads <- standard_metapeak_matrix(gr, sample, upstream, downstream, diff_length=F, approx_nu=NULL)
    reads.df <- data.frame(tss_distance=(-1 * upstream):(downstream - 1),
                           reads=colMeans(reads),
                           sample_name=sample_name)
    if(!is.na(smooth)) reads.df$reads <- as.numeric(runmean(Rle(reads.df$reads), k=smooth, endrule="constant"))

  }else{
    reads <- standard_metapeak_matrix(regions.gr = gr, sample,upstream, downstream,  diff_length= T, approx_n=approx_n)
    reads.df <- data.frame(tss_distance=1:ncol(reads),
                           reads=colMeans(reads),
                           sample_name=sample_name)
  }

  reads.df
}

exo_metapeak <- function(gr, sample, upstream=100, downstream=100, sample_name=NA, smooth=NA) {
  message("exo metapeak: ", sample_name)
  reads.list <- exo_metapeak_matrix(gr, sample, upstream, downstream)

  reads.p <- reads.list$pos
  reads.n <- reads.list$neg

  df.p <- data.frame(tss_distance=(-1 * upstream):(downstream - 1),
                     reads=colMeans(reads.p),
                     strand="+")

  df.n <- data.frame(tss_distance=(-1 * upstream):(downstream - 1),
                     reads=colMeans(reads.n) *(-1),
                     strand="-")

  if(!is.na(smooth)) {
    df.n$reads <- as.numeric(runmean(Rle(df.n$reads), k=smooth, endrule="constant"))
    df.p$reads <- as.numeric(runmean(Rle(df.p$reads), k=smooth, endrule="constant"))
  }

  reads.df <- rbind(df.p, df.n)
  reads.df$sample_name <- sample_name
  reads.df$sample <- paste(reads.df$sample_name, reads.df$strand)
  reads.df
}


#' @useDynLib cop cop_allreduce_spar_densevec
spadd_reducer = function(x, root, comm, type)
{
  comm = as.integer(comm)
  comm_ptr = pbdMPI::get.mpi.comm.ptr(comm)

  type = comm.match.arg(tolower(type), TYPES_STR, comm=comm)
  type_int = type_str2int(type)

  .Call(cop_allreduce_spar_densevec, x, root, comm_ptr, type_int)
}

#' Sparse Adder Reduction
#'
#' Given a sparse matrix on each process, this computes the sum of all of those
#' matrices. The return will be stored as a sparse matrix, although it is not
#' guaranteed to be sparse.
#'
#' @param x
#' The input data. Should be a sparse \code{"dgCMatrix"} object. The matrix
#' should be the same dimensions across all processes.
#' @param comm
#' MPI communicator number.
#' @param type
#' The type used for the intermediate operations. Should be one of
#' "double" or "float".
#' @param root
#' MPI rank that should receive the return in the non-all version.
#'
#' @return
#' If the all version is called or if the calling rank is equal to \code{root},
#' then a sparse \code{"dgCMatrix"} object is returned, and otherwise
#' \code{NULL}.
#'
#' @name spadd_allreduce
#' @rdname spadd_allreduce
NULL

#' @rdname spadd_allreduce
#' @export
spadd_allreduce = function(x, comm=0L, type="double")
{
  UseMethod("spadd_allreduce", x)
}

#' @rdname spadd_allreduce
#' @export
spadd_reduce = function(x, root=0L, comm=0L, type="double")
{
  UseMethod("spadd_allreduce", x)
}

#' @rdname spadd_allreduce
#' @export
spadd_allreduce.dgCMatrix = function(x, comm=0L, type="double")
{
  spadd_reducer(x=x, root=REDUCE_TO_ALL, comm=comm, type=type)
}

#' @rdname spadd_allreduce
#' @export
spadd_reduce.dgCMatrix = function(x, root=0L, comm=0L, type="double")
{
  spadd_reducer(x=x, root=root, comm=comm, type=type)
}


############################################################
# For macaque paper, 08.19
# Makes scatterplots of sv length vs gene overlap.
# Gregg Thomas
############################################################

this.dir <- dirname(parent.frame(2)$ofile)
setwd(this.dir)

library(ggplot2)
library(reshape2)
library(plyr)
library(ggpubr)
library(cowplot)
library("ggtree")

source("../lib/read_svs.r")
source("../lib/filter_svs.r")
source("../lib/subset_svs.r")

cat("----------\n")

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

savefiles = T
# Run options

maxlen = 100000
# CNV length cutoffs

mq_svs = read.csv("../data/macaque-cnv-gene-overlaps.csv", header=T)
mq_svs = subset(mq_svs, length<=maxlen)
mq_svs$Species = "Macaque"
hu_svs = read.csv("../data/brandler-cnv-gene-overlaps.csv", header=T)
huvs = subset(hu_svs, length<=maxlen)
hu_svs$Species = "Human"
# Read and filter data

mq_svs$exons = mq_svs$exon.del.full.count + mq_svs$exon.del.partial.count + mq_svs$exon.dup.full.count + mq_svs$exon.dup.partial.count
hu_svs$exons = hu_svs$exon.del.full.count + hu_svs$exon.del.partial.count + hu_svs$exon.dup.full.count + hu_svs$exon.dup.partial.count
# Count exons per SV

######################
# Macaque
mq_reg = lm(mq_svs$exons ~ mq_svs$length)

mq_svs$Species = factor(mq_svs$Species, levels=c("Macaque", "Human"))

figX1a = ggplot(mq_svs, aes(length, exons, color=Species)) +
  #geom_smooth(method="loess", color="#999999", linetype="dashed", size=2, se=FALSE) +
  geom_point(size=3, alpha=0.2) +
  ggtitle("") +
  labs(x="CNV length (bp)", y="# Exons overlapping CNV") +
  scale_color_manual(name="", values=c("Macaque"='#490092',"Human"='#920000'), drop=FALSE) +
  theme_classic() +
  theme(axis.text=element_text(size=12),
        axis.title=element_text(size=16),
        axis.title.y=element_text(margin=margin(t=0,r=10,b=0,l=0),color="black"),
        axis.title.x=element_text(margin=margin(t=10,r=0,b=0,l=0),color="black"),
        axis.line=element_line(colour='#595959',size=0.75),
        axis.ticks=element_line(colour="#595959",size = 1),
        axis.ticks.length=unit(0.2,"cm"),
        legend.position="right",
        legend.key.width = unit(0.75,  unit = "cm"),
        legend.spacing.x = unit(0.25, 'cm'),
        legend.title = element_blank(),
        legend.text=element_text(size=12),
        plot.title = element_text(hjust=0.5, size=20),
        plot.margin = unit(c(1,1,0,1), "cm")
  ) +
  guides(colour = guide_legend(override.aes = list(alpha = 1)))
print(figX1a)

######################
# Human
hu_reg = lm(hu_svs$exons ~ hu_svs$length)

figX1b = ggplot(hu_svs, aes(length, exons, color=Species)) +
  #geom_smooth(method="loess", color="#999999", linetype="dashed", size=2, se=FALSE) +
  geom_point(size=3, alpha=0.2) +
  ggtitle("") +
  labs(x="CNV length (bp)", y="") +
  scale_color_manual(name="", values=c("Macaque"='#490092',"Human"='#920000'), drop=FALSE) +
  theme_classic() +
  theme(axis.text=element_text(size=12),
        axis.title=element_text(size=16),
        axis.title.y=element_text(margin=margin(t=0,r=10,b=0,l=0),color="black"),
        axis.title.x=element_text(margin=margin(t=10,r=0,b=0,l=0),color="black"),
        axis.line=element_line(colour='#595959',size=0.75),
        axis.ticks=element_line(colour="#595959",size = 1),
        axis.ticks.length=unit(0.2,"cm"),
        legend.position="right",
        legend.key.width = unit(0.75,  unit = "cm"),
        legend.spacing.x = unit(0.25, 'cm'),
        legend.title = element_blank(),
        legend.text=element_text(size=12),
        plot.title = element_text(hjust=0.5, size=20),
        plot.margin = unit(c(1,1,0,0), "cm")
  )
print(figX1b)

######################
# Combine plots for figure

cat("Combining plots...\n")
prow = plot_grid(figX1a + theme(legend.position="none"),
                 figX1b + theme(legend.position="none"),
                 align = 'vh',
                 labels = c("A", "B"),
                 label_size = 24,
                 hjust = -1,
                 nrow = 1)
# Combine panels A and B

legend_b = get_legend(figX1a + theme(legend.direction="horizontal", legend.justification="center", legend.box.just="bottom"))
# Extract the legend from one of the plots

p = plot_grid(prow, legend_b, ncol=1, rel_heights=c(1, 0.1))
# Add the legend underneath the row we made earlier with 10% of the height of the row.
print(p)

if(savefiles){
  outfile = "figX1.png"
  cat(" -> ", outfile, "\n")
  ggsave(filename=outfile, p, width=10, height=5, units="in")
}
# Save the figure
######################