# libraries
library('affy')
library('gtools')
library('limma')
library('frma')
library(hgu133plus2.db)
library(ClassDiscovery)
library(simpleaffy)
library(oligo)
library('CoGAPS')
library('gplots')
library('heatmap.plus')
library('Hmisc')

# directory structure
# if not in the current working directory, redefine as appropriate
baseDir <- function(x='') {
  return(paste(getwd(),x,sep="/"))
}

dataDir <- function(x='') {
  return(paste(baseDir('Data'),x,sep='/'))
}
analysisDir <- function(x='') {
  return(paste(baseDir('Analysis5Jan2012'),x,sep='/'))
}
scriptDir <- function(x='') {
  return(paste(analysisDir('R'),x,sep="/"))
}
figDir <- function(x='') {
  return(paste(analysisDir('Fig'),x,sep="/"))
}
GAPSDir <- function(x='',nP=NA) {
  outDir <- analysisDir('GAPS')
  if (!is.na(nP)) {
    outDir <- paste(outDir,sprintf('nP%d',nP),sep="/")
  }
  return(paste(outDir,x,sep="/"))
}

# preprocessing
affyData <- ReadAffy(celfile.path=dataDir('CEL'))
frmaData <- frma(affyData)

# reading in annotation
annot <- read.table(file=dataDir('ExperimentalDesciption.txt'),
                    header=T,row.names=1,sep="\t",
                    stringsAsFactors=F,comment.char="")
cellLinesFiles <-row.names(annot)[which(annot[,'Sample.Description']=='Cell line')]

normCellLines <- exprs(frmaData)[,cellLinesFiles]
colnames(normCellLines) <- paste('X', gsub('-','.', colnames(normCellLines)), 
   sep='')
row.names(annot) <- paste('X',gsub('-','.',row.names(annot)),sep='')
cellLinesFiles <- paste('X',gsub('-','.',cellLinesFiles),sep='')

# batch correction
pdf(figDir('ClusterRawData.pdf'))
affyClust <- standard.pearson(normCellLines)
cols <- rainbow(length(unique(annot[cellLinesFiles,'Date'])))
sub("#FFFF00FF",'black',cols) -> cols
names(cols) <- unique(annot[cellLinesFiles,'Date'])
plotColoredClusters(affyClust,
                    lab=paste(annot[cellLinesFiles,'Over.expression'],
                      annot[cellLinesFiles,'media.stim'],
                      annot[cellLinesFiles,'Time'],
                      annot[cellLinesFiles,'treatment'],sep='.'),
                    cols=cols[annot[cellLinesFiles,'Date']],xlab='',cex=0.5)
legend('topright',legend=names(cols),col=cols,pch=rep('-',length(cols)))
dev.off()

cellType <- as.factor(annot[cellLinesFiles,'Over.expression'])
media <- as.factor(annot[cellLinesFiles,'media'])
stim <- as.factor(annot[cellLinesFiles,'stim'])
media.stim <- as.factor(annot[cellLinesFiles,'media.stim'])
time <- as.factor(annot[cellLinesFiles,'Time'])
media.stim.time <- paste(media.stim,time,sep=".")
media.stim.time[grep('serum',media.stim.time)] <- '0.serum'
media.stim.time <- as.factor(media.stim.time)
treatment <- as.factor(annot[cellLinesFiles,'treatment'])
biol.factors <- factor(paste(cellType, media.stim, treatment, sep='.'))
names(biol.factors) <- names(media.stim) <- names(cellType) <-  cellLinesFiles

biol.factors.baseline <- rep(T, length(biol.factors))
biol.factors.baseline[grep('gefitinib', biol.factors)] <- F
biol.factors.baseline[grep('U1026', biol.factors)] <- F
biol.factors.baseline[grep('LY294002', biol.factors)] <- F

isolation <- as.factor(annot[cellLinesFiles,'RNA.Isolation.Method'])
dateEffect <- as.factor(sub('/','.',sub('/','.',annot[cellLinesFiles,'Date'])))

