## R Script for Preprocessing and WGCNA Postprocessing with Eric's FET and other Code for Queen/MSM 03/30/2018
## Adopted from Neal Parikshak, Vivek Swarup, Duc Duong, and Eric Dammer's code

###############################SET PARAMETERS################################################
rootdir <- "/Users/aohandjo/Library/Mobile Documents/com~apple~CloudDocs/MSM Research/Dissertation/1. TCGA Data Analysis/3. WGCNA/Emory Collab/" # This is the folder containing all of the analysis scripts, input, and output for this project
functiondir <- "CODE"
datadir <- "data"
outputfigs <- "figures"
outputtabs <- "tables"
InputExprMat <- "Rpkm_Tumor+Normal-proteincodingonly.csv" 
TraitsMat <-    "prad_clinical_data_numeric.csv"

############################INSTALL PACKAGES################################################
install.packages("NMF")
install.packages("igraph")
install.packages("gplots")
install.packages("boot")
install.packages("prerocessCore")
install.packages("doParallel")

source("https://bioconductor.org/biocLite.R")
biocLite("impute")
biocLite("affy")
biocLite("preprocessCore")
biocLite("sva")


############################LOAD PACKAGES####################################################
library(WGCNA) # Network analysis package
library(Cairo) # nicer graphics, anti-aliased, etc.
library(NMF) # this package has a great annotated heatmap function - aheatmap
library(igraph)
library(gplots)
library(affy)
library(impute)
library(boot)
library(preprocessCore)
library(doParallel)
#library(foreach)
Fonts(regular="Arial:style=Regular",bold="Arial:style=Bold",italic="Arial:style=Italic",bolditalic="Arial:style=Bold Italic,BoldItalic",symbol="Symbol")
options(stringsAsFactors=FALSE)
enableWGCNAThreads()
setwd(rootdir)

###########################LOAD DATA#######################################
exprMat<-as.matrix(read.csv(file=paste(rootdir,"/",datadir,"/",InputExprMat,sep=""),header=T, row.names=1))
numericMeta<-read.csv(paste(rootdir,"/",datadir,"/",TraitsMat,sep=""),header=TRUE,row.names=1)
rownames(numericMeta)<-gsub("-",".",rownames(numericMeta))
exprMat<-exprMat[,match(rownames(numericMeta),colnames(exprMat))] #match column order in exprMat to numericMeta

###########################CLEAN DATA/LOG TRANSFORM########################
quantile(exprMat,c(0,0.025,0.05,0.075,0.1,0.15,0.2,0.25,0.5,0.75,0.975,1),na.rm=TRUE)
exprMat[grepl("CXCR5",rownames(exprMat)),] #gene of interest has low (0.0x) RPKM expression

zeroCountsPerRow<-apply(exprMat,1,function(x) length(which(x==0)))
exprMat1<-exprMat[-which(zeroCountsPerRow>(ncol(exprMat)/2)),] #remove rows with more than 50% zero RPKM
quantile(exprMat,c(0,0.025,0.05,0.075,0.1,0.15,0.2,0.25,0.5,0.75,0.975,1),na.rm=TRUE)

exprMat2<-log2(exprMat1+0.01)


########################## Batch CORRECTION - ComBat ######################

library(sva)
library(impute)

#NAmatrix1<-exprMat
#NAmatrix1[!is.na(exprMat)] <- 1

#exprMatIMP<-impute.knn(exprMat)
#exprMatIMP<-exprMatIMP$data   

CombatInfo<-numericMeta
CombatInfo$Batch<-factor(CombatInfo$CollectionSite)

Grouping <- as.numeric(numericMeta$Tumor)
Grouping[which(numericMeta$Tumor==1)] <- "Tumor"
Grouping[which(numericMeta$Tumor==0)] <- "Normal"

CombatInfo$SampleID <- Grouping
CombatInfo$SampleID<-factor(CombatInfo$SampleID)

model=model.matrix(~CombatInfo$SampleID, data=as.data.frame(exprMat2))
exprMat.combat<-ComBat(dat=exprMat2,batch=as.vector(CombatInfo$Batch),mod=model)

#exprMat.combat.NAsReplaced<-exprMat.combat*NAmatrix1


#<SKIP>
#=======================================================================================#
# Perseus Style Imputation --impute according to assumption of infromative missingness  #
#=======================================================================================#
#exprMat0<-log2(exprMat)
#exprMat0<-exprMat.combat.NAsReplaced
#NAmatrix<-exprMat0
#NAmatrix[!is.na(exprMat0)] <- 1


######Calculate imputation parameters
#masterAvg <- mean(exprMat0[!is.na(exprMat0)])
#masterAvg
#masterSD <- sd(exprMat0[!is.na(exprMat0)])
#masterSD
#downshift <- 1.8*masterSD
#downshift
#noisePlusMinus <- 0.3*masterSD
#noisePlusMinus
#noiseAvg <- masterAvg-downshift
#noiseAvg

##############Impute noise!
#exprMatImp <- exprMat0
#avgVec <- rowMeans(exprMat0,na.rm=TRUE)
#seed=0
#set.seed(seed+3)
#for (i in 1:nrow(exprMat0)) {
  #noise<-ifelse(avgVec[i]<noiseAvg,avgVec[i],noiseAvg)
  #randVec<-runif(sum(is.na(exprMat0[i,]))+1,noise-noisePlusMinus,noise+noisePlusMinus)
  #exprMatImp[i,is.na(exprMat0[i,])]<-sample(randVec,sum(is.na(exprMat0[i,])),replace=FALSE)
#}
#dim(exprMatImp) #note: some rows may be all NA-> NaN
#exprMat<-exprMatImp[!is.na(rowSums(exprMatImp)),]  #remove those rows
#dim(exprMat) 



###################### Outlier Removal By First Pass WGCNA correlation/connectivity #########################################

cleanDat<-exprMat.combat
cleanDat<-cleanDat[,match(rownames(numericMeta),colnames(cleanDat))]

# Outlier removal by WGCNA connectivity (Z.k) fold SD 2.5 or 3
library(WGCNA)
####Check Outliers
sdout=3 #Z.k SD fold for outlier threshold
normadj <- (0.5+0.5*bicor(cleanDat,use="pairwise.complete.obs")^2)

## Calculate connectivity
netsummary <- fundamentalNetworkConcepts(normadj)
ku <- netsummary$Connectivity
z.ku <- ku-(mean(ku))/sqrt(var(ku))
## Declare as outliers those samples which are more than sdout sd above the mean connectivity based on the chosen measure
outliers <- (z.ku > mean(z.ku)+sdout*sd(z.ku))|(z.ku < mean(z.ku)-sdout*sd(z.ku))
print(paste("There are ",sum(outliers)," outliers samples based on a bicor distance sample network connectivity standard deviation above ",sdout,sep=""))
print(colnames(cleanDat)[outliers])
print(table(outliers))
targets.All=numericMeta


pdf(file="ConnectivityOutlierDetection.PDF",width=20,height=20)
par(mfrow=c(1,1))
par(mar = c(6, 8.5, 8.5, 3));

z.ku.zscore=(z.ku-mean(z.ku))/sd(z.ku)
boxplot(z.ku.zscore~factor(Grouping,c("Normal","Tumor")),col="lightgreen",ylab="z.Ku (z-score)",main="Connectivity Outlier Detection",xlab=NULL,las=2,outline=FALSE,ylim=c(min(z.ku.zscore)-0.2,max(z.ku.zscore)+0.2))
abline(h=-3,col="red")
stripchart(z.ku.zscore[!outliers]~factor(Grouping,c("Normal","Tumor"))[!outliers], vertical = TRUE, method = "jitter", jitter=0.2,add = TRUE, pch = 20, col = "blue")
stripchart(z.ku.zscore[outliers]~factor(Grouping,c("Normal","Tumor"))[outliers], vertical = TRUE, method = "jitter", jitter=0.2,add = TRUE, pch = 20, col = "red")

dev.off()

pointColvec<-rep("blue",length(z.ku))
pointColvec[match(names(which(outliers)),colnames(cleanDat))]<-"red"
names(pointColvec)<-colnames(cleanDat)

sampleTree = hclust(dist(t(cleanDat)), method = "average");
stree<-as.dendrogram(sampleTree)
#nodePar <- list(lab.cex = 0.6, pch = c(NA, 19), cex = 0.7, col = pointColvec)
#plot(stree, ylab = "Height", nodePar = nodePar, leaflab = "none")

i=0
colLab<<-function(n){
  if(is.leaf(n)){
    
    #I take the current attributes
    a=attributes(n)
    
    #I deduce the line in the original data, and so the outlier status.
    ligne=match(attributes(n)$label,names(pointColvec))
    olStatus=pointColvec[ligne];
    if(olStatus=="red"){col_treatment="red"};if(olStatus=="blue"){col_treatment="blue"}
    #        specie=data[ligne,2];
    #            if(specie=="dicoccoides"){col_specie="red"};if(specie=="dicoccum"){col_specie="Darkgreen"};if(specie=="durum"){col_specie="blue"}
    
    #Modification of leaf attribute
    attr(n,"nodePar")<-c(a$nodePar,list(cex=1.5,lab.cex=1,pch=20,col=col_treatment,lab.font=1,lab.cex=1)) #lab.col=col_specie
  }
  return(n)
}

stree2 <- dendrapply(stree, colLab)

pdf(file="ConnectivityOutlierDetection_part2-small.PDF",width=20,height=12)
par(mfrow=c(1,1))
par(mar = c(6, 8.5, 8.5, 3));

plot(stree2, ylab = "Height", nodePar = nodePar, main="Hierarchical Clustering of all 550 TCGA Samples",leaflab = "none")
legend("topright", 
       legend = c("Non-outlier", "Outlier"), 
       col = c("blue", "red"), 
       pch = c(20,20), bty = "n",  pt.cex = 1.5, cex = 0.8 , 
       text.col = "black", horiz = FALSE, inset = c(0.1, 0.1))

dev.off()

#MIDDLE OUTLIER:  TCGA.G9.6347.01A.11R.A31N.07

#cleanDat.ALL<-cleanDat
cleanDat <- cleanDat[,!outliers] #12 outlier at 3 SD (7 are normal tissue), more at 2.5 SD (not used)
targets= targets.All[!outliers,]


#enforce <50% missingness (NA values) (skip)
dim(cleanDat)
#cleanDat<-cleanDat[-which(rowSums(as.matrix(is.na(cleanDat)))>(ncol(cleanDat)/2-1)),]
#dim(cleanDat)

###########################LOAD PARAMETERS##################################
GI <- rownames(cleanDat)
numericMeta <- numericMeta[match(colnames(cleanDat),rownames(numericMeta)),]

#<SKIP> - no regressible traits other than age.
##########################BOOTSTRAP REGRESSION########################################
boot <- TRUE
numboot <- 1000
bs <- function(formula, data, indices) {
  d <- data[indices,] # allows bootstrap function to select samples
  fit <- lm(formula, data=d)
  return(coef(fit))
}  

library(doParallel)

#To run in parallel
#stopCluster(Cluster) #if a prior makeCluster() function call happened.
parallelThreads=30
clusterLocal <- makeCluster(c(rep("haplotein.biochem.emory.edu",parallelThreads)), type = "SOCK", port=10191, user="edammer", rscript="/usr/bin/Rscript",rscript_args="OUT=/dev/null SNOWLIB=/usr/lib64/R/library",manual=FALSE)
registerDoParallel(clusterLocal)

cleanDat.unreg<-cleanDat

age=as.numeric(numericMeta$AGE)
sex=as.numeric(factor(numericMeta$SEX))
PMI=as.numeric(numericMeta$PMD)


regvars <- as.data.frame(cbind(age,sex,PMI)) #all 3 for regression

## Run the regression
normExpr.reg <- matrix(NA,nrow=nrow(cleanDat),ncol=ncol(cleanDat))
rownames(normExpr.reg) <- rownames(cleanDat)
colnames(normExpr.reg) <- colnames(cleanDat)
coefmat <- matrix(NA,nrow=nrow(cleanDat),ncol=ncol(regvars)+1) # ncol= needs to match number of columns in regvar


