#' Generic Wrapper function for running dimensionality reduction #' @details Wrapper function to run one of the available dimensionality #' reduction algorithms integrated within SCTK from \code{\link{scaterPCA}}, #' \code{\link{runSeuratPCA}}, \code{\link{runSeuratICA}}, \code{\link{runTSNE}}, #' \code{\link{runSeuratTSNE}}, \code{\link{runUMAP}} and #' \code{\link{runSeuratUMAP}}. Users can use an assay by specifying #' \code{useAssay}, use the assay in an altExp by specifying both #' \code{useAltExp} and \code{useAssay}, or use a low-dimensionality #' representation by specifying \code{useReducedDim}. #' @param inSCE Input \linkS4class{SingleCellExperiment} object. #' @param method One from \code{"scaterPCA"}, \code{"seuratPCA"}, #' \code{"seuratICA"}, \code{"rTSNE"}, \code{"seuratTSNE"}, \code{"scaterUMAP"} #' and \code{"seuratUMAP"}. #' @param useAssay Assay to use for computation. If \code{useAltExp} is #' specified, \code{useAssay} has to exist in #' \code{assays(altExp(inSCE, useAltExp))}. Default \code{"counts"}. #' @param useAltExp The subset to use for computation, usually for the #' selected variable features. Default \code{NULL}. #' @param useReducedDim The low dimension representation to use for embedding #' computation. Default \code{NULL}. #' @param reducedDimName The name of the result matrix. Required. #' @param useFeatureSubset Subset of feature to use for dimension reduction. A #' character string indicating a \code{rowData} variable that stores the logical #' vector of HVG selection, or a vector that can subset the rows of #' \code{inSCE}. Default \code{NULL}. #' @param scale Logical scalar, whether to standardize the expression values. #' Default \code{TRUE}. #' @param nComponents Specify the number of dimensions to compute with the #' selected method in case of PCA/ICA and the number of components to #' use in the case of TSNE/UMAP methods. #' @param seed Random seed for reproducibility of results. #' Default \code{NULL} will use global seed in use by the R environment. #' @param ... The other arguments for running a specific algorithm. Please refer #' to the one you use. #' @return The input \linkS4class{SingleCellExperiment} object with #' \code{reducedDim} updated with the result. #' @export #' @examples #' data(scExample, package = "singleCellTK") #' sce <- subsetSCECols(sce, colData = "type != 'EmptyDroplet'") #' sce <- runNormalization(sce, useAssay = "counts", #' outAssayName = "logcounts", #' normalizationMethod = "logNormCounts") #' sce <- runDimReduce(inSCE = sce, method = "scaterPCA", #' useAssay = "logcounts", scale = TRUE, #' reducedDimName = "PCA") runDimReduce <- function(inSCE, method = c("scaterPCA", "seuratPCA", "seuratICA", "rTSNE", "seuratTSNE", "scaterUMAP", "seuratUMAP"), useAssay = NULL, useReducedDim = NULL, useAltExp = NULL, reducedDimName = method, nComponents = 20, useFeatureSubset = NULL, scale = FALSE, seed = NULL, ...) { method <- match.arg(method) args <- list(...) if (method %in% c("scaterPCA", "seuratPCA", "seuratICA") & !is.null(useReducedDim)) { stop("`useReducedDim` is not allowed for linear dimension reduction.") } if (method == "scaterPCA") { inSCE <- scaterPCA(inSCE = inSCE, useAssay = useAssay, useAltExp = useAltExp, reducedDimName = reducedDimName, nComponents = nComponents, useFeatureSubset = useFeatureSubset, scale = scale, seed = seed, ...) } else if (method == "scaterUMAP") { inSCE <- runUMAP(inSCE = inSCE, useAssay = useAssay, useAltExp = useAltExp, useReducedDim = useReducedDim, useFeatureSubset = useFeatureSubset, scale = scale, reducedDimName = reducedDimName, seed = seed, ...) } else if (method == "rTSNE") { inSCE <- runTSNE(inSCE = inSCE, useAssay = useAssay, useAltExp = useAltExp, useReducedDim = useReducedDim, useFeatureSubset = useFeatureSubset, scale = scale, reducedDimName = reducedDimName, seed = seed, ...) } else { # Seurat part # TODO: Honestly, the input checks should have been implemented for # functions being wrapped because they are being exposed to users as well. # We should not being performing redundant checks when wrapping them again. useMat <- .selectSCEMatrix(inSCE, useAssay = useAssay, useReducedDim = useReducedDim, useAltExp = useAltExp, returnMatrix = FALSE) useAssay <- useMat$names$useAssay if (!is.null(useAltExp)) { tempSCE <- SingleCellExperiment::altExp(inSCE, useAltExp) } else if (!is.null(useAssay)) { tempSCE <- inSCE } if (method %in% c("seuratPCA", "seuratICA")) { ## SeuratPCA/ICA if (method == "seuratPCA") { message(paste0(date(), " ... Computing Seurat PCA.")) tempSCE <- runSeuratPCA(tempSCE, useAssay = useAssay, reducedDimName = reducedDimName, nPCs = nComponents, useFeatureSubset = useFeatureSubset, scale = scale, seed = seed, ...) } else if (method == "seuratICA") { message(paste0(date(), " ... Computing Seurat ICA.")) tempSCE <- runSeuratICA(tempSCE, useAssay = useAssay, reducedDimName = reducedDimName, nics = nComponents, useFeatureSubset = useFeatureSubset, scale = scale, seed = seed, ...) } seuratObj <- tempSCE@metadata$seurat if (!is.null(useAltExp)) { altExp(inSCE, useAltExp)@metadata$seurat <- seuratObj } else if (!is.null(useAssay)) { inSCE@metadata$seurat <- seuratObj } } else { ## SeuratUMAP/TSNE if (is.null(useReducedDim)) { ### using assay if (!"useReduction" %in% names(args)) { stop("Must specify `useReduction` when using `useAssay` in seuratUMAP/TSNE") } if (args$useReduction == "pca") { message(paste0(date(), " ... Computing Seurat PCA.")) tempSCE <- runSeuratPCA(inSCE = tempSCE, useAssay = useAssay, reducedDimName = paste0(useAssay, "_seuratPCA"), useFeatureSubset = useFeatureSubset, seed = seed) } else if (args$useReduction == "ica") { message(paste0(date(), " ... Computing Seurat ICA.")) tempSCE <- runSeuratICA(inSCE = tempSCE, useAssay = useAssay, reducedDimName = paste0(useAssay, "_seuratICA"), useFeatureSubset = useFeatureSubset, seed = seed) } if (method == "seuratUMAP") { message(paste0(date(), " ... Computing Seurat UMAP.")) tempSCE <- runSeuratUMAP(inSCE = tempSCE, reducedDimName = reducedDimName, seed = seed, ...) } else { message(paste0(date(), " ... Computing Seurat tSNE.")) tempSCE <- runSeuratTSNE(inSCE = tempSCE, reducedDimName = reducedDimName, seed = seed, ...) } } else { ### using external reducedDim if (!is.null(args$useReduction)) { stop("Cannot specify `useReduction` when using `useReducedDim` in seuratUMAP/TSNE") } tempSCE <- inSCE seuratObj <- convertSCEToSeurat(inSCE) tempSCE@metadata$seurat$obj <- seuratObj reDim <- SingleCellExperiment::reducedDim(inSCE, useReducedDim) colnames(reDim) <- paste0(useReducedDim, "_", seq_len(length(colnames(reDim)))) rownames(reDim) <- gsub('_', '-', rownames(reDim)) key <- gsub('_', '', useReducedDim) # hard-code "pca" tempSCE@metadata$seurat$obj@reductions$pca <- Seurat::CreateDimReducObject(embeddings = reDim, key = paste0(key, "_"), assay = "RNA") if (method == "seuratUMAP") { # hard-code useReduction="pca" message(paste0(date(), " ... Computing Seurat UMAP.")) tempSCE <- runSeuratUMAP(inSCE = tempSCE, useReduction = "pca", reducedDimName = reducedDimName, seed = seed, ...) } else { # hard-code useReduction="pca" message(paste0(date(), " ... Computing Seurat tSNE.")) tempSCE <- runSeuratTSNE(inSCE = tempSCE, useReduction = "pca", reducedDimName = reducedDimName, seed = seed, ...) } } } SingleCellExperiment::reducedDim(inSCE, reducedDimName) <- SingleCellExperiment::reducedDim(tempSCE, reducedDimName) } return(inSCE) }