## ----setup, include = FALSE------------------------------------------------ knitr::opts_chunk$set( collapse = TRUE, comment = "#>", error = FALSE, warning = FALSE, message = FALSE ) stopifnot(requireNamespace("htmltools")) htmltools::tagList(rmarkdown::html_dependency_font_awesome()) sce <- readRDS('sce.rds') ## ----CUSTOM_PCA------------------------------------------------------------ library(scater) CUSTOM_PCA <- function(se, rows, columns, colour_by=NULL, scale_features=TRUE) { if (!is.null(columns)) { kept <- se[, columns] } else { return( ggplot() + theme_void() + geom_text( aes(x, y, label=label), data.frame(x=0, y=0, label="No column data selected."), size=5) ) } scale_features <- as.logical(scale_features) kept <- runPCA(kept, feature_set=rows, scale_features=scale_features) plotPCA(kept, colour_by=colour_by) } ## ----CUSTOM_SUMMARY-------------------------------------------------------- CUSTOM_SUMMARY <- function(se, ri, ci, assay="logcounts", min_exprs=0) { if (is.null(ri)) { ri <- rownames(se) } if (is.null(ci)) { ci <- colnames(se) } assayMatrix <- assay(se, assay)[ri, ci, drop=FALSE] data.frame( Mean = rowMeans(assayMatrix), Var = rowVars(assayMatrix), Sum = rowSums(assayMatrix), n_detected = rowSums(assayMatrix > min_exprs), row.names = ri ) } ## ----mean_log-var_log------------------------------------------------------ rowData(sce)$mean_log <- rowMeans(logcounts(sce)) rowData(sce)$var_log <- apply(logcounts(sce), 1, var) ## ----app------------------------------------------------------------------- library(iSEE) reddim <- redDimPlotDefaults(sce, 1) rowdat <- rowDataPlotDefaults(sce, 1) rowdat$XAxis <- "Row data" rowdat$XAxisRowData <- "mean_log" rowdat$YAxis <- "var_log" cdp <- customDataPlotDefaults(sce, 1) cdp$Function <- "CUSTOM_PCA" cdp$Arguments <- "colour_by Nanog\nscale_features FALSE" cdp$ColumnSource <- "Reduced dimension plot 1" cdp$RowSource <- "Row data plot 1" cst <- customStatTableDefaults(sce, 1) cst$Function <- "CUSTOM_SUMMARY" cst$Arguments <- "assay logcounts\nmin_exprs 1" cst$ColumnSource <- "Reduced dimension plot 1" cst$RowSource <- "Row data plot 1" app <- iSEE( sce, redDimArgs=reddim, rowDataArgs=rowdat, customDataArgs=cdp, customStatArgs=cst, initialPanels=DataFrame( Name=c( "Reduced dimension plot 1", "Row data plot 1", "Custom data plot 1", "Custom statistics table 1"), Width=c(4, 4, 4, 12)), customDataFun=list(CUSTOM_PCA=CUSTOM_PCA), customStatFun=list(CUSTOM_SUMMARY=CUSTOM_SUMMARY) ) ## ----CUSTOM_LFC------------------------------------------------------------ caching <- new.env() CUSTOM_LFC <- function(se, rows, columns) { if (is.null(columns)) { return(data.frame(logFC=numeric(0))) } if (!identical(caching$columns, columns)) { caching$columns <- columns in.subset <- rowMeans(logcounts(sce)[,columns]) out.subset <- rowMeans(logcounts(sce)[,setdiff(colnames(sce), columns)]) caching$logFC <- setNames(in.subset - out.subset, rownames(sce)) } lfc <- caching$logFC if (!is.null(rows)) { out <- data.frame(logFC=lfc[rows], row.names=rows) } else { out <- data.frame(logFC=lfc, row.names=rownames(se)) } out } ## ----app2------------------------------------------------------------------ cst <- customStatTableDefaults(sce, 1) cst$Function <- "CUSTOM_LFC" cst$ColumnSource <- "Reduced dimension plot 1" cst$RowSource <- "Row data plot 1" app2 <- iSEE(sce, redDimArgs=reddim, rowDataArgs=rowdat, customStatArgs=cst, initialPanels=DataFrame(Name=c("Reduced dimension plot 1", "Row data plot 1", "Custom statistics table 1")), customStatFun=list(CUSTOM_LFC=CUSTOM_LFC)) ## ----sessioninfo----------------------------------------------------------- sessionInfo() # devtools::session_info()