model.design <- model.matrix(~0 +biol.factors+dateEffect)
lm.fit <- lmFit(normCellLines,model.design)
effectsCorrect <- intersect(c(paste('dateEffect',
                                    unique(dateEffect),sep='')),
                            colnames(model.design))
lmCorrection <- normCellLines - lm.fit$coefficients[,effectsCorrect]%*%
  t(model.design[,effectsCorrect])

pdf(figDir('ClusterLMFitData.pdf'))
plotColoredClusters(standard.pearson(lmCorrection),lab=paste(annot[cellLinesFiles,'Over.expression'],
	annot[cellLinesFiles,'media.stim'],
	annot[cellLinesFiles,'Time'],annot[cellLinesFiles,'treatment'],sep='.'),
	cols[annot[cellLinesFiles,'Date']],xlab='',cex=0.5)
legend('topright',legend=names(cols),col=cols,pch=rep('-',length(cols)))
dev.off()

# subsetting data to genes of interest and defining gene sets
source(scriptDir('PathwayHeatmap.R'))
load(dataDir('TF2Gene_2010.Rda'))
TF2Gene <- lapply(TF2Gene,unique)
pathwayTargets <- list()

pathwayTargets[['STAT']] <- c('STAT1','STAT1:STAT1','STAT1:STAT3',
                              'STAT3','STAT3:STAT3',
                              'STAT5','STAT5B','STAT5B:STAT5B')
pathwayTargets[['RAS']] <- c('Elk-1', 'Elk1-isoform1',
                             'Sp1', 'c-Myc','N-Myc')
pathwayTargets[['AKT']] <- c('NFkappaB', 'NF-kappaB',
                             'RelA-p65', "RelA-p65:RelA-p65",
                             "p53", "FOXO", "HIF-1", "HIF-1alpha")
pathwayTargets[['TGFB']] <- c('Smad2','Smad3','Smad4',"Smad2:Smad3:Smad4",
                              "Smad3:Smad4")
pathwayTargets[['NOTCH']] <- c('HES-1', "HES-1:Hes6","Hey2")

SYMBOL2Probe <- revmap(as.list(hgu133plus2SYMBOL))
probesKeep <- row.names(lmCorrection)[which(apply(lmCorrection,1,
                                                  function(x){
                                                    max(x)-min(x)>1}))]

pathwayGenes <- lapply(pathwayTargets,
                       function(x){unique(unlist(TF2Gene[x]))})
pathwayProbes <- lapply(pathwayGenes,
                        function(x){unique(unlist(SYMBOL2Probe[x]))})

TFProbes <- lapply(unique(unlist(pathwayTargets)),
function(x){unique(unlist(SYMBOL2Probe[unique(unlist(TF2Gene[x]))]))})
names(TFProbes) <- unique(unlist(pathwayTargets))
TFProbes <- TFProbes[names(TFProbes)[which(sapply(TFProbes,length)>0)]]

pathwayTargets <- lapply(pathwayTargets,
                         function(x){intersect(x,names(TFProbes))})

candidateGenes <- unique(unlist(TF2Gene))
candidateProbes <- SYMBOL2Probe[intersect(candidateGenes,
                                          names(SYMBOL2Probe))]


# filter probes to ensure a sufficient response 
validCandidates <-unlist(candidateProbes)[apply(lmCorrection[unlist(candidateProbes),],1,function(x){max(x)-min(x)>1})]
validCandidates <- lapply(candidateProbes,
                          function(x){intersect(x,validCandidates)})
validCandidates <- validCandidates[sapply(validCandidates,
                                          function(x){length(x)>0})]

# select single probe for each gene for robustness of gene set statistics

