###################################################
### chunk number 1: helpDataPack eval=FALSE
###################################################
## help(package="rfcdmin")


###################################################
### chunk number 2: Table1BinaryFCSDataFiles
###################################################
table1<-rbind(c("2.0", "UW", "facscan", "8", "0-256"),
              c("3.0", "FHCRC", "DiVa", "10", "0-1024"),
              c("2.0", "BCCRC", "FACSCalibur", "10", "0-1024"))
table1 <- as.data.frame(table1)
## column names are the summary variables
colnames(table1)<-c("FCS Version", "Source", "Machine",
                    "bit resolution", "Integer range")
## rownames are the names of the FCS binary files
rownames(table1)<-c( "facscan256.fcs","SEB-NP22.fcs","A06-H06")
save(table1,file="table1.Rda")


###################################################
### chunk number 3: GenerateTable1BinaryFCSDataFiles
###################################################
if (require(xtable)) {
  xtable(table1,
         caption="Example FCS binary files in 'rfcdmin' package that can be 
         read in using read.FCS or read.series.FCS.
         (UW: University of Washington, Seattle; FHCRC: Fred Hutchinson Cancer 
         Research Center, Seattle; BCCRC: British Columbia Cancer Research Center, Vancouver)",
         label="tab:1")
}else {
  cat("XTABLE not present; please install to get the right table.")
}


###################################################
### chunk number 4: rflowcytLibraryCall
###################################################
library(rflowcyt)
if (!require(rfcdmin)) {
  stop("rfcdmin not available?")
}


###################################################
### chunk number 5: FindingLocationOfFCSDirectoryOfrfcdmin
###################################################
fcs.loc <- system.file("fcs", package="rfcdmin")


###################################################
### chunk number 6: readFCSfacscan256binaryFile
###################################################
file.location <- paste(fcs.loc, "facscan256.fcs", sep="/")
FC.FCSRobj <- read.FCS(file.location, UseS3=TRUE, MY.DEBUG=FALSE)


###################################################
### chunk number 7: convertS3toS4FCS
###################################################
FC.FCSRobj<-convertS3toS4(FC.FCSRobj,
                          myFCSobj.name="FC.FCSRobj",
                          fileName=file.location)


###################################################
### chunk number 8: FindingLocationOfbccrcDirectoryOfrfcdmin eval=FALSE
###################################################
##  pathFiles <- system.file("bccrc", package="rfcdmin")
##  drugFiles <- dir(pathFiles)
##  drugData <- read.series.FCS(drugFiles, path=pathFiles, MY.DEBUG=FALSE)


###################################################
### chunk number 9: DataRFCSobjects
###################################################
data(VRCmin)
data(MC.053min)
data(flowcyt.fluors)


###################################################
### chunk number 10: NewDefaultS4Object
###################################################
## default S4 objects
new.FCS <- new("FCS")
new.FCSmetadata <- new("FCSmetadata")
new.FCSsummary <- new("FCSsummary")
new.FCSgate <- new("FCSgate")


###################################################
### chunk number 11: asFCSobject
###################################################
data2 <- rbind(1:10, 2:11, 3:12)
## coerce data into a matrix object
data2.matrix <- as(data2, "matrix")
## coerce data into a data.frame object
data2.df <- as.data.frame(data2)
## coercing matrix into FCS
test.FCSRobj <- as(data2.matrix, "FCS")
## coercing data.frame into FCS
test.FCSobj2 <- as(data2.df, "FCS")
## coercing a FCS object to a matrix
original.matrix <- as(test.FCSobj2, "matrix")
## coercing a FCS object to a data.frame
original.matrix <- as(test.FCSobj2, "data.frame")
## assigning the metadata
metadata <- new("FCSmetadata", size=dim(data2)[1], nparam=dim(data2)[2],
               fcsinfo=list("comment"="This is a pseudo FCS-R object."))
test.FCSRobj@metadata<-metadata
test.FCSRobj


