R/runDimReduce.R
457d9e56
 #' Generic Wrapper function for running dimensionality reduction
 #' @details Wrapper function to run one of the available dimensionality
e63b0785
 #' reduction algorithms integrated within SCTK from \code{\link{scaterPCA}},
27e3c620
 #' \code{\link{runSeuratPCA}}, \code{\link{runSeuratICA}}, \code{\link{runTSNE}},
c35af4eb
 #' \code{\link{runSeuratTSNE}}, \code{\link{runUMAP}} and
792e35eb
 #' \code{\link{runSeuratUMAP}}. Users can use an assay by specifying
457d9e56
 #' \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"},
225e7648
 #' \code{"seuratICA"}, \code{"rTSNE"}, \code{"seuratTSNE"}, \code{"scaterUMAP"}
457d9e56
 #' 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.
93e2414e
 #' @param useFeatureSubset Subset of feature to use for dimension reduction. A
cd24c4e7
 #' character string indicating a \code{rowData} variable that stores the logical
93e2414e
 #' vector of HVG selection, or a vector that can subset the rows of
cd24c4e7
 #' \code{inSCE}. Default \code{NULL}.
87eb03af
 #' @param scale Logical scalar, whether to standardize the expression values.
 #' Default \code{TRUE}.
ea5c5444
 #' @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.
64501d0d
 #' @param seed Random seed for reproducibility of results.
 #' Default \code{NULL} will use global seed in use by the R environment.
457d9e56
 #' @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",
ef10cb29
 #'                         outAssayName = "logcounts",
 #'                         normalizationMethod = "logNormCounts")
457d9e56
 #' sce <- runDimReduce(inSCE = sce, method = "scaterPCA",
ef10cb29
 #'                     useAssay = "logcounts", scale = TRUE,
457d9e56
 #'                     reducedDimName = "PCA")
 runDimReduce <- function(inSCE,
                          method = c("scaterPCA",
                                     "seuratPCA",
                                     "seuratICA",
                                     "rTSNE",
                                     "seuratTSNE",
225e7648
                                     "scaterUMAP",
457d9e56
                                     "seuratUMAP"),
                          useAssay = NULL, useReducedDim = NULL,
93e2414e
                          useAltExp = NULL, reducedDimName = method,
                          nComponents = 20, useFeatureSubset = NULL,
                          scale = FALSE, seed = NULL, ...)
87eb03af
 {
457d9e56
 
   method <- match.arg(method)
   args <- list(...)
93e2414e
   if (method %in% c("scaterPCA", "seuratPCA", "seuratICA") &
       !is.null(useReducedDim)) {
     stop("`useReducedDim` is not allowed for linear dimension reduction.")
457d9e56
   }
 
   if (method == "scaterPCA") {
93e2414e
     inSCE <- scaterPCA(inSCE = inSCE, useAssay = useAssay,
                        useAltExp = useAltExp, reducedDimName = reducedDimName,
                        nComponents = nComponents,
                        useFeatureSubset = useFeatureSubset, scale = scale,
cd24c4e7
                        seed = seed, ...)
225e7648
   } else if (method == "scaterUMAP") {
c35af4eb
     inSCE <- runUMAP(inSCE = inSCE, useAssay = useAssay, useAltExp = useAltExp,
93e2414e
                      useReducedDim = useReducedDim,
                      useFeatureSubset = useFeatureSubset, scale = scale,
cd24c4e7
                      reducedDimName = reducedDimName, seed = seed, ...)
457d9e56
   } else if (method == "rTSNE") {
27e3c620
     inSCE <- runTSNE(inSCE = inSCE, useAssay = useAssay, useAltExp = useAltExp,
93e2414e
                      useReducedDim = useReducedDim,
                      useFeatureSubset = useFeatureSubset, scale = scale,
cd24c4e7
                      reducedDimName = reducedDimName, seed = seed, ...)
457d9e56
   } else {
     # Seurat part
93e2414e
     # 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
457d9e56
     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") {
86735c7a
         message(paste0(date(), " ... Computing Seurat PCA."))
93e2414e
         tempSCE <- runSeuratPCA(tempSCE, useAssay = useAssay,
87eb03af
                                 reducedDimName = reducedDimName,
93e2414e
                                 nPCs = nComponents,
cd24c4e7
                                 useFeatureSubset = useFeatureSubset,
87eb03af
                                 scale = scale, seed = seed, ...)
457d9e56
       } else if (method == "seuratICA") {
86735c7a
         message(paste0(date(), " ... Computing Seurat ICA."))
0eafe06c
         tempSCE <- runSeuratICA(tempSCE, useAssay = useAssay,
87eb03af
                                 reducedDimName = reducedDimName,
93e2414e
                                 nics = nComponents,
                                 useFeatureSubset = useFeatureSubset,
87eb03af
                                 scale = scale, seed = seed, ...)
19356bef
       }
       seuratObj <- tempSCE@metadata$seurat
       if (!is.null(useAltExp)) {
         altExp(inSCE, useAltExp)@metadata$seurat <- seuratObj
       } else if (!is.null(useAssay)) {
         inSCE@metadata$seurat <- seuratObj
457d9e56
       }
     } 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") {
