########################################################################################################################
####
#### R-Script to reproduce the results (Figures and Tables) of the paper
#### "Asymmetric latent semantic indexing for gene expression experiments visualization"
#### Submitted to Advances in data analysis and classifciation.
####
#### Authors: Javier Gonzalez, Alberto Munoz and Gabriel Martos
####
#### 15/02/2014
####
########################################################################################################################
# requiered libraries
library(geneplotter)
library(RColorBrewer)
library(genefilter)
library(MASS)
library(mclust)
library(gplots)
library(mclust)
library(xtable)

### Load the data
data      <- read.table("nci.data")
labels    <- read.table("labels.txt")[,1]

# Expression estimates on the UN-LOGGED scale
e.mat     <- exp(data)

# look at mean, sd, & cv for each gene across arrays
gene.mean <- apply(e.mat,1,mean)
gene.sd   <- apply(e.mat,1,sd)
gene.cv   <- gene.sd/gene.mean

# Plot of the gene.sd over the gene mean and histogram of those with cv. larger that 7.7
blues.ramp <- colorRampPalette(brewer.pal(9,"Blues")[-1])
dCol       <- densCols(log(gene.mean),log(gene.sd), colramp=blues.ramp)

###########
# Figure 3: cut-off for differential expression analysis
###########
par(mfrow=c(1,2))
plot(gene.mean,gene.sd,log='xy',col=dCol,pch=16,cex=0.1,xlim = c(1,2),ylim = c(0.2,5),xlab="Gene mean", ylab="Gene sd.",main="A",cex.main=2)
abline(v=100,lwd=3,col='red')
hist(log(gene.cv),xlab = "Gene CV (log. scale)",col="grey",main="B",cex.main=2)
abline(v=log(.5),lwd=3,col='red')
text(0.8,800,"Theshold: CV>0.5")

# We select those genes with CV larger.5 (genes differentially expressed in the data)
ffun          <- filterfun(cv(0.5,100))
t.fil         <- genefilter(e.mat,ffun)

# Apply filter and transform back on log scale
small.eset    <- e.mat[t.fil,]
small.noeset  <- e.mat[!t.fil,]

# Threshod to consider that a gene is expressed (the maximum value of the not expressed).
thres = max(small.noeset)

###########
# Figure 2: diff-expressed vs. not diff-expressed gene.
###########
par(mfrow=c(1,2))
par(mar=c(5,5,3,3))
plot(1:64,small.eset[99,],ylim=c(0,15),pch =20,xlab="Experiment",ylab="Expression",main="Differentially expressed gene",cex=2)
abline(h = thres ,lwd=2, col = "red",lty=2)
plot(1:64,small.noeset[2,],ylim=c(0,15),pch =20,xlab="Experiment",ylab="Expression",main="Non differentially expressed gene",cex=2)
abline(h = thres ,lwd=2, col = "red",lty=2)

# Select those genes expressed at least one time
ffun2         <- filterfun(pOverA(0.025,thres))
t.fil2        <- genefilter(small.eset,ffun2)
small.eset2   <- small.eset[t.fil2,]

# Create genes by experiments matrix of differentially expressed genes
colnames(small.eset2) <- labels
X                     <- as.matrix((sign(small.eset2 - thres)+1)/2)  # genes by experiments matrix
colnames(X)           <- labels
n.genes               <- nrow(X)

###########
# Figure 2: Zipf's law, histogram of the norm of the genes
###########
par(mfrow=c(1,1))
norm.genes = apply(X,1,sum)
hist(norm.genes,nclass=25,col = "grey",main = " ",xlab="Genes Norm",ylab="Frequency")
text(16,600,paste(n.genes," differentially expressed genes"),cex=1.7)

###########
# Figure 1 (A and B): Heatmaps pf raw data and differentially expressed genes
###########
heatmapA <- heatmap(log(t(small.eset2)), Rowv=NA, Colv=NA,scale="column",margins = c(0.5, 15))
heatmapB <- heatmap(t(X), Rowv=NA, Colv=NA, scale="none",margins = c(0.5, 15))

# Define the degree of membership of each gene to each type of experiment
n.groups                          <- length(table(labels))
membership.genes.probs            <- matrix(0,n.genes,n.groups )
membership.genes                  <- matrix(0,n.genes,n.groups )
colnames(membership.genes.probs)  <- levels(labels)
colnames(membership.genes)        <- levels(labels)

for (i in 1:n.genes)
  {
  membership.genes.probs[i,] = table(labels[X[i,]==1])/norm.genes[i]
  membership.genes[i,which(membership.genes.probs[i,] == max(membership.genes.probs[i,]))]=1
  }

### Calculate the (asymmetric) matrix of similarities between genes with respect to the experiments
S0 		            <- X %*% t(X)
Matrix.norms.inv	<- diag(1/norm.genes)
S 		            <- Matrix.norms.inv %*% S0

## Calculate the polar decomposition
svdS              <- svd(S)
M1                <- svdS$u%*%diag(svdS$d)%*%t(svdS$u)
M2                <- svdS$v%*%diag(svdS$d)%*%t(svdS$v)

### Calculate the (asymmetric) matrix of similarities between genes with respect to the classes
Z                 <- membership.genes%*%t(membership.genes)%*%diag(1/apply(membership.genes,1,sum))
svdZ              <- svd(Z)
R1                <- svdZ$u%*%diag(svdZ$d)%*%t(svdZ$u)
R2                <- svdZ$v%*%diag(svdZ$d)%*%t(svdZ$v)

## Matrix combination of the two asymmetric similarities
A                 <- (M1+M2)/2 + 0.2*(R1+R2)

## Extract components
eigA              <- eigen(A)
XX                <- Re(eigA$vectors[,Re(eigA$values)>0.0001])%*%diag(sqrt(Re(eigA$values)[Re(eigA$values)>0.0001]))

# Extract components of the mixture
cluster.lsa       <- Mclust(XX, G =14)

# Cross the clusters with the original classes
cross = matrix(NA,14,14)
for (k in 1:14){cross[k,] = table(membership.genes[,k],cluster.lsa$classification)[2,]}
rownames(cross)   <- levels(labels)
colnames(cross)   <- c("C1","C2","C3","C4","C5","C6","C7","C8","C9","C10","C11","C12","C13","C14")

###########
# Table 2: clusters vs. orignal classes
###########
xtable(cross)