###################################################
### chunk number 12: isS4object
###################################################
is(MC.053, "matrix")
is(MC.053, "FCS")
is(MC.053@metadata, "FCSmetadata")
is(MC.053, "FCSgate")


###################################################
### chunk number 13: isFCSsummary
###################################################
sum.FCS <- summary(MC.053)
is(sum.FCS, "FCSsummary")


###################################################
### chunk number 14: ExtractMetadata
###################################################
## returns the same FCSmetadata object
meta1<-st.1829@metadata
meta1<-metaData(st.1829)


###################################################
### chunk number 15: DescribeFCSmetadata
###################################################
show(st.1829@metadata)


###################################################
### chunk number 16: SummaryFCSmetadata eval=FALSE
###################################################
## summary(st.1829@metadata)


###################################################
### chunk number 17: table4
###################################################
slotnames<-c( "mode", "size", "nparam", 
"shortnames", "longnames", "paramranges", 
"filename", "objectname", "original", "fcsinfo")
description<-c("Mode", "number of cells/rows", 
"number of column parameters", 
"shortnames of column parameters", 
"longnames of column parameters", 
"Ranges/Max value of the columns", 
"original FCS filename", 
"name of the current object", 
"current object original status", 
"misc.metadata info")
table4 <- data.frame(slotnames, description)
save(table4, file="table4.Rda")


###################################################
### chunk number 18: GenerateTable4FCSmetadataslots
###################################################
if (require(xtable)) {
  xtable(table4,
         caption="FCSmetadata slot descriptions",
         label="tab:4")
}else {
  cat("XTABLE not present; please install to get the right table.")
}


###################################################
### chunk number 19: SlotExtractMeta
###################################################
## extracting the ranges
st.1829@metadata@paramranges
st.1829@metadata["paramranges"]
st.1829@metadata[["$PnR"]]


###################################################
### chunk number 20: SlotExtractMeta
###################################################
st.1829@metadata[["$P1R"]]


###################################################
### chunk number 21: ReplaceMeta
###################################################
## longnames before the change
st.1829@metadata["longnames"]
## some longname changes
st.1829@metadata["longnames"] <- rep("dummy", length(st.1829@metadata["longnames"]))
## name the third column longname as "wrongname"
st.1829@metadata["$P3S"] <- "wrongname"
## longnames after the change
st.1829@metadata["longnames"]


###################################################
### chunk number 22: FCSmetadataExtractReplace
###################################################
## extraction
shortnames.1829 <- st.1829[["shortnames"]]
shortnames.1829

##replacement
st.1829[["$PnR"]]
st.1829[["$P1R"]] <- 0
st.1829[["paramranges"]]

st.1829[["newslot"]]
st.1829[["newslot"]] <- "this is even cooler"
st.1829[["newslot"]]


###################################################
### chunk number 23: AddNewSlotMeta
###################################################
## making a newslot
st.1829@metadata[["newslot"]]<- "wow this is cool"
## newslot is automatically made in the "fcsinfo" slot
st.1829@metadata@fcsinfo[["newslot"]]


###################################################
### chunk number 24: ExtractMetadata
###################################################
## returns the same FCSmetadata object
meta1<-st.1829@metadata
meta1<-metaData(st.1829)


###################################################
### chunk number 25: ExtractData
###################################################
## returns the same data matrix
data1<-st.1829@data
data1<-fluors(st.1829)
summary(data1)


###################################################
### chunk number 26: printFCSobject
###################################################
print(unst.1829) 
print(MC.053)


###################################################
### chunk number 27: FCSmetadataExtractReplace
###################################################
## extraction first 10 rows
firstten.1829 <- as(st.1829[1:10,], "matrix")
firstten.1829
## etraction of single element
firstobs.1829 <- as(st.1829[1,1], "matrix")
firstobs.1829
##replacement of first element
st.1829[1,1] <- 99999999
as(st.1829[1,1], "matrix")
st.1829[1,1]<-firstobs.1829
as(st.1829[1,1], "matrix")
st.1829[1,1] 


