###################################################
### chunk number 1: loadPackage
###################################################
library(flowCore)


###################################################
### chunk number 2: ReadFiles
###################################################
file.name <- system.file("extdata","0877408774.B08", package="flowCore")
x <- read.FCS(file.name, transformation=FALSE)
summary(x)


###################################################
### chunk number 3: SearchKeywords
###################################################
keyword(x,c("$P1E", "$P2E", "$P3E", "$P4E"))


###################################################
### chunk number 4: PrintSummary
###################################################
summary(read.FCS(file.name))


###################################################
### chunk number 5: PrintSummary2
###################################################
summary(read.FCS(file.name,transformation="scale")) 


###################################################
### chunk number 6: ReadFiles2
###################################################
read.FCS(file.name,alter.names=TRUE) 


###################################################
### chunk number 7: RedFiles3
###################################################
x <- read.FCS(file.name, column.pattern="-H") 
x 


###################################################
### chunk number 8: RedFiles3
###################################################
lines <- sample(100:500, 50)
y <- read.FCS(file.name, which.lines = lines) 
y 


###################################################
### chunk number 9: Plot1
###################################################
library(flowViz)
plot(x)


###################################################
### chunk number 10: Plot2
###################################################
plot(x,c("FL1-H", "FL2-H"))


###################################################
### chunk number 11: plot3
###################################################
plot(x, "FL1-H", breaks=256)


###################################################
### chunk number 12: Frames
###################################################
frames <- lapply(dir(system.file("extdata", "compdata", "data",
                                 package="flowCore"), full.names=TRUE), 
                 read.FCS)
as(frames, "flowSet")


###################################################
### chunk number 13: Frames
###################################################
names(frames) <- sapply(frames, keyword, "SAMPLE ID")
fs <- as(frames, "flowSet")
fs


###################################################
### chunk number 14: metaData
###################################################
phenoData(fs)$Filename <- fsApply(fs,keyword, "$FIL")
pData(phenoData(fs))


###################################################
### chunk number 15: ReadFlowSet
###################################################
read.flowSet(path = system.file("extdata", "compdata", "data", 
             package="flowCore"))


###################################################
### chunk number 16: ReadFowSet2
###################################################
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))


###################################################
### chunk number 17: fsApply1
###################################################
fsApply(fs, each_col, median)


###################################################
### chunk number 18: fsApply2
###################################################
fsApply(fs,function(x) apply(x, 2, median), use.exprs=TRUE)


###################################################
### chunk number 19: Transfo1
###################################################
plot(transform(fs[[1]], `FL1-H`=log(`FL1-H`), `FL2-H`=log(`FL2-H`)), 
     c("FL1-H","FL2-H"))


###################################################
### chunk number 20: Transfo2
###################################################
plot(transform(fs[[1]], log.FL1.H=log(`FL1-H`), 
               log.FL2.H=log(`FL2-H`)), c("log.FL1.H", "log.FL2.H"))


###################################################
### chunk number 21: Transfo3
###################################################
aTrans <- truncateTransform("truncate at 1", a=1)
aTrans


###################################################
### chunk number 22: Transfo4
###################################################
transform(fs,`FL1-H`=aTrans(`FL1-H`))


###################################################
### chunk number 23: rectGate
###################################################
rectGate <- rectangleGate(filterId="Fluorescence Region", 
                          "FL1-H"=c(0, 12), "FL2-H"=c(0, 12))


###################################################
### chunk number 24: 
###################################################
result = filter(fs[[1]],rectGate)
result


###################################################
### chunk number 25: Summary3
###################################################
summary(result)
summary(result)$n
summary(result)$true
summary(result)$p


###################################################
### chunk number 26: SummarFilter
###################################################
summary(filter(fs[[1]], kmeansFilter("FSC-H"=c("Low", "Medium", "High"),
                                     filterId="myKMeans")))


###################################################
### chunk number 27: 
###################################################
filter(fs,rectGate)


###################################################
### chunk number 28: Norm2Filter
###################################################
morphGate <- norm2Filter("FSC-H", "SSC-H", filterId="MorphologyGate", 
                         scale=2)
smaller <- Subset(fs, morphGate)
fs[[1]]
smaller[[1]]