if (parallelThreads > 1) {
  
  if (boot==TRUE) { #ORDINARY NONPARAMETRIC BOOTSTRAP
    set.seed(8675309)
    cat('[bootstrap-PARALLEL] Working on ORDINARY NONPARAMETRIC BOOTSTRAP regression with ', parallelThreads, ' threads over ', nrow(cleanDat), ' iterations.\n Estimated time to complete:', round(120/parallelThreads*nrow(cleanDat)/2736,1), ' minutes.\n') #intermediate progress printouts would not be visible in parallel mode
    coefmat <- foreach (i=1:nrow(cleanDat), .combine=rbind) %dopar% {
      options(stringsAsFactors=FALSE)
      library(boot)
      thisexp <- as.numeric(cleanDat[i,])
      bs.results <- boot(data=data.frame(thisexp,regvars), statistic=bs,
                         R=numboot, formula=thisexp~age+sex+PMI) #condition.ad+condition.ftdu+condition.tau+condition.pdd+condition.msa+condition.pd+condition.als
      ## get the median - we can sometimes get NA values here... so let's exclude these - old code #bs.stats <- apply(bs.results$t,2,median) 
      bs.stats <- rep(NA,ncol(bs.results$t)) ##ncol is 3 here (thisexp, construct and extracted)
      for (n in 1:ncol(bs.results$t)) {
        bs.stats[n] <- median(na.omit(bs.results$t[,n]))
      }
      bs.stats
      #cat('[bootstrap] Done for Protein ',i,'\n') #will not be visible
    }
    normExpr.reg <-foreach (i=1:nrow(cleanDat), .combine=rbind) %dopar% { (cleanDat[i,]- coefmat[i,3]*regvars[,"sex"] - coefmat[i,4]*regvars[,"PMI"]) }
  } else { #linear model regression; faster but incomplete regression of Age, Sex, PMI effects, SO NOT USED WITH boot=TRUE (requires changing coefmat matrix ncol to 1 less above)
    coefmat<-coefmat[,-ncol(coefmat)] #handles different column requirement for lm regression method
    for (i in 1:nrow(cleanDat)) {
      if (i%%1000 == 0) {print(i)}
      lmmod1 <- lm(as.numeric(cleanDat[i,])~condition.AD+condition.PSP+condition.PA+age+PMI,data=regvars) #ALL 3 regression
      #      lmmod1 <- lm(as.numeric(cleanDat[i,])~condition +age+sex+PMI,data=regvars)
      ##datpred <- predict(object=lmmod1,newdata=regvars)
      coef <- coef(lmmod1)
      coefmat[i,] <- coef
      normExpr.reg[i,] <- coef[1] + coef[2]*regvars[,"condition.AD"] + lmmod1$residuals ## The full data - the undesired covariates
      ## Also equivalent to <- thisexp - coef*var expression above
      cat('Done for Protein ',i,'\n')
    }
  }
  
} else {
  #single thread not handled
}
##check to see if quantile are pretty close together -> ensure that there are no N/A and that there is no drastic differences 
quantile(cleanDat.unreg[,1],c(0,0.025,0.25,0.5,0.75,0.975,1),na.rm=TRUE)
quantile(normExpr.reg[,1],c(0,0.025,0.25,0.5,0.75,0.975,1),na.rm=TRUE)

cleanDat<-normExpr.reg
rownames(cleanDat)<-rownames(cleanDat.unreg)

save(cleanDat,cleanDat.unreg,numericMeta,file=paste(rootdir,"/",InputExprMat,"_BootRegrSexPMI_AgeModelledExplicitly&noOLsRemoved+COMBATwith4AgeTiers.rData",sep=""))
#write.csv(file=paste(rootdir,"/",outputtabs,"/",InputExprMat,"_BootRegrSexPMI_AgeModelledExplicitly&noOLsRemoved+COMBATwith4AgeTiers.csv",sep=""),cleanDat)


############################GET SOFT THRESHOLD ##########################
enableWGCNAThreads()
powers <- seq(4,14,by=2) #seq(5,10,by=1) #was run on a first pass
sft <- pickSoftThreshold(t(cleanDat),
                         powerVector=powers,
                         corFnc="bicor",networkType="signed")
# Plot the results:
sizeGrWindow(9, 5)
par(mfrow = c(1,2));
cex1 = 0.9;
# Scale-free topology fit index as a function of the soft-thresholding power
plot(sft$fitIndices[,1], -sign(sft$fitIndices[,3])*sft$fitIndices[,2],
     xlab="Soft Threshold (power)",ylab="Scale Free Topology Model Fit,signed R^2",type="n",
     main = paste("Scale independence"));
text(sft$fitIndices[,1], -sign(sft$fitIndices[,3])*sft$fitIndices[,2],
     labels=powers,cex=cex1,col="red");
# this line corresponds to using an R^2 cut-off of h
abline(h=0.80,col="red")
# Mean connectivity as a function of the soft-thresholding power
plot(sft$fitIndices[,1], sft$fitIndices[,5],
     xlab="Soft Threshold (power)",ylab="Mean Connectivity", type="n",
     main = paste("Mean connectivity"))
text(sft$fitIndices[,1], sft$fitIndices[,5], labels=powers, cex=cex1,col="red")
#with ComBat, and connectivity outlier removal (3SD), visualization of power 4-14,by=1 shows power 10 gets us right to 0.8 SFT R?

############################GET NETWORK##############################
power <- 10
mergeHeight <- 0.1
PAMstage <- TRUE
ds=2
net <- blockwiseModules(t(cleanDat),power=power,deepSplit=ds,minModuleSize=75,TOMDenom="mean",
			mergeCutHeight=mergeHeight, corType="bicor",networkType="signed", 
			pamStage=PAMstage, pamRespectsDendro=TRUE,reassignThresh=0.05,
                        verbose=3,saveTOMs=FALSE,maxBlockSize=20000)
table(net$colors)
cbind(colnames(as.matrix(table(net$colors))),table(net$colors))

#overwrite Rdata file with same variables, plus network.
save(net,cleanDat,numericMeta,file=paste0(rootdir,"/",InputExprMat,"_ComBatTumorORnormal&no12OLsRemoved_ds2_power10_MergeCutHeight0.10.rData"))

###########################VISUALIZATIONS###################################

nModules<-length(table(net$colors))-1
modules<-cbind(colnames(as.matrix(table(net$colors))),table(net$colors))
orderedModules<-cbind(paste("M",seq(1:nModules),sep=""),labels2colors(c(1:nModules)))
modules<-modules[match(as.character(orderedModules[,2]),rownames(modules)),]
cbind(orderedModules,modules)
#number of modules with comBat, outlier removal (power 10), ds=2, MinModuleSize=75, mergeCutHeight=0.1:  12 modules


## Output Information about the modules
pdf(file=paste(rootdir,"/",outputfigs,"/GlobalNetworkPlots-PrCaTCGA_power",power,"_MergeHeight",mergeHeight,"_PAMstage",PAMstage,"_ds",ds,".pdf",sep=""),width=16,height=12)     

## Plot dendrogram with module colors and trait correlations
MEList = moduleEigengenes(t(cleanDat), colors = net$colors)
MEs = MEList$eigengenes

geneSignificance <- cor(numericMeta,t(cleanDat),use="pairwise.complete.obs")
rownames(geneSignificance) <- colnames(numericMeta)
geneSigColors <- t(numbers2colors(t(geneSignificance),,signed=TRUE,lim=c(-1,1),naColor="black"))
rownames(geneSigColors) <- colnames(numericMeta)

plotDendroAndColors(dendro=net$dendrograms[[1]],
                    colors=t(rbind(net$colors,geneSigColors)),
                    cex.dendroLabels=1.2,addGuide=TRUE,
                    dendroLabels=FALSE,
                    groupLabels=c("Module Colors",colnames(numericMeta)))

## Plot eigengene dendrogram/heatmap - using bicor
MEs <- net$MEs #already redefined above (without MCI)
plotEigengeneNetworks(MEs, "Eigengene Network", marHeatmap = c(3,4,2,2), marDendro = c(0,4,2,0),plotDendrograms = TRUE, xLabelsAngle = 90,heatmapColors=blueWhiteRed(50))
colnames(MEs) <- substr(colnames(MEs),3,100)
rownames(MEs) <- colnames(cleanDat)

## Find differences between AD, Asym, and CT
regvars <- data.frame(as.factor(Grouping),as.numeric(numericMeta$Age)) # often Dx is first regvar.
colnames(regvars) <- c("Group","Age") ## data frame with covaraites in case we want to try multivariate regression
#aov1 <- aov(data.matrix(MEs)~Group,data=regvars) ## ANOVA framework yields same results
lm1 <- lm(data.matrix(MEs)~Group,data=regvars)

pvec <- rep(NA,ncol(MEs))
for (i in 1:ncol(MEs)) {
  f <- summary(lm1)[[i]]$fstatistic ## Get F statistics
  pvec[i] <- pf(f[1],f[2],f[3],lower.tail=F) ## Get the p-value corresponding to the whole model
}
names(pvec) <- colnames(MEs)

## Get sigend kME values
tmpMEs <- MEs
colnames(tmpMEs) <- paste("ME",colnames(MEs),sep="")
kMEdat <- signedKME(t(cleanDat), tmpMEs, corFnc="bicor")

## Plot eigengene-trait correlations - using bicor
MEcors <- bicorAndPvalue(MEs,numericMeta)
moduleTraitCor <- MEcors$bicor
moduleTraitPvalue <- MEcors$p

textMatrix = paste(signif(moduleTraitCor, 2), " / (",
  signif(moduleTraitPvalue, 1), ")", sep = "");
dim(textMatrix) = dim(moduleTraitCor)
par(mfrow=c(1,1))
par(mar = c(6, 8.5, 3, 3));

## Display the correlation values within a heatmap plot
colvec <- rep("white",100)
colvec[1:10] <- "red"
labeledHeatmap(Matrix = moduleTraitPvalue,
               xLabels = colnames(numericMeta),
               yLabels = names(MEs),
               ySymbols = names(MEs),
               colorLabels = FALSE,
               colors = colvec,
               textMatrix = textMatrix,
               setStdMargins = FALSE,
               cex.text = 0.8,
               zlim = c(0,1),
               main = paste("Module-trait relationships\n bicor r-value \n (p-value)"),
               cex.main=0.8)

#dev.off()

## Plot annotated heatmap - annotate all the metadata, plot the eigengenes!
toplot <- MEs
Grouping <- as.numeric(numericMeta$Tumor)
Grouping[which(numericMeta$Tumor==1)] <- "Tumor"
Grouping[which(numericMeta$Tumor==0)] <- "Normal"

######################
## Plot eigengene-trait heatmap custom - using bicor

MEcors <- bicorAndPvalue(MEs,numericMeta)
moduleTraitCor <- MEcors$bicor
moduleTraitPvalue <- MEcors$p

moduleTraitPvalue<-signif(moduleTraitPvalue, 1)
moduleTraitPvalue[moduleTraitPvalue > as.numeric(0.05)]<-as.character("")


textMatrix = paste(signif(moduleTraitCor, 2), " / (",
  moduleTraitPvalue, ")", sep = "");
dim(textMatrix) = dim(moduleTraitCor)
textMatrix = gsub("()", "", textMatrix,fixed=TRUE)

labelMat<-matrix(nrow=(length(names(MEs))-1), ncol=2,data=c(rep(1:(length(names(MEs))-1)),labels2colors(1:(length(names(MEs))-1))))
labelMat<-labelMat[match(names(MEs),labelMat[,2]),]
labelMat[length(names(MEs)),2]<-"grey"
for (i in 1:(length(names(MEs))-1)) { labelMat[i,1]<-paste("M",labelMat[i,1],sep="") }
for (i in 1:length(names(MEs))) { labelMat[i,2]<-paste("ME",labelMat[i,2],sep="") }

par( mar = c(8, 12, 3, 3) );
par(mfrow=c(2,1))

bw<-colorRampPalette(c("#0058CC", "white"))
wr<-colorRampPalette(c("white", "#CC3300"))

colvec<-c(bw(50),wr(50))

labeledHeatmap(Matrix = t(moduleTraitCor),
               yLabels = colnames(numericMeta),
               xLabels = labelMat[,2],
               xSymbols = labelMat[,1],
               xColorLabels=TRUE,
               colors = colvec,
#               textMatrix = t(textMatrix), #signif(moduleTraitPvalueEmory, 2), #if you want text values over the heatmap
               setStdMargins = FALSE,
               cex.text = 0.5,
               verticalSeparator.x=c(rep(c(1:(length(colnames(MEs))-1)),as.numeric(ncol(MEs)-1))),
               verticalSeparator.col = 1,
               verticalSeparator.lty = 1,
               verticalSeparator.lwd = 1,
               verticalSeparator.ext = 0,
               horizontalSeparator.y=c(rep(TRUE,ncol(numericMeta))),
               horizontalSeparator.col = 1,
               horizontalSeparator.lty = 1,
               horizontalSeparator.lwd = 1,
               horizontalSeparator.ext = 0,
               zlim = c(-1,1),
               main = "27 TMT log2(norm abun/GIS) Module-trait Relationships\n Heatmap: signed bicor r-value", # \n (Sig. p-values shown)"),
               cex.main=0.8)

#++++++++++++++++++++++++++++++++++
colnames(toplot) <- colnames(MEs)
rownames(toplot) <- rownames(MEs)
toplot <- t(toplot)

pvec <- pvec[match(names(pvec),rownames(toplot))]
rownames(toplot) <- paste(rownames(toplot),"\np = ",signif(pvec,2),sep="")

par(mfrow=c(4,6))
par(mar=c(5,6,4,2))

