## ----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()

