## ----style, echo = FALSE, results = 'asis'-------------------------------------------------------- BiocStyle::markdown() options(width=100, max.print=1000) knitr::opts_chunk$set( eval=as.logical(Sys.getenv("KNITR_EVAL", "TRUE")), cache=as.logical(Sys.getenv("KNITR_CACHE", "TRUE"))) ## ----setup, echo=FALSE, messages=FALSE, warnings=FALSE-------------------------------------------- ## suppressPackageStartupMessages({}) ## ----shiny-BAMSpector, eval=FALSE----------------------------------------------------------------- # app <- system.file(package="BiocAsiaPacific2015", "BAMSpector") # shiny::runApp(app) ## ----shiny-MAPlotExplorer, eval=FALSE------------------------------------------------------------- # app <- system.file(package="BiocAsiaPacific2015", "MAPlotExplorer") # shiny::runApp(app) ## ----lapply-args---------------------------------------------------------------------------------- args(lapply) ## ----lapply-eg------------------------------------------------------------------------------------ lst <- list(a=1:2, b=2:4) lapply(lst, log) # 'base' argument default; natural log lapply(lst, log, 10) # '10' is second argument to 'log()', i.e., log base 10 ## ------------------------------------------------------------------------------------------------- args(mapply) ## ----mapply-eg------------------------------------------------------------------------------------ mapply(seq, 1:3, 4:6, SIMPLIFY=FALSE) # seq(1, 4); seq(2, 5); seq(3, 6) ## ----apply---------------------------------------------------------------------------------------- args(apply) ## ---- eval=FALSE---------------------------------------------------------------------------------- # if (test) { # ## code if TEST == TRUE # } else { # ## code if TEST == FALSE # } ## ----myfun---------------------------------------------------------------------------------------- fun <- function(x) { length(unique(x)) } ## list of length 5, each containsing a sample (with replacement) of letters lets <- replicate(5, sample(letters, 50, TRUE), simplify=FALSE) sapply(lets, fun) ## ------------------------------------------------------------------------------------------------- x <- rnorm(1000) # atomic vectors y <- x + rnorm(1000, sd=.5) df <- data.frame(x=x, y=y) # object of class 'data.frame' plot(y ~ x, df) # generic plot, method plot.formula fit <- lm(y ~x, df) # object of class 'lm' methods(class=class(fit)) # introspection anova(fit) plot(y ~ x, df) # methods(plot); ?plot.formula abline(fit, col="red", lwd=3, lty=2) # a function, not generic.method ## ----lapply-setup, echo=FALSE--------------------------------------------------------------------- fl <- system.file(package="BiocAsiaPacific2015", "extdata", "symgo.csv") ## ----lapply-user-setup, eval=FALSE---------------------------------------------------------------- # ## example data # fl <- file.choose() ## symgo.csv ## ----lapply--------------------------------------------------------------------------------------- symgo <- read.csv(fl, row.names=1, stringsAsFactors=FALSE) head(symgo) dim(symgo) length(unique(symgo$SYMBOL)) ## split-sapply go2sym <- split(symgo$SYMBOL, symgo$GO) len1 <- sapply(go2sym, length) # compare with lapply, vapply ## built-in functions for common actions len2 <- lengths(go2sym) identical(len1, len2) ## smarter built-in functions, e.g., omiting NAs len3 <- aggregate(SYMBOL ~ GO, symgo, length) head(len3) ## more fun with aggregate() head(aggregate(GO ~ SYMBOL, symgo, length)) head(aggregate(SYMBOL ~ GO, symgo, c)) ## your own function -- unique, lower-case identifiers uidfun <- function(x) { unique(tolower(x)) } head(aggregate(SYMBOL ~ GO , symgo, uidfun)) ## as an 'anonymous' function head(aggregate(SYMBOL ~ GO, symgo, function(x) { unique(tolower(x)) })) ## ----echo=FALSE----------------------------------------------------------------------------------- fname <- system.file(package="BiocAsiaPacific2015", "extdata", "ALLphenoData.tsv") stopifnot(file.exists(fname)) pdata <- read.delim(fname) ## ----echo=TRUE, eval=FALSE------------------------------------------------------------------------ # fname <- file.choose() ## "ALLphenoData.tsv" # stopifnot(file.exists(fname)) # pdata <- read.delim(fname) ## ----ALL-properties------------------------------------------------------------------------------- class(pdata) colnames(pdata) dim(pdata) head(pdata) summary(pdata$sex) summary(pdata$cyto.normal) ## ----ALL-subset----------------------------------------------------------------------------------- pdata[1:5, 3:4] pdata[1:5, ] head(pdata[, 3:5]) tail(pdata[, 3:5], 3) head(pdata$age) head(pdata$sex) head(pdata[pdata$age > 21,]) ## ----ALL-subset-NA-------------------------------------------------------------------------------- idx <- pdata$sex == "F" & pdata$age > 40 table(idx) dim(pdata[idx,]) ## ----ALL-BCR/ABL-subset--------------------------------------------------------------------------- bcrabl <- pdata[pdata$mol.biol %in% c("BCR/ABL", "NEG"),] ## ----ALL-BCR/ABL-drop-unused---------------------------------------------------------------------- bcrabl$mol.biol <- factor(bcrabl$mol.biol) ## ----ALL-BT--------------------------------------------------------------------------------------- levels(bcrabl$BT) ## ----ALL-BT-recode-------------------------------------------------------------------------------- table(bcrabl$BT) levels(bcrabl$BT) <- substring(levels(bcrabl$BT), 1, 1) table(bcrabl$BT) ## ----ALL-BCR/ABL-BT------------------------------------------------------------------------------- xtabs(~ BT + mol.biol, bcrabl) ## ----ALL-aggregate-------------------------------------------------------------------------------- aggregate(age ~ mol.biol + sex, bcrabl, mean) ## ----ALL-age-------------------------------------------------------------------------------------- t.test(age ~ mol.biol, bcrabl) boxplot(age ~ mol.biol, bcrabl)