###################################################
### chunk number 28: OriginalStatus
###################################################
## the data was changed so the original flag should be FALSE
st.1829[["original"]]


###################################################
### chunk number 29: dim.FCS
###################################################
dim.1829 <- dim.FCS(st.1829)
dim.1829


###################################################
### chunk number 30: addDataParametertoFCS
###################################################
column.to.add <- rep(0, dim.1829[1])
st.1829 <-addParameter(st.1829, colvar=column.to.add, 
                shortname="test", longname="example", 
                use.shortname=FALSE)


###################################################
### chunk number 31: checkvarsFCS
###################################################
st.1829.checkstat <- checkvars(st.1829,
  MY.DEBUG=TRUE)
st.1829.checkstat


###################################################
### chunk number 32: fixvarsFCS
###################################################
if (st.1829.checkstat==FALSE){
   ## fix the FCS R object
   st.1829 <- fixvars(st.1829, MY.DEBUG=TRUE)
}


###################################################
### chunk number 33: ExtractFCSobj
###################################################
st.1829 <- get(st.1829[["objectname"]])
original.FC.FCSRobj <- read.FCS(FC.FCSRobj[["filename"]], 
  MY.DEBUG=FALSE)


###################################################
### chunk number 34: EqualityFCSobjsome
###################################################
## default is to not check the equality 
## of filenames and objectnames and
## only check the equality of the data and 
## the other metadata slots
equals(st.1829, unst.1829)


###################################################
### chunk number 35: EqualityFCSobjall
###################################################
## check equality of everything in the metadata 
## and the data of the FCS objects
equals(st.1829, st.1829, check.filename=TRUE, 
check.objectname=TRUE)


###################################################
### chunk number 36: GetDataTimeCourse
###################################################
 require(rfcdmin)
 data(flowcyt.data)


###################################################
### chunk number 37: PlotDensityTimeCourse
###################################################
 ## Draw a  density plot for the Foward scatter parameter 
 old.par <- par(no.readonly=TRUE)
 mat <- matrix(c(1:2),1,2,byrow=TRUE)
 nf <- layout(mat,respect=TRUE)
 plotdensity.FCS(flowcyt.data[1:8],
                 varpos=c(1),
                 main="FSC density plot at time point 1",
                 ylim=c(0,0.015), 
                 ylab="density of cells")
 legend(450,0.012,paste("stain",c(1:8),sep=""),col=c(1:8),pch=22)
 
 plotdensity.FCS(flowcyt.data[65:72],
                 varpos=c(1),
                 main="FSC density plot at time point 9",
                 ylim=c(0,0.015),
                 ylab="density of cells")
 legend(450,0.012,paste("stain",c(1:8),sep=""),col=c(1:8),pch=22)
 par(old.par)


###################################################
### chunk number 38: PlotECDFTimeCourse
###################################################
 ##Draw an empirical cumulative density plot for the Foward scatter
 ##parameter of the different stains at a particular different time point
 ##(one panel per time point).
print(plotECDF.FCS(flowcyt.data,
                   varpos=c(1),
                   var.list=c(paste("time",1:12,sep="")),
                   group.list=paste("Stain",c(1:8),sep=""),
                   main="ECDF of the FSC for different stains at a particular time point",
                   lwd=2,
                   cex=1.5))



###################################################
### chunk number 39: BoxplotTimeCourse
###################################################
 ## Draw a boxplot for the Foward SCatter parameter for the time points 1
 ## and 6 (in this experiment, each time point corresponds to a column of
 ## a 96 wells plates)
 old.par <- par(no.readonly=TRUE)
 mat <- matrix(c(1:4),2,2,byrow=TRUE)
 nf <- layout(mat,respect=TRUE)
print(boxplot.FCS(flowcyt.data[1:8],
             varpos=c(1),col=c(1:8),
             main="FSC across stains time point 1",
             names=paste("stain",c(1:8),sep="")))