###################################################
### chunk number 29: Split
###################################################
split(smaller[[1]], kmeansFilter("FSC-H"=c("Low","Medium","High"),
                                 filterId="myKMeans"))


###################################################
### chunk number 30: Split2
###################################################
split(smaller, kmeansFilter("FSC-H"=c("Low", "Medium", "High"),
                            filterId="myKMeans"))


###################################################
### chunk number 31: CombineFilter
###################################################

rectGate & morphGate
rectGate | morphGate
!morphGate



###################################################
### chunk number 32: Summary5
###################################################
summary(filter(smaller[[1]],rectGate %&% morphGate))


###################################################
### chunk number 33: Transfo5
###################################################
tFilter <- transform("FL1-H"=log,"FL2-H"=log)
tFilter


###################################################
### chunk number 34: TectGate3
###################################################
rect2 <- rectangleGate(filterId="Another Rect", "FL1-H"=c(1,2), 
"FL2-H"=c(2,3)) %on% tFilter
rect2


###################################################
### chunk number 35: Plot6
###################################################
plot(tFilter %on% smaller[[1]],c("FL1-H","FL2-H"))


###################################################
### chunk number 36: FilterSet1
###################################################
fset1 = filterSet(
	rectangleGate(filterId="Fluorescence Region","FL1-H"=c(50,100),
                      "FL2-H"=c(50,100)),
	norm2Filter("FSC-H","SSC-H",filterId="Morphology Gate", scale=2),
	~ `Fluorescence Region` & `Morphology Gate`,
	~ `Fluorescence Region` | `Morphology Gate`,
	Debris ~ ! `Morphology Gate`,
	~ `Fluorescence Region` %&% `Morphology Gate`
)
fset1



###################################################
### chunk number 37: FilterSet2
###################################################

f = filter(fs,fset1)
f


###################################################
### chunk number 38: FilterSet3
###################################################

split(fs[[1]], fset1, flowSet=TRUE)



###################################################
### chunk number 39: FilterSet4
###################################################

split(fs[[1]],fset1,drop=TRUE,flowSet=TRUE)



###################################################
### chunk number 40: createWorkFlow
###################################################
data(GvHD)
wf <- workFlow(GvHD[1:5], name="myWorkflow")
wf


###################################################
### chunk number 41: views
###################################################
views(wf)


###################################################
### chunk number 42: addItems
###################################################
tf <- transformList(colnames(GvHD[[1]])[3:6], asinh, transformationId="asinh")
add(wf, tf)
wf
views(wf)


###################################################
### chunk number 43: itemName
###################################################
add(wf, tf, name="another asinh transform")
wf


###################################################
### chunk number 44: addGate
###################################################
rg <- rectangleGate("FSC-H"=c(200,400), "SSC-H"=c(250, 400),
                    filterId="rectangle")
add(wf, rg, parent="asinh")
wf


###################################################
### chunk number 45: addQuadGate
###################################################
qg <- quadGate("FL1-H"=2, "FL2-H"=4)
add(wf,qg,parent="rectangle+")
wf


###################################################
### chunk number 46: plotwf eval=FALSE
###################################################
## plot(wf)


###################################################
### chunk number 47: plotwfdo
###################################################
if(suppressWarnings(require(Rgraphviz))){
    plot(wf)
}else{
    plot(1,1, type="n", axes=FALSE, ann=FALSE)
    text(1,1,"Need to install Rgraphviz")
}


###################################################
### chunk number 48: getView
###################################################
wf[["rectangle+"]]
wf$asinh


###################################################
### chunk number 49: getAction
###################################################
wf[["action_rectangle"]]


###################################################
### chunk number 50: getData
###################################################
Data(wf[["rectangle-"]])


###################################################
### chunk number 51: summaries
###################################################
summary(wf[["action_rectangle"]])
summary(wf[["CD15 FITC+CD45 PE+"]])


###################################################
### chunk number 52: plotViews
###################################################
densityplot(wf[["base view"]])
xyplot(`FL1-H` ~ `FL2-H`, wf[["CD15 FITC+CD45 PE+"]])


###################################################
### chunk number 53: undo
###################################################
undo(wf)
wf


###################################################
### chunk number 54: RmView
###################################################
Rm('rectangle-', wf)


###################################################
### chunk number 55: RmAction
###################################################
Rm('asinh', wf)