### R code from vignette source 'vignettes/rflowcyt/inst/doc/rflowcyt.Rnw' ################################################### ### code chunk number 1: helpDataPack (eval = FALSE) ################################################### ## help(package="rfcdmin") ################################################### ### code 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") ################################################### ### code 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.") } ################################################### ### code chunk number 4: rflowcytLibraryCall ################################################### library(rflowcyt) if (!require(rfcdmin)) { stop("rfcdmin not available?") } ################################################### ### code chunk number 5: FindingLocationOfFCSDirectoryOfrfcdmin ################################################### fcs.loc <- system.file("fcs", package="rfcdmin") ################################################### ### code chunk number 6: readFCSfacscan256binaryFile ################################################### file.location <- paste(fcs.loc, "facscan256.fcs", sep="/") FC.FCSRobj <- read.FCS(file.location, UseS3=TRUE, MY.DEBUG=FALSE) ################################################### ### code chunk number 7: convertS3toS4FCS ################################################### FC.FCSRobj<-convertS3toS4(FC.FCSRobj, myFCSobj.name="FC.FCSRobj", fileName=file.location) ################################################### ### code 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) ################################################### ### code chunk number 9: DataRFCSobjects ################################################### data(VRCmin) data(MC.053min) data(flowcyt.fluors) ################################################### ### code chunk number 10: NewDefaultS4Object ################################################### ## default S4 objects new.FCS <- new("FCS") new.FCSmetadata <- new("FCSmetadata") new.FCSsummary <- new("FCSsummary") new.FCSgate <- new("FCSgate") ################################################### ### code 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 ################################################### ### code chunk number 12: isS4object ################################################### is(MC.053, "matrix") is(MC.053, "FCS") is(MC.053@metadata, "FCSmetadata") is(MC.053, "FCSgate") ################################################### ### code chunk number 13: isFCSsummary ################################################### sum.FCS <- summary(MC.053) is(sum.FCS, "FCSsummary") ################################################### ### code chunk number 14: ExtractMetadata ################################################### ## returns the same FCSmetadata object meta1<-st.1829@metadata meta1<-metaData(st.1829) ################################################### ### code chunk number 15: DescribeFCSmetadata ################################################### show(st.1829@metadata) ################################################### ### code chunk number 16: SummaryFCSmetadata (eval = FALSE) ################################################### ## summary(st.1829@metadata) ################################################### ### code 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") ################################################### ### code 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.") } ################################################### ### code chunk number 19: SlotExtractMeta ################################################### ## extracting the ranges st.1829@metadata@paramranges st.1829@metadata["paramranges"] st.1829@metadata[["$PnR"]] ################################################### ### code chunk number 20: SlotExtractMeta ################################################### st.1829@metadata[["$P1R"]] ################################################### ### code 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"] ################################################### ### code 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"]] ################################################### ### code 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"]] ################################################### ### code chunk number 24: ExtractMetadata ################################################### ## returns the same FCSmetadata object meta1<-st.1829@metadata meta1<-metaData(st.1829) ################################################### ### code chunk number 25: ExtractData ################################################### ## returns the same data matrix data1<-st.1829@data data1<-fluors(st.1829) summary(data1) ################################################### ### code chunk number 26: printFCSobject ################################################### print(unst.1829) print(MC.053) ################################################### ### code 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] ################################################### ### code chunk number 28: OriginalStatus ################################################### ## the data was changed so the original flag should be FALSE st.1829[["original"]] ################################################### ### code chunk number 29: dim.FCS ################################################### dim.1829 <- dim.FCS(st.1829) dim.1829 ################################################### ### code 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) ################################################### ### code chunk number 31: checkvarsFCS ################################################### st.1829.checkstat <- checkvars(st.1829, MY.DEBUG=TRUE) st.1829.checkstat ################################################### ### code chunk number 32: fixvarsFCS ################################################### if (st.1829.checkstat==FALSE){ ## fix the FCS R object st.1829 <- fixvars(st.1829, MY.DEBUG=TRUE) } ################################################### ### code chunk number 33: ExtractFCSobj ################################################### st.1829 <- get(st.1829[["objectname"]]) original.FC.FCSRobj <- read.FCS(FC.FCSRobj[["filename"]], MY.DEBUG=FALSE) ################################################### ### code 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) ################################################### ### code 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) ################################################### ### code chunk number 36: GetDataTimeCourse ################################################### require(rfcdmin) data(flowcyt.data) ################################################### ### code 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) ################################################### ### code 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)) ################################################### ### code 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) ################################################### ### code 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) } ################################################### ### code 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") ################################################### ### code 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.")) ################################################### ### code 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)) ################################################### ### code chunk number 44: plotvarhist ################################################### plotvar.FCS(unst.1829, varpos=c(1)) ################################################### ### code chunk number 45: plotvarrectbin (eval = FALSE) ################################################### ## plotvar.FCS(unst.1829, varpos=c(3,4), hexbin.CSPlot=FALSE) ################################################### ### code chunk number 46: obtainTwoColumnvars ################################################### ## obtain the two column variables xvar<-as(unst.1829[,3], "matrix") yvar<-as(unst.1829[,4], "matrix") ################################################### ### code 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) ################################################### ### code 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)) ################################################### ### code chunk number 49: PlotFCSobj ################################################### ## should be able to implement because it is a pairsplot print(plot(unst.1829)) ################################################### ### code chunk number 50: plotFCSHexbin (eval = FALSE) ################################################### ## ## plot(st.1829, alternate.hexbinplot=TRUE) ################################################### ### code chunk number 51: ParallelCoordinatesPlot ################################################### par(mfrow=c(1,1)) row.obs<-1:10 parallelCoordinates(as(unst.1829[row.obs,], "matrix")) ################################################### ### code 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))) ################################################### ### code 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) ################################################### ### code 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) ################################################### ### code 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") ################################################### ### code 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") ################################################### ### code 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.") } ################################################### ### code 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") ################################################### ### code 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.") } ################################################### ### code 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") ################################################### ### code 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.") } ################################################### ### code 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") ################################################### ### code 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) ################################################### ### code 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=".") ################################################### ### code 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) ################################################### ### code 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) ################################################### ### code chunk number 67: FCSgateEquality ################################################### equals(unst.1829.subset1.1, unst.1829.subset1.2, check.filename=FALSE, check.objectname=FALSE) ################################################### ### code 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) ################################################### ### code chunk number 69: extractGateHistory1 ################################################### info.gate1 <- extractGateHistory(unst.1829.gate2, gateNum=1) info.gate1 info.gate2 <- extractGateHistory(unst.1829.gate2, gateNum=2) info.gate2 ################################################### ### code 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 ################################################### ### code 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) ################################################### ### code 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) ################################################### ### code 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)) ################################################### ### code 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) ################################################### ### code 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") ################################################### ### code 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.") } ################################################### ### code 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) ################################################### ### code 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) ################################################### ### code 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) ################################################### ### code 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) ################################################### ### code chunk number 81: FCSExtractGatedObjs ################################################### unst.DRT.ex <- extractGatedData(unst.DRT.gt, gateNum=2) st.DRT.ex <- extractGatedData(st.DRT.gt, gateNum=2) ################################################### ### code chunk number 82: FCSgetIFNgamma ################################################### IFN.unst <- unlist(as(unst.DRT.ex[,4], "matrix")) IFN.st <- unlist(as(st.DRT.ex[,4], "matrix")) ################################################### ### code 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) ################################################### ### code chunk number 84: ProbBinFCScombined ################################################### PB.combined <- ProbBin.FCS(IFN.unst, IFN.st, 100, varname=unst.DRT[["longnames"]][4], PBspec="combined", MY.DEBUG=FALSE) ################################################### ### code chunk number 85: isProbBinFCS ################################################### is(PB.by.control, "ProbBin.FCS") is(PB.combined, "ProbBin.FCS") ################################################### ### code chunk number 86: plotProbBinFCSunstimul ################################################### plot(PB.by.control, plots.made="unstimulated", freq=TRUE) ################################################### ### code chunk number 87: plotProbBinFCSstimul ################################################### plot(PB.by.control, plots.made="stimulated", freq=TRUE) ################################################### ### code chunk number 88: summaryProbBinFCS ################################################### summary(PB.by.control) summary(PB.combined) ################################################### ### code chunk number 89: runflowcytestsExample ################################################### output.runflowcytests <- runflowcytests(IFN.unst, IFN.st, KS.plotted=FALSE, WLR.plotted=FALSE, PBobj.plotted=FALSE) ################################################### ### code chunk number 90: KSflowcytestPlot ################################################### output.KSflowcytest <- KS.flowcytest(IFN.unst, IFN.st, KS.plotted=TRUE, MY.DEBUG=FALSE) ################################################### ### code chunk number 91: WLRflowcytestPlot ################################################### output.WLRflowcytest <- WLR.flowcytest(IFN.unst, IFN.st, WLR.plotted=TRUE, MY.DEBUG=FALSE) ################################################### ### code chunk number 92: percentileFCS ################################################### unst.percentile <- percentile.FCS(IFN.unst, percent=0.999) ################################################### ### code chunk number 93: PercentPosFCS ################################################### PercentPos.FCS(IFN.unst, percentile=unst.percentile)$percent.pos PercentPos.FCS(IFN.st, percentile = unst.percentile)$percent.pos ################################################### ### code chunk number 94: callPerPosROC ################################################### data(PerPosROCmin, package="rfcdmin") ################################################### ### code 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))