print( boxplot.FCS(flowcyt.data[17:24],
             varpos=c(1),
             col=c(1:8),
             main="FSC across stains time point 3",
             names=paste("stain",c(1:8),sep="")))

print( boxplot.FCS(flowcyt.data[49:56],
             varpos=c(1),
             col=c(1:8),
             main="FSC across stains time point 7",
             names=paste("stain",c(1:8),sep="")))

print( boxplot.FCS(flowcyt.data[65:72],
             varpos=c(1),
             col=c(1:8),
             main="FSC across stains time point 9",
             names=paste("stain",c(1:8),sep="")))
 par(old.par)


###################################################
### chunk number 40: GetDataCellLine
###################################################
 if (require(rfcdmin)) {
 ##Obtaining the location of the fcs files in the data
  pathFiles<-system.file("bccrc", package="rfcdmin")
  drugFiles<-dir(pathFiles)
 
 ##Reading in the FCS files
  drugData<-read.series.FCS(drugFiles,path=pathFiles,MY.DEBUG=FALSE)

 ##Extract fluorescent information from the serie of FCS files
 drug.fluors<-lapply(drugData,fluors)
}


###################################################
### chunk number 41: PlotDensityCellLine
###################################################
 ##Draw a density plot for the Foward SCatter parameter for the
 ##differents aliquots (of the same cell line) tested with different
 ##compounds.
 plotdensity.FCS(drugData,
                 varpos=c(1),
                 main="FSC for aliquots 
treated with different compounds",
                 ylim=c(0,0.005),
                 ylab="Density of cells")


###################################################
### chunk number 42: BoxplotCellLine
###################################################
 ##Draw a boxplot for the Foward SCatter parameter
 ##for the differents aliquots (of the same cell line)
 ##tested with different compounds. 