###########
# Figure 6: MDS of the groups
##########
X.cross = sammon(dist(cross))
plot(X.cross$points,xlab= "Component 1",ylab= "Component 2",type="n",col=1:14,xlim=c(-270,270),ylim=c(-270,270),main = "aLSI mapping of types of Cancer")
text(X.cross$points,rownames(X.cross$points),col="blue",cex=1.1)

### Obtain genes with higest probability in each cluster
mp                <- matrix(NA,5,14)
for (i in 1:14){mp[,i] = order(cluster.lsa$z[,i],decreasing = TRUE)[1:5]}
colnames(mp)      <- c("C1","C2","C3","C4","C5","C6","C7","C8","C9","C10","C11","C12","C13","C14")
rownames(mp)      <- c("gene 1","gene 2","gene 3","gene 4","gene 5")

###########
# Table 1: most probable genes of each cluster
###########
xtable(t(mp))

## Sammon mapping for the combination
mds.S12         <- prcomp(XX)$x[,c(1,2)]  ## save similarity matrix
mds.S13         <- prcomp(XX)$x[,c(1,3)]  ## save s
cluster.lsa     <- hclust(dist(XX),method="ward")

### MDS-Correlation
C               <- cor(log(t(small.eset2)))
mds.C12         <- cmdscale(1-C,k=3)[,c(1,2)]
mds.C13         <- cmdscale(1-C,k=3)[,c(1,3)]

### MDS-Euclidean
D               <- dist(log(small.eset2))
mds.D12         <- cmdscale(D,k=3)[,c(1,2)]
mds.D13         <- cmdscale(D,k=3)[,c(1,3)]

###########
# Figure 5: genes maps produced by the aLSI, Pearson's correlation and Euclidean distance.
###########
par(mfrow = c(3,2))
par(mar= c(5,5,1.5,1))
plot(mds.S12,pch=19,cex=0.8,col="grey",type="n",main = "Asymmetric LSI",xlab="1st component",ylab="2nd component",xlim=c(-1,1.4))
for(k in 1:14)
points(mds.S12[which(apply(membership.genes,1,sum)==1 & membership.genes[,k]==1), ],col=k,pch=k,cex=0.9)
legend("topleft",  c("G1","G2","G3","G4","G5","G6","G7"), col=1:7,pch=1:7)
legend("topright", c("G8","G9","G10","G11","G12","G13","G14"), col=8:14,pch=8:14)

plot(mds.S13,pch=19,cex=0.8,col="grey",type="n",main = "Asymmetric LSI",xlab="1st component",ylab="3th component",xlim=c(-1,1.4))
for(k in 1:14)
points(mds.S13[which(apply(membership.genes,1,sum)==1 & membership.genes[,k]==1), ],col=k,pch=k,cex=0.9,xlab="1st component")
legend("topleft",  c("G1","G2","G3","G4","G5","G6","G7"), col=1:7,pch=1:7)
legend("topright", c("G8","G9","G10","G11","G12","G13","G14"), col=8:14,pch=8:14)

plot(mds.C12,pch=19,cex=0.8,col="grey",main = "Correlation",xlab="1st component",ylab="2nd component",xlim=c(-1,1.2))
for(k in 1:14)
points(mds.C12[which(apply(membership.genes,1,sum)==1 & membership.genes[,k]==1), ],col=k,pch=k,cex=0.9)
legend("topleft",  c("G1","G2","G3","G4","G5","G6","G7"), col=1:7,pch=1:7)
legend("topright", c("G8","G9","G10","G11","G12","G13","G14"), col=8:14,pch=8:14)

plot(mds.C13,pch=19,cex=0.8,col="grey",main = "Correlation",xlab="1st component",ylab="3th component",xlim=c(-1,1.2))
for(k in 1:14)
points(mds.C13[which(apply(membership.genes,1,sum)==1 & membership.genes[,k]==1), ],col=k,pch=k,cex=0.9)
legend("topleft",  c("G1","G2","G3","G4","G5","G6","G7"), col=1:7,pch=1:7)
legend("topright", c("G8","G9","G10","G11","G12","G13","G14"), col=8:14,pch=8:14)

plot(mds.D12,pch=19,cex=0.8,col="grey",main = "Euclidean distance",xlab="1st component",ylab="2nd component",xlim=c(-20,20))
for(k in 1:14)
points(mds.D12[which(apply(membership.genes,1,sum)==1 & membership.genes[,k]==1), ],col=k,pch=k,cex=0.9)
legend("topleft",  c("G1","G2","G3","G4","G5","G6","G7"), col=1:7,pch=1:7)
legend("topright", c("G8","G9","G10","G11","G12","G13","G14"), col=8:14,pch=8:14)

plot(mds.D13,pch=19,cex=0.8,col="grey",main = "Euclidean distance",xlab="1st component",ylab="3th component",xlim=c(-20,20))
for(k in 1:14)
points(mds.D13[which(apply(membership.genes,1,sum)==1 & membership.genes[,k]==1), ],col=k,pch=k,cex=0.9)
legend("topleft",  c("G1","G2","G3","G4","G5","G6","G7"), col=1:7,pch=1:7)
legend("topright", c("G8","G9","G10","G11","G12","G13","G14"), col=8:14,pch=8:14)

code/Script for aLSI for gene expression visualization.r


setwd("/Users/xxuadmin/BUSINESS/PUBLICATIONS/WorkingOn_Abramoff_Perspective/millennial_code_2017July_Century_WT")