for (i in 1:nrow(toplot)) {
  boxplot(toplot[i,]~factor(Grouping,c("Normal","Tumor")),col=colnames(MEs)[i],ylab="Eigengene Value",main=paste0(orderedModules[match(colnames(MEs)[i],orderedModules[,2]),1]," ", rownames(toplot)[i]),xlab=NULL,las=2)
  verboseScatterplot(x=numericMeta[,"Age"],y=toplot[i,],xlab="Age (years)",ylab="Eigengene",abline=TRUE,cex.axis=1,cex.lab=1,cex=1,col=colnames(MEs)[i],pch=19)
  verboseScatterplot(x=numericMeta[,"AJCC.T.Stage.Numeric"],y=toplot[i,],xlab="AJCC Tumor Stage",ylab="Eigengene",abline=TRUE,cex.axis=1,cex.lab=1,cex=1,col=colnames(MEs)[i],pch=19)
  verboseScatterplot(x=numericMeta[,"Gleason.Sum"],y=toplot[i,],xlab="Gleason Score",ylab="Eigengene",abline=TRUE,cex.axis=1,cex.lab=1,cex=1,col=colnames(MEs)[i],pch=19)
  verboseScatterplot(x=numericMeta[,"PSA"],y=toplot[i,],xlab="PSA measurement",ylab="Eigengene",abline=TRUE,cex.axis=1,cex.lab=1,cex=1,col=colnames(MEs)[i],pch=19)
  verboseScatterplot(x=numericMeta[,"Distant.Metastasis.M.Stage"],y=toplot[i,],xlab="Metastasis M Stage",ylab="Eigengene",abline=TRUE,cex.axis=1,cex.lab=1,cex=1,col=colnames(MEs)[i],pch=19)
}

dev.off()

write.table(cbind(rownames(cleanDat),net$colors,kMEdat),file=paste0(rootdir,"/",outputtabs,"/ModuleAssignments-PrCaTCGA_power",power,"_MergeHeight",mergeHeight,"_PAMstage",PAMstage,"_ds",ds,".txt"),sep="\t")


## PCA Check for Batch/Site Effects


## FET HEATMAP
####################

GeneIndex<-as.matrix(strsplit(rownames(cleanDat), "\\|"))
modulesData<-data.frame(UniqueID=rownames(cleanDat))
for (i in c(1:nrow(GeneIndex))){
	modulesData$GI[i] <- GeneIndex[[i]][1]
	modulesData$UniprotID[i] <- GeneIndex[[i]][2]
}
modulesData$colors<-net$colors

allGenes<-modulesData$GI
allGenesNetwork <- as.matrix(allGenes,stringsAsFactors = FALSE) 

moduleList <- list()
modcolors=unique(modulesData$colors)
for (i in 1:length(modcolors)) {
	element<-modcolors[i]
	moduleList[[element]] <- modulesData$GI[which(modulesData$colors==modcolors[i])]
}

moduleList$grey <- NULL

###########
refDataDir <- "F:/Emory Collab/data/"
refDataFile1 <- "FET_GeneLists-MSM.csv"
outputDir <- "f:/Emory Collab/tables/"
###########

pdf(file=paste0(rootdir,"/",outputfigs,"/FETheatmap-GeneLists-PrCaTCGA-12modules.pdf"),height=10,width=16) 

for (refDataFile in c(refDataFile1)) { #
#+#+#+#+#+#+#+#+#+#+#+#+#+
refData <- as.list(read.csv(paste(refDataDir,refDataFile, sep=""),sep=",", stringsAsFactors = FALSE,header=T)) 

nModules <- length(names(moduleList))
nCellTypes <- length(names(refData))

for (a in 1:nModules) {
	moduleList[[a]] <- unique(moduleList[[a]][moduleList[[a]] != ""])
	moduleList[[a]] <- moduleList[[a]][!is.na(moduleList[[a]])]
}
for (b in 1:nCellTypes) {
	refData[[b]] <- unique(refData[[b]][refData[[b]] != ""])
}

moduleList <- moduleList[order(sapply(moduleList,length),decreasing=T)]
refData <- refData[order(sapply(refData,length),decreasing=T)]

allGenes_cleaned <- na.omit(allGenesNetwork)
totProteomeLength <- length(allGenes_cleaned)

### Fisher's Exact Test

FTpVal <- matrix(,nrow = nModules, ncol = nCellTypes) 
cellOverlap <- matrix(,nrow = nModules, ncol = nCellTypes) 
numCellTypeInDataset <- matrix(,nrow = nModules, ncol = nCellTypes) 
cellTypeInDataset <- list()


for (i in 1:nModules){
	sampleSize <- length(moduleList[[i]])
	for (j in 1:nCellTypes){
		#cellTypeInProteome <- refData[[j]] ## If using all of the markers and not just markers in proteome
		cellTypeInProteome <- intersect(refData[[j]],allGenesNetwork[,1])
		numCellTypeInProteome <- length(cellTypeInProteome)
		numNonCellTypeInProteome <- totProteomeLength - numCellTypeInProteome
		overlapGenes <- intersect(moduleList[[i]],cellTypeInProteome)
		numOverlap <- length(overlapGenes)
		otherCells <- sampleSize - numOverlap
		notInModule <- numCellTypeInProteome - numOverlap
		notInMod_otherCells <- totProteomeLength - numCellTypeInProteome - otherCells
		contingency <- matrix(c(numOverlap,otherCells,notInModule,notInMod_otherCells),nrow=2,ncol=2)		
		FT <- fisher.test(contingency,alternative="greater")
		FTpVal[i,j] <- FT$p.value
		cellOverlap[i,j] <- numOverlap
		numCellTypeInDataset[i,j] <- numCellTypeInProteome 
		if (i==1){
			cellTypeInDataset[[j]] <- array(cellTypeInProteome)
		}		
	}
}

cellTypes <- names(refData)
rownames(FTpVal) <- paste(names(moduleList))
colnames(FTpVal) <- cellTypes
rownames(cellOverlap) <- paste(names(moduleList))
colnames(cellOverlap) <- cellTypes
colnames(numCellTypeInDataset) <- cellTypes
rownames(numCellTypeInDataset) <- paste(names(moduleList))
names(cellTypeInDataset) <- cellTypes

#### Format Data for Plotting ########

NegLogUncorr <- -log10(FTpVal)
rownames(NegLogUncorr) <- rownames(FTpVal)
colnames(NegLogUncorr) <- colnames(FTpVal)
NegLogUncorr <- as.matrix(NegLogUncorr)

nCellTypes = ncol(FTpVal)
nModules = nrow(FTpVal)

FisherspVal <- unlist(FTpVal)
adjustedPVal <- p.adjust(FisherspVal, method = "fdr", n=length(FisherspVal))
adjustedPval <- matrix(adjustedPVal,nrow=nModules,ncol=nCellTypes)
rownames(adjustedPval) <- rownames(FTpVal)
colnames(adjustedPval) <- colnames(FTpVal)
NegLogCorr <- -log10(adjustedPval)

cellTypes <- colnames(FTpVal)

##Make sure colors are in correct (WGCNA) order before changing to numbered modules!
library(WGCNA)
orderedLabels<- cbind(paste("M",seq(1:nModules),sep=""),labels2colors(c(1:nModules)))

##if you want the modules in decreasing size order:
#NegLogUncorr<-NegLogUncorr[match(orderedLabels[,2],rownames(NegLogUncorr)),]
#NegLogCorr<-NegLogCorr[match(orderedLabels[,2],rownames(NegLogCorr)),]
#xlabels <- orderedLabels[,1]
  #(adjustedPval is in correct order already)

#if you want the modules in order of relatedness from the module relatedness dendrogram:
orderedLabelsByRelatedness<- cbind( orderedLabels[ match(gsub("ME","",names(net$MEs)),orderedLabels[,2]) ,1] ,gsub("ME","",names(net$MEs)) )
orderedLabelsByRelatedness<-orderedLabelsByRelatedness[-which(is.na(orderedLabelsByRelatedness[,1])),]
NegLogUncorr<-NegLogUncorr[match(orderedLabelsByRelatedness[,2],rownames(NegLogUncorr)),]
NegLogCorr<-NegLogCorr[match(orderedLabelsByRelatedness[,2],rownames(NegLogCorr)),]
xlabels <- orderedLabelsByRelatedness[,1] #paste("M",seq(1:nModules),sep="")
adjustedPval<-adjustedPval[match(orderedLabelsByRelatedness[,2],rownames(adjustedPval)),]
FTpVal<-FTpVal[match(orderedLabelsByRelatedness[,2],rownames(FTpVal)),]

### Write p Values to a table/file
outputData <- rbind("FET pValue", FTpVal,"FDR corrected",adjustedPval,"Overlap",cellOverlap,"CellTypeInDataSet",numCellTypeInDataset[1,])
write.csv(outputData,file = paste0(outputDir,"FETvs.GeneLists.output.csv"))

## Use the text function with the FDR filter in labeledHeatmap to add asterisks, e.g. * 
 txtMat <- adjustedPval
 txtMat[adjustedPval>=0.05] <- ""
  txtMat[adjustedPval <0.05&adjustedPval >0.01] <- "*"
  txtMat[adjustedPval <0.01&adjustedPval >0.005] <- "**"
  txtMat[adjustedPval <0.005] <- "***"

  txtMat1 <- signif(adjustedPval,2)
 txtMat1[adjustedPval>0.1] <- ""

  
  textMatrix1 = paste( txtMat1, '\n', txtMat , sep = '');
  textMatrix1= matrix(textMatrix1,ncol=ncol(adjustedPval),nrow=nrow(adjustedPval))




### Plotting

par(mfrow=c(2.5,1))
par( mar = c(4, 8.5, 3, 1) ) #bottom, left, top, right #text lines

bw<-colorRampPalette(c("#0058CC", "white"))
wr<-colorRampPalette(c("white", "#CC3300"))
#maxVAL=max(NegLogCorr,na.rm=T) #*** max(NegLogUncorr,na.rm=T)
#FractionRed=round( (maxVAL-1.3)/maxVAL*100,digits=0)
#FractionBlue=100-FractionRed
#colvec<-c(bw(FractionBlue*5),wr(FractionRed*5)) #*5 smooths the blue part

colvec<-wr(500)

labeledHeatmap(Matrix = t(NegLogCorr), #*** t(NegLogUncorr),
               yLabels = cellTypes,
               xLabels = names(net$MEs),
               xSymbols = xlabels,
               xColorLabels=TRUE,
               colors = colvec,
               textMatrix = t(textMatrix1), #signif(t(adjustedPval), 2), #*** signif(t(FTpVal), 2),
               setStdMargins = FALSE,
               cex.text = 0.6,
               verticalSeparator.x=c(rep(c(1:nrow(orderedLabelsByRelatedness)),nrow(orderedLabelsByRelatedness))),
               verticalSeparator.col = 1,
               verticalSeparator.lty = 1,
               verticalSeparator.lwd = 1,
               verticalSeparator.ext = 0,
               horizontalSeparator.y=c(rep(c(1:length(cellTypes)),nrow(orderedLabelsByRelatedness))),
               horizontalSeparator.col = 1,
               horizontalSeparator.lty = 1,
               horizontalSeparator.lwd = 1,
               horizontalSeparator.ext = 0,
               zlim = c(0,3), #maxVAL),
               main = paste0("TCGA 530+ Sample RNA-Seq Network (12 Modules) Gene List FET Overlap (",refDataFile,")\n Heatmap: -log(p), BH Corrected\n (Corrected p-values shown)"), #*** Uncorrected\n (p-values shown)"),
               cex.main=0.8)
#+#+#+#+#+#+#+#+#+#+#+#+#+
}
dev.off()
#*** Toggle these 4 lines' comments above to switch from BH corrected to uncorr FTpVal for Heatmap.




## ANOVA / DiffEx
##################################

outfileprefix = "PrCa_TCGA-"
outfile = paste0(outfileprefix,"-output_ANOVA_diffEx")
data = as.data.frame(cbind(colnames(cleanDat), Grouping, t(cleanDat)))
colnames(data)[1:2]<-c("CODE","SampleType")
#test run gets column headers for output
i=3
aov<-aov(data[,i]~SampleType, data=data)
anovaresult<-anova(aov)
tuk <- TukeyHSD(aov)
tukresult<-data.frame(tuk$SampleType)
j=length(rownames(tukresult))
comparisonList<-rownames(tukresult)

line = c(paste("Protein", "F-Value", "Pr(>F)", sep=","))
for (a in 1:length(comparisonList)) {
  line=c(paste(line,comparisonList[a],sep=","))
}
for (a in 1:length(comparisonList)) {
  line=c(paste(line,paste0("diff ",comparisonList[a]),sep=","))
}

ANOVAout<-as.vector(data.frame(do.call("rbind",strsplit(as.character(line),"[,]"))))
for (i in 3:(ncol(data))){
	aov<-aov(data[,i]~SampleType, data=data)
	anovaresult<-anova(aov)
	tuk <- TukeyHSD(aov)
	tukresult<-data.frame(tuk$SampleType)
	ANOVAout<-rbind(ANOVAout, c(colnames(data)[i], anovaresult$F[1], anovaresult$Pr[1], as.vector(tukresult[,"p.adj"]),as.vector(tukresult[,"diff"])))
}
colnames(ANOVAout)<-ANOVAout[1,]
rownames(ANOVAout)<-ANOVAout[,1]
ANOVAout<-ANOVAout[c(2:nrow(ANOVAout)),c(2:ncol(ANOVAout))]

ANOVAout$NETcolors <- net$colors

#*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+
write.csv(ANOVAout,file=paste0(rootdir,outputtabs,"/",outfile,".csv"))
#*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+

##########################################
## ALTERNATE (T Test) output matrix

outfileprefix = "PrCa_TCGA-"
outfile = paste0(outfileprefix,"-output_ANOVA_diffEx")
data = as.data.frame(cbind(colnames(cleanDat), Grouping, t(cleanDat)))
colnames(data)[1:2]<-c("CODE","SampleType")