print( boxplot.FCS(drugData,
             varpos=c(1),
             col=c(1:8),
             main="FSC of differents aliquots from 
a cell line treated with different compounds."))


###################################################
### chunk number 43: PlotECDFCellLine
###################################################
 ##Draw a empirical cumulative density plot for the Foward scatter
 ##parameter for the differents aliquots (of the same cell line)
 ##treated with different compounds. 
print(plotECDF.FCS(drugData,
              varpos=c(1),
              var.list=c("Serie"),
              group.list=paste("compound",c(1:8),sep=""),
              main="ECDF for different aliquots
	treated with diffrent compounds.",
              lwd=2,
              cex=1.5))


###################################################
### chunk number 44: plotvarhist
###################################################
plotvar.FCS(unst.1829, varpos=c(1))


###################################################
### chunk number 45: plotvarrectbin eval=FALSE
###################################################
## plotvar.FCS(unst.1829, varpos=c(3,4), hexbin.CSPlot=FALSE)


###################################################
### chunk number 46: obtainTwoColumnvars
###################################################
## obtain the two column variables
xvar<-as(unst.1829[,3], "matrix")
yvar<-as(unst.1829[,4], "matrix")


###################################################
### chunk number 47: CSPhexbin eval=FALSE
###################################################
## ## hexagon cells without contour lines; default n.hexbins=100
## ContourScatterPlot(xvar, yvar,
##                    xlab=unst.1829[["longnames"]][3],
##                    ylab=unst.1829[["longnames"]][4],
##                    main="Individual unst.1829",
##                    hexbin.plotted=TRUE)


###################################################
### chunk number 48: CSPrectbin eval=FALSE
###################################################
## ## rectangular cells with the contour plot 
## ContourScatterPlot(xvar, yvar,
##                    xlab = unst.1829[["longnames"]][3],
##                    ylab = unst.1829[["longnames"]][4],
##                    main = "Individual 042402c1.053",
##                    hexbin.plotted = FALSE,
##                    numlev = 25, 
##                    image.col = heat.colors(15))


###################################################
### chunk number 49: PlotFCSobj
###################################################
## should be able to implement because it is a pairsplot
print(plot(unst.1829))


###################################################
### chunk number 50: plotFCSHexbin eval=FALSE
###################################################
## ## plot(st.1829, alternate.hexbinplot=TRUE)


###################################################
### chunk number 51: ParallelCoordinatesPlot
###################################################
par(mfrow=c(1,1))
row.obs<-1:10
parallelCoordinates(as(unst.1829[row.obs,], "matrix"))


###################################################
### chunk number 52: ParallelCoordinatesPlot2
###################################################
row.obs<-1:10
parallelCoordinates(as(unst.1829[row.obs,], "matrix"), 
                     scaled=TRUE,
                     group=c(rep(1, 5), rep(2, 5)))


###################################################
### chunk number 53: ImageParCoordPlot
###################################################
## need to separate legend plotting
output1<-ImageParCoord(unst.1829@data[1:1000, 1:5], 
                       num.bins=16,
                       title="1000 obs 16 bins 5 trans", 
                       ntrans=5,
                       legend.plotted=FALSE,
                       plotted=TRUE,
                       image.plotted=TRUE,
                       lines.plotted=TRUE,
                       MY.DEBUG=FALSE)


###################################################
### chunk number 54: JointImageParCoordPlot eval=FALSE
###################################################
## ## need to separate legend plotting
## output3<-JointImageParCoord(unst.1829@data[1:1000,1:5],
##                             num.bins=16,
##                             title="1000 obs 16 bins 5 trans", 
##                             ntrans=5, 
##                             legend.plotted=FALSE, 
##                             MY.DEBUG=FALSE)


###################################################
### chunk number 55: ExampleXgobi eval=FALSE
###################################################
## ## plots first 1/15 rows
## ## plots first 1/2 columns
## xgobi.FCS(unst.1829, 
##   title="unst.1829 default subset")
## ## plots all the rows
## ## plots only the first 3 columns
## xgobi.FCS(unst.1829, 
##   subset.row=1:6000, 
##   subset.col=1:2,
##   title="unst.1829: 6000 rows, 2 vars")


###################################################
### chunk number 56: table5
###################################################
slotnames<-c("gate", "history", "extractGatedData.msg", 
"current.data.obs", "data", "metadata")
description<-c("matrix of column indices for row selection", 
"vector of strings describing columns in gate", 
"vector of strings describing extraction of the data", 
"vector of the original row positions in current data", 
"matrix of column variables for rows denoting cells",
"FCSmetadata object")
table5 <- data.frame(slotnames, description)
save(table5, file="table5.Rda")


###################################################
### chunk number 57: GenerateTable5FCSgateslots
###################################################
if (require(xtable)) {
  xtable(table5,
         caption="FCSgate slot descriptions",
         label="tab:5")
} else {
  cat("XTABLE not present; please install to get the right table.")
}


###################################################
### chunk number 58: table6
###################################################
slotnames<-c("uniscut", "bipcut", "bidcut", "biscut", "biscut.quadrant", "")
description<-c("univariate single cut",
"bivariate polygonal cut", "bivariate double cut",
"bivariate single cut",
"values denoting the quadrant to be selected",
"$+$/$+$, $+$/$-$, $-$/$-$, $+$/$-$")
table6 <- data.frame(slotnames, description)
save(table6, file="table6.Rda")


###################################################
### chunk number 59: GenerateTable6GateTypes
###################################################
if (require(xtable)) {
  xtable(table6,
         caption="Types of Gating",
         label="tab:6")
} else {
  cat("XTABLE not present; please install to get the right table.")
}


###################################################
### chunk number 60: table7
###################################################
slotnames<-c("gateNum", "gateName", "type", 
"biscut.quadrant", "data.colpos", "data.colnames",
"IndexValue.In", "gatingrange", "prev.gateNum", 
"prev.gateName", "comment")
description<-c("column position in 'gate' matrix", 
"name of gate index", 
"type of gating", 
"quadrant selected, if gating type is 'biscut'", 
"'data' column variable positions used in gating",
"'data' names of the column variables used in gating",
"value of the gating index denoting inclusion",
"vector of gating thresholds",
"gateNum of previous gating, if any",
"gateName of previous gating, if any",
"comment by user for this gating index")
table7 <- data.frame(slotnames, description)
save(table7, file="table7.Rda")


###################################################
### chunk number 61: GenerateTable7extractGateHistoryOutput
###################################################
if (require(xtable)) {
  xtable(table7,
         caption=paste("Description of 'extractGateHistory' output:",
                 "Gating Details", sep =" "),
         label="tab:7")
} else {
  cat("XTABLE not present; please install to get the right table.")
}


###################################################
### chunk number 62: createGate1
###################################################
gate.range.x <- c(300,600)
gate.range.y <- c(300, 600)
unst.1829.gate1 <- createGate(unst.1829, 
  varpos=c(1,2), 
  gatingrange=c(gate.range.x, 
     gate.range.y), 
  type="bidcut", 
  comment="first gate")


###################################################
### chunk number 63: HexGate1 eval=FALSE
###################################################
## par(mfrow=c(1,1))
## data.vars<-1:2
## plotvar.FCS(unst.1829.gate1, varpos=data.vars, 
##             plotType="ContourScatterPlot",
##             hexbin.CSPlot=TRUE)


###################################################
### chunk number 64: showGate1 eval=FALSE
###################################################
## data.vars<-1:2
## plotvar.FCS(unst.1829.gate1, varpos=data.vars, 
##             plotType="ContourScatterPlot",
##             hexbin.CSPlot=FALSE)
## showgate.FCS(unst.1829.gate1@data[,data.vars], 
##              gatingrange= c(gate.range.x, gate.range.y), 
##              Index = unst.1829.gate1@gate[,1], 
##              type="bidcut", pchtype=".")


###################################################
### chunk number 65: showGate2
###################################################
unst.1829.gate2 <- icreateGate(unst.1829.gate1, varpos=4, 
                               gatingrange=500, type="uniscut", 
                               prev.gateNum=1, 
                               prev.IndexValue.In=1,
                               comment="", MY.DEBUG=FALSE, 
                               prompt.all.options=FALSE)


###################################################
### chunk number 66: extractGatedData1
###################################################
unst.1829.subset1.1 <- extractGatedData(unst.1829.gate2, 
  gateNum = 1, 
  IndexValue.In = 1, 
  MY.DEBUG = FALSE)
unst.1829.subset1.2 <- extractGatedData(unst.1829.gate1, 
  gateNum=1, 
  IndexValue.In=1, 
  MY.DEBUG=FALSE)


###################################################
### chunk number 67: FCSgateEquality
###################################################
equals(unst.1829.subset1.1, 
  unst.1829.subset1.2, 
  check.filename=FALSE, 
  check.objectname=FALSE)


###################################################
### chunk number 68: extractGatedData2
###################################################
unst.1829.subset2.1 <- extractGatedData(unst.1829.subset1.1, 
  gateNum = 2, 
  IndexValue.In = 1, 
  MY.DEBUG = FALSE)
unst.1829.subset2.2 <- extractGatedData(unst.1829.gate2, 
  gateNum = 2, 
  IndexValue.In = 1, 
  MY.DEBUG = FALSE)
equals(unst.1829.subset2.1, 
  unst.1829.subset2.2, 
  check.filename=FALSE, 
  check.objectname=FALSE)


###################################################
### chunk number 69: extractGateHistory1
###################################################
info.gate1 <- extractGateHistory(unst.1829.gate2, gateNum=1)
info.gate1
info.gate2 <- extractGateHistory(unst.1829.gate2, gateNum=2)
info.gate2


###################################################
### chunk number 70: extractGateHistory2
###################################################
info.gate1.1 <- extractGateHistory(unst.1829.subset2.1, gateNum=1)
info.gate1.1
info.gate2.1 <- extractGateHistory(unst.1829.subset2.1, gateNum=2)
info.gate2.1


###################################################
### chunk number 71: createExtractGateHistory
###################################################
gate.range.x <- c(200, 300)
gate.range.y <- c(100, 500)
previous.gateNum <- info.gate1$gateNum
previous.IndexValue.In <-info.gate1$InexValue.In
unst.1829.gate3 <- createGate(unst.1829.gate2, 
  varpos = c(1,2), 
  gatingrange = c(gate.range.x, gate.range.y), 
  type="bidcut", 
  prev.gateNum = previous.gateNum, 
  prev.IndexValue.In = previous.IndexValue.In, 
  comment="first gate")
extractGateHistory(unst.1829.gate3, gateNum=3)


###################################################
### chunk number 72: HVTNFCS eval=FALSE
###################################################
## MC.053.gt <- FHCRC.HVTNFCS(MC.053)
## MC.054.gt <- FHCRC.HVTNFCS(MC.054)
## MC.055.gt <- FHCRC.HVTNFCS(MC.055)
## st.1829.gt <- VRC.HVTNFCS(st.1829)
## unst.1829.gt <- VRC.HVTNFCS(unst.1829)
## st.DRT.gt <- VRC.HVTNFCS(st.DRT)
## unst.DRT.gt <- VRC.HVTNFCS(unst.DRT)


###################################################
### chunk number 73: FHCRCgatevarschange eval=FALSE
###################################################
## data(MC.053min)
## MC.053[["longnames"]]
## FHCRC.HVTNFCS(MC.053, gate2.vars=c(7,5), gate3.vars=c(4,3))


###################################################
### chunk number 74: gateIPC eval=FALSE
###################################################
## st.DRT2 <- st.DRT
## st.DRT2@data <- st.DRT@data[1:1000,]
## gate.IPC(st.DRT2, 3,
##          hist.plotted=FALSE,
##          image.plotted=TRUE,
##          para.plotted=FALSE,
##          lines.plotted=TRUE,
##          MY.DEBUG=FALSE)


###################################################
### chunk number 75: table8
###################################################
slotnames<-c("unst.hist", "st.hist", "PB", 
"N.in.bin", "varname")
description<-c("unstimulated histogram", 
"stimulated histogram", 
"'combined'/'by.control'", 
"number per bin for cut-off construction",
"name of distribution/variable")
table8 <- data.frame(slotnames, description)
save(table8, file="table8.Rda")


###################################################
### chunk number 76: GenerateTable8ProbBinFCSslots
###################################################
if (require(xtable)) {
  xtable(table8,
         caption=paste("Description of 'ProbBin.FCS' S3 list",
                 "output", sep =" "),
         label="tab:8")
} else {
  cat("XTABLE not present; please install to get the right table.")
}


###################################################
### chunk number 77: FCSicreateGate1
###################################################
unst.DRT.gt <- icreateGate(unst.DRT, varpos=c(1,2), 
                           gatingrange=c(300,650, 300, 500), type="bidcut", 
                           comment="", MY.DEBUG=FALSE, 
                           prompt.all.options=FALSE)


###################################################
### chunk number 78: FCSicreateGate2
###################################################
st.DRT.gt <- icreateGate(st.DRT, varpos=c(1,2), 
gatingrange=c(300,650, 300, 500), type="bidcut", 
comment="", MY.DEBUG=FALSE, 
prompt.all.options=FALSE)


###################################################
### chunk number 79: FCSicreateGate3
###################################################
unst.DRT.gt <- icreateGate(unst.DRT.gt, varpos=c(7,5), 
gatingrange=c(500,1024, 0, 1024), type="bidcut", 
prev.gateNum=1, prev.IndexValue.In=1,
comment="", MY.DEBUG=FALSE, 
prompt.all.options=FALSE)


###################################################
### chunk number 80: FCSicreateGate4
###################################################
st.DRT.gt <- icreateGate(st.DRT.gt,
                         varpos=c(7,5),
                         gatingrange=c(500,1024, 0, 1024), 
                         type="bidcut", 
                         prev.gateNum=1,
                         prev.IndexValue.In=1,
                         comment="", 
                         MY.DEBUG=FALSE,
                         prompt.all.options=FALSE)


###################################################
### chunk number 81: FCSExtractGatedObjs
###################################################
unst.DRT.ex <- extractGatedData(unst.DRT.gt, gateNum=2)
st.DRT.ex <- extractGatedData(st.DRT.gt, gateNum=2)


###################################################
### chunk number 82: FCSgetIFNgamma
###################################################
IFN.unst <- unlist(as(unst.DRT.ex[,4], "matrix"))
IFN.st <- unlist(as(st.DRT.ex[,4], "matrix"))


###################################################
### chunk number 83: ProbBinFCSbycontrol
###################################################
PB.by.control <- ProbBin.FCS(IFN.unst, 
  IFN.st, 100, 
  varname=unst.DRT[["longnames"]][4],
  PBspec="by.control", 
  MY.DEBUG=FALSE)


###################################################
### chunk number 84: ProbBinFCScombined
###################################################
PB.combined <- ProbBin.FCS(IFN.unst, 
  IFN.st, 100, 
  varname=unst.DRT[["longnames"]][4],
  PBspec="combined", 
  MY.DEBUG=FALSE)


###################################################
### chunk number 85: isProbBinFCS
###################################################
is(PB.by.control, "ProbBin.FCS")
is(PB.combined, "ProbBin.FCS")


###################################################
### chunk number 86: plotProbBinFCSunstimul
###################################################
plot(PB.by.control, plots.made="unstimulated", freq=TRUE)


###################################################
### chunk number 87: plotProbBinFCSstimul
###################################################
plot(PB.by.control, plots.made="stimulated", freq=TRUE)


###################################################
### chunk number 88: summaryProbBinFCS
###################################################
summary(PB.by.control)
summary(PB.combined)


###################################################
### chunk number 89: runflowcytestsExample
###################################################
output.runflowcytests <- runflowcytests(IFN.unst, 
  IFN.st, 
  KS.plotted=FALSE, 
  WLR.plotted=FALSE, 
  PBobj.plotted=FALSE)


###################################################
### chunk number 90: KSflowcytestPlot
###################################################
output.KSflowcytest <- KS.flowcytest(IFN.unst, 
  IFN.st, 
  KS.plotted=TRUE,
  MY.DEBUG=FALSE)


###################################################
### chunk number 91: WLRflowcytestPlot
###################################################
output.WLRflowcytest <- WLR.flowcytest(IFN.unst, 
  IFN.st, 
  WLR.plotted=TRUE,
  MY.DEBUG=FALSE)


###################################################
### chunk number 92: percentileFCS
###################################################
unst.percentile <- percentile.FCS(IFN.unst, percent=0.999)


###################################################
### chunk number 93: PercentPosFCS
###################################################
PercentPos.FCS(IFN.unst, percentile=unst.percentile)$percent.pos
PercentPos.FCS(IFN.st, percentile = unst.percentile)$percent.pos


###################################################
### chunk number 94: callPerPosROC
###################################################
data(PerPosROCmin, package="rfcdmin")


###################################################
### chunk number 95: ROCexample1
###################################################
GAG<-ROC.FCS(hivpos.gag, hivneg.gag)
#plotting the pola stimulated 100* percent positives
POLA<-ROC.FCS(hivpos.pola, hivneg.pola, lineopt=2, colopt=2, overlay=TRUE)
#plotting the polb stimulated 100* percent positives
POLB<-ROC.FCS(hivpos.polb, hivneg.polb, lineopt=4, colopt=3, overlay=TRUE)
legend(0.7, 0.7, c("gag", "polA", "polB"), col = c(1,2,3), lty=c(1,2,4))