86735c7a
           message(paste0(date(), " ... Computing Seurat PCA."))
0eafe06c
           tempSCE <- runSeuratPCA(inSCE = tempSCE,
457d9e56
                                useAssay = useAssay,
93e2414e
                                reducedDimName = paste0(useAssay, "_seuratPCA"),
cd24c4e7
                                useFeatureSubset = useFeatureSubset, seed = seed)
457d9e56
         } else if (args$useReduction == "ica") {
86735c7a
           message(paste0(date(), " ... Computing Seurat ICA."))
0eafe06c
           tempSCE <- runSeuratICA(inSCE = tempSCE,
457d9e56
                                useAssay = useAssay,
93e2414e
                                reducedDimName = paste0(useAssay, "_seuratICA"),
cd24c4e7
                                useFeatureSubset = useFeatureSubset, seed = seed)
457d9e56
         }
         if (method == "seuratUMAP") {
86735c7a
           message(paste0(date(), " ... Computing Seurat UMAP."))
93e2414e
           tempSCE <- runSeuratUMAP(inSCE = tempSCE,
                                    reducedDimName = reducedDimName,
cd24c4e7
                                    seed = seed, ...)
457d9e56
         } else {
86735c7a
           message(paste0(date(), " ... Computing Seurat tSNE."))
0eafe06c
           tempSCE <- runSeuratTSNE(inSCE = tempSCE,
93e2414e
                                    reducedDimName = reducedDimName,
cd24c4e7
                                    seed = seed, ...)
457d9e56
         }
       } else {
         ### using external reducedDim
bd222e9a
         if (!is.null(args$useReduction)) {
457d9e56
           stop("Cannot specify `useReduction` when using `useReducedDim` in seuratUMAP/TSNE")
         }
         tempSCE <- inSCE
bd222e9a
         seuratObj <- convertSCEToSeurat(inSCE)
         tempSCE@metadata$seurat$obj <- seuratObj
457d9e56
         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"
86735c7a
           message(paste0(date(), " ... Computing Seurat UMAP."))
0eafe06c
           tempSCE <- runSeuratUMAP(inSCE = tempSCE, useReduction = "pca",
93e2414e
                                    reducedDimName = reducedDimName,
cd24c4e7
                                    seed = seed, ...)
457d9e56
         } else {
           # hard-code useReduction="pca"
86735c7a
           message(paste0(date(), " ... Computing Seurat tSNE."))
0eafe06c
           tempSCE <- runSeuratTSNE(inSCE = tempSCE, useReduction = "pca",
93e2414e
                                    reducedDimName = reducedDimName,
cd24c4e7
                                    seed = seed, ...)
457d9e56
         }
       }
     }
     SingleCellExperiment::reducedDim(inSCE, reducedDimName) <-
       SingleCellExperiment::reducedDim(tempSCE, reducedDimName)
   }
   return(inSCE)
 }