if (!file.exists(GAPSDir('EGFRGAPSD.txt'))) {
   # only do this calculation if the file does not exist (to save time)

   kin.baseline.contrasts <- makeContrasts((biol.factorsEGFR.EGF.none -
                                            biol.factorsEGFR.none.none) + 
                                           (biol.factorsp65.TNF.none -
                                            biol.factorsp65.none.none),
                                           levels=model.design)

   kin.baseline.contrast.fit <- eBayes(contrasts.fit(lm.fit,
                                                     kin.baseline.contrasts))
   kin.baseline.p <- c(kin.baseline.contrast.fit$p.value)
   names(kin.baseline.p) <- kin.baseline.contrast.fit$genes[,1]

   maxPProbes <- lapply(validCandidates,
                        function(x){names(which.min(kin.baseline.p[x]))[1]})

   D <- lmCorrection[unlist(maxPProbes),cellLinesFiles]

   write.table(D,file=dataDir('EGFRGAPSD.txt'),sep="\t")

} else {
   D <- read.table(GAPSDir('EGFRGAPSD.txt'), header=T, row.names=1, sep="\t")
   maxPProbes <- row.names(D)   
}

# select only untreated cell lines 
DSbst <- D[,which(biol.factors.baseline)]
write.table(DSbst,file=GAPSDir('EGFRGAPSDSbst.txt'),sep="\t")

# GAPS analysis (performed only if GAPS matrices are not found for efficiency)

# Run the GAPS decomposition (if the files are not found)
S <- 0.1*DSbst

nSimTotal = 3
chi2Fit <- matrix(NA, nrow=nSimTotal, ncol=length(3:8))
colnames(chi2Fit) <- paste('nP',3:8,sep='.')

for (nP in 3:8) {

	numSimRun <- length(list.files(GAPSDir(nP=nP),pattern='Amean'))
	if (numSimRun < nSimTotal) {
		outputDir <- GAPSDir(nP=nP)
		dir.create(outputDir, recursive=T)
		for (iSim in 1:(nSimTotal-numSimRun)) {
			message(sprintf('Running GAPS decomposition %d of %d for %d patterns\n',
							iSim, numSimTotal - numSimRun, nP))
			GAPS(data=DSbst, unc=S, outputDir=outputDir, isPercentError=F,
				 numPatterns=nP, keepChain=T)		
		}
	}
	
	for (iSim in 1:nSimTotal) {
		A <- as.matrix(read.table(list.files(GAPSDir(nP=nP),pattern='Amean',full.names=T)[iSim], 
								  header=T, row.names=1,sep="\t"))
		
		P <- as.matrix(read.table(sub('Amean','Pmean',
									  list.files(GAPSDir(nP=nP),pattern='Amean',full.names=T)[iSim]),
								  header=T, row.names=1, sep="\t"))
		chi2Fit[iSim, sprintf('nP.%d',nP)] <- sum(((DSbst-A%*%P)*(DSbst-A%*%P))/(2.*S*S))
	}
}

# plot chi^2 vs number of patterns to assess dimensionaltiy
pdf(figDir('GAPSDimensionality.pdf'))
plot(3:8, apply(chi2Fit,2,mean), type='l', xlab='number of patterns', ylab=expression(chi^2), lwd=3)
dev.off()

# demonstrate robustness of 6 patterns by plotting heatmap 
# this should also demonstrate the relationship of patterns to the cell lines
n6SimTotal <- 3
num6Sim <- length(list.files(GAPSDir(nP=6), pattern='Amean'))

if (num6Sim < n6SimTotal) {
	outputDir <- GAPSDir(nP=6)
	dir.create(outputDir, recursive=T)
	for (iSim in 1:(n6SimTotal-num6Sim)) {
		message(sprintf('Running GAPS decomposition %d of %d for 6 patterns\n',
						iSim, n6SimTotal - num6Sim))
		GAPS(data=DSbst, unc=S, outputDir=outputDir, isPercentError=F,
			 numPatterns=6, keepChain=T)
	}
}


# extract the results from the GAPS decomposition and compute the pathway level statistics using the CoGAPS
# based Z-score
A6.mean <- list()
A6.sd <- list()
P6.mean <- list()
P6.sd <- list()

P6.PathwayStats <- list()
P6.TFStats <- list()

pathwayTestProbes <- lapply(pathwayProbes, function(x) {intersect(x,row.names(D))})
TFTestProbes <- lapply(TFProbes, function(x) {intersect(x,row.names(D))})

