R/simplifyToSCE.R

In drisso/SingleCellExperiment: S4 Classes for Single Cell Data

#' Simplify a list to a single SingleCellExperiment
#'
#' Simplify a list of \linkS4class{SingleCellExperiment}, usually generated by \code{\link{applySCE}} on main and alternative Experiments,
#' into a single SingleCellExperiment containing some of the results in its \code{\link{altExps}}.
#'
#' @param results A named list of SummarizedExperiment or SingleCellExperiment objects.
#' @param which.main Integer scalar specifying which entry of \code{results} contains the output generated from the main Experiment.
#' If \code{NULL} or a vector of length zero, this indicates that no entry was generated from the main Experiment.
#' Defaults to the unnamed entry of \code{results}.
#' @param warn.level Integer scalar specifying the type of warnings that can be emitted.
#'
#' @return 
#' A SingleCellExperiment corresponding to the entry of \code{results} generated from the main Experiment.
#' All results generated from the alternative Experiments of \code{x} are stored in the \code{\link{altExps}} of the output.
#' 
#' If no main Experiment was used to generate \code{results}, an empty SingleCellExperiment is used as a container for the various \code{\link{altExps}}.
#'
#' If simplification could not be performed, \code{NULL} is returned with a warning (depending on \code{warn.level}.
#'
#' @author Aaron Lun
#'
#' @details
#' Each entry of \code{results} should be a \linkS4class{SummarizedExperiment} with the same number and names of the columns.
#' There should not be any duplicate entries in \code{names(results)}, as the names are used to represent the names of the alternative Experiments in the output.
#' If \code{which.main} is a scalar, the corresponding entry of \code{results} should be a \linkS4class{SingleCellExperiment}.
#' Failure to meet these conditions may result in a warning or error depending on \code{warn.level}.
#'
#' The type of warnings that are emitted can be controlled with \code{warn.level}.
#' If \code{warn.level=0}, no warnings are emitted.
#' If \code{warn.level=1}, all warnings are emitted except for those related to \code{results} not being of the appropriate class.
#' If \code{warn.level=2}, all warnings are emitted, and if \code{warn.level=3}, warnings are promoted to errors.
#'
#' @examples
#' ncells <- 100
#' u <- matrix(rpois(20000, 5), ncol=ncells)
#' sce <- SingleCellExperiment(assays=list(counts=u))
#' altExp(sce, "BLAH") <- SingleCellExperiment(assays=list(counts=u*10))
#' altExp(sce, "WHEE") <- SingleCellExperiment(assays=list(counts=u*2))
#'
#' # Setting FUN=identity just extracts each piece:
#' results <- applySCE(sce, FUN=identity, SIMPLIFY=FALSE)
#' results
#' 
#' # Simplifying to an output that mirrors the structure of 'sce'.
#' simplifyToSCE(results)
#' 
#' @seealso
#' \code{\link{applySCE}}, where this function is used when \code{SIMPLIFY=TRUE}.
#' 
#' @export
#' @importFrom S4Vectors make_zero_col_DFrame
simplifyToSCE <- function(results, which.main, warn.level=2) {
    if (warn.level==3) {
        WTFUN <- stop
    } else if (warn.level==0) {
        WTFUN <- identity
    } else {
        WTFUN <- warning
    }

    for (i in seq_along(results)) {
        curres <- results[[i]]
        if (!is(curres, "SummarizedExperiment")) {
            if (warn.level > 1) {
                WTFUN("could not simplify as result ", i, " is not a SummarizedExperiment")
            }
            return(NULL)
        } 
    }

    if (missing(which.main)) {
        which.main <- which(names(results)=="")
        if (is.null(names(results)) || length(which.main) > 1) {
            stop("multiple entries in 'results' are unnamed")
        }
    } else {
        stopifnot(length(which.main)<=1)
    }

    if (dup <- anyDuplicated(names(results))) {
        WTFUN(paste(strwrap(paste0("could not simplify results due to multiple references to the '", names(results)[dup], "' alternative Experiment in 'results'")), collapse="\n"))
        return(NULL)
    }

    u.ncols <- unique(lapply(results, ncol))
    u.colnames <- unique(lapply(results, colnames))
    if (length(u.ncols)!=1 || length(u.colnames)!=1) {
        if (warn.level > 0) {
            WTFUN("could not simplify results as the columns are different")
        }
        return(NULL)
    }

    if (length(which.main)) {
        sce <- results[[which.main]]
        if (!is(sce, "SingleCellExperiment")) {
            if (warn.level > 1) {
                WTFUN("entry of 'results' corresponding to main Experiment is not a SingleCellExperiment")
            }
            return(NULL)
        }
    } else {
        df <- make_zero_col_DFrame(nrow=u.ncols[[1]])
        rownames(df) <- u.colnames[[1]]
        sce <- SingleCellExperiment(colData=df)
    }

    for (a in setdiff(seq_along(results), which.main)) {
        altExp(sce, names(results)[a]) <- results[[a]]
    }

    sce
}