## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", error = FALSE, warning = FALSE, message = FALSE, crop = NULL ) 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_DIFFEXP <- function(se, ri, ci, assay="logcounts") { ri <- ri$active if (is.null(ri)) { # ignoring saved gene selections for now. ri <- rownames(se) } if (is.null(ci$active) || length(ci$saved)==0L) { return(data.frame(row.names=character(0), LogFC=integer(0))) # dummy value. } assayMatrix <- assay(se, assay)[ri, , drop=FALSE] active <- rowMeans(assayMatrix[,ci$active,drop=FALSE]) lfcs <- vector("list", length(ci$saved)) for (i in seq_along(lfcs)) { saved <- rowMeans(assayMatrix[,ci$saved[[i]],drop=FALSE]) lfcs[[i]] <- active - saved } names(lfcs) <- sprintf("LogFC/%i", seq_along(lfcs)) output <- do.call(data.frame, lfcs) rownames(output) <- ri output } ## ----------------------------------------------------------------------------- CUSTOM_HEAT <- function(se, ri, ci, assay="logcounts") { everything <- CUSTOM_DIFFEXP(se, ri, ci, assay=assay) if (nrow(everything) == 0L) { return(ggplot()) # empty ggplot if no genes reported. } everything <- as.matrix(everything) top <- head(order(rowMeans(abs(everything)), decreasing=TRUE), 50) topFC <- everything[top, , drop=FALSE] dimnames(topFC) <- list(gene=rownames(topFC), contrast=colnames(topFC)) dfFC <- reshape2::melt(topFC) ggplot(dfFC, aes(contrast, gene)) + geom_raster(aes(fill = value)) } ## ----------------------------------------------------------------------------- cdp2 <- customDataPlotDefaults(sce, 1) cdp2$Function <- "CUSTOM_HEAT" cdp2$Arguments <- "assay logcounts" cdp2$ColumnSource <- "Reduced dimension plot 1" cdp2$RowSource <- "Row data plot 1" cst2 <- customStatTableDefaults(sce, 1) cst2$Function <- "CUSTOM_DIFFEXP" cst2$Arguments <- "assay logcounts" cst2$ColumnSource <- "Reduced dimension plot 1" cst2$RowSource <- "Row data plot 1" app <- iSEE( sce, redDimArgs=reddim, rowDataArgs=rowdat, customDataArgs=cdp2, customStatArgs=cst2, 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_HEAT=CUSTOM_HEAT), customStatFun=list(CUSTOM_DIFFEXP=CUSTOM_DIFFEXP), customSendAll=TRUE ) ## ----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()