## ----echo=FALSE, include=FALSE------------------------------------------- library(knitr) opts_chunk$set( concordance=TRUE, warning = FALSE ) ## ----loadPackage, echo=FALSE,results='hide'------------------------------ library(flowCore) ## ----ReadFiles, echo=TRUE, results='markup'------------------------------ file.name <- system.file("extdata","0877408774.B08", package="flowCore") x <- read.FCS(file.name, transformation=FALSE) summary(x) ## ----SearchKeywords, echo=TRUE, results='markup'------------------------- keyword(x,c("$P1E", "$P2E", "$P3E", "$P4E")) ## ----PrintSummary, echo=TRUE, results='markup'--------------------------- summary(read.FCS(file.name)) ## ----PrintSummary2, echo=TRUE,results='markup'--------------------------- summary(read.FCS(file.name,transformation="scale")) ## ----ReadFiles2, echo=TRUE,results='markup'------------------------------ read.FCS(file.name,alter.names=TRUE) ## ----ReadFiles3, echo=TRUE, results='markup'----------------------------- x <- read.FCS(file.name, column.pattern="-H") x ## ----ReadFiles4, echo=TRUE, results='markup'----------------------------- lines <- sample(100:500, 50) y <- read.FCS(file.name, which.lines = lines) y ## ----Frames1, echo=TRUE, results='markup'-------------------------------- fcs.dir <- system.file("extdata", "compdata", "data", package="flowCore") frames <- lapply(dir(fcs.dir, full.names=TRUE), read.FCS) fs <- as(frames, "flowSet") fs sampleNames(fs) ## ----Frames2, echo=TRUE,results='markup'--------------------------------- names(frames) <- sapply(frames, keyword, "SAMPLE ID") fs <- as(frames, "flowSet") fs sampleNames(fs) ## ----metaData, echo=TRUE, results='markup'------------------------------- phenoData(fs)$Filename <- fsApply(fs,keyword, "$FIL") pData(phenoData(fs)) ## ----ReadFlowSet, echo=TRUE,results='markup'----------------------------- fs <- read.flowSet(path = fcs.dir) ## ----ReadFowSet2, echo=TRUE,results='markup'----------------------------- fs <- read.flowSet(path=system.file("extdata", "compdata", "data", package="flowCore"), name.keyword="SAMPLE ID", phenoData=list(name="SAMPLE ID", Filename="$FIL")) fs pData(phenoData(fs)) ## ----fsApply1, echo=TRUE, results='markup'------------------------------- fsApply(fs, each_col, median) ## ----fsApply2, echo=TRUE,results='markup'-------------------------------- fsApply(fs,function(x) apply(x, 2, median), use.exprs=TRUE) ## ----Plot, echo=TRUE, results='hide'------------------------------------- library(ggcyto) autoplot(x, "FL1-H", "FL2-H") ## ----Plot2, echo=TRUE, results='hide'------------------------------------ autoplot(x, "FL1-H") ## ----Plot3, echo=TRUE, results='hide'------------------------------------ fs <- read.flowSet(path = system.file("extdata", package = "flowCore"), pattern = "\\.") autoplot(fs, "FL1-H", "FL2-H") ## ----Comp, echo=TRUE, results='markup'----------------------------------- fcsfiles <- list.files(pattern = "CytoTrol", system.file("extdata", package = "flowWorkspaceData"), full = TRUE) fs <- read.flowSet(fcsfiles) x <- fs[[1]] comp_list <- spillover(x) comp_list comp <- comp_list[[1]] ## ----Comp2, echo=TRUE, results='markup'---------------------------------- x_comp <- compensate(x, comp) ## ----Comp3, echo=TRUE, results='markup'---------------------------------- comp <- fsApply(fs, function(x) spillover(x)[[1]], simplify=FALSE) fs_comp <- compensate(fs, comp) ## ----CompViz, echo=TRUE, results='markup'-------------------------------- library(gridExtra) transList <- estimateLogicle(x, c("V450-A","V545-A")) p1 <- autoplot(transform(x, transList), "V450-A", "V545-A") + ggtitle("Before") p2 <- autoplot(transform(x_comp, transList), "V450-A", "V545-A") + ggtitle("Before") grid.arrange(as.ggplot(p1), as.ggplot(p2), ncol = 2) ## ----Comp4, echo=TRUE, results='markup'---------------------------------- fcs.dir <- system.file("extdata", "compdata", "data", package="flowCore") frames <- lapply(dir(fcs.dir, full.names=TRUE), read.FCS) names(frames) <- c("UNSTAINED", "FL1-H", "FL2-H", "FL4-H", "FL3-H") frames <- as(frames, "flowSet") comp <- spillover(frames, unstained="UNSTAINED", patt = "-H", fsc = "FSC-H", ssc = "SSC-H", stain_match = "ordered") comp ## ----Comp5, echo=TRUE, results='markup'---------------------------------- sampleNames(frames) comp <- spillover(frames, unstained="UNSTAINED", patt = "-H", fsc = "FSC-H", ssc = "SSC-H", stain_match = "regexpr") comp ## ----Comp6, echo=TRUE, results='markup'---------------------------------- comp_match <- system.file("extdata", "compdata", "comp_match", package="flowCore") # The matchfile has a simple format writeLines(readLines(comp_match)) control_path <- system.file("extdata", "compdata", "data", package="flowCore") # Using path rather than pre-constructed flowSet matched_fs <- spillover_match(path=control_path, fsc = "FSC-H", ssc = "SSC-H", matchfile = comp_match) comp <- spillover(matched_fs, fsc = "FSC-H", ssc = "SSC-H", prematched = TRUE) ## ----Transfo1, echo=TRUE, results='hide'--------------------------------- fs <- read.flowSet(path=system.file("extdata", "compdata", "data", package="flowCore"), name.keyword="SAMPLE ID", phenoData=list(name="SAMPLE ID", Filename="$FIL")) autoplot(transform(fs[[1]], `FL1-H`=log(`FL1-H`), `FL2-H`=log(`FL2-H`) ), "FL1-H","FL2-H") ## ----Transfo2, results='hide'-------------------------------------------- autoplot(transform(fs[[1]], log.FL1.H=log(`FL1-H`), log.FL2.H=log(`FL2-H`) ), "log.FL1.H", "log.FL2.H") ## ----Transfo3, echo=TRUE------------------------------------------------- aTrans <- truncateTransform("truncate at 1", a=1) aTrans ## ----Transfo4, echo=TRUE,results='markup'-------------------------------- transform(fs,`FL1-H`=aTrans(`FL1-H`)) ## ----Transfo4.1, echo=TRUE,results='markup'------------------------------ f1 <- function(fs,...){ transform(fs, ...)[,'FL1-H'] } f2 <- function(fs){ aTrans <- truncateTransform("truncate at 1", a=1) f1(fs, `FL1-H` = aTrans(`FL1-H`)) } res <- try(f2(fs), silent = TRUE) res ## ----Transfo4.2, echo=TRUE,results='markup'------------------------------ myTrans <- transformList('FL1-H', aTrans) transform(fs, myTrans) ## ----rectGate, echo=TRUE, results='markup'------------------------------- rectGate <- rectangleGate(filterId="Fluorescence Region", "FL1-H"=c(0, 12), "FL2-H"=c(0, 12)) ## ----echo=TRUE,results='markup'------------------------------------------ result = filter(fs[[1]],rectGate) result ## ----Summary3, echo=TRUE, results='markup'------------------------------- summary(result) summary(result)$n summary(result)$true summary(result)$p ## ----SummarFilter, echo=TRUE, results='markup'--------------------------- summary(filter(fs[[1]], kmeansFilter("FSC-H"=c("Low", "Medium", "High"), filterId="myKMeans"))) ## ----echo=TRUE,results='markup'------------------------------------------ filter(fs,rectGate) ## ----Norm2Filter1, echo=TRUE, results='markup'--------------------------- autoplot(fs[[1]], "FSC-H", "SSC-H") ## ----Norm2Filter2, echo=TRUE, results='markup'--------------------------- morphGate <- norm2Filter("FSC-H", "SSC-H", filterId="MorphologyGate", scale=2) smaller <- Subset(fs, morphGate) fs[[1]] smaller[[1]] ## ----Split, echo=TRUE, results='markup'---------------------------------- split(smaller[[1]], kmeansFilter("FSC-H"=c("Low","Medium","High"), filterId="myKMeans")) ## ----Split2, echo=TRUE, results='markup'--------------------------------- split(smaller, kmeansFilter("FSC-H"=c("Low", "Medium", "High"), filterId="myKMeans")) ## ----CombineFilter, echo=TRUE, results='markup'-------------------------- rectGate & morphGate rectGate | morphGate !morphGate ## ----Summary5, echo=TRUE, results='markup'------------------------------- summary(filter(smaller[[1]],rectGate %&% morphGate)) ## ----Transfo5, echo=TRUE,results='markup'-------------------------------- tFilter <- transform("FL1-H"=log,"FL2-H"=log) tFilter ## ----TectGate3, echo=TRUE, results='markup'------------------------------ rect2 <- rectangleGate(filterId="Another Rect", "FL1-H"=c(1,2), "FL2-H"=c(2,3)) %on% tFilter rect2 ## ----Plot6,echo=TRUE, results='hide'------------------------------------- autoplot(tFilter %on% smaller[[1]], "FL1-H","FL2-H") ## ----loadData------------------------------------------------------------ library(flowWorkspace) fcsfiles <- list.files(pattern = "CytoTrol", system.file("extdata", package = "flowWorkspaceData"), full = TRUE) fs <- read.flowSet(fcsfiles) ## ----createGatingSet----------------------------------------------------- gs <- GatingSet(fs) gs ## ----getComp, echo=FALSE------------------------------------------------- gs_manual <- load_gs(list.files(pattern = "gs_manual", system.file("extdata", package = "flowWorkspaceData"), full = TRUE)) comp <- getCompensationMatrices(gs_manual[[1]]) ## ----Compensate---------------------------------------------------------- comp gs <- compensate(gs, comp) fs_comp <- getData(gs) ## ----nodes--------------------------------------------------------------- getNodes(gs) ## ----addTrans------------------------------------------------------------ biexpTrans <- flowJo_biexp_trans(channelRange=4096, maxValue=262144 , pos=4.5,neg=0, widthBasis=-10) chnls <- parameters(comp) tf <- transformerList(chnls, biexpTrans) # or use estimateLogicle directly on GatingHierarchy # object to generate transformerList automatically: # tf <- estimateLogicle(gs[[1]], chnls) gs <- transform(gs, tf) ## ----plotTrans,echo=TRUE, results='hide'--------------------------------- p1 <- autoplot(fs_comp[[1]], "B710-A") + ggtitle("raw") p2 <- autoplot(flowData(gs)[[1]], "B710-A") + ggtitle("trans") + ggcyto_par_set(limits = "instrument") grid.arrange(as.ggplot(p1), as.ggplot(p2), ncol = 2) ## ----addGate-nonDebris--------------------------------------------------- rg1 <- rectangleGate("FSC-A"=c(50000, Inf), filterId="NonDebris") add(gs, rg1, parent = "root") getNodes(gs) # gate the data recompute(gs) ## ----plotGate,echo=TRUE, results='hide'---------------------------------- autoplot(gs, "NonDebris") ## ----plotGate-density,echo=TRUE, results='hide'-------------------------- ggcyto(gs, aes(x = `FSC-A`)) + geom_density() + geom_gate("NonDebris") ## ----getStats1----------------------------------------------------------- getTotal(gs[[1]], "NonDebris")#counts getProp(gs[[1]], "NonDebris")#proportion ## ----addGate-singlets---------------------------------------------------- # add the second gate mat <- matrix(c(54272,59392,259071.99382782 ,255999.994277954,62464,43008,70656 ,234495.997428894,169983.997344971,34816) , nrow = 5) colnames(mat) <-c("FSC-A", "FSC-H") mat pg <- polygonGate(mat) add(gs, pg, parent = "NonDebris", name = "singlets") # add the third gate rg2 <- rectangleGate("V450-A"=c(2000, Inf)) add(gs, rg2, parent = "singlets", name = "CD3") getNodes(gs) ## ----addQuadGate--------------------------------------------------------- qg <- quadGate("B710-A" = 2000, "R780-A" = 3000) add(gs, qg, parent="CD3", names = c("CD8", "DPT", "CD4", "DNT")) getChildren(gs[[1]], "CD3") # gate the data from "singlets" recompute(gs, "singlets") ## ----plotgs, eval=FALSE-------------------------------------------------- # plot(gs) ## ----plotwfdo, echo=FALSE, results='hide'-------------------------------- if(suppressWarnings(require(Rgraphviz))){ plot(gs) }else{ plot(1,1, type="n", axes=FALSE, ann=FALSE) text(1,1,"Need to install Rgraphviz") } ## ----plotGateAll, results='hide'----------------------------------------- autoplot(gs[[1]]) ## ----getData------------------------------------------------------------- fs_nonDebris <- getData(gs, "NonDebris") fs_nonDebris nrow(fs_nonDebris[[1]]) nrow(fs[[1]]) ## ----getStats2----------------------------------------------------------- getPopStats(gs) ## ----Rm------------------------------------------------------------------ Rm('CD3', gs) getNodes(gs) Rm('NonDebris', gs) getNodes(gs) ## ----openCyto-nonDebris-------------------------------------------------- if(require(openCyto)){ thisData <- getData(gs) nonDebris_gate <- fsApply(thisData, function(fr) openCyto:::.mindensity(fr, channels = "FSC-A")) add(gs, nonDebris_gate, parent = "root", name = "nonDebris") recompute(gs) } ## ----openCyto-singletGate------------------------------------------------ if(require(openCyto)){ thisData <- getData(gs, "nonDebris") #get parent data singlet_gate <- fsApply(thisData, function(fr) openCyto:::.singletGate(fr, channels =c("FSC-A", "FSC-H"))) add(gs, singlet_gate, parent = "nonDebris", name = "singlets") recompute(gs) } ## ----openCyto-CD3-------------------------------------------------------- if(require(openCyto)){ thisData <- getData(gs, "singlets") #get parent data CD3_gate <- fsApply(thisData, function(fr) openCyto:::.mindensity(fr, channels ="V450-A")) add(gs, CD3_gate, parent = "singlets", name = "CD3") recompute(gs) } ## ----openCyto-Tsub------------------------------------------------------- if(require(openCyto)){ thisData <- getData(gs, "CD3") #get parent data Tsub_gate <- fsApply(thisData, function(fr) openCyto::quadGate.seq(fr, channels = c("B710-A", "R780-A"), gFunc = 'mindensity') ) add(gs, Tsub_gate, parent = "CD3", names = c("CD8", "DPT", "CD4", "DNT")) recompute(gs) } ## ----plotALL-openCyto, results='hide'------------------------------------ autoplot(gs[[1]])