Merge pull request campbio#398 from zhewa/RELEASE_3_18

Release 3 18
irzamsarfraz · Nov 4, 2023 · 50211da · 50211da
2 parents 92905bd + 8b9685f
commit 50211da
Show file tree

Hide file tree

Showing 9 changed files with 131 additions and 130 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: celda
 Title: CEllular Latent Dirichlet Allocation
-Version: 1.14.2
+Version: 1.18.1
 Authors@R: c(person("Joshua", "Campbell", email = "[email protected]",
     role = c("aut", "cre")),
     person("Shiyi", "Yang", email="[email protected]", role = c("aut")),
@@ -22,15 +22,15 @@ Imports: plyr, foreach, ggplot2, RColorBrewer, grid, scales, gtable,
         Rcpp, RcppEigen, uwot, enrichR, SummarizedExperiment,
         MCMCprecision, ggrepel, Rtsne, withr,
         scater (>= 1.14.4), scran, dbscan,
-        DelayedArray, stringr, ComplexHeatmap, multipanelfigure,
+        DelayedArray, stringr, ComplexHeatmap, gridExtra,
         circlize
 Suggests: testthat, knitr, roxygen2, rmarkdown, biomaRt, covr,
         BiocManager, BiocStyle, TENxPBMCData, singleCellTK, M3DExampleData
 LinkingTo: Rcpp, RcppEigen
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
 BugReports: https://github.com/campbio/celda/issues
 biocViews: SingleCell, GeneExpression, Clustering, Sequencing, Bayesian, ImmunoOncology, DataImport
 NeedsCompilation: yes
diff --git a/NAMESPACE b/NAMESPACE
@@ -152,7 +152,6 @@ importFrom(matrixStats,logSumExp)
 importFrom(methods,.hasSlot)
 importFrom(methods,is)
 importFrom(methods,new)
-importFrom(multipanelfigure,multi_panel_figure)
 importFrom(plyr,mapvalues)
 importFrom(reshape2,melt)
 importFrom(scales,brewer_pal)

diff --git a/R/moduleHeatmap.R b/R/moduleHeatmap.R
@@ -3,9 +3,7 @@
 #'  ordered from those with the lowest probability of the module on the left to
 #'  the highest probability on the right. Features are ordered from those
 #'  with the highest probability in the module
-#'  on the top to the lowest probability on the bottom. Use of
-#'  \link[multipanelfigure]{save_multi_panel_figure} is recommended for
-#'  outputting figures in various formats.
+#'  on the top to the lowest probability on the bottom.
 #' @param x A numeric \link{matrix} of counts or a
 #'  \linkS4class{SingleCellExperiment}
 #'  with the matrix located in the assay slot under \code{useAssay}.
@@ -20,7 +18,7 @@
 #'  Multiple modules can be included in a vector. Default \code{NULL} which
 #'  plots all module heatmaps.
 #' @param featureModule Same as \code{modules}. Either can be used to specify
-#' the modules to display. 
+#'  the modules to display.
 #' @param col Passed to \link[ComplexHeatmap]{Heatmap}. Set color boundaries
 #'  and colors.
 #' @param topCells Integer. Number of cells with the highest and lowest
@@ -89,11 +87,11 @@
 #'  vector of the same length as \code{featureModule}. Default "auto", which
 #'  automatically pulls module labels from \code{x}.
 #' @param moduleLabelSize Passed to \link{gpar}. The size of text (in points).
-#' @param width Passed to \link[multipanelfigure]{multi_panel_figure}. The
-#'  width of the output figure.
-#' @param height Passed to \link[multipanelfigure]{multi_panel_figure}. The
-#'  height of the output figure.
-#' @param unit Passed to \link[multipanelfigure]{multi_panel_figure}. Single
+#' @param byrow Passed to \link{matrix}. logical. If \code{FALSE} (the default)
+#'  the figure panel is filled by columns, otherwise the figure panel is filled
+#'  by rows.
+#' @param top Passed to \link[gridExtra]{marrangeGrob}. The title for each page.
+#' @param unit Passed to \link[grid]{unit}. Single
 #'  character object defining the unit of all dimensions defined.
 #' @param ncol Integer. Number of columns of module heatmaps. If \code{NULL},
 #' then this will be automatically calculated so that the number of columns
@@ -103,20 +101,19 @@
 #' then rasterization will be automatically determined by the underlying
 #' \link[ComplexHeatmap]{Heatmap} function. Default \code{TRUE}.
 #' @param returnAsList Boolean. If \code{TRUE}, then a list of plots will be
-#' returned instead of a single multi-panel figure. These plots can be 
+#' returned instead of a single multi-panel figure. These plots can be
 #' displayed using the \link[grid]{grid.draw} function. Default \code{FALSE}.
 #' @param ... Additional parameters passed to \link[ComplexHeatmap]{Heatmap}.
-#' @return A \link[multipanelfigure]{multi_panel_figure} object if plotting
+#' @return A list object if plotting
 #'  more than one module heatmaps. Otherwise a
 #'  \link[ComplexHeatmap]{HeatmapList} object is returned.
 #' @importFrom methods .hasSlot
-#' @importFrom multipanelfigure multi_panel_figure
 #' @export
 setGeneric("moduleHeatmap",
     function(x,
         useAssay = "counts",
         altExpName = "featureSubset",
-        modules = NULL,        
+        modules = NULL,
         featureModule = NULL,
         col = circlize::colorRamp2(c(-2, 0, 2),
             c("#1E90FF", "#FFFFFF", "#CD2626")),
@@ -137,8 +134,8 @@ setGeneric("moduleHeatmap",
         showModuleLabel = TRUE,
         moduleLabel = "auto",
         moduleLabelSize = NULL,
-        width = "auto",
-        height = "auto",
+        byrow = TRUE,
+        top = NA,
         unit = "mm",
         ncol = NULL,
         useRaster = TRUE,
@@ -150,8 +147,7 @@ setGeneric("moduleHeatmap",
 #' @rdname moduleHeatmap
 #' @examples
 #' data(sceCeldaCG)
-#' moduleHeatmap(sceCeldaCG, width = 250, height = 250,
-#'  displayName = "rownames")
+#' moduleHeatmap(sceCeldaCG, displayName = "rownames")
 #' @export
 setMethod("moduleHeatmap",
     signature(x = "SingleCellExperiment"),
@@ -179,20 +175,20 @@ setMethod("moduleHeatmap",
         showModuleLabel = TRUE,
         moduleLabel = "auto",
         moduleLabelSize = NULL,
-        width = "auto",
-        height = "auto",
+        byrow = TRUE,
+        top = NA,
         unit = "mm",
         ncol = NULL,
         useRaster = TRUE,
         returnAsList = FALSE,
         ...) {
 
-        # 'modules' is an easier parameter name to remember so we include 
-        # support for both. 
+        # 'modules' is an easier parameter name to remember so we include
+        # support for both.
         if(!is.null(modules)) {
             featureModule <- modules
         }
-        
+
         altExp <- SingleCellExperiment::altExp(x, altExpName)
 
         counts <- SummarizedExperiment::assay(altExp, i = useAssay)
@@ -285,12 +281,12 @@ setMethod("moduleHeatmap",
             # If there is more than 1 module selected, then the miniumum size
             # size will be caculated for each module. This will ensure that
             # all modules will have the same rowFontSize and the module
-            # heatmaps will have the same width. 
+            # heatmaps will have the same width.
             maxlen <- max(unlist(lapply(featureIndices, length)))
             maxlen <- maxlen * sqrt(length(featureIndices))
             rowFontSize <- rep(min(200 / maxlen, 20), length(featureIndices))
           } else {
-            # If there is only one plot or each plot will be generated 
+            # If there is only one plot or each plot will be generated
             # separately and returned in a list, then the size of the labels,
             # will be caculated for each module separately.
             len <- unlist(lapply(featureIndices, length))
@@ -330,7 +326,7 @@ setMethod("moduleHeatmap",
             return(plts[[1]])
         } else {
             if (is.null(ncol)) {
-              ncol <- floor(sqrt(length(plts)))
+                ncol <- floor(sqrt(length(plts)))
             }
             nrow <- ceiling(length(plts) / ncol)
 
@@ -340,22 +336,19 @@ setMethod("moduleHeatmap",
                     wrap.grobs = TRUE)
             }
 
-            if(isTRUE(returnAsList)) {
-                figure <- plts    
+            if (isTRUE(returnAsList)) {
+                figure <- plts
             } else {
-                figure <- multipanelfigure::multi_panel_figure(
-                    columns = ncol,
-                    rows = nrow,
-                    width = width,
-                    height = height,
-                    unit = unit)
-
-                for (i in seq(length(plts))) {
-                    figure <- suppressMessages(multipanelfigure::fill_panel(figure,
-                                                                            plts[[i]], label = ""))
-                }
+                figure <- gridExtra::marrangeGrob(plts,
+                    ncol = ncol,
+                    nrow = nrow,
+                    layout_matrix = matrix(seq_len(nrow * ncol),
+                        nrow = nrow,
+                        ncol = ncol,
+                        byrow = TRUE),
+                    top = NA)
             }
-            
+
             suppressWarnings(return(figure))
         }
     }

diff --git a/R/splitModule.R b/R/splitModule.R
@@ -5,13 +5,13 @@
 #' @param x A \linkS4class{SingleCellExperiment} object
 #'  with the matrix located in the assay slot under \code{useAssay}.
 #'  Rows represent features and columns represent cells.
+#' @param module Integer. The module to be split.
 #' @param useAssay A string specifying which \link{assay}
 #'  slot to use for \code{x}. Default "counts".
 #' @param altExpName The name for the \link{altExp} slot
-#'  to use. Default "featureSubset".
-#' @param module Integer. The module to be split.
+#'  to use. Default \code{"featureSubset"}.
 #' @param n Integer. How many modules should \code{module} be split into.
-#'  Default 2.
+#'  Default \code{2}.
 #' @param seed Integer. Passed to \link[withr]{with_seed}. For reproducibility,
 #'  a default value of 12345 is used. If NULL, no calls to
 #'  \link[withr]{with_seed} are made.
@@ -21,9 +21,9 @@
 #' @export
 setGeneric("splitModule",
     function(x,
+        module,             
         useAssay = "counts",
         altExpName = "featureSubset",
-        module,
         n = 2,
         seed = 12345) {
 
@@ -39,9 +39,9 @@ setGeneric("splitModule",
 #' @export
 setMethod("splitModule", signature(x = "SingleCellExperiment"),
     function(x,
+        module,             
         useAssay = "counts",
         altExpName = "featureSubset",
-        module,
         n = 2,
         seed = 12345) {
 
@@ -92,54 +92,66 @@ setMethod("splitModule", signature(x = "SingleCellExperiment"),
     counts <- SummarizedExperiment::assay(x, i = useAssay)
     counts <- .processCounts(counts)
     .validateCounts(counts)
-    ix <- SummarizedExperiment::rowData(x)$celda_feature_module == module
-
-    if (sum(ix) > 1) {
-        tempModel <- .celda_G(
-            counts = counts[ix, , drop = FALSE],
-            L = n,
-            yInitialize = "random",
-            splitOnIter = -1,
-            splitOnLast = FALSE,
-            nchains = 1,
-            verbose = FALSE)
-
-        splitY <- celdaClusters(tempModel)$y
-        splitIx <- celdaClusters(tempModel)$y > 1
-        splitY[splitIx] <- S4Vectors::metadata(x)$celda_parameters$L +
-            splitY[splitIx] - 1
-        splitY[!splitIx] <- module
-
-        newY <- as.integer(
-            SummarizedExperiment::rowData(x)$celda_feature_module)
-        newY[ix] <- splitY
-        newL <- max(newY)
-
-        newLl <- .logLikelihoodcelda_G(
-            counts = counts,
-            y = newY,
-            L = newL,
-            beta = S4Vectors::metadata(x)$celda_parameters$beta,
-            delta = S4Vectors::metadata(x)$celda_parameters$delta,
-            gamma = S4Vectors::metadata(x)$celda_parameters$gamma)
-        model <- methods::new(
-            "celda_G",
-            clusters = list(y = newY),
-            params = list(
-                L = newL,
-                beta = S4Vectors::metadata(x)$celda_parameters$beta,
-                delta = S4Vectors::metadata(x)$celda_parameters$delta,
-                gamma = S4Vectors::metadata(x)$celda_parameters$gamma,
-                countChecksum = .createCountChecksum(counts)
-            ),
-            names = list(row = rownames(x),
-                column = colnames(x),
-                sample = x@metadata$celda_parameters$sampleLevels),
-            finalLogLik = newLl
-        )
-    } else {
-        stop("Module ", module, "contains <= 1 feature. No additional",
-            " splitting was able to be performed.")
-    }
+
+    L <- S4Vectors::metadata(x)$celda_parameters$L
+    y <- as.numeric(SummarizedExperiment::rowData(x)$celda_feature_module)
+    ix <- y == module
+
+    if (sum(ix) < n) {
+      stop("Module ", module, " contains less than ", n, " features. ",
+            "Module splitting was not performed.")
+    }      
+
+    tempModel <- .celda_G(
+      counts = counts[ix, , drop = FALSE],
+      L = n,
+      yInitialize = "random",
+      splitOnIter = -1,
+      splitOnLast = FALSE,
+      nchains = 1,
+      verbose = FALSE
+    )
+
+    # Need to set some of the features to the original module number.
+    # The remaining features need to have "L + something" as they represent
+    # a new module. Note that there may be more than 1 new module. 
+    splitY <-
+      as.numeric(as.character(celdaClusters(tempModel)$y))
+    splitIx <- splitY > 1
+    splitY[splitIx] <- L + splitY[splitIx] - 1
+    splitY[!splitIx] <- module
+
+    # Set up new y and L
+    newY <- y
+    newY[ix] <- splitY
+    newL <- max(newY)
+
+    newLl <- .logLikelihoodcelda_G(
+      counts = counts,
+      y = newY,
+      L = newL,
+      beta = S4Vectors::metadata(x)$celda_parameters$beta,
+      delta = S4Vectors::metadata(x)$celda_parameters$delta,
+      gamma = S4Vectors::metadata(x)$celda_parameters$gamma
+    )
+
+    model <- methods::new(
+      "celda_G",
+      clusters = list(y = factor(newY, seq(newL))),
+      params = list(
+        L = newL,
+        beta = S4Vectors::metadata(x)$celda_parameters$beta,
+        delta = S4Vectors::metadata(x)$celda_parameters$delta,
+        gamma = S4Vectors::metadata(x)$celda_parameters$gamma,
+        countChecksum = .createCountChecksum(counts)
+      ),
+      names = list(
+        row = rownames(x),
+        column = colnames(x),
+        sample = x@metadata$celda_parameters$sampleLevels
+      ),
+      finalLogLik = newLl
+    )
+
     return(model)
 }
diff --git a/inst/rmarkdown/CeldaCG_PlotResults.Rmd b/inst/rmarkdown/CeldaCG_PlotResults.Rmd
@@ -36,7 +36,7 @@ require(kableExtra)
 require(grid)
 require(knitr)
 require(ggplot2)
-require(multipanelfigure)
+require(gridExtra)
 require(SingleCellExperiment)
 
 sce <- params$sce