AFiles <- list.files(GAPSDir(nP=6), pattern='Amean', full.names=T)
for (iSim in 1:n6SimTotal) {
	A6.mean[[AFiles[iSim]]] <- as.matrix(read.table(AFiles[iSim], header=T, row.names=1, sep="\t",
													check.names=F))
	A6.sd[[AFiles[iSim]]] <- as.matrix(read.table(sub('Amean','Asd',AFiles[iSim]), 
												  header=T, row.names=1, sep="\t", check.names=F))
	P6.mean[[AFiles[iSim]]] <- as.matrix(read.table(sub('Amean','Pmean',AFiles[iSim]),
													header=T, row.names=1, sep="\t", check.names=F))
	P6.sd[[AFiles[iSim]]] <- as.matrix(read.table(sub('Amean','Psd',AFiles[iSim]), 
												  header=T, row.names=1, sep="\t", check.names=F))
	
	P6.PathwayStats[[AFiles[iSim]]] <- calcCoGAPSStat(Amean=A6.mean[[AFiles[iSim]]],
													  Asd=A6.sd[[AFiles[iSim]]],
													  GStoGenes=pathwayTestProbes)
	P6.TFStats[[AFiles[iSim]]] <- calcCoGAPSStat(Amean=A6.mean[[AFiles[iSim]]],
												 Asd=A6.sd[[AFiles[iSim]]],
												 GStoGenes=TFTestProbes)
}

# plot the patterns obtained from CoGAPS
plotNames <- paste(cellType, media.stim, sep=' + ')
names(plotNames) <- names(cellType)
plotNames <- plotNames[colnames(P6.mean[[1]])]
plotNames <- plotNames[order(plotNames)]
plotNames[grep('ras',plotNames)] <- 'HRAS + serum'


borderColors <- rep('grey', length(plotNames))
borderColors[grep('EGFR', plotNames)] <- 'green'
borderColors[grep('RAS', plotNames)] <- 'red'
borderColors[grep('p65', plotNames)] <- 'blue'
borderColors[grep('vector',plotNames)] <- 'black'

plotColors <- rep('white', length(plotNames))
plotColors[grep('none', plotNames)] <- 'white'
plotColors[grep('serum', plotNames)] <- 'grey'
plotColors[grep('+ EGF', plotNames)] <- 'green'
plotColors[grep('TNF', plotNames)] <- 'blue'

# determining conditions of each pattern
patternTypes <- matrix(NA, nrow=n6SimTotal, ncol=6)
colnames(patternTypes) <- c('baseline', 'HRAS', 'vector', 'EGFR', 'serum', 'p65')
for (i in 1:n6SimTotal) {
	patternTypes[i,'EGFR'] <- which.max(apply(P6.mean[[i]][,names(plotNames)[grep('EGFR',plotNames)]],1,sum))
	patternTypes[i,'HRAS'] <- which.max(apply(P6.mean[[i]][,names(plotNames)[grep('HRAS',plotNames)]],1,sum))
	patternTypes[i,'p65'] <- which.max(apply(P6.mean[[i]][,names(plotNames)[grep('p65',plotNames)]],1,sum))
	patternTypes[i,'vector'] <- which.max(apply(P6.mean[[i]][,names(plotNames)[grep('vector',plotNames)]],1,sum))
	patternTypes[i,'serum'] <- setdiff(1:6,patternTypes[i,])[which.max(apply(P6.mean[[i]][setdiff(1:6,patternTypes[i,]),
																			 names(plotNames)[grep('serum',plotNames)]],1,sum))]
	patternTypes[i,'baseline'] <- setdiff(1:6,patternTypes[i,])
	
	patternTypes[i,] <- patternTypes[i,] + 6*(i-1)
	
}


# compute the mean profile across simulations

P6Mean <- matrix(0, nrow=nrow(P6.mean[[1]]), ncol=ncol(P6.mean[[1]]))
dimnames(P6Mean) <- dimnames(P6.mean[[1]])
for (i in 1:n6SimTotal) {
	p <- patternTypes[i,] - 6*(i-1)	
	P6Mean <- P6Mean + P6.mean[[i]][p,]
}
P6Mean <- P6Mean / n6SimTotal
row.names(P6Mean) <- colnames(patternTypes)