t.temp.pval<-apply(data[,3:ncol(data)],2,function(x) { t.test(as.numeric(x[which(Grouping==unique(Grouping)[2])]),as.numeric(x[which(Grouping==unique(Grouping)[1])]),alternative="two.sided",var.equal=TRUE)$p.value })
diff.temp.all<-apply(data[,3:ncol(data)],2,function(x) { mean(as.numeric(x[which(Grouping==unique(Grouping)[2])])) - mean(as.numeric(x[which(Grouping==unique(Grouping)[1])]))})

unique(Grouping)[2] #Normal, so above diff is log2(Normal/Tumor)

ANOVAout <- Ttestout <- data.frame(UniqueID=colnames(data)[3:ncol(data)], NormalvsTumor=as.vector(t.temp.pval),diff.NormalvsTumor=as.vector(diff.temp.all))

ANOVAout$NETcolors <- net$colors
rownames(ANOVAout)<-ANOVAout$UniqueID
ANOVAout<-ANOVAout[,-1]
colnames(ANOVAout)[c(1:2)]<-c("Normal-Tumor","diff Normal-Tumor")


#*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+
write.csv(ANOVAout,file=paste0(rootdir,outputtabs,"/",outfile,".csv"))
#*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+


#<SKIP, UNLESS YOU HAVE 2-3 different pairwise comparisons to overlap significant hits for>
#######################
## Venn (repeat for multiple 3-way venns), & then Volcano
library(VennDiagram,limma)
library(ggplot2,gplots)
library("gridExtra")

Grouping
colnames(ANOVAout) 
######################## *******************************
pValColsForVenn=c(1,2,3) #choose 3 columns with p values
######################## *******************************


#Check Venn Counts
vennDexCount <- as.data.frame(matrix(integer(nrow(ANOVAout)), ncol=4,nrow=nrow(ANOVAout)))
colnames(vennDexCount)=c(colnames(ANOVAout)[pValColsForVenn],"IntersectCount")
rownames(vennDexCount)=rownames(ANOVAout)
vennDexCount[which(as.numeric(as.matrix(ANOVAout[pValColsForVenn[1]]))<0.05), 1] <- 1
vennDexCount[which(as.numeric(as.matrix(ANOVAout[pValColsForVenn[2]]))<0.05), 2] <- 1
vennDexCount[which(as.numeric(as.matrix(ANOVAout[pValColsForVenn[3]]))<0.05), 3] <- 1
vennDexCount$IntersectCount[which(rowSums(vennDexCount)==3)] <- 1
head(vennDexCount)
colSums(vennDexCount) # Significant hit counts



dev.off()
venn.plot <- venn.diagram(
	x = list( 
		I  = c(which(as.numeric(as.matrix(ANOVAout[pValColsForVenn[1]]))<0.05)),
		II = c(which(as.numeric(as.matrix(ANOVAout[pValColsForVenn[2]]))<0.05)),
		III= c(which(as.numeric(as.matrix(ANOVAout[pValColsForVenn[3]]))<0.05))
	),
	category.names = c(
		paste0("(", bquote(.(colSums(vennDexCount)[1])) , " hits)\n", bquote(.(colnames(ANOVAout[pValColsForVenn[1]]))) ),
		paste0("(", bquote(.(colSums(vennDexCount)[2])) , " hits)\n", bquote(.(colnames(ANOVAout[pValColsForVenn[2]]))) ),
		paste0( bquote(.(colnames(ANOVAout[pValColsForVenn[3]]))) , "\n(", bquote(.(colSums(vennDexCount)[3])) , " hits)" )
	),
	filename = NULL,
	output = TRUE,
	height = 3000,
	width = 3000,
	resolution = 300,
	compression = 'lzw',
	units = 'px',
	lwd = 6,
	lty = 'blank',
	fill = c('hotpink', 'dodgerblue', 'darkslateblue'),
	cex = 3.5,
	fontface = "bold",
	fontfamily = "sans",
	cat.cex = 3,
#	cat.fontface = "bold",
	cat.default.pos = "outer",
	cat.pos = c(-27, 27, 135),
	cat.dist = c(0.055, 0.055, 0.085),
	cat.fontfamily = "sans",
	cat.fontcolor = "grey",
	rotation = 1
	);
grid.draw(venn.plot)

pdf(file=paste0(rootdir,"/",outputfigs,"/Venn_3way-",outfile,".pdf"),height=8,width=8)
  grid.draw(venn.plot)
dev.off()


###############
## Volcano
library(ggplot2)
library("gridExtra")

cutoff=log2(1.25)
cutoff

#df<-ANOVAout
colnames(ANOVAout) #choose a column for -log10 p (change column number to point to testIndex below)
n=nrow(ANOVAout)
#***********************************
testIndexMasterList <- c(1)
flip=as.vector(c(1)) #edit this vector, to flip sign of this/these comparison(s)
#***************************** (stop here, edit above)
dexComps<-list()
iter=length(testIndexMasterList)+1
comparisonIDs <- data.frame(dfVariable=rep(NA,length(testIndexMasterList)),Comparison=rep(NA,length(testIndexMasterList)))
numComp=1 #of columns separating comparisons from matched column of log2(diffs), i.e. # of comparisons
for (i in testIndexMasterList) {
 iter=iter-1;
# dexRows<-which(ANOVAout[,i]<0.05) #choose rows where the DEX p<0.05
 comparisonIDs[iter,] <- as.vector( c(paste0("dexTargets.",gsub("-",".",colnames(ANOVAout)[i])),paste0(as.character(gsub("-"," vs ",colnames(ANOVAout)[i])))))
 dexComps[[comparisonIDs[iter,1]]] <- ANOVAout
 if(!is.na(match(i,flip))) { dexComps[[comparisonIDs[iter,1]]][,i+numComp] <- -1*as.numeric(dexComps[[comparisonIDs[iter,1]]][,i+numComp])
  comparisonIDs[iter,2]<-gsub("(*.*) vs (*.*)","\\2 vs \\1",comparisonIDs[iter,2]) #flip label "vs" in comParisonIDs$Comparison[iter]
 }
}
comparisonIDs #list element names and Logical comparisons for those retrievable Dex measurements in the list elements
ls(dexComps) #list elements are dataframes with the DEX entries for that comparison


pdf(file=paste0(rootdir,"/",outputfigs,"/ANOVA_volcanoes-",outfile,".pdf"),height=8,width=8)
par(mfrow=c(1,1))
par(mar = c(6, 8.5, 3, 3))

volcList<-list()
dfList<-list()

iter=length(testIndexMasterList)+1;
for (testIndex in testIndexMasterList) {
iter=iter-1;
df=eval(parse(text="dexComps[[comparisonIDs$dfVariable[iter]]]"))
cat(paste0("Processing ANOVA column ", testIndex, " (", comparisonIDs$Comparison[iter], ") for volcano...\n"))
# correct 0 Tukey pValues to ANOVA p (in column 2); it's better than taking -log10 of 0 in the next step
df[which(df[,testIndex]==0),testIndex] <- as.numeric(df[which(df[,testIndex]==0),2])
df$negLogP=-log10(as.numeric(df[,testIndex]))

#Check if ANOVA pVal is Significant and above FC cutoff defined above. Thresholds are used to set volcano point colors
df$threshold1=as.numeric(rep(0,n))
#Any COMPARISON SIGNIFICANT (uses ANOVA p in column 2 of df instead of Tukey p): # for (i in 1:n) { if (abs(as.numeric(df[i,testIndex+numComp]))<cutoff | df[i,2]>0.05 ) {df$threshold1[i]=3} else { if (df[i,testIndex+numComp]<cutoff) {df$threshold1[i]=2} else {df$threshold1[i]=1}} }
for (i in 1:n) { if (abs(as.numeric(df[i,testIndex+numComp]))<cutoff | as.numeric(df[i,testIndex])>0.05 ) {df$threshold1[i]=3} else { if (as.numeric(df[i,testIndex+numComp])<cutoff) {df$threshold1[i]=2} else {df$threshold1[i]=1}} }

df$threshold1=as.factor(df$threshold1)
df$Symbol=do.call("rbind",strsplit(as.character(rownames(df)),"[|]"))[,1]


volcano1=ggplot(data=df, aes(x=as.numeric(df[,testIndex+numComp]), y=df$negLogP, color=threshold1,text=Symbol )) +
 scale_colour_manual(values = c("red","darkgreen", "dodgerblue"))+
 #scale_y_continuous(breaks = seq(0, 8, by = 1))+
geom_point(alpha=0.66, size=2.5) +
  theme(legend.position = "none") +
  xlim(c(min(as.numeric(df[,testIndex+numComp])),max(as.numeric(df[,testIndex+numComp])))) + ylim(c(0,max(df$negLogP))) +
xlab(as.expression(bquote('Difference, log'[2]~.( comparisonIDs$Comparison[iter] )))) + #colnames(df)[testIndex]
ylab(as.expression(bquote('log'[10]~'p value'))) +
theme(axis.title.x = element_text(size = rel(1.8), angle = 00))+
theme(axis.title.y = element_text(size = rel(1.8), angle = 90))+

geom_hline(yintercept=1.30103, linetype="dashed",color="black",size=1.2)+
#geom_text(aes(0,1.30103,label = 1.30103, vjust = -1))+
geom_vline(xintercept=cutoff, linetype="dashed",color="black",size=1.2)+
geom_vline(xintercept=-cutoff, linetype="dashed",color="black",size=1.2)+
annotate("text", x=min(as.numeric(df[,testIndex+numComp]))/2, y=max(df$negLogP)*.95, size = 5, label= paste0( "Downregulated: ", bquote(.(length(which(as.numeric(df$threshold1)==2)))) ))+
annotate("text", x=max(as.numeric(df[,testIndex+numComp]))/2, y=max(df$negLogP)*.95, size = 5, label= paste0( "Upregulated: ", bquote(.(length(which(as.numeric(df$threshold1)==1)))) ))+

  theme(
    #axis.text = element_text(size = 14),
    #legend.key = element_rect(fill = "navy"),
    #legend.background = element_rect(fill = "white"),
    #legend.position = c(0.14, 0.80),
    panel.grid.major = element_line(color="darkgrey",linetype="dashed"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "white")
  )

list_element <- comparisonIDs$dfVariable[iter] #colnames(df)[testIndex]
volcList[[list_element]] <- volcano1

print(volcano1) #prints to active output (separate page)
rm(volcano1)
dfList[[list_element]] <- df
}

dev.off()

#multiple volcanos on one PDF sheet.
pdf(file=paste0(rootdir,"/",outputfigs,"/ANOVA-volcanoesComparison-",outfile,".pdf"),height=14,width=21)
 marrangeGrob(volcList, nrow=1, ncol=3, top="Volcano spot color set by last plot thresholds for all plots") #prints with spot color set by last plot thresholds for all 6 plots
dev.off()


## html volcano plot

# Rebuild Volcano Elements without using as.expression (plotly cannot handle this anymore):
volcList<-list()
dfList<-list()

iter=length(testIndexMasterList)+1;
for (testIndex in testIndexMasterList) {
iter=iter-1;
df=eval(parse(text="dexComps[[comparisonIDs$dfVariable[iter]]]"))
cat(paste0("Processing ANOVA column ", testIndex, " (", comparisonIDs$Comparison[iter], ") for volcano...\n"))
# correct 0 Tukey pValues to ANOVA p (in column 2); it's better than taking -log10 of 0 in the next step
df[which(df[,testIndex]==0),testIndex] <- as.numeric(df[which(df[,testIndex]==0),2])
df$negLogP=-log10(as.numeric(df[,testIndex]))

#Check if ANOVA pVal is Significant and above FC cutoff defined above. Thresholds are used to set volcano point colors
df$threshold1=as.numeric(rep(0,n))
#Any COMPARISON SIGNIFICANT (uses ANOVA p in column 2 of df instead of Tukey p): # for (i in 1:n) { if (abs(as.numeric(df[i,testIndex+numComp]))<cutoff | df[i,2]>0.05 ) {df$threshold1[i]=3} else { if (df[i,testIndex+numComp]<cutoff) {df$threshold1[i]=2} else {df$threshold1[i]=1}} }
for (i in 1:n) { if (abs(as.numeric(df[i,testIndex+numComp]))<cutoff | as.numeric(df[i,testIndex])>0.05 ) {df$threshold1[i]=3} else { if (as.numeric(df[i,testIndex+numComp])<cutoff) {df$threshold1[i]=2} else {df$threshold1[i]=1}} }

df$threshold1=as.factor(df$threshold1)
df$Symbol=do.call("rbind",strsplit(as.character(rownames(df)),"[|]"))[,1]


volcano1=ggplot(data=df, aes(x=as.numeric(df[,testIndex+numComp]), y=df$negLogP, color=threshold1,text=Symbol )) +
 scale_colour_manual(values = c("red","darkgreen", "dodgerblue"))+
 #scale_y_continuous(breaks = seq(0, 8, by = 1))+
geom_point(alpha=0.66, size=2.5) +
  theme(legend.position = "none") +
  xlim(c(min(as.numeric(df[,testIndex+numComp])),max(as.numeric(df[,testIndex+numComp])))) + ylim(c(0,max(df$negLogP))) +
xlab(paste0("Difference, log2 ", comparisonIDs$Comparison[iter] )) +
ylab(paste0("-log10 p value")) +
theme(axis.title.x = element_text(size = rel(1.8), angle = 00))+
theme(axis.title.y = element_text(size = rel(1.8), angle = 90))+

geom_hline(yintercept=1.30103, linetype="dashed",color="black",size=1.2)+
#geom_text(aes(0,1.30103,label = 1.30103, vjust = -1))+
geom_vline(xintercept=cutoff, linetype="dashed",color="black",size=1.2)+
geom_vline(xintercept=-cutoff, linetype="dashed",color="black",size=1.2)+
annotate("text", x=min(as.numeric(df[,testIndex+numComp]))/2, y=max(df$negLogP)*.95, size = 5, label= paste0( "Downregulated: ", bquote(.(length(which(as.numeric(df$threshold1)==2)))) ))+
annotate("text", x=max(as.numeric(df[,testIndex+numComp]))/2, y=max(df$negLogP)*.95, size = 5, label= paste0( "Upregulated: ", bquote(.(length(which(as.numeric(df$threshold1)==1)))) ))+

  theme(
    #axis.text = element_text(size = 14),
    #legend.key = element_rect(fill = "navy"),
    #legend.background = element_rect(fill = "white"),
    #legend.position = c(0.14, 0.80),
    panel.grid.major = element_line(color="darkgrey",linetype="dashed"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "white")
  )

list_element <- comparisonIDs$dfVariable[iter] #colnames(df)[testIndex]
volcList[[list_element]] <- volcano1

rm(volcano1)
dfList[[list_element]] <- df
}

