###################################################
### chunk number 1: setup1
###################################################
#line 68 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
library("cellHTS")


###################################################
### chunk number 2: setup2
###################################################
#line 72 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
## for debugging:
options(error=recover)


###################################################
### chunk number 3: dataPath
###################################################
#line 101 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
experimentName = "TwoWayAssay"
dataPath=system.file(experimentName, package="cellHTS") 


###################################################
### chunk number 4: source import function
###################################################
#line 118 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
source(file.path(dataPath, "importData.R"))


###################################################
### chunk number 5: readPlateData
###################################################
#line 123 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
x <- readPlateData("Platelist.txt", 
  importFun=importData, name=experimentName, path=dataPath)


###################################################
### chunk number 6: showX
###################################################
#line 128 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
x


###################################################
### chunk number 7: plateFileTable
###################################################
#line 135 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
cellHTS:::tableOutput(file.path(dataPath, "Platelist.txt"), selRows=1, 
  "plate list", preName="twoWay")


###################################################
### chunk number 8: configure the data
###################################################
#line 158 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
x <- configure(x, confFile="Plateconf.txt", 
     descripFile = "Description.txt", path=dataPath)


###################################################
### chunk number 9: well annottaion
###################################################
#line 173 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
table(x$wellAnno)


###################################################
### chunk number 10: annotate the data
###################################################
#line 186 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
x <- annotate(x, geneIDFile="GeneIDs.txt", path=dataPath)


###################################################
### chunk number 11: plateConfscreenLogTable
###################################################
#line 191 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
cellHTS:::tableOutput(file.path(dataPath, "Plateconf.txt"), 
    "plate configuration", selRows=1:4, preName="twoWay")


###################################################
### chunk number 12: geneIDsTable
###################################################
#line 196 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
cellHTS:::tableOutput(file.path(dataPath, "GeneIDs.txt"), "gene ID", 
  selRows = 3:6, preName="twoWay")


###################################################
### chunk number 13: define controls
###################################################
#line 226 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
negCtr <- "(?i)^GFP$|^mock$"
posCtr <- list(act = "(?i)^AATK$|^ATTK$", inh = "(?i)^MAP2K6$")


###################################################
### chunk number 14: writeReport1Show eval=FALSE
###################################################
## #line 233 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
## out <- writeReport(x, outdir="2Wraw",
##      posControls=posCtr, negControls=negCtr, 
##      plotPlateArgs=list(xrange=c(300, 4000)))


###################################################
### chunk number 15: writeReport1Do
###################################################
#line 239 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
out <- writeReport(x, force=TRUE, outdir="2Wraw", 
   posControls=posCtr, negControls=negCtr, 
   plotPlateArgs=list(xrange=c(300, 4000)))


###################################################
### chunk number 16: browseReport1 eval=FALSE
###################################################
## #line 248 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
## browseURL(out)


###################################################
### chunk number 17: normalization
###################################################
#line 260 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
x <- normalizePlates(x, normalizationMethod ="negatives", 
   negControls = negCtr, transform=log2)


###################################################
### chunk number 18: summarizeReplicates
###################################################
#line 273 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
x <- summarizeReplicates(x, zscore="+", summary="mean") 


###################################################
### chunk number 19: boxplotzscore
###################################################
#line 281 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
ylim <- quantile(x$score, c(0.001, 0.999), na.rm=TRUE)
boxplot(x$score ~ x$wellAnno, col="lightblue", main="scores", outline=FALSE, ylim=ylim, xaxt="n")
lab <- unique(x$plateConf$Content)
lab <- lab[match(levels(x$wellAnno), tolower(lab))]
axis(1, at=c(1:nlevels(x$wellAnno)), labels=lab)


###################################################
### chunk number 20: report2Show eval=FALSE
###################################################
## #line 296 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
## out <- writeReport(x, outdir="2Wnormalized", posControls=posCtr, negControls=negCtr, 
##    plotPlateArgs=list(xrange=c(-1,1)), imageScreenArgs=list(zrange=c(-2,3)))


###################################################
### chunk number 21: report2Do
###################################################
#line 300 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
out <- writeReport(x, outdir="2Wnormalized", posControls=posCtr, negControls=negCtr, 
   plotPlateArgs=list(xrange=c(-1,1)), imageScreenArgs=list(zrange=c(-2,3)), force=TRUE)


###################################################
### chunk number 22: browse2 eval=FALSE
###################################################
## #line 304 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
## browseURL(out)


###################################################
### chunk number 23: savex
###################################################
#line 315 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
save(x, file=paste(experimentName, ".rda", sep=""))


###################################################
### chunk number 24: sessionInfo
###################################################
#line 327 "vignettes/cellHTS/inst/doc/twoWay.Rnw"
toLatex(sessionInfo())