# compute the mean profile across simulations
A6Mean <- matrix(0, nrow=nrow(A6.mean[[1]]), ncol=ncol(A6.mean[[1]]))
dimnames(A6Mean) <- dimnames(A6.mean[[1]])
for (i in 1:n6SimTotal) {
	p <- patternTypes[i,] - 6*(i-1)	
	A6Mean <- A6Mean + A6.mean[[i]][,p]
}
A6Mean <- A6Mean / n6SimTotal
colnames(A6Mean) <- colnames(patternTypes)


# boxpolot of profiles for each simulation
for (j in 1:n6SimTotal) {

	pdf(figDir(sprintf('PBoxplot%d.pdf',j)))

	p <- patternTypes[j,]-6*(j-1)
	par(mfrow=c(3,2))

	for (i in 1:6) {
		boxplot(P6.mean[[j]][p[i],names(plotNames)]~plotNames,las=2,
				ylim=c(0,max(P6.mean[[j]][p[i],names(plotNames)])),
				border=c(rep('green',3),'red','grey',rep('blue',3),rep('black',4)),
				ylab=sprintf('P[%d,] (%s)', p[i], colnames(patternTypes)[i]))

	}

	dev.off()
}

# boxplot of profiles for average simulation
	
pdf(figDir('PBoxplotMean.pdf'))

par(mfrow=c(3,2))
	
for (i in 1:6) {
	boxplot(P6Mean[i,names(plotNames)]~plotNames,las=2,
			ylim=c(0,max(P6Mean[i,names(plotNames)])),
			border=c(rep('green',3),'red','grey',rep('blue',3),rep('black',4)),
			ylab=sprintf('P[%d,] (%s)', i, colnames(patternTypes)[i]))
		
}
	
dev.off()

# compute the p-values of association for each pattern
TNFP <- t.test(P6Mean['p65',names(plotNames)[which(plotNames=="p65 + TNF")]],
               P6Mean['p65',names(plotNames)[which(plotNames=="p65 + none")]],
   	       alternative='greater')$p.value
	
EGFP <- t.test(P6Mean['EGFR',names(plotNames)[which(plotNames=="EGFR + EGF")]],
  	       P6Mean['EGFR',names(plotNames)[which(plotNames=="EGFR + none")]],
	       alternative='greater')$p.value

NonePEGFR <- t.test(P6Mean['vector',
                    names(plotNames)[which(plotNames=="EGFR + none")]], 
                    alternative='greater')$p.value

NonePp65<- t.test(P6Mean['vector',
                  names(plotNames)[which(plotNames=="p65 + none")]], 
                  alternative='greater')$p.value


# pathway heatmap demonstrating signatures represented in each
PathwayActData <- P6.PathwayStats[[1]]$GSActEst
TFActData <- P6.TFStats[[1]]$GSActEst

for (i in 2:n6SimTotal) {
	PathwayActData <- rbind(PathwayActData, P6.PathwayStats[[i]]$GSActEst)
	TFActData <- rbind(TFActData, P6.TFStats[[i]]$GSActEst)
}

pdf(figDir('GAPSPathwayHeatmap.pdf'))
PathwayHeatmap(pathwayTargets=pathwayTargets, pathwayStats=t(PathwayActData), 
	targetStats=t(TFActData),Colv=T,ColSideColors=rep(rainbow(n6SimTotal),each=6),colsep=n6SimTotal*(1:5))
dev.off()

pathwayMeanAct <- matrix(NA, nrow=ncol(PathwayActData), ncol=6)
colnames(pathwayMeanAct) <- colnames(patternTypes)
row.names(pathwayMeanAct) <- colnames(PathwayActData)
pathwayMinAct <- pathwayMaxAct <- pathwayMeanAct
for (p in colnames(patternTypes)) {
	pathwayMeanAct[,p] <- apply(PathwayActData[patternTypes[,p],],2,mean)
	pathwayMinAct[,p] <- apply(PathwayActData[patternTypes[,p],],2,min)
	pathwayMaxAct[,p] <- apply(PathwayActData[patternTypes[,p],],2,max)
}