library(plotly)

iter=length(testIndexMasterList)+1;
for (testIndex in testIndexMasterList) {
	iter=iter-1; 
	plotName<- comparisonIDs$dfVariable[iter] #colnames(df)[testIndex]
	df<-dfList[[plotName]]
	webPlot = ggplotly(volcList[[plotName]])
	htmlwidgets::saveWidget(webPlot, paste0(rootdir,"/",outputfigs,"/Interactive_ANOVA_volcano-",gsub(" ","_",comparisonIDs$Comparison[iter]),".html"))
}
dev.off()


## volcano plots with module colors (repeating above with minor changes to formatting of point colors)

pdf(file=paste0(rootdir,"/",outputfigs,"/ANOVA-volcanoesModColors-",outfile,".pdf"),height=8,width=8)
par(mfrow=c(1,1))
par(mar = c(6, 8.5, 3, 3))

volcListModColors<-list()
dfListModColors<-list()

iter=length(testIndexMasterList)+1;
for (testIndex in testIndexMasterList) {
iter=iter-1;
df=eval(parse(text="dexComps[[comparisonIDs$dfVariable[iter]]]"))
cat(paste0("Processing ANOVA column ", testIndex, " (", comparisonIDs$Comparison[iter], ") for volcano...\n"))
# correct 0 Tukey pValues to ANOVA p (in column 2); it's better than taking -log10 of 0 in the next step
df[which(df[,testIndex]==0),testIndex] <- as.numeric(df[which(df[,testIndex]==0),2])
df$negLogP=-log10(as.numeric(df[,testIndex]))

##Check if ANOVA pVal is Significant and above FC cutoff defined above. Thresholds are used to set volcano point colors
df$threshold1=as.numeric(rep(0,n))
df$modColDummy=as.numeric(rep(0,n))
##Any COMPARISON SIGNIFICANT (uses ANOVA p in column 2 of df instead of Tukey p): # for (i in 1:n) { if (abs(as.numeric(df[i,testIndex+numComp]))<cutoff | df[i,2]>0.05 ) {df$threshold1[i]=3} else { if (df[i,testIndex+numComp]<cutoff) {df$threshold1[i]=2} else {df$threshold1[i]=1}} }
for (i in 1:n) { if (abs(as.numeric(df[i,testIndex+numComp]))<cutoff | as.numeric(df[i,testIndex])>0.05 ) {df$threshold1[i]=3} else { if (as.numeric(df[i,testIndex+numComp])<cutoff) {df$threshold1[i]=2} else {df$threshold1[i]=1}} }
df$threshold1=as.factor(df$threshold1)

#for (i in 1:n) { df$modColDummy[i]=i }
#df$modColDummy=as.factor(df$modColDummy)
df$modColDummy=as.factor(df$NETcolors)

df$Symbol=do.call("rbind",strsplit(as.character(rownames(df)),"[|]"))[,1]


volcano1=ggplot(data=df, aes(x=as.numeric(df[,testIndex+numComp]), y=df$negLogP, color=modColDummy,text=Symbol )) +
 scale_colour_manual(values = sort(unique(df$NETcolors)))+ #"red","darkgreen", "dodgerblue"))+
 #scale_y_continuous(breaks = seq(0, 8, by = 1))+
geom_point(alpha=0.66, size=2.5) +
  theme(legend.position = "none") +
  xlim(c(min(as.numeric(df[,testIndex+numComp])),max(as.numeric(df[,testIndex+numComp])))) + ylim(c(0,max(df$negLogP))) +
xlab(as.expression(bquote('Difference, log'[2]~.( comparisonIDs$Comparison[iter] )))) + #colnames(df)[testIndex]
ylab(as.expression(bquote('log'[10]~'p value'))) +
theme(axis.title.x = element_text(size = rel(1.8), angle = 00))+
theme(axis.title.y = element_text(size = rel(1.8), angle = 90))+

geom_hline(yintercept=1.30103, linetype="dashed",color="black",size=1.2)+
#geom_text(aes(0,1.30103,label = 1.30103, vjust = -1))+
geom_vline(xintercept=cutoff, linetype="dashed",color="black",size=1.2)+
geom_vline(xintercept=-cutoff, linetype="dashed",color="black",size=1.2)+
annotate("text", x=min(as.numeric(df[,testIndex+numComp]))/2, y=max(df$negLogP)*.95, size = 5, label= paste0( "Downregulated: ", bquote(.(length(which(as.numeric(df$threshold1)==2)))) ))+
annotate("text", x=max(as.numeric(df[,testIndex+numComp]))/2, y=max(df$negLogP)*.95, size = 5, label= paste0( "Upregulated: ", bquote(.(length(which(as.numeric(df$threshold1)==1)))) ))+

  theme(
    #axis.text = element_text(size = 14),
    #legend.key = element_rect(fill = "navy"),
    #legend.background = element_rect(fill = "white"),
    #legend.position = c(0.14, 0.80),
    panel.grid.major = element_line(color="darkgrey",linetype="dashed"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "white")
  )

list_element <- comparisonIDs$dfVariable[iter] #colnames(df)[testIndex]
volcListModColors[[list_element]] <- volcano1

print(volcano1) #prints to active output (separate page)
rm(volcano1)
dfListModColors[[list_element]] <- df
}

dev.off()

#Multiple comparisons
pdf(file=paste0(rootdir,"/",outputfigs,"/ANOVA-volcanoesComparisonModColors-",outfile,".pdf"),height=14,width=21)
 gridExtra::marrangeGrob(volcListModColors, nrow=1, ncol=3, top="Volcano spot color set by WGCNA module color of protein") #prints with spot color set by last plot thresholds for all 6 plots
dev.off()

## html volcano plot (module colors)

# Rebuild volcano graphics without as.expression() call (plotly no longer handles it)
volcListModColors<-list()
dfListModColors<-list()

iter=length(testIndexMasterList)+1;
for (testIndex in testIndexMasterList) {
iter=iter-1;
df=eval(parse(text="dexComps[[comparisonIDs$dfVariable[iter]]]"))
cat(paste0("Processing ANOVA column ", testIndex, " (", comparisonIDs$Comparison[iter], ") for volcano...\n"))
# correct 0 Tukey pValues to ANOVA p (in column 2); it's better than taking -log10 of 0 in the next step
df[which(df[,testIndex]==0),testIndex] <- as.numeric(df[which(df[,testIndex]==0),2])
df$negLogP=-log10(as.numeric(df[,testIndex]))

##Check if ANOVA pVal is Significant and above FC cutoff defined above. Thresholds are used to set volcano point colors
df$threshold1=as.numeric(rep(0,n))
df$modColDummy=as.numeric(rep(0,n))
##Any COMPARISON SIGNIFICANT (uses ANOVA p in column 2 of df instead of Tukey p): # for (i in 1:n) { if (abs(as.numeric(df[i,testIndex+numComp]))<cutoff | df[i,2]>0.05 ) {df$threshold1[i]=3} else { if (df[i,testIndex+numComp]<cutoff) {df$threshold1[i]=2} else {df$threshold1[i]=1}} }
for (i in 1:n) { if (abs(as.numeric(df[i,testIndex+numComp]))<cutoff | as.numeric(df[i,testIndex])>0.05 ) {df$threshold1[i]=3} else { if (as.numeric(df[i,testIndex+numComp])<cutoff) {df$threshold1[i]=2} else {df$threshold1[i]=1}} }
df$threshold1=as.factor(df$threshold1)

#for (i in 1:n) { df$modColDummy[i]=i }
#df$modColDummy=as.factor(df$modColDummy)
df$modColDummy=as.factor(df$NETcolors)

df$Symbol=do.call("rbind",strsplit(as.character(rownames(df)),"[|]"))[,1]


volcano1=ggplot(data=df, aes(x=as.numeric(df[,testIndex+numComp]), y=df$negLogP, color=modColDummy,text=Symbol )) +
 scale_colour_manual(values = sort(unique(df$NETcolors)))+ #"red","darkgreen", "dodgerblue"))+
 #scale_y_continuous(breaks = seq(0, 8, by = 1))+
geom_point(alpha=0.66, size=2.5) +
  theme(legend.position = "none") +
  xlim(c(min(as.numeric(df[,testIndex+numComp])),max(as.numeric(df[,testIndex+numComp])))) + ylim(c(0,max(df$negLogP))) +
xlab(paste0("Difference, log2 ", comparisonIDs$Comparison[iter] )) +
ylab(paste0("-log10 p value")) +
theme(axis.title.x = element_text(size = rel(1.8), angle = 00))+
theme(axis.title.y = element_text(size = rel(1.8), angle = 90))+

geom_hline(yintercept=1.30103, linetype="dashed",color="black",size=1.2)+
#geom_text(aes(0,1.30103,label = 1.30103, vjust = -1))+
geom_vline(xintercept=cutoff, linetype="dashed",color="black",size=1.2)+
geom_vline(xintercept=-cutoff, linetype="dashed",color="black",size=1.2)+
annotate("text", x=min(as.numeric(df[,testIndex+numComp]))/2, y=max(df$negLogP)*.95, size = 5, label= paste0( "Downregulated: ", bquote(.(length(which(as.numeric(df$threshold1)==2)))) ))+
annotate("text", x=max(as.numeric(df[,testIndex+numComp]))/2, y=max(df$negLogP)*.95, size = 5, label= paste0( "Upregulated: ", bquote(.(length(which(as.numeric(df$threshold1)==1)))) ))+

  theme(
    #axis.text = element_text(size = 14),
    #legend.key = element_rect(fill = "navy"),
    #legend.background = element_rect(fill = "white"),
    #legend.position = c(0.14, 0.80),
    panel.grid.major = element_line(color="darkgrey",linetype="dashed"),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "white")
  )

list_element <- comparisonIDs$dfVariable[iter] #colnames(df)[testIndex]
volcListModColors[[list_element]] <- volcano1

rm(volcano1)
dfListModColors[[list_element]] <- df
}


library(plotly)

iter=length(testIndexMasterList)+1;
for (testIndex in testIndexMasterList) {
	iter=iter-1; 
	plotName<- comparisonIDs$dfVariable[iter] #colnames(df)[testIndex]
	df<-dfListModColors[[plotName]]
	webPlot = ggplotly(volcListModColors[[plotName]])
	htmlwidgets::saveWidget(webPlot, paste0(rootdir,"/",outputfigs,"/Interactive_ANOVA_volcano_with_ModuleColors-",gsub(" ","_",comparisonIDs$Comparison[iter]),".html"))
}
dev.off()



## Stacked DiffEx Barplots
##################################
ANOVAout$Symbol=do.call("rbind",strsplit(as.character(rownames(ANOVAout)),"[|]"))[,1]