# output
data <- read.table("outputcontrol.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
outputcontrol <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
#par(mai = c(1,1,1,1,1))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "outputcontrol.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("Control run:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("output5cwarm.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
output5cwarm <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "output5cwarm.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("5 C warming:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("output10clay.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
output10clay <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "output10clay.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("10% Clay content:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("output20clay.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
output20clay <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "output20clay.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("20% Clay content:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("output30clay.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
output30clay <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "output30clay.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("30% clay content:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("output40clay.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
output40clay <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "output40clay.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("40% clay content:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("output50clay.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
output50clay <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "output50clay.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("50% clay content:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("output60clay.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
output60clay <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "output60clay.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("60% clay content:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end
# output
data <- read.table("output70clay.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
output70clay <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "output70clay.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("70% Clay content:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("output80clay.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
output80clay <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "output80clay.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("80% Clay content:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("outputdoubleCinput.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
outputdoubleCinput <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "outputdoubleCinput.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("Double C input:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("outputhalfwater.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
outputhalfwater <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "outputhalfwater.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("Half water moisture:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("outputTandCinput.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
outputTandCinput <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "outputTandCinput.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("5C Warming and Double C input:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

# output
data <- read.table("outputTandW.txt")
LMC <- data$V2[729636:730000]
POM <- data$V3[729636:730000]
MB <- data$V4[729636:730000]
MINERAL <- data$V5[729636:730000]
AGG <- data$V6[729636:730000]
outputTandW <- data$V2 + data$V3 + data$V4 + data$V5 + data$V6

summary(LMC)
summary(POM)
summary(MB)
summary(MINERAL)
summary(AGG)
lmcaverage = mean(LMC)
pomaverage = mean(POM)
mbaverage = mean(MB)
mineralaverage = mean(MINERAL)
aggaverage = mean(AGG)

carbon <- c(lmcaverage, pomaverage, mbaverage, mineralaverage, aggaverage)
#lbls <- c("LMWC", "POM", "MB", "MINERAL", "AGGREGATE")
#pct <- round(carbon/sum(carbon)*100)
#lbls <- paste(lbls,pct) # add percents to labels
#lbls <- paste(lbls, "%", sep="")
#pie(carbon, labels=lbls, col=rainbow(length(lbls)),main=round(sum(carbon)))
colors <- c("black","red","green","blue","pink")
numb_labels <- round(carbon/sum(carbon) * 100,1)
numb_labels <- paste(numb_labels, "%", sep="")
xx <- c("LMWC","POM","MB","MINERAL","AGGREGATE")
xx <- paste(round(carbon/sum(carbon) * 100,1),xx,sep=" ")

pdf(file = "outputTandW.pdf")
pie(carbon, labels="", col=colors,clockwise=TRUE,main=paste("5C Warming and Half Water:", round(sum(carbon)),"gC",sep=" "))
legend(-1.25,-0.5, legend = xx, fill=colors,bty="n")
dev.off()

rm(data)
rm(LMC)
rm(POM)
rm(MB)
rm(MINERAL)
rm(AGG)
# end

#plot time series of total carbon for all scenarios
#outputcontrol
#output5cwarm
#output10clay
#output20clay
#output30clay
#output40clay
#output50clay
#output60clay
#output70clay
#output80clay
#outputdoubleCinput
#outputhalfwater
#outputTandCinput
#outputTandW
pdf(file = "timeseries.pdf")
day=c(1:136500)
plot(c(1,175000),c(-2000,2000),type="n",xlab="Day",ylab="changed in total C storage")
lines(day,output5cwarm[1:136500] - outputcontrol[1:136500],col="blue")
lines(day,output10clay[1:136500] - outputcontrol[1:136500],col="brown")
lines(day,output20clay[1:136500] - outputcontrol[1:136500],col="yellow")
lines(day,output30clay[1:136500] - outputcontrol[1:136500],col="cyan")
lines(day,output40clay[1:136500] - outputcontrol[1:136500],col="darkblue")
lines(day,output50clay[1:136500] - outputcontrol[1:136500],col="darkgreen")
lines(day,output60clay[1:136500] - outputcontrol[1:136500],col="darkgray")
lines(day,output70clay[1:136500] - outputcontrol[1:136500],col="darkorange")
lines(day,output80clay[1:136500] - outputcontrol[1:136500],col="darkred")
lines(day,outputdoubleCinput[1:136500] - outputcontrol[1:136500],col="deeppink")
lines(day,outputhalfwater[1:136500] - outputcontrol[1:136500],col="deepskyblue")
lines(day,outputTandCinput[1:136500] - outputcontrol[1:136500],col="darkgreen")
lines(day,outputTandW[1:136500] - outputcontrol[1:136500],col="lightgreen")
legend(137500,1000,c("warming","10% clay","20% clay","30% clay","40% clay","50% clay","60% clay","70% clay","80% clay","double C input","half water","warming and double C input","warming and half water"),lty=c(1,1),lwd=c(2.5,2.5),col=c("blue","brown","yellow","cyan","darkblue","darkgreen","darkgray","darkorange","darkred","deeppink","deepskyblue","darkgreen","lightgreen"))
dev.off()


# Methods for in silico tryptic digestion, formula calculation, monoisotopic mass
# calculation and b and y fragment ion simulation in R.
#
# Written by Tom Taverner for Pacific Northwest National Lab.
# 10-26-2010

# Methods for in silico digestion,

# Required packages
install.packages("seqinr")
library(seqinr)
library(reshape)

  # lookup table for amino acid formulae
my.aa <- array(c(6, 6, 6, 5, 9, 4, 11, 5, 6, 6, 3, 4, 4, 3, 5, 5, 2, 5, 3, 9, 11, 11, 12, 9, 9, 7, 10, 9, 12, 7, 5, 6, 5, 5, 7, 8, 3, 7, 5, 9, 1, 1, 2, 1, 1, 1, 2, 1, 4, 3, 1, 2, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 3, 1, 3, 2, 1, 1, 2, 2, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0), c(20L, 5L))
dimnames(my.aa) <- list(c("I", "L", "K", "M", "F", "T", "W", "V", "R", "H", "A", "N", "D", "C", "E", "Q", "G", "P", "S", "Y"), c("C", "H", "N", "O", "S"))

  # lookup table for monoisotopic masses
my.fw = c(C = 12.0, H = 1.00782503207, N = 14.0030740048, O = 15.99491461956, S = 31.97207100)

  # get.formula: given a string of 1-letter amino acid codes, returns the formula of the peptide
  # arguments: x, peptide sequence,
  # plusFormula - default corresponds to H2O for peptides
    # b ions: plusFormula = c(C=0,H=0,N=0,O=0,S=0)
    # y ions: default is OK
  # charge, charge to place on sequence
get.formula <- function(x, charge=1, plusFormula=c(C=0, H=2, N=0, O=1, S=0)){
  f1 <- factor(strsplit(x, "")[[1]], levels=rownames(my.aa))
  colSums(rbind(model.matrix(~f1-1) %*% my.aa, plusFormula, c(C=0, H=charge, N=0, O=0, S=0)))
}

  # get.monoisotopic.mass: given a formula output from get.formula, get the monoisotopic mass
get.monoisotopic.mass <- function(ff){
  stopifnot(identical(names(ff), names(my.fw)))
  drop(ff %*% my.fw)
}

  # apply.protease: virtual protease digestion function
  # arguments:
  # prots: list containing protein sequences
  # missed: number of missed cleavages
  # include.re and exclude.re: regular expressions corresponding to protease cleavage rules
  #   the cleavage sites are the include.re matches that aren't in exclude.re
  # note: only supports cleavage on C-terminal side
  # output: the same list of prots, with $peptide containing
  #   (1) list of peptides
  #   (2) position of cleavage
  #   (3) number of missed cleavages
apply.protease <- function(prots, missed=1, include.re = "[KR]", exclude.re = "([KR]$)|([KR][P])"){
 for(jj in seq(length=length(prots))){
   prot <- prots[[jj]][[1]]
   pos <- setdiff(gregexpr(include.re, prot)[[1]], gregexpr(exclude.re, prot)[[1]])

   pos <- c(0, c(pos), nchar(prot))
   n <- length(pos)+1
   nmis <- missed+1
   pid <- cbind(rep(1:n, each=nmis), rep(1:nmis, n))
   zz <- cbind(pos[pid[,1]], pos[pid[,1]+pid[,2]])
   ok.idx <- !rowSums(is.na(zz))
   zz <- zz[ok.idx,,drop=F]
     # this is where we'd extend the method with PTM's, etc
   suppressWarnings(prots[[jj]]$peps <- substr(rep(prot[[1]], nrow(zz)), zz[,1]+1, zz[,2]))

   attr(prots[[jj]]$peps, "start") <- pos[pid[ok.idx,1]]
   attr(prots[[jj]]$peps, "missed") <- pid[ok.idx,2]-1
  }
  return(prots)
}

  # For a given protein from the apply.protease() output
  # create a Protein Prospector style data frame
  # Input: a single list item from apply.protease() output
  # Output: a data frame containing sequence, start, missed cleavages, charge, monoisotopic m/z
create.peptides.table <- function(digested.peps, minMZ=800, maxMZ=4000, maxCharge=1){
 thePeps <- digested.peps$peps
 theFormulas <- sapply(thePeps, get.formula)
 theCharge <- rep(1:maxCharge, each=length(thePeps))

 mono.mz <- c()
 for(z in 1:maxCharge)
   mono.mz <- c(mono.mz, c(t(theFormulas)%*%my.fw + (z-1)*my.fw[["H"]])/z)

 peps.and.masses <- data.frame(MassToCharge = mono.mz,
   Start = attr(thePeps, "start"), MissedCleavages = attr(thePeps, "missed"),
   Charge = theCharge, Sequence=thePeps)

 # ensure we have reasonable numbers of charges - don't allow more charge than K + R + 1
 maxAllowedCharge <- sapply(gregexpr("[KR]", thePeps), length)+1
 peps.and.masses <- peps.and.masses[peps.and.masses$Charge <= maxAllowedCharge,,drop=FALSE]

 peps.and.masses <- peps.and.masses[minMZ< peps.and.masses$MassToCharge
   & peps.and.masses$MassToCharge < maxMZ,,drop=FALSE]
 peps.and.masses <- peps.and.masses[order(peps.and.masses$MassToCharge),,drop=FALSE]

 return(peps.and.masses)
}

 # create b and y ions for a given peptide sequence
 # input: peptide sequence
 # output: list containing b.ions and y.ions
 # both are named vectors containing monoisotopic singly charged masses of ions
create.ions <- function(peptide){
  ncp <- nchar(peptide)
  b.sequences <- c(mapply(substr, rep(peptide, ncp), 1, 1:ncp))
  names(b.sequences) <- paste("b", 1:length(b.sequences), sep="")

  b.ions <- sapply(b.sequences,
   function(x) get.monoisotopic.mass(get.formula(x, plusFormula = c(C=0,H=0,N=0,O=0,S=0))))
  b.ions[1] <- NA # there's no such thing as a b1 ion ;-)
  b.ions[length(b.ions)] <- NA

  y.sequences <- c(mapply(substr, rep(peptide, ncp), ncp:1, ncp))
  names(y.sequences) <- paste("y", 1:length(y.sequences), sep="")

  y.ions <- sapply(y.sequences,
   function(x) get.monoisotopic.mass(get.formula(x, plusFormula = c(C=0,H=2,N=0,O=1,S=0))))
  y.ions[length(y.ions)] <- NA

  return(list(b.ions=b.ions, y.ions=y.ions))
}

#
# Demonstration code
#

library(seqinr)
  # read in the Shew fasta file here
my.fasta <- read.fasta(file.choose(), as.string=TRUE, forceDNAtolower=FALSE)

 # take the first 5
prots <- my.fasta[1:5]

 # apply simulated tryptic digestion to get a list of all peptides given 1 missed
digested <- apply.protease(prots, missed=1)

 # create tables including monoisotopic masses, etc
peptide.tables <- lapply(digested, create.peptides.table, minMZ=800, maxMZ=4000, maxCharge=3)

library(RGtk2Extras)
dfedit(peptide.tables$SO_0001)
# compare to prospector
http://prospector.ucsf.edu/prospector/cgi-bin/msform.cgi?form=msdigest

# enter in MTKIAILVGTTLGSSEYIADEMQAQLTPLGHEVHTFLHPTLDELKPYPLWILVSSTHGAGDLPDNLQPFCKELLL
NTPDLTQVKFALCAIGDSSYDTFCQGPEKLIEALEYSGAKAVVDKIQIDVQQDPVPEDPALAWLAQWQDQI
# notice we predict some peptides their algorithm doesn't...

 # bring peptides from first 5 proteins together
library(reshape)
mm <- melt(peptide.tables, measure.vars="MassToCharge")
all.peptides <- cast(mm)
colnames(all.peptides)[colnames(all.peptides)=="L1"] <- "Protein"
all.peptides <- all.peptides[order(all.peptides$MassToCharge),,drop=FALSE]

 # take a look
dfedit(all.peptides)

# generate some b and y ions
my.fragments <- create.ions("LIEALEYSGAKAVVDK")
data.frame(b.type=names(my.fragments$b.ions), b.mass=my.fragments$b.ions, y.type=rev(names(my.fragments$y.ions)), y.mass=rev(my.fragments$y.ions))

# compare to prospector
http://prospector.ucsf.edu/prospector/cgi-bin/mssearch.cgi?search_name=msproduct&output_type=HTML&report_title=MS-Product&version=5.6.2&instrument_name=ESI-Q-TOF&use_instrument_ion_types=1&parent_mass_convert=monoisotopic&user_aa_composition=C2%20H3%20N1%20O1&max_charge=2&s=1&sequence=LIEALEYSGAKAVVDK&


#This contains all of the functions used in the model

#Hardcode the corps names by class as generally accessible variables
WorldClass = c("The Academy","Blue Devils","Blue Knights","Blue Stars","Bluecoats","Boston Crusaders","The Cadets","Carolina Crown",
	"The Cavaliers","Colts","Crossmen","Genesis","Jersey Surf","Madison Scouts","Mandarins","Music City","Oregon Crusaders",
	"Pacific Crest","Phantom Regiment","Pioneer","Santa Clara Vanguard","Seattle Cascades","Spirit of Atlanta","Troopers"
)
OpenClass = c("7th Regiment","The Battalion","Blue Devils B","Blue Devils C","Colt Cadets","Columbians","Encorps","Gold","Golden Empire",
	"Guardians","Heat Wave","Impulse","Incognito","Legends","Louisiana Stars","Raiders","River City Rhythm","Shadow",
	"Southwind","Spartans","Vanguard Cadets","Vessel","Watchmen"
)
OC_NotAttending = c("The Battalion","Blue Devils B","Blue Devils C","Columbians","Encorps","Impulse","Incognito",
	"Vanguard Cadets","Vessel","Watchmen"
)

ScoreParse <- function(filename, WorldNames=WorldClass, OpenNames=OpenClass) {
	#Start by loading the file
	BigTable = read.csv(filename, stringsAsFactors=F)

	#This function creates a data frame for a given corps
	FrameCreate <- function(CorpsName, Table) {
		#Start by finding all the rows which have data
		CorpsRows = which(Table$Corps == CorpsName)
		if (length(CorpsRows) == 0) {
			return(NULL)
		}

		#Get vectors for the scores and Day
		GEvec = Table[CorpsRows,"GE"]
		VisVec = Table[CorpsRows,"Visual"]
		MusVec = Table[CorpsRows,"Music"]
		DayVec = Table[CorpsRows,"Day"]

		#Now make the data frame
		OutFrame = data.frame(Day=DayVec, GE=GEvec, Vis=VisVec, Mus=MusVec)
		return(OutFrame)
	}

	#Now run the function on all the world class and open class corps
	WorldFrames = lapply(WorldNames, FrameCreate, Table=BigTable)
	OpenFrames = lapply(OpenNames, FrameCreate, Table=BigTable)
	#Combine them into a single frame
	AllFrames = c(WorldFrames, OpenFrames)

	#Add the corps names to the frames
	names(AllFrames) = c(WorldNames, OpenNames)
	return(AllFrames)
}

#Create a function that fits the exponential curve to a data frame
ExpFitter <- function(CorpsFrame, BaseDay, PrelimsDay=50) {
	#50 is the prelims day for 2019, which is why it's defaulted here

	#Start by checking the number of shows
	if (is.null(CorpsFrame)) { return(NULL) }
	if (nrow(CorpsFrame) < 6) { return(NULL) }

	#Order the frame by day
	CorpsFrame = CorpsFrame[order(CorpsFrame$Day),]

	#The weight vector reduces weights of recent scores, based on their correlation with finals week scores
	#The weight vector reduces weights of recent scores, based on their correlation with finals week scores
	DayVec = seq(from=0, to=PrelimsDay+2, by=1)
	WeightVec = 1 - (PrelimsDay-DayVec)*0.00224
	DiscountOrig = 0.25 + (0.75-0.25)/PrelimsDay * BaseDay
	DiscountVec = seq(from=1, to=DiscountOrig, length.out=6)

	#Create a vector for the corps-specific day weights
	ShowWeights = WeightVec[CorpsFrame$Day]
	#Now discount the most recent 5
	Nshow = length(ShowWeights)
	ShowWeights[(Nshow-5):Nshow] = ShowWeights[(Nshow-5):Nshow] * DiscountVec

	#Pull out the individual vectors to match nls input better
	N = sum(CorpsFrame$Day <= BaseDay)
	GE = CorpsFrame$GE[CorpsFrame$Day <= BaseDay]
	Vis = CorpsFrame$Vis[CorpsFrame$Day <= BaseDay]
	Mus = CorpsFrame$Mus[CorpsFrame$Day <= BaseDay]
	Day = CorpsFrame$Day[CorpsFrame$Day <= BaseDay]

	#Now fit the curve for each caption, wrapped in a try to avoid catastrophic errors
	#This tryCatch won't make the objects if we're not successful
	tryCatch({
		GEModel = nls(GE ~ a + Day^b, data=data.frame(GE, Day), start=list(a=GE[1], b=0.5),
			control=nls.control(warnOnly=TRUE), weights=ShowWeights)
		VisModel = nls(Vis ~ a + Day^b, data=data.frame(Vis, Day), start=list(a=Vis[1], b=0.5),
			control=nls.control(warnOnly=TRUE), weights=ShowWeights)
		MusModel = nls(Mus ~ a + Day^b, data=data.frame(Mus, Day), start=list(a=Mus[1], b=0.5),
			control=nls.control(warnOnly=TRUE), weights=ShowWeights)
	}, warning = function(w) { #This makes it so scenarios of non-convergence don't return bad coefficients
		#print("Can't run corps due to non-convergence")
	}, error = function(e) {
		#print("Can't run corps due to an error in curve fitting")
	})

	#Check to see how many of the 3 models exist
	ExistVec = c(exists('GEModel'), exists('VisModel'), exists('MusModel'))

	#Create a copy of CorpsFrame we can modify
	CorpsFrame2 = CorpsFrame
	TrimmedResult = NA #This tracks if we're successful in the if loop

	if (sum(ExistVec) < 3) { #This means we didn't get a good fit in at least 1 caption
		#print("Nonconvergence!")
		#Try removing the most recent scores until we get convergence or too small a sample
		CorpsFrame2 = CorpsFrame2[1:(nrow(CorpsFrame2)-1) ,]

		if (nrow(CorpsFrame) < 6) { #Check for sample size
			break
		} else {
			#Recursion!
			TrimmedResult = ExpFitter(CorpsFrame2, BaseDay)
			#No matter what, we can return TrimmedResult because this is the top level of the recursion
			return(TrimmedResult)
		}
	}

	#Pull out the summary of the models
	GEcoef = summary(GEModel)$coefficients
	Vcoef = summary(VisModel)$coefficients
	Mcoef = summary(MusModel)$coefficients

	#Now pull out the coefficients
	aVec = c(GEcoef[1,1], Vcoef[1,1], Mcoef[1,1])
	bVec = c(GEcoef[2,1], Vcoef[2,1], Mcoef[2,1])

	#And now pull out the standard errors
	aseVec = c(GEcoef[1,2], Vcoef[1,2], Mcoef[1,2])
	bseVec = c(GEcoef[2,2], Vcoef[2,2], Mcoef[2,2])

	#Put the coefficients and standard errors into a data frame
	OutFrame = data.frame(a=aVec, b=bVec, aSE=aseVec, bSE=bseVec, N=rep(N,3))
	row.names(OutFrame) = c('GE','Vis','Mus')
	#return the data frame
	return(OutFrame)
}

#Now make a function that predicts a day for all corps
Predictor <- function(CorpsList, PredictDay, Nmonte, RankDay) {
	#Start by making a function that predicts N scores based on the exponential uncertainty
	ExpPredict <- function(CorpsCoefList, PredictDay, Nmonte) {
		#Start by gathering basic information
		Ncorps = length(CorpsCoefList)

		#This function returns a list of N predictions
		ScoreList = vector(mode='list', length=Ncorps)

		#Loop through each corps and make the random vectors
		for (C in 1:Ncorps) {
			CorpsCoefs = CorpsCoefList[[C]]
			#Recall the exponential is of the form Score = a + Day^b

			#Make a vector of random a's for each caption
			GEa = rnorm(Nmonte, mean=CorpsCoefs["GE","a"], sd=CorpsCoefs["GE","aSE"])
			Va = rnorm(Nmonte, mean=CorpsCoefs["Vis","a"], sd=CorpsCoefs["Vis","aSE"])
			Ma = rnorm(Nmonte, mean=CorpsCoefs["Mus","a"], sd=CorpsCoefs["Mus","aSE"])
			#Make a vector of b's for each caption
			GEb = rnorm(Nmonte, mean=CorpsCoefs["GE","b"], sd=CorpsCoefs["GE","bSE"])
			Vb = rnorm(Nmonte, mean=CorpsCoefs["Vis","b"], sd=CorpsCoefs["Vis","bSE"])
			Mb = rnorm(Nmonte, mean=CorpsCoefs["Mus","b"], sd=CorpsCoefs["Mus","bSE"])

			#Now create the score for each caption
			GEscore = GEa + PredictDay ^ GEb
			Vscore = Va + PredictDay ^ Vb
			Mscore = Ma + PredictDay ^ Mb

			#Now correct each score to make sure they're actually possible
			GEscore[GEscore > 40] = 40
			Vscore[Vscore > 30] = 30
			Mscore[Mscore > 30] = 30

			#Now get the total score list
			ScoreList[[C]] = GEscore + Vscore + Mscore
		}

		#Convert each simulation score to gaps
		BaseScores = vector(mode='double', length=Nmonte)
		for (i in 1:Nmonte) {
			BaseScores[i] = max(sapply(ScoreList, '[[', i))
		}
		#Now loop through each corps and subtract the base score
		for (C in 1:length(ScoreList)) {
			ScoreList[[C]] = ScoreList[[C]] - BaseScores
		}
		return(ScoreList)
	}

	#Now create a function that predicts N scores based on the random error
	RandPredict <- function(CorpsCoefList, PredictDay, Nmonte, RankDay) {
		library(MASS)

		#Get the basic information
		Ncorps = length(CorpsCoefList)
		#The output will be the score list
		ScoreList = vector(mode='list', length=Ncorps)

		#Make a correlation matrix for the errors
		CorrMat = matrix(nrow=Ncorps, ncol=Ncorps)
		for (Row in 1:Ncorps) {
			for (Col in 1:Ncorps) {
				IndexDiff = abs(Row - Col)
				#Use IndexDiff to determine the correlation
				if (IndexDiff == 0) {
					#This is a diag
					CorrMat[Row,Col] = 1
				} else if (IndexDiff > 14) {
					#This is a background correlation
					CorrMat[Row,Col] = 0.263
				} else {
					#This is an off-diag
					CorrMat[Row,Col] = 0.513 - (IndexDiff-1)*(0.25/14)
				}
			}
		}
		#To account for the effect of doing caption specific correlations, we increase the correlation
		CorrMat = CorrMat * 1.25
		diag(CorrMat) = 1

		#Now multiply the correlation matrix by the variances for each captions
		#the historical noise magnitude is 4, so the captions are adjusted to add to that:
			# 40^2 * GEvar + 30^2 * Mvar + 30^2 Vvar = 4
			# 1600GEvar + 900Mvar + 900Vvar = 4
			# Mvar = Vvar = Cvar - assuming the music and visual errors are the same
			# 1600GEvar + 1800Cvar = 4
			# GEvar = 4/3 * Cvar - assuming error is scaled by total caption score
			# (4/3)1600Cvar + 1800Cvar = 4
			# with some rounding...
			# 3900Cvar = 4
			# Cvar = 4 / 3900
		# We now need to apply the variance to each individual caption
		# At some point the error needs to be scaled by total points, so we'll do it  here
		GEcov = CorrMat * 40 * sqrt(4/3900)
		CapCov = CorrMat * 30 * sqrt(4/3900)

		#Draw the random numbers using the covariance matrices,
		GErand = mvrnorm(Nmonte, mu=rep(0,Ncorps), Sigma=GEcov, empirical=F)
		Mrand = mvrnorm(Nmonte, mu=rep(0,Ncorps), Sigma=CapCov, empirical=F)
		Vrand = mvrnorm(Nmonte, mu=rep(0,Ncorps), Sigma=CapCov, empirical=F)

		#We choose the column of random numbers for each corps based on their rank
		# In 2018, we ranked by caption but now we use total score as it better indicates performance order
		RankScores = vector(mode='double', length=Ncorps)

		#We still need the caption scores to do the predictions
		GEscores = vector(mode='double', length=Ncorps)
		Vscores = vector(mode='double', length=Ncorps)
		Mscores = vector(mode='double', length=Ncorps)

		#Fill in the vectors
		for (C in 1:Ncorps) {
			GEscores[C] = CorpsCoefList[[C]]["GE","a"] + RankDay ^ CorpsCoefList[[C]]["GE","b"]
			Vscores[C] = CorpsCoefList[[C]]["Vis","a"] + RankDay ^ CorpsCoefList[[C]]["Vis","b"]
			Mscores[C] = CorpsCoefList[[C]]["Mus","a"] + RankDay ^ CorpsCoefList[[C]]["Mus","b"]
			RankScores = GEscores + Vscores + Mscores
		}

		#Convert these to gaps
		GEscores = GEscores - max(GEscores)
		Vscores = Vscores - max(Vscores)
		Mscores = Mscores - max(Mscores)
		RankScores = RankScores - max(RankScores)

		#Adjust the scores down of OC if we're late in the season
		# OC coprs need to be discounted because the scores get inflated late in the season
		if (RankDay >= 40 & PredictDay > 48) {
			needOCadjust = names(CorpsCoefList) %in% OpenClass
			GEscores[needOCadjust] = GEscores[needOCadjust] - (2 * 0.4)
			Vscores[needOCadjust] = Vscores[needOCadjust] - (2 * 0.3)
			Mscores[needOCadjust] = Mscores[needOCadjust] - (2 * 0.3)
			RankScores[needOCadjust] = RankScores[needOCadjust] - 2
		}

		#Get the rank vector
		CorpsRanks = match(RankScores, sort(RankScores, decreasing=T)) #Ranks from highest to lowest

		#Now loop through each corps and fill in ScoreList
		for (C in 1:Ncorps) {
			# In 2018 we had a damping effect to account for slotting, but that effect is now captured
			# 	by other parts in the model.
			GEvec = GEscores[C] + GErand[,CorpsRanks[C]]
			Mvec = Mscores[C] + Mrand[,CorpsRanks[C]]
			Vvec = Vscores[C] + Vrand[,CorpsRanks[C]]

			#Put the summed scores into the list
			ScoreList[[C]] = GEvec + Mvec + Vvec
		}

		return(ScoreList)
	}

	#Get the number of corps
	Ncorps = length(CorpsList)

	#Run both score predictors
	ExpScoreList = ExpPredict(CorpsList, PredictDay, Nmonte)
	RandScoreList = RandPredict(CorpsList, PredictDay, Nmonte, RankDay)
	#print(RandScoreList)

	#Now create the overall score and rank lists to return
	ScoreList = vector(mode='list', length=Ncorps)
	RankList = vector(mode='list', length=Ncorps)

	#Fill in the final ScoreList
	for (C in 1:Ncorps) {
		ScoreList[[C]] = 0.317*ExpScoreList[[C]] + 0.683*RandScoreList[[C]]
	}
	# vars = sapply(ScoreList, var); print(mean(vars)); print(vars) #debugging

	#Fill in RankList by sorting the scores
	for (n in 1:Nmonte) {
		#Get the scores and rank them
		scores = sapply(ScoreList, '[[', n)
		ranks = match(scores, sort(scores, decreasing=T))
		#Now put the ranks into the list
		for (C in 1:Ncorps) {
			RankList[[C]][n] = ranks[C]
		}
	}

	#Retain the names in the lists
	names(ScoreList) = names(CorpsList)
	names(RankList) = names(CorpsList)

	#return the lists
	return(list(ScoreList, RankList))
}

#this function returns a vector of information for each corps
	#mean score,percent odds of being in 1st, second, thrid, top12, and top25
PredictionReduce_WorldClass <- function(PredictionList) {
	ScoreList = PredictionList[[1]]
	RankList = PredictionList[[2]]

	#Get the simple information
	Ncorps = length(PredictionList[[1]])
	Nmonte = length(PredictionList[[1]][[1]])
	CorpsNames = names(PredictionList[[1]])

	#create a vector for each returned value
	MeanScores = vector(mode='double', length=Ncorps)
	PercGold = vector(mode='double', length=Ncorps)
	PercSilver = vector(mode='double', length=Ncorps)
	PercBronze = vector(mode='double', length=Ncorps)
	PercFinals = vector(mode='double', length=Ncorps)
	PercSemis = vector(mode='double', length=Ncorps)

	#Loop through each corps and fill the vectors in
	for (C in 1:Ncorps) {
		MeanScores[C] = mean(ScoreList[[C]])
		PercGold[C] = sum(RankList[[C]] == 1) / Nmonte
		PercSilver[C] = sum(RankList[[C]] == 2) / Nmonte
		PercBronze[C] = sum(RankList[[C]] == 3) / Nmonte
		PercFinals[C] = sum(RankList[[C]] <= 12) / Nmonte
		PercSemis[C] = sum(RankList[[C]] <= 25) / Nmonte
	}

	#Adjust the gaps to make sure 1st place is a 0
	MeanScores = MeanScores - max(MeanScores)

	#Now format these into a data frame
	OutFrame = data.frame(Mean=MeanScores, Gold=PercGold, Silver=PercSilver, Bronze=PercBronze, Finals=PercFinals, Semis=PercSemis)
	row.names(OutFrame) = CorpsNames

	#Sort the data frame by percent chance of gold
	OutFrame = OutFrame[order(OutFrame$Mean, decreasing=T),]

	#Now return the data frame
	return(OutFrame)
}

#This function returns a vector of information for each corps, based on open class
	#that's mean score, percent odds of being in 1st, 2nd, 3rd, and making OC Finals
PredictionReduce_OpenClass <- function(PredictionList) {
	ScoreList = PredictionList[[1]]
	RankList = PredictionList[[2]]

	#Get the simple information
	Ncorps = length(PredictionList[[1]])
	Nmonte = length(PredictionList[[1]][[1]])
	CorpsNames = names(PredictionList[[1]])

	#create a vector for each returned value
	MeanScores = vector(mode='double', length=Ncorps)
	PercGold = vector(mode='double', length=Ncorps)
	PercSilver = vector(mode='double', length=Ncorps)
	PercBronze = vector(mode='double', length=Ncorps)
	PercFinals = vector(mode='double', length=Ncorps)

	#Loop through each corps and fill the vectors in
	for (C in 1:Ncorps) {
		MeanScores[C] = mean(ScoreList[[C]])
		PercGold[C] = sum(RankList[[C]] == 1) / Nmonte
		PercSilver[C] = sum(RankList[[C]] == 2) / Nmonte
		PercBronze[C] = sum(RankList[[C]] == 3) / Nmonte
		PercFinals[C] = sum(RankList[[C]] <= 12) / Nmonte
	}

	#Make sure 1st place's gap is 0
	MeanScores = MeanScores - max(MeanScores)

	#Now format these into a data frame
	OutFrame = data.frame(Mean=MeanScores, Gold=PercGold, Silver=PercSilver, Bronze=PercBronze, Finals=PercFinals)
	row.names(OutFrame) = CorpsNames

	#Sort the data frame by percent chance of gold
	OutFrame = OutFrame[order(OutFrame$Mean, decreasing=T),]

	#Now return the data frame
	return(OutFrame)
}


# plotrocfischer.r - plot ROCs for different method on Fischer and Nh3D data
#
# Alex Stivala, October 2008
#
# Plot ROC curves for different methods on the Fischer data set
# (Fischer et al 1996) and Nh3D data set (Thiruv et al 2005)
#  as used in Pelta et al 2008.
#
# Requires the ROCR package from CRAN (developed with version 1.0-2)
# (ROCR in turn requires gplots, gtools, gdata)
#
# Run this on the output of e.g. tsevalfn.py with the -l option,
# it is a table with one column of scores from classifier, and second
# column of true class label (0 or 1)
#
# The citation for the ROCR package is
#   Sing et al 2005 "ROCR: visualizing classifier performance in R"
#   Bioinformatics 21(20):3940-3941
#
#
# $Id: plotrocs_fischer_nh3d.r 2376 2009-05-14 01:40:32Z astivala $

library(ROCR)

#
# globals
#

colorvec=c('deepskyblue4','brown','red','turquoise','blue','purple','green','cyan','gray20','magenta','darkolivegreen2','midnightblue','magenta3','darkseagreen','violetred3','darkslategray3')
ltyvec=c(1,2,4,5,6,1,2,1,5,6,1,2,4,5,6,1,2)
namevec=c('MSVNS3 norm1','MSVNS3 norm2', 'MSVNS3 norm3', 'QP tableau search norm1', 'QP tableau search norm2', 'QP tableau search norm3')

fischer_fold_files=c('../maxcmo_results/fischer/norm1/fold.slrtab', '../maxcmo_results/fischer/norm2/fold.slrtab','../maxcmo_results/fischer/norm3/fold.slrtab','fischer/norm1/fold.slrtab','fischer/norm2/fold.slrtab','fischer/norm3/fold.slrtab')
fischer_class_files=c('../maxcmo_results/fischer/norm1/class.slrtab','../maxcmo_results/fischer/norm2/class.slrtab','../maxcmo_results/fischer/norm3/class.slrtab','fischer/norm1/class.slrtab','fischer/norm2/class.slrtab','fischer/norm3/class.slrtab')
nh3d_arch_files=c('../maxcmo_results/nh3d/norm1/arch.slrtab','../maxcmo_results/nh3d/norm2/arch.slrtab','../maxcmo_results/nh3d/norm3/arch.slrtab','nh3d/norm1/arch.slrtab','nh3d/norm2/arch.slrtab','nh3d/norm3/arch.slrtab')
nh3d_class_files=c('../maxcmo_results/nh3d/norm1/class.slrtab','../maxcmo_results/nh3d/norm2/class.slrtab','../maxcmo_results/nh3d/norm3/class.slrtab','nh3d/norm1/class.slrtab','nh3d/norm2/class.slrtab','nh3d/norm3/class.slrtab')

#
# functions
#

#
# Return the ROCR performance object for plotting ROC curve
#
# Parameters:
#   tab : data frame with score and label columns
#
# Return value:
#   ROCR performance object with FPR and TPR for plotting ROC curve
#
compute_perf <- function(tab)
{
    # tab is a data frame with score and label columns
    pred <- prediction(tab$score, tab$label)
    perfroc <- performance(pred, measure="tpr",x.measure="fpr")
    return(perfroc)
}

#
# main
#

# EPS suitable for inserting into LaTeX

postscript('rocs_fischer_fold.eps',
           onefile=FALSE,paper="special",horizontal=FALSE,
           width = 9, height = 6)
for (i in 1:length(fischer_fold_files)) {
    tab <- read.table(fischer_fold_files[i], header=TRUE)
    perfroc <- compute_perf(tab)
    plot(perfroc, lty=ltyvec[i], col=colorvec[i], add=(i>1),
         #main='Fischer data set at fold level' # remove title for paper
         )
}
legend('bottomright', col=colorvec, lty=ltyvec, legend=namevec)
#lines(c(0,1),c(0,1),type='l',lty=3)
dev.off()

postscript('rocs_fischer_class.eps',
           onefile=FALSE,paper="special",horizontal=FALSE,
           width = 9, height = 6)
for (i in 1:length(fischer_class_files)) {
    tab <- read.table(fischer_class_files[i], header=TRUE)
    perfroc <- compute_perf(tab)
    plot(perfroc, lty=ltyvec[i], col=colorvec[i], add=(i>1),
#         main='Fischer data set at class level'  # remove title for paper
         )
}
legend('bottomright', col=colorvec, lty=ltyvec, legend=namevec)
#lines(c(0,1),c(0,1),type='l',lty=3)
dev.off()

postscript('rocs_nh3d_arch.eps',
           onefile=FALSE,paper="special",horizontal=FALSE,
           width = 9, height = 6)
for (i in 1:length(nh3d_arch_files)) {
    tab <- read.table(nh3d_arch_files[i], header=TRUE)
    perfroc <- compute_perf(tab)
    plot(perfroc, lty=ltyvec[i], col=colorvec[i], add=(i>1),
         # main='Nh3D data set at architecture level' # remove title for paper
         )
}
legend('bottomright', col=colorvec, lty=ltyvec, legend=namevec)
#lines(c(0,1),c(0,1),type='l',lty=3)
dev.off()

postscript('rocs_nh3d_class.eps',
           onefile=FALSE,paper="special",horizontal=FALSE,
           width = 9, height = 6)
for (i in 1:length(nh3d_class_files)) {
    tab <- read.table(nh3d_class_files[i], header=TRUE)
    perfroc <- compute_perf(tab)
    plot(perfroc, lty=ltyvec[i], col=colorvec[i], add=(i>1),
         # main='Nh3D data set at class level' #  removed title for paper
         )

}
#lines(c(0,1),c(0,1),type='l',lty=3)
legend('bottomright', col=colorvec, lty=ltyvec, legend=namevec)
dev.off()