pdf(figDir('barplotPathwayByPathway.pdf'))
barplot((pathwayMeanAct),ylim=c(-1,1),beside=T,col=rainbow(nrow(pathwayMeanAct)),
	ylab='Pathway activity')
errbar(x=rep(seq(from=0.5,to=4.5,length.out=5),ncol(pathwayMinAct)) + rep(seq(from=1,to=31,length.out=6),each=5), 
	y=as.numeric(pathwayMeanAct), 
	yplus=as.numeric(pathwayMaxAct), 
	yminus=as.numeric(pathwayMinAct),add=T, pch=NA,
	col=nrow(pathwayMeanAct))
legend('topleft', fill=rainbow(nrow(pathwayMeanAct)), border='black', legend=row.names(pathwayMeanAct))
dev.off()

# t-statistics from a direction comparison to GAPS
geneSetStats <- function(genesSelected,stats,mixedTest=F, logScale=F) {
  if (mixedTest) {
    return(geneSetTest(genesSelected,stats,alternative='mixed'))
  } else {
    upReg <- geneSetTest(genesSelected,stats,alternative='up')
    downReg <- geneSetTest(genesSelected,stats,alternative='down')
    if (upReg < downReg) {
      if (logScale) {
        return(-log10(upReg))
      }
      return(1-upReg)
    } else {
      if (logScale) {
        return(log10(downReg))
      }
      return(downReg-1)
    }  
  }
}

media.GAPS <- as.factor(annot[colnames(DSbst),'media'])
cellType.GAPS <- annot[colnames(DSbst),'Over.expression']
cellType.GAPS <- as.factor(sub('none','0.none',cellType.GAPS))

GAPSlmModel <- model.matrix(~media.GAPS + cellType.GAPS)
colnames(GAPSlmModel)[1] <- 'Intercept'
GAPSlmFit <- lmFit(DSbst, design=GAPSlmModel)
GAPSlmChi2 <- sum((DSbst - GAPSlmFit$coefficients %*% t(GAPSlmModel))*
  (DSbst - GAPSlmFit$coefficients %*% t(GAPSlmModel)) / (2.*S*S))

GAPSlmContrasts <- makeContrasts(Intercept, media.GAPSserum, cellType.GAPSp65,
  cellType.GAPSras, cellType.GAPSvector, cellType.GAPSEGFR,
  levels=GAPSlmModel)
GAPSlmContrastsFit <- eBayes(contrasts.fit(GAPSlmFit, GAPSlmContrasts))
GAPSlmTFStats <- matrix(0, length(TFProbes), 5)
GAPSlmPathwayStats <- matrix(0, length(pathwayProbes),5)
row.names(GAPSlmTFStats) <- names(TFTestProbes)
row.names(GAPSlmPathwayStats) <- names(pathwayTestProbes)
colnames(GAPSlmPathwayStats) <- colnames(GAPSlmTFStats) <- c('serum', 'p65', 'HRAS', 'vector', 'EGFR')

for (i in 2:6) {
	GAPSlmPathwayStats[,i-1] <- as.matrix(sapply(pathwayTestProbes,function(x){
											 geneSetStats(x,GAPSlmContrastsFit$t[unlist(maxPProbes),i],
														  logScale=F)}))
	GAPSlmTFStats[,i-1] <- as.matrix(sapply(TFTestProbes,function(x){
										  geneSetStats(x,GAPSlmContrastsFit$t[unlist(maxPProbes),i],
													 logScale=F)}))
}

pdf(figDir('barplotGAPSLMPathwayByPathway.pdf'))
barplot((GAPSlmPathwayStats),ylim=c(-1,1),beside=T,col=rainbow(nrow(GAPSlmPathwayStats)),ylab='Pathway activity')
legend('topleft', fill=rainbow(nrow(pathwayMeanAct)), border='black', legend=row.names(GAPSlmPathwayStats))
dev.off()

pdf(figDir('GAPSLmStats.pdf'))
PathwayHeatmap(pathwayTargets=pathwayTargets,
	targetStats=GAPSlmTFStats,pathwayStats=GAPSlmPathwayStats,colsep=1:4)