#Human DEX Tables Built from ANOVAout dataframe
ANOVAin<-ANOVAout
ANOVAin$Unique.ID<-rownames(ANOVAin)
colnames(ANOVAin)
#***************************** (stop here, edit below)
## Choose columns 
masterDEXlookup<-c(1)
flip=as.vector(c(1)) #edit this vector, to flip sign of this/these comparison(s)
numComp=1 #of columns separating comparisons from matched column of log2(diffs), i.e. # of comparisons
#***************************** (stop here, edit above)
dexComps<-list()
iter=length(masterDEXlookup)+1
comparisonIDs <- data.frame(dfVariable=rep(NA,length(masterDEXlookup)),Comparison=rep(NA,length(masterDEXlookup)))
for (i in masterDEXlookup) {
 iter=iter-1;
 dexRows<-which(ANOVAin[,i]<0.05) #choose rows where the DEX p<0.05
 comparisonIDs[iter,] <- as.vector( c(paste0("dexTargets.",gsub("-",".",colnames(ANOVAin)[i])),paste0(as.character(gsub("-"," vs ",colnames(ANOVAin)[i])))))
# assign(as.character(comparisonIDs[iter,1]), ANOVAin[dexRows,])
 dexComps[[comparisonIDs[iter,1]]] <- ANOVAin[dexRows,]
 if(!is.na(match(i,flip))) { dexComps[[comparisonIDs[iter,1]]][,i+numComp] <- -1*as.numeric(dexComps[[comparisonIDs[iter,1]]][,i+numComp])
  comparisonIDs[iter,2]<-gsub("(*.*) vs (*.*)","\\2 vs \\1",comparisonIDs[iter,2]) #flip label "vs" in comParisonIDs$Comparison[iter]
 }
}
comparisonIDs #list element names and Logical comparisons for those retrievable Dex measurements in the list elements
ls(dexComps) #list elements are dataframes with the DEX entries for that comparison

head(dexComps$dexTargets.CT.AsymAD) # Check flipped number signs; how to access the list elements; 'list[[element]]' only works for writing the dataframe to a list element here
#colnames(dexTargetsRat) # look at structure of animal model data, defined above.
#Add the column indexes to retrieve pVals and log2Diff for each comparison in the respective dexComps$ list element
comparisonIDs$pValColIndex<-as.integer(c(rev(masterDEXlookup) )) #,c(7,7)
comparisonIDs$log2DiffIndex<-as.integer(c((rev(masterDEXlookup)+numComp) )) #,c(8,8)

comparisonIDs # Complete lookup table for Dex Target Comparisons


#precalculate maxUP and maxDN to normalize scale of the plots
library(ggplot2)
library(reshape2)

maxDN<-0
maxUP<-0
yscaleMax<-0

orderedModules=gsub("ME","",colnames(MEs))
orderedModules<-orderedModules[-which(orderedModules=="grey")]
nModules=length(orderedModules)

dexCompsStacks<-list()
for (redo in 1:2) { #repeat is necessary to equalize min and max blue and red color scheme across all plots
for (z in 1:length(comparisonIDs$Comparison)) {

dataframeName<-as.character(comparisonIDs$dfVariable[z])
dexTargets<-dexComps[[comparisonIDs$dfVariable[z]]]  #retrieve z'th data frame of dexTargets<-eval(parse(text=paste0("dexComps$",comparisonIDs$dfVariable[z])))

orderedLabels<- cbind(paste("M",seq(1:(nModules+20)),sep=""),labels2colors(c(1:(nModules+20))))
#if you want the modules in order of relatedness from the module relatedness dendrogram:
netcolSizeTable<-table(net$colors)[-which(names(table(net$colors))=="grey")]
orderedModules2<-cbind(orderedModules,Size=netcolSizeTable[match(orderedModules,names(netcolSizeTable))])
orderedLabelsByRelatedness<- cbind(Mnum= orderedLabels[ match(orderedModules,orderedLabels[,2]) ,1] ,Color=orderedModules )
orderedLabelsByRelatedness<- cbind( orderedLabelsByRelatedness,Size=orderedModules2[,"Size"] )
##Get fraction occupancy and average log2 diff for each group!
#test of function: length(which(dexTargets$NETcolors=="turquoise" & dexTargets[,comparisonIDs$log2DiffIndex[z]]<0))
downTargets<-sapply(1:nrow(orderedLabelsByRelatedness),function(x) length(which(dexTargets$NETcolors==orderedLabelsByRelatedness[x,"Color"] & dexTargets[,comparisonIDs$log2DiffIndex[z]]<0)))
upTargets<-sapply(1:nrow(orderedLabelsByRelatedness),function(x) length(which(dexTargets$NETcolors==orderedLabelsByRelatedness[x,"Color"] & dexTargets[,comparisonIDs$log2DiffIndex[z]]>0)))
orderedLabelsByRelatedness<-cbind(orderedLabelsByRelatedness,downTargets,upTargets)
fractDown<-as.numeric(orderedLabelsByRelatedness[,"downTargets"])/as.numeric(orderedLabelsByRelatedness[,"Size"])
fractUp<-as.numeric(orderedLabelsByRelatedness[,"upTargets"])/as.numeric(orderedLabelsByRelatedness[,"Size"])
yscaleMax<-max( c(yscaleMax, max(eval(fractDown+fractUp))) )
downTargetAvg<-sapply(1:nrow(orderedLabelsByRelatedness),function(x) mean(as.numeric(dexTargets[,comparisonIDs$log2DiffIndex[z]][which(dexTargets$NETcolors==orderedLabelsByRelatedness[x,"Color"] & dexTargets[,comparisonIDs$log2DiffIndex[z]]<0)])))
upTargetAvg<-sapply(1:nrow(orderedLabelsByRelatedness),function(x) mean(as.numeric(dexTargets[,comparisonIDs$log2DiffIndex[z]][which(dexTargets$NETcolors==orderedLabelsByRelatedness[x,"Color"] & dexTargets[,comparisonIDs$log2DiffIndex[z]]>0)])))
orderedLabelsByRelatedness<-cbind(orderedLabelsByRelatedness,fractDown,fractUp,downTargetAvg,upTargetAvg)

#Colorscale 
#bw<-colorRampPalette(c("#0058CC", "white"))
wb<-colorRampPalette(c("white","#0058CC")) # #0058CC"))
wr<-colorRampPalette(c("white", "#CC3300")) # #CC3300"))
colvecwb<-wb(100)
colvecwr<-wr(100)
maxDN<-max( c(maxDN, max(abs(downTargetAvg),na.rm=T)) )
maxUP<-max( c(maxUP, max(upTargetAvg,na.rm=T)) )
print(paste0(round(maxDN,2)," - max down average log2"))
print(paste0(round(maxUP,2)," + max up average log2"))
vecDN<- -sapply(1:nrow(orderedLabelsByRelatedness),function(x) round( as.numeric(orderedLabelsByRelatedness[x,"downTargetAvg"])/maxDN*100, 0 ))
vecUP<-sapply(1:nrow(orderedLabelsByRelatedness),function(x) round( as.numeric(orderedLabelsByRelatedness[x,"upTargetAvg"])/maxUP*100, 0 ))
colvecDN<-sapply(1:nrow(orderedLabelsByRelatedness),function(x) colvecwb[vecDN[x]])
colvecUP<-sapply(1:nrow(orderedLabelsByRelatedness),function(x) colvecwr[vecUP[x]])
colvecDN<-lapply(colvecDN, function(x) if (identical(x,character(0))) {"#FFFFFF" } else { x }) #HANDLE rounded values that were 0 (target averages less than 0.005)
colvecUP<-lapply(colvecUP, function(x) if (identical(x,character(0))) {"#FFFFFF" } else { x })

colMATRIX<-cbind(colvecDN,colvecUP)
colvec<-as.vector(c(""))
for (i in 1:nrow(colMATRIX)) {
 colvec<-c(colvec,colMATRIX[i,])
}
colvec<-colvec[2:length(colvec)]
colvecFinal <- colvec[-which(is.na(colvec))]

meltPlot<-melt(orderedLabelsByRelatedness[,c(1,6,7)],"Mnum")
meltPlot[,2]<-rep(orderedLabelsByRelatedness[1:nrow(orderedLabelsByRelatedness),1],3)
meltPlot<-meltPlot[c(eval(nModules+1):eval(nModules*3)),c(2:3)]
names(meltPlot)<-c("Mnum","value")
colvec<-c(colvecDN,colvecUP)

meltPlot3<-melt(meltPlot,"Mnum")
meltPlot3[,2]<-rep(c(1:2),(length(meltPlot3[,2])/2))
meltPlot3$sort2<-rep(c(1:nModules),2)
meltPlot3$colvec<-colvec
meltPlot3<-meltPlot3[order(as.numeric(meltPlot3$sort2),meltPlot3[,2]),]
meltPlot3$Mnum<-factor(meltPlot3$Mnum,levels=unique(meltPlot3$Mnum))

dexCompsStacks[[comparisonIDs$dfVariable[z]]] <- meltPlot3
}
#2 iterations to get min and max colors right
}

#yscaleMax=0.72 lower this to the highest bar in any plot, must be higher if ggplot gives an error in the below for loop; can't need to be >1
pdf(file=paste(rootdir,"/",outputfigs,"/ANOVA-moduleMembershipStackedBar-",outfile,".pdf",sep=""),width=16,height=12)
par(mfrow=c(2,1))
par(mar=c(5,6,4,2))

for (z in 1:length(comparisonIDs$Comparison)) {
 print( ggplot(dexCompsStacks[[comparisonIDs$dfVariable[z]]], aes(x=Mnum, y=as.numeric(value))) + geom_bar(stat="identity", fill=dexCompsStacks[[comparisonIDs$dfVariable[z]]]$colvec, color="#000000") + theme(axis.text.x=element_text(angle=90, hjust=1, vjust=0.3)) + labs(x="", y="Fraction of DEX Module Members") + theme(axis.title = element_text(family = "arial", color="#000000", face="bold", size=22), axis.text.x = element_text(face="bold", color="#000000", size=14, angle=90), axis.text.y = element_text(face="bold", color="#000000", size=14, angle=0), panel.background = element_rect(fill = "transparent",colour = NA), panel.grid.minor = element_blank(), panel.grid.major = element_blank(), plot.background = element_rect(fill = "transparent",colour = NA)) + scale_y_continuous(limits=c(0,ceiling(yscaleMax*100)/100)) + ggtitle(as.character(comparisonIDs$Comparison[z])) + theme(plot.title=element_text(family="Trebuchet MS", color="black", face="bold", size=32)) )
 # + scale_color_gradient(low = "white", high = "#CC3300", space = "Lab", na.value = "grey", guide = "colourbar") + scale_color_gradient(low = "white", high = "#0058CC", space = "Lab", na.value = "grey", guide = "colourbar")
 #theme(axis.ticks = element_blank())
}

 bw<-colorRampPalette(c("#0058CC", "white"))
 downbars<-round(maxDN/maxUP*100,0)
 colvecbw<-bw(downbars)
 colvecwr<-wr(100)
 colvecLegend<-c(colvecbw,colvecwr)
 labeledHeatmap(Matrix = t(as.matrix(c(-maxDN,maxUP))),
               yLabels = "",
               xLabels = c("min","max"),
               xSymbols = "",
               xColorLabels=FALSE,
               colors = colvecLegend,
               setStdMargins = FALSE,
               cex.text = 0.5,
               verticalSeparator.x= 1,
               verticalSeparator.col = 1,
               verticalSeparator.lty = 1,
               verticalSeparator.lwd = 1,
               verticalSeparator.ext = 0,
               horizontalSeparator.y= 1,
               horizontalSeparator.col = 1,
               horizontalSeparator.lty = 1,
               horizontalSeparator.lwd = 1,
               horizontalSeparator.ext = 0,
#               zlim = c(-1,1),
               main = "Legend",
               cex.main=0.8)

dev.off()


######################################
#PCA matrix visualization to check for residual/noticeable site effect

####Check Outliers
sdout=3
 normadj <- (0.5+0.5*bicor(cleanDat)^2)
  
  ## Calculate connectivity
  netsummary <- fundamentalNetworkConcepts(normadj)
  ku <- netsummary$Connectivity
  z.ku <- ku-(mean(ku))/sqrt(var(ku))
  ## Declare as outliers those samples which are more than sdout sd above the mean connectivity based on the chosen measure
  outliers <- (z.ku > mean(z.ku)+sdout*sd(z.ku))|(z.ku < mean(z.ku)-sdout*sd(z.ku))
  print(paste("There are ",sum(outliers)," outliers samples based on a bicor distance sample network connectivity standard deviation above ",sdout,sep=""))
  print(colnames(cleanDat)[outliers])
  print(table(outliers))
  # datExpr.logData.All= datExpr.logData
  targets.All=numericMeta

  noOLs.cleanDat <- cleanDat[,!outliers]
  targets= targets.All[!outliers,]

## Get the first 5 PCs in the HTSC data

pdf(paste0(rootdir,outputfigs,"/PCA-siteEffectCheck.pdf"),height=20,width=24)

		thisdat.cleanDat <- t(scale(t(noOLs.cleanDat),scale=F)) ## Centers the mean of all genes - this means the PCA gives us the eigenvectors of the geneXgene covariance matrix, allowing us to assess the proportion of variance each component contributes to the data
		PC.HTSC <- prcomp(thisdat.cleanDat,center=F);
		topPC.cleanDat <- PC.HTSC$rotation[,1:5];
		varexp <- (PC.HTSC$sdev)^2 / sum(PC.HTSC$sdev^2)
		topvar <- varexp[1:5]
		colnames(topPC.cleanDat) <- paste("MaxQuant.LFQ\n",colnames(topPC.cleanDat)," (",signif(100*topvar[1:5],2),"%)",sep="")
		
		pairsdat <- data.frame(Tumor=as.factor(targets$Tumor),Age=as.numeric(targets$Age)) #,Tstage=as.numeric(targets$AJCC.T.Stage.Numeric),DiseaseFreeMonths=as.numeric(targets$Disease.Free.Months))
		cond=labels2colors(as.numeric(as.factor(targets$CollectionSite)))  ## colors

