library("Starr")

## Reading data:
## cel and bpmap files from the original publication are used

bpmap <- readBpmap("Sc03b_MR_saccer1.new.bpmap")

cel_files <- c("Rpb3_1.CEL", "Rpb3_2.CEL", "BY4741_2007037.CEL", "BY4741-M2_2007134.CEL")
type <- c("IP", "IP", "CONTROL", "CONTROL")
exp_names <- c("IP1_rpb3", "IP2_rpb3", "IP1_wt", "IP2_wt")
E_MEXP_1676 <- readCelFile(bpmap, cel_files, exp_names, type, experimentData=NULL, featureData=T, log.it=T)
ips <- E_MEXP_1676$type == "IP"
controls <- E_MEXP_1676$type == "CONTROL"


## Sequence-dependent hybridization bias of raw intensities

plotGCbias(exprs(E_MEXP_1676)[,1], featureData(E_MEXP_1676)$seq, main="")
plotPosBias(exprs(E_MEXP_1676)[,1], featureData(E_MEXP_1676)$seq)


## Using rMAT for normalization
## Convert expressionSet to tilingSet and apply rMAT

library(rMAT)
expressionSet2TilingSet <- function(eSet) {
	featureChromosome <- as.vector(featureData(eSet)$chr)
	featurePosition <- featureData(eSet)$pos
	featureCopyNumber <- as.integer(rep(1, length=length(featurePosition)))
	exprs <- exprs(eSet)
	featureSequence <- featureData(eSet)$seq
	
	
	newSet <- new('tilingSet', featureChromosome=featureChromosome, featureSequence=featureSequence,
				featurePosition=featurePosition, featureCopyNumber=featureCopyNumber, exprs=exprs, experimentData=experimentData(eSet))
	newSet				
}

tilingSet_Sc <- expressionSet2TilingSet(E_MEXP_1676)
ScSetNorm <- NormalizeProbes(tilingSet_Sc,method="MAT",robust=FALSE,all=FALSE,standard=TRUE,verbose=FALSE)  


par(mfcol=c(1,2))
plotGCbias(exprs(ScSetNorm)[,1], ScSetNorm@featureSequence, main="")
plotPosBias(exprs(ScSetNorm)[,1], ScSetNorm@featureSequence, ylim=c(-0.1, 0.1))



## Normalization of the data

E_MEXP_1676_rp <- normalize.Probes(E_MEXP_1676, method="rankpercentile")
E_MEXP_1676_rp_ratio <- getRatio(E_MEXP_1676_rp, ips, controls, "E_MEXP_1676_rankpercentile_ratio", fkt=median, featureData=FALSE)


## Sequence-dependent hybridization bias of rank-percentile normalized intensities

par(mfcol=c(1,2))
plotGCbias(exprs(E_MEXP_1676_rp_ratio)[,1], featureData(E_MEXP_1676)$seq, main="")
plotPosBias(exprs(E_MEXP_1676_rp_ratio)[,1], featureData(E_MEXP_1676)$seq, ylim=c(-0.1, 0.1))


## Creating probeAnno object

probeAnno <- bpmapToProbeAnno(bpmap)


## Data read-in and normalization of gene expression data

library("yeast2.db")
library("yeast2cdf")
library("vsn")

celnames <- c("wt_1.CEL", "wt_2.CEL", "wt_3.CEL")
affyBatch <- ReadAffy(filenames=celnames)
E_MEXP_2123 <- expresso(affyBatch, bg.correct = FALSE, normalize.method = "vsn",
						normalize.param = list(subsample = 1000), pmcorrect.method = "pmonly",
						summary.method = "medianpolish")
features <- unlist(mget(featureNames(E_MEXP_2123), yeast2ORF))
affy_ids <- names(features)
E_MEXP_2123_ORF <- list()
for (i in 1:length(features)) {
	nr <- which(features == features[i])
	E_MEXP_2123_ORF[[features[i]]] <- median(exprs(E_MEXP_2123)[affy_ids[nr], ], na.rm = T)
}
E_MEXP_2123_ORF <- unlist(E_MEXP_2123_ORF)


## Reading transcript annotation from a gff file

transcriptAnno <- read.gffAnno("transcriptAnno.gff", feature="transcript")

tssAnno <- transcriptAnno
watson <- which(tssAnno$strand == 1)
crick <- which(tssAnno$strand == -1)
tssAnno[watson,]$end <- tssAnno[watson,]$start
tssAnno[crick,]$start <- tssAnno[crick,]$end


## Plotting profiles along the transcription start site (TSS)

q <- quantile(E_MEXP_2123_ORF, probs=c(0.2,0.9), na.rm=T)
low <- names(E_MEXP_2123_ORF)[which(E_MEXP_2123_ORF <= q[1])]
high <- names(E_MEXP_2123_ORF)[which(E_MEXP_2123_ORF >= q[2])]
take <- which(tssAnno$name  %in% c(low, high))
tssAnno <- tssAnno[take,]
profile <- getProfiles(E_MEXP_1676_rp_ratio, probeAnno, tssAnno, 500, 500, feature="TSS", borderNames="TSS", method="basewise")
clus <- rep(0, dim(tssAnno)[1])
clus[which(tssAnno$name %in% low)] <- 1
clus[which(tssAnno$name %in% high)] <- 2
names(clus) <- tssAnno$name
plotProfiles(profile, cluster=clus, type="l", lwd=2)


## Plotting correlation of mean intensities along the transcript to gene expression values 

pos <- c("start", "start", "start", "region", "region","region","region", "stop","stop","stop")
upstream <- c(500, 0, 250, 0, 0, 500, 500, 500, 0, 250)
downstream <- c(0, 500, 250, 0, 500, 0, 500, 0, 500, 250)
info_transcript <- data.frame(pos=pos, upstream=upstream, downstream=downstream, stringsAsFactors=F)
means_rpb3_transcript <- getMeans(E_MEXP_1676_rp_ratio, probeAnno, transcriptAnno, info_transcript)
info_with_cor_transcript <- correlate(info_transcript, means_rpb3_transcript, E_MEXP_2123_ORF)
level <- c(1, 1, 2, 3, 4, 5, 6, 1, 1, 2)
info_with_cor_transcript$level <- level
correlationPlot(info_with_cor_transcript, labels=c("TSS", "TTS"), ylim=c(0,1))