dev.off()

pdf(figDir('GAPSLmPatterns.pdf'))
APlot <- A6.mean[[1]]
for (i in 2:n6SimTotal) {
  APlot <- cbind(APlot, A6.mean[[i]])
}

patternNames <- paste(colnames(patternTypes)[order(patternTypes[1,])],'1', sprintf('(p%d)',1:6))
for (i in 2:n6SimTotal) {
	patternNames <- c(patternNames, paste(colnames(patternTypes)[order(patternTypes[i,])],i,sprintf('(p%d)',1:6)))
}

plotColoredClusters(standard.pearson(cbind(APlot,
  GAPSlmContrastsFit$coefficients)),
  lab=c(patternNames,
        colnames(GAPSlmContrastsFit$coefficients)),
  col=rep(c(rainbow(n6SimTotal),'black'),each=6))
legend('topleft',legend=c(paste('sim',1:n6SimTotal), 'lm'), 
  col=c(rainbow(2),'black'), pch='-')
dev.off()

pdf(figDir('GAPSLmStatsCoGAPSGS.pdf'))
GAPSlmPathwayCoGAPS <- calcCoGAPSStat(Amean=GAPSlmContrastsFit$t, 
  Asd=matrix(1,nrow=nrow(GAPSlmContrastsFit$t),ncol=ncol(GAPSlmContrastsFit$t)),
  GStoGenes=pathwayTestProbes)$GSActEst
GAPSlmTFCoGAPS <- calcCoGAPSStat(Amean=GAPSlmContrastsFit$t, 
  Asd=matrix(1,nrow=nrow(GAPSlmContrastsFit$t),ncol=ncol(GAPSlmContrastsFit$t)),
  GStoGenes=TFTestProbes)$GSActEst
PathwayHeatmap(pathwayTargets=pathwayTargets,
  targetStats=t(GAPSlmTFCoGAPS),pathwayStats=t(GAPSlmPathwayCoGAPS),
  colsep=1:5)
dev.off()

pdf(figDir('GAPSLMStatsCoGAPSGSByPathway.pdf'))
barplot(t(GAPSlmPathwayCoGAPS),ylim=c(-1,1),beside=T,col=rainbow(ncol(GAPSlmPathwayCoGAPS)),ylab='Pathway activity', las=2)
legend('topleft', fill=rainbow(nrow(pathwayMeanAct)), border='black', legend=colnames(GAPSlmPathwayCoGAPS))
dev.off()

# project signature obtained from this using Z-score onto panel of cell lines

# read in cel files from experiments
cellLineDataDir <- function(x='', CEL=F) {
	if (CEL) {
		return(list.files(dataDir('CellLineCEL'),pattern='CEL'))
	} else {
		return(paste(dataDir('CellLineCEL'),x,sep='/'))
	}
}

CellLineAnnot <- read.table(dataDir('CTXSCC11CC8.txt'),
  header=T,row.names=1,sep="\t")
colnames(CellLineAnnot) <- c('survival','CellLine')
cellLineData <- ReadAffy(filenames=sapply(row.names(CellLineAnnot),
  cellLineDataDir))

# perform fRMA normalization
cellLineData <- (frma(cellLineData))
cellLineData <- exprs(cellLineData)

# project onto basis formed by GAPS decomposition
cellLineProjection <- list()
 
HaCaTProjection <- list()
patternModel <- list()
for (sim in names(A6.mean)) {
  patternModel[[sim]] <- model.matrix(~0 + A6.mean[[sim]])
  cellLineProjection[[sim]] <- lmFit(t(cellLineData[row.names(A6.mean[[sim]]),]), 
    design=patternModel[[sim]])
  HaCaTProjection[[sim]] <- lmFit(t(DSbst),design=patternModel[[sim]])
}
cellLineProjectionMean <- lmFit(t(cellLineData[row.names(A6Mean),]), design=model.matrix(~0 + A6Mean))