panel.cor <- function(x, y, digits = 2, prefix = "", cex.cor, ...) { ## Useful function for comparing multivariate data
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  r <- abs(cor(x, y,use="pairwise.complete.obs",method="pearson"))
  txt <- format(c(r, 0.123456789), digits = digits)[1]
  txt <- paste0(prefix, txt)
  if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt)
  text(0.5, 0.5, txt, cex = cex.cor * r)
}


	panel.cor <- function(x, y, digits = 2, prefix = "", cex.cor, ...) { ## Useful function for comparing multivariate data
		  usr <- par("usr"); on.exit(par(usr))
		  par(usr = c(0, 1, 0, 1))
		  if (class(x) == "numeric" & class(y) == "numeric") {
		    r <- abs(cor(x, y,use="pairwise.complete.obs",method="pearson"))
		  } else {
		    lmout <- lm(y~x)
		    r <- sqrt(summary(lmout)$adj.r.squared)
		  }
		  txt <- format(c(r, 0.123456789), digits = digits)[1]
		  txt <- paste0(prefix, txt)
		  if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt)
		  text(0.5, 0.5, txt, cex = cex.cor * r)
	}

		pairs(cbind(pairsdat, topPC.cleanDat),col= cond,pch=19,upper.panel = panel.cor,main="Covariates and MaxQuant Comparison -- |Spearman's rho| correlation values")

dev.off()






## CUSTOM Target Boxplots
#####################################

#<you can specify gene names, or use p values, skip to below>
targets<-c("CXCR5")

targetRownames<-vector()

for (i in 1:length(targets)) {
        targetRownames <- c(targetRownames,rownames(cleanDat)[which(grepl(paste0(targets[i],"\\|"),rownames(cleanDat)))])
}
targets<-targetRownames

toplot2<-as.data.frame(matrix(data=NA,nrow=length(targets),ncol=dim(cleanDat)[2]))
rownames(toplot2)<-targets
for (i in 1:length(targets)) {
	toplot2[i,] <-cleanDat[which(rownames(cleanDat)==targets[i]),]
}

###############################################
#<SKIP if you specify gene names above>
thresholdP=0.000000000000001
thresholdFC=log2(3)
toplot2 <-cleanDat[which(ANOVAout[,1]<thresholdP & abs(ANOVAout[,2])>thresholdFC),]
rownames(toplot2)<-rownames(ANOVAout)[which(ANOVAout[,1]<thresholdP & abs(ANOVAout[,2])>thresholdFC)]
dim(toplot2) #3607with p < 1e-8; 1855 with p < 1e-12
###############################################

regvars <- data.frame(as.numeric(as.factor(Grouping))-1,as.numeric(numericMeta[,"Age"]))
colnames(regvars) <- c("Group","Age") ## data frame with covaraites in case we want to try multivariate regression
lmTargets <- lm(t(data.matrix(na.omit(toplot2)))~Group,data=regvars)

pvecTargets <- rep(NA,length(colnames(lmTargets$coefficients))) #targets))
for (i in 1:length(colnames(lmTargets$coefficients))) { #targets)) {
  f <- summary(lmTargets)[[i]]$fstatistic ## Get F statistics
  pvecTargets[i] <- pf(f[1],f[2],f[3],lower.tail=F) ## Get the p-value corresponding to the whole model
}
names(pvecTargets) <- colnames(lmTargets$coefficients) #targets

TpvecTargets <- rep(NA,length(targets))
for (i in 1:length(targets)) {
  pT <- t.test(data.matrix(toplot2)[i,regvars$Group==0],data.matrix(toplot2)[i,regvars$Group==1],var.equal=T)  ## Get P values
  TpvecTargets[i] <- pT$p.value
}
names(TpvecTargets) <- targets


pvecTargetsPlusNAs <- rep(NA,length(targets))
names(pvecTargetsPlusNAs) <- targets
for (i in 1:length(targets)) {
 if (!is.na(match(names(pvecTargetsPlusNAs)[i],colnames(lmTargets$coefficients)))) { pvecTargetsPlusNAs[i] <- pvecTargets[match(names(pvecTargetsPlusNAs)[i],names(pvecTargets))] }
}

rownames(toplot2) <- paste0(rownames(toplot2),"\nANOVA p = ",signif(pvecTargetsPlusNAs,2),"\nTumor vs. Normal t-test p = ",signif(TpvecTargets,2))
colnames(toplot2) <- colnames(cleanDat)

colorvec="lightgreen"

pdf(paste0(rootdir,"/",outputfigs,"/PrCaTCGA-ANOVAorCustomTargets_Stats.pdf"),height=10,width=16) 
	par(mfrow=c(4,5))
	par(mar=c(5,5,6,5))

	ylabels=paste0(targets,"\nlog2 RNA RPKM+0.01")
	for (i in 1:nrow(toplot2)) {
	  boxplot(t(toplot2[i,])~factor(Grouping,c("Normal","Tumor")),col=colorvec,ylab=ylabels[i],main=rownames(toplot2)[i],xlab=NULL)
	}

dev.off()

write.csv(cbind(Hits=targets,ANOVAp=pvecTargetsPlusNAs,TpADCT=TpvecTargets,TpASCT=TpvecTargetsASCT,TpADAS=TpvecTargetsADAS),file=paste0(rootdir,"/",datadir,"/PrCaTCGA-CustomTargets-statOut.csv"))


## Clustering (Z-score transformed abundances)
metdat<-regvars
metdat$Group<-as.numeric(metdat$Group)
metdat$Group[metdat$Group==0]<-"Normal"
metdat$Group[metdat$Group==1]<-"Tumor"
metdat$Group<-as.factor(metdat$Group)
metdat$AJCC.Stage<-as.factor(signif(numericMeta$AJCC.T.Stage.Numeric,0))

rownames(metdat) <- rownames(numericMeta)
toplotsub <- toplot2
#rownames(toplotsub) <- targetRownames

toplotMean <- apply(toplotsub,2,mean,na.rm=TRUE)
toplotSD <- apply(toplotsub,2,sd,na.rm=TRUE)
toplotZ <- (toplotsub-toplotMean)/toplotSD
toplotZ[toplotZ>5] <-5
toplotZ[toplotZ< -5] <- -5

library(NMF)
library(WGCNA)

pdf(paste0(rootdir,"/",outputfigs,"/Clustering_highlySignificantTumorVsNormal_Targets(pLT",thresholdP,"_&_FCgt",thresholdFC,").pdf"),width=10,height=10)
#par(mfrow=c(1,1))
par(mar=c(8,10,10,8))

bw<-colorRampPalette(c("blue","white") )
wr<-colorRampPalette(c("white","red") )

bwr<-c( bw(round(100*(-min(toplotZ))/(max(toplotZ)-min(toplotZ)),0)) , wr(round(100*max(toplotZ)/(max(toplotZ)-min(toplotZ)),0)) )


aheatmap(x=t(t(as.matrix(toplotZ))), ## Numeric Matrix
         annCol=metdat,
#         distfun="correlation",hclustfun="average", ## Clustering options
         distfun="euclidean",hclustfun="complete",
         scale="none", ## Scale by row (each gene scaled)
         cexRow=1, ## Character sizes
         col=bwr, #blueWhiteRed(100), ## Color map scheme
#         annColors=metCols,
         treeheight=25,
         Rowv=TRUE,Colv=TRUE)  #Cluster, but don't show dendro: FALSE ; don't cluster/reorder: NA

dev.off()









##### ORA
load("c:/Users/Eric Dammer/Documents/wgcnatest/BLSA89 & Emory29 Networks (for ORA).Rdata")

################################### ORA Overlap FET ######################################

#FOR REFERENCE, replace inputDat1,2 and net1,2 for ORA overlap comparisons below
#PAIRS OF cleanDat				WGCNA NET		NOTES
#-----------------				--------------------	---------------------------------------------------
cleanDatBLSA89					netBLSA89final		#Cell Syst 2017				      HUMAN
cleanDatEmory29					netEmory29final		#Cell Syst 2017                               HUMAN


#################
#CHANGE THESE PARAMETERS
inputDat1=cleanDat #data.frame(Symbol=synapseAndNon$Gene)
#  rownames(inputDat1)<-inputDat1$Symbol
inputDat2=cleanDatBLSA89    #used for background
net1=net
net2=netBLSA89final
species1="human" #this would be your fly species if fly-human
species2="human"
# test="p" #"p" or "FDR" #both are handled below with a for loop
outfiletitle="HumanBLSA89_vs_U01-2018TMT27"
heatmapTitle="BLSA Cell Systems Protein vs Preliminary Data U01 TMT Protein Network"
HeatmapNet1moduleType="T"
HeatmapNet2moduleType="B"
#################

if (!species1==species2) {
	fly = useMart("ensembl",dataset="rnorvegicus_gene_ensembl")
	human = useMart("ensembl",dataset="hsapiens_gene_ensembl")
}

OR <- function(q,k,m,t) {
        q #<-  ## Intersection of test list and reference list, aka number of white balls drawn
        m #<-  ## All genes in reference list, aka number of draws
        k #<-  ## All genes in test list, aka number white balls
        t #<-  ## Total number of genes assessed, aka black plus white balls
        
        fisher.out <- fisher.test(matrix(c(q, k-q, m-q, t-m-k+q), 2, 2),conf.int=TRUE)
        OR <- fisher.out$estimate
        pval <- fisher.out$p.value
         upCI <- fisher.out$conf.int[1]
      downCI <- fisher.out$conf.int[2]
               
        output <- c(OR,pval,upCI,downCI)
      	names(output) <- c("OR","Fisher p","-95%CI","+95%CI")
        return(output)
      }

     ## count overlaps and run the analysis
     ORA <- function(testpath,refpath,testbackground,refbackground) {
 	 q <- length(intersect(testpath,refpath)) ## overlapped pathway size
  	k <- length(intersect(refpath,testbackground))  ## input gene set
  	m <- length(intersect(testpath,refbackground)) ## input module
 	 t <- length(intersect(testbackground,refbackground)) ## Total assessed background (intersect reference and test backgrounds)
  
 	 empvals <- OR(q,k,m,t)
  
  	tmpnames <- names(empvals)
 	 empvals <- as.character(c(empvals,q,k,m,t,100*signif(q/k,3)))
 	 names(empvals) <- c(tmpnames,"Overlap","Reference List","Input List","Background","% List Overlap")
  	return(empvals)
     }

#***
geneInfo.BLSA<-inputDat1
geneInfo.BLSA$Symbol=do.call("rbind",strsplit(as.character(rownames(inputDat1)),"[|]"))[,1]

geneInfo.Emory<-inputDat2
geneInfo.Emory$Symbol=do.call("rbind",strsplit(as.character(rownames(inputDat2)),"[|]"))[,1]

##Convert to same species lists
genelist1 <- data.frame(unlist(geneInfo.BLSA$Symbol),ncol=1)
colnames(genelist1)<-"species1"
genelist1<-data.frame(genelist1[which(!genelist1[,1]==""),"species1"],ncol=1)
colnames(genelist1)<-"species1"
genelist1<-data.frame(genelist1$species1[!grepl("'", genelist1$species1)],ncol=1)
colnames(genelist1)<-c("species1","species2")

### Must rerun whole chunk of code from *** above or $Symbol will lookup previously lookedup values!
if (!species1==species2) {
	if (species1=="fly") {
		genelist.clean<-getLDS(attributes="external_gene_name", filters="external_gene_name", values=genelist1$species1, mart=fly, attributesL="hgnc_symbol",martL = human)
#		write.table(listHumanFly[,2],file=paste(outputDir,outputFile,"_AllGenes_human.txt",sep=""),row.names=FALSE,col.names=TRUE,sep="\t", quote=FALSE)
#		write.table(modulesData$GI,file=paste(outputDir,outputFile,"_AllGenes_fly.txt",sep=""),row.names=FALSE,col.names=TRUE,sep="\t",quote=FALSE)
	}
	if (species1=="human") {
		genelist.clean<-getLDS(attributes="hgnc_symbol", filters="hgnc_symbol", values=genelist1$species1, mart=human, attributesL="external_gene_name", martL=fly)
#		write.table(listHumanFly[,2],file=paste(outputDir,outputFile,"_AllGenes_fly.txt",sep=""),row.names=FALSE,col.names=TRUE,sep="\t", quote=FALSE)
#		write.table(modulesData$GI,file=paste(outputDir,outputFile,"_AllGenes_human.txt",sep=""),row.names=FALSE,col.names=TRUE,sep="\t",quote=FALSE)
	}
	geneInfo.BLSA$SymbolOriginal<-geneInfo.BLSA$Symbol
	geneInfo.BLSA$Symbol<-genelist.clean[match(geneInfo.BLSA$SymbolOriginal,genelist.clean[,1]),2]
}
background.BLSA=as.character(unique(geneInfo.BLSA$Symbol))
background.Emory=as.character(unique(geneInfo.Emory$Symbol)) #[geneInfo.Emory$Symbol!=''])) #Ensembl.Gene.ID))
###***

#\/----------------------------REPEAT FOR BOTH FDR AND P-VALUE CALCULATIONS--------------------------------------------\/
for (test in c("FDR","p")) {

Emory.Order <- c(1:(length(unique(net2$colors))-1))
BLSA.Order <- c(1:(length(unique(net1$colors)))) #-1 NO GREY#***
#Emory.Order <- c(21,3,4,19,11,9,20,10,18,12,2,6,1,15,7,5,13,8,14,16,17,22,23) #You can manually define order

uniquemodcolors.BLSA=labels2colors(BLSA.Order)
uniquemodcolors.Emory=labels2colors(Emory.Order)


ORmat=matrix(NA,nrow=length(uniquemodcolors.Emory),ncol=1)
Pmat=matrix(NA,nrow=length(uniquemodcolors.Emory),ncol=1)
overlapList=matrix(NA,ncol=length(uniquemodcolors.BLSA),nrow=length(uniquemodcolors.Emory))

for (i in 1:length(uniquemodcolors.BLSA)){
	thismod= uniquemodcolors.BLSA[i]
	thisGene= geneInfo.BLSA$Symbol[net1$colors==thismod] #[net$colors==thismod,"Symbol"]
	testpath <- as.character(unique(thisGene)) ## Module Genes
	 oraMat1=matrix(NA,ncol=9,nrow=length(uniquemodcolors.Emory))

	 for(j in 1:length(uniquemodcolors.Emory)){
		thismod1= uniquemodcolors.Emory[j]
		thisGene1= geneInfo.Emory$Symbol[net2$colors==thismod1]
		refpath <- as.character(unique(thisGene1)) ## Module Genes
	 
		testbackground <- background.BLSA
		refbackground <- background.Emory
	  
		oraout=ORA(testpath,refpath,testbackground,refbackground)
  		oraMat1[j,]=oraout

		## GENERATE LIST OF ACTUAL OVERLAPPING SYMBOLS
		overlapList1 <- intersect(refpath,testpath)
		if (length(as.character(unlist(overlapList1)))>0) { overlapList[j,i] <- paste(unlist(overlapList1),collapse=",") }
	 }
	 
	ORmat=cbind(ORmat,as.numeric(oraMat1[,1]))
	Pmat=cbind(Pmat,as.numeric(oraMat1[,2]))
}

ORmat.Array =ORmat[,-1]
Pmat.Array =Pmat[,-1]
FDRmat.Array <- matrix(p.adjust(Pmat.Array,method="BH"),nrow=nrow(Pmat.Array),ncol=ncol(Pmat.Array))

colnames(overlapList) <- colnames(ORmat.Array) <- colnames(Pmat.Array) <- colnames(FDRmat.Array) <- paste(HeatmapNet1moduleType,uniquemodcolors.BLSA,sep='.')
rownames(overlapList) <- rownames(ORmat.Array) <- rownames(Pmat.Array) <- rownames(FDRmat.Array) <- paste(HeatmapNet2moduleType,uniquemodcolors.Emory,sep='.')

###########
if (test=="p") {
##P-value-based
	dispMat <- -log10(Pmat.Array)*sign(log2(ORmat.Array))
	FDRmat.Array<-Pmat.Array
	testtext="-log10(P Value)"
	testfileext="pval"
} else {
##FDR-based: 
	outputData=rbind("FET pValue", Pmat.Array, "FDR (BH) corrected", FDRmat.Array, "Overlap (Symbols)", overlapList)
	write.csv(outputData,file=paste0(rootdir,"ORA-",outfiletitle,".FULL.csv"))

	dispMat <- -log10(FDRmat.Array)*sign(log2(ORmat.Array)) ## You can change this to be just log2(Bmat) if you want the color to reflect the odds ratios
	testtext="-log10(FDR, BH)"
	testfileext="FDR"
}
###########


## Use the text function with the FDR filter in labeledHeatmap to add asterisks, e.g. * 
 txtMat <- dispMat #ORmat.Array
 txtMat[FDRmat.Array>=0.05] <- ""
  txtMat[FDRmat.Array <0.05&FDRmat.Array >0.01] <- "*"
  txtMat[FDRmat.Array <0.01&FDRmat.Array >0.005] <- "**"
  txtMat[FDRmat.Array <0.005] <- "***"

  txtMat1 <- signif(dispMat,2) #ORmat.Array
 txtMat1[txtMat1<1.5] <- ""

  
  textMatrix1 = paste( txtMat1, '\n', txtMat , sep = '');
  textMatrix1= matrix(textMatrix1,ncol=ncol(Pmat.Array),nrow=nrow(Pmat.Array))

#if (rownames(net2)[100]==rownames(speakeasyModules)[100] && rownames(net2)[200]==rownames(speakeasyModules)[200]) { #check if net2 is speakeasyModules; if so, reassign the SE module numbers to the modules!
#	ordinalConversion<-unique(speakeasyModules[-nrow(speakeasyModules),c(3:4)])
#	Emory.Order2<-as.vector(ordinalConversion[Emory.Order,1])
#} else { Emory.Order2<-Emory.Order }
Emory.Order2<-Emory.Order

bw<-colorRampPalette(c("#0058CC", "white"))
wr<-colorRampPalette(c("white", "#CC3300"))

colvec<-c(bw(50),wr(50))

pdf(paste(rootdir,"/ORA-",outfiletitle,".FULL.",testfileext,".pdf",sep=""), width=16,height=8)
par( mar = c(8, 12, 3, 3) );
par(mfrow=c(1,1))

labeledHeatmap(Matrix=dispMat,
  colorLabels=TRUE,
  setStdMargins = FALSE,
  yLabels= paste("ME",uniquemodcolors.Emory,sep=""),
  ySymbols=as.vector(as.character(paste(HeatmapNet2moduleType,"-M",Emory.Order2,sep=""))),
  xLabels= paste("ME",uniquemodcolors.BLSA,sep=""),
  xSymbols=as.vector(as.character(paste(HeatmapNet1moduleType,"-M",BLSA.Order,sep=""))),
  colors=colvec,
  textMatrix = textMatrix1,
  cex.text=0.55,
  cex.lab.x=1,
  zlim=c(-10,10),
  main=paste0(heatmapTitle," ORA/FET Signed ",testtext))

dev.off()

###########################REORDER MATRIX####################################
#find significantly correlated modules and find the order to subset them in a diagonal-positive overlap pattern, then repeat above code

orderVecEmory=matrix(NA,ncol=1,nrow=1) #length(uniquemodcolors.Emory))
orderVecBLSA=matrix(NA,ncol=1,nrow=1) #length(uniquemodcolors.Emory))

BetterThanCutoff=1 #(1, include all modules in reordered PDFs; 0.5, only keep modules with a p-significance <0.5...)

#transposed - works well
for (j in 1:length(uniquemodcolors.BLSA)) {
	bestMatch= which(dispMat[,j]==max(dispMat[,j])[1])
        if (dispMat[bestMatch,j] >BetterThanCutoff) {
           orderVecBLSA=rbind(orderVecBLSA,j)
           truncatedRow=dispMat[-bestMatch,j]
           if (is.na(orderVecEmory [1,1])) { orderVecEmory=matrix(bestMatch,ncol=1)
              } else {
              if (is.na(match(bestMatch,orderVecEmory[,1]))) {
                 orderVecEmory=rbind(as.matrix(orderVecEmory,ncol=1),bestMatch)
              }
           }
           bestMatch1= which(dispMat[,j]==max(truncatedRow)[1])
           truncatedRow1=truncatedRow[-match(max(truncatedRow),truncatedRow)]
           if (is.na(match(bestMatch1,orderVecEmory)) & dispMat[bestMatch1,j] >BetterThanCutoff) {
              orderVecEmory=rbind(as.matrix(orderVecEmory,ncol=1),bestMatch1)
              bestMatch2= which(dispMat[,j]==max(truncatedRow1)[1])
              truncatedRow2=truncatedRow1[-which(truncatedRow1==bestMatch2)]
              if (is.na(match(bestMatch2,orderVecEmory)) & dispMat[bestMatch2,j] >BetterThanCutoff) {
                 orderVecEmory=rbind(as.matrix(orderVecEmory,ncol=1),bestMatch2)
              }
           }
        }
}

if (!dim(orderVecBLSA)[1]==1) { #handle case where there is ZERO overlap
 		#*** *** *** *** ***
Emory.ReOrder<-as.vector(orderVecEmory[1:nrow(orderVecEmory),1])
#Defined by convoluted code above ##
BLSA.ReOrder<-as.vector(orderVecBLSA[2:nrow(orderVecBLSA),1])
BLSA.ReOrder <- c(19, 1, 44, 18, 40, 41, 27, 20, 35, 25, 36, 7, 11, 17, 39, 28, 26, 13, 32, 5, 30, 21, 22, 42, 16, 37, 3, 6, 2, 12, 34, 33, 24, 29, 15, 8, 10, 4, 14, 43, 23, 9)
#^Manually defined, excluding unmatched! (modules 31 and 38 at p<0.5)
BLSA.ReOrder <- c(19, 1, 44, 18, 40, 41, 27, 20, 35, 25, 36, 7, 11, 17, 39, 28, 26, 13, 31, 32, 5, 30, 21, 38, 22, 42, 16, 37, 3, 6, 2, 12, 34, 33, 24, 29, 15, 8, 10, 4, 14, 43, 23, 9)
#^Manually defined, includes all, even completely unmatched modules

uniquemodcolors.ordered.Emory=labels2colors(Emory.ReOrder)
uniquemodcolors.ordered.BLSA=labels2colors(BLSA.ReOrder)

dispMat.ordered<-dispMat[Emory.ReOrder,BLSA.ReOrder]
FDRmat.Array.ordered<-FDRmat.Array[Emory.ReOrder,BLSA.ReOrder]

 txtMat <- dispMat.ordered
 txtMat[FDRmat.Array.ordered>=0.05] <- ""
  txtMat[FDRmat.Array.ordered <0.05&FDRmat.Array.ordered >0.01] <- "*"
  txtMat[FDRmat.Array.ordered <0.01&FDRmat.Array.ordered >0.005] <- "**"
  txtMat[FDRmat.Array.ordered <0.005] <- "***"

  txtMat1 <- signif(dispMat.ordered,2)
  txtMat1[txtMat1<1.5] <- ""
  
  textMatrix.ordered = paste( txtMat1, '\n', txtMat , sep = '');
  textMatrix.ordered= matrix(textMatrix.ordered,ncol=length(BLSA.ReOrder),nrow=length(Emory.ReOrder))

#Transpose back to original rows and columns, but rows still reordered and culled
dispMat.ordered.untransposed<-t(dispMat.ordered)
textMatrix.ordered.untransposed<-t(textMatrix.ordered)

#if (rownames(net2)[100]==rownames(speakeasyModules)[100] && rownames(net2)[200]==rownames(speakeasyModules)[200]) { #check if net2 is speakeasyModules; if so, reassign the SE module numbers to the modules!
#	ordinalConversion<-unique(speakeasyModules[-nrow(speakeasyModules),c(3:4)])
#	Emory.ReOrder2<-as.vector(ordinalConversion[Emory.ReOrder,1])
#} else { Emory.ReOrder2<-Emory.ReOrder }
Emory.ReOrder2<-Emory.ReOrder

pdf(paste(rootdir,"/ORA-",outfiletitle,".reordered.","GTcutoff",BetterThanCutoff,".",testfileext,".pdf",sep=""), width=16,height=8)
par( mar = c(8, 12, 3, 3) );
par(mfrow=c(1,1))

labeledHeatmap(Matrix=t(dispMat.ordered.untransposed),
  colorLabels=TRUE,
  setStdMargins = FALSE,
  yLabels= paste("ME",uniquemodcolors.ordered.Emory,sep=""),
  ySymbols=as.vector(as.character(paste(HeatmapNet2moduleType,"-M",Emory.ReOrder2,sep=""))),
  xLabels= paste("ME",uniquemodcolors.ordered.BLSA,sep=""),
  xSymbols=as.vector(as.character(paste(HeatmapNet1moduleType,"-M",BLSA.ReOrder,sep=""))),
  colors=colvec,
  textMatrix = t(textMatrix.ordered.untransposed),
  cex.text=0.55,
  cex.lab.x=1,
  zlim=c(-10,10),
  main=paste0(heatmapTitle," ORA/FET Signed ",testtext))


labeledHeatmap(Matrix=t(dispMat.ordered),
  colorLabels=TRUE,
  setStdMargins = FALSE,
  xLabels= paste("ME",uniquemodcolors.ordered.Emory,sep=""),
  xSymbols=as.vector(as.character(paste(HeatmapNet2moduleType,"-M",Emory.ReOrder2,sep=""))),
  yLabels= paste("ME",uniquemodcolors.ordered.BLSA,sep=""),
  ySymbols=as.vector(as.character(paste(HeatmapNet1moduleType,"-M",BLSA.ReOrder,sep=""))),
  colors=colvec,
  textMatrix = t(textMatrix.ordered),
  cex.text=0.55,
  cex.lab.x=1,
  zlim=c(-10,10),
  main=paste0(heatmapTitle," (transposed) ORA/FET Signed ",testtext))

dev.off()

} 		#*** *** *** *** *** ZERO Overlap case handled
#/\----------------------------REPEATS FOR BOTH FDR AND P-VALUE CALCULATIONS-------(all warnings follow)----------------/\
}