# validate that projection gives simlar, albeit slightly noiser fits to the data
PProjHaCaTPlotRaw <- t(HaCaTProjection[[1]]$coefficients)
for (iSim in 2:n6SimTotal) {
  PProjHaCaTPlotRaw <- rbind(PProjHaCaTPlotRaw, 
    t(HaCaTProjection[[iSim]]$coefficients))
}

ProjHaCaTPlot <- sweep(PProjHaCaTPlotRaw, 1, 
  apply(PProjHaCaTPlotRaw, 1, max), FUN="/")
row.names(ProjHaCaTPlot) <- paste(rep('proj.',12),'p',rep(1:6,n6SimTotal),sep='')

rowColors2 <- cbind(rep(rainbow(2),each=6),
  rep(rep(rainbow(n6SimTotal),each=6),2))
colnames(rowColors2) <- c('A type', 'Simulation')
  

pdf(figDir('PatternProjectionHeatmap.pdf'))
PPlotRaw <- P6.mean[[1]]
for (i in 2:n6SimTotal) {
	PPlotRaw <- rbind(PPlotRaw, P6.mean[[i]])
}

colColors <- cbind(plotColors, borderColors) 
colnames(colColors) <- c('media','cell type')

PPlot <- sweep(PPlotRaw, 1, apply(PPlotRaw, 1, max), FUN="/")

heatmap.plus(rbind(PPlot,ProjHaCaTPlot)[,names(plotNames)], 
  col=blueyellow(32), scale='none', 
  RowSideColors = rowColors2, ColSideColors = colColors, 
  labCol=plotNames)
dev.off()



X1CC8 <- cellLineProjectionMean$coefficients[row.names(CellLineAnnot)[match(paste('1CC8',1:3,sep="_"),
	as.character(CellLineAnnot[,'CellLine']))],]
SCC1 <- cellLineProjectionMean$coefficients[row.names(CellLineAnnot)[match(paste('SCC1',1:3,sep="_"),
	as.character(CellLineAnnot[,'CellLine']))],]
X1CC8.CTX <- cellLineProjectionMean$coefficients[row.names(CellLineAnnot)[match(paste('1CC8_CTX24h',1:3,sep="_"),
	as.character(CellLineAnnot[,'CellLine']))],]
SCC1.CTX <- cellLineProjectionMean$coefficients[row.names(CellLineAnnot)[match(paste('SCC1_CTX24h',1:3,sep="_"),
	as.character(CellLineAnnot[,'CellLine']))],]

X1CC8.mean <- apply(X1CC8, 2, mean)
X1CC8.sd <- apply(X1CC8, 2, sd)

X1CC8.CTX.mean <- apply(X1CC8.CTX, 2, mean)
X1CC8.CTX.sd <- apply(X1CC8.CTX, 2, sd)

SCC1.mean <- apply(SCC1, 2, mean)
SCC1.sd <- apply(SCC1, 2, sd)

SCC1.CTX.mean <- apply(SCC1.CTX, 2, mean)
SCC1.CTX.sd <- apply(SCC1.CTX, 2, sd)

SCC1Response <- rep(NA, 3)
X1CC8Response <- rep(NA, 3)
names(SCC1Response) <- names(X1CC8Response) <- c('HRAS','EGFR','p65')

SCC1Vs1CC8 <- SCC1Response

pdf(figDir('SCC11CC8CTXResponse.pdf'))
par(mfrow=c(1,3))
for (pName in c('HRAS','EGFR', 'p65'))  {
	
	p <- grep(pName, colnames(SCC1))
	
	boxplot(cbind(SCC1[,p], SCC1.CTX[,p], X1CC8[,p], X1CC8.CTX[,p]), col=rep(c('blue','red'),2), 
			names=c('SCC1','SCC1.CTX','1CC8','1CC8.CTX'), las=2, ylab=sprintf('P[%d,]',p))
	
	title(sprintf('%s \n SCC1 (%0.1e) 1CC8 (%0.1e)', pName, SCC1Response[pName], X1CC8Response[pName]), cex=0.3)

}
dev.off()


session <- sessionInfo()
save(list=ls(), file=scriptDir('AnalysisResults.Rda'))