@@ -44,7 +44,7 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

         model <- celdaModel(sce, altExpName = altExpName)

         if (model == "celda_C") {

-            z <- celdaClusters(sce, altExpName = altExpName)

+            z <- as.integer(celdaClusters(sce, altExpName = altExpName))

             g <- .celdaHeatmapCelda_C(

                 counts = counts,

                 z = z,

@@ -53,8 +53,8 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

         } else if (model == "celda_CG") {

             fm <- factorizeMatrix(x = sce, useAssay = useAssay,

                 altExpName = altExpName, type = "proportion")

-            z <- celdaClusters(sce, altExpName = altExpName)

-            y <- celdaModules(sce, altExpName = altExpName)

+            z <- as.integer(celdaClusters(sce, altExpName = altExpName))

+            y <- as.integer(celdaModules(sce, altExpName = altExpName))

             g <- .celdaHeatmapCelda_CG(

                 counts = counts,

                 fm = fm,

@@ -65,7 +65,7 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

         } else if (model == "celda_G") {

             fm <- factorizeMatrix(x = sce, useAssay = useAssay,

                 altExpName = altExpName, type = "proportion")

-            y <- celdaModules(sce, altExpName = altExpName)

+            y <- as.integer(celdaModules(sce, altExpName = altExpName))

             g <- .celdaHeatmapCelda_G(counts,

                 fm,

                 y,

@@ -19,7 +19,13 @@

 #' @return list A list containing dendrogram information and the heatmap grob

 #' @export

 setGeneric("celdaHeatmap",

-    function(sce, ...) {

+    function(sce,

+        useAssay = "counts",

+        altExpName = "featureSubset",

+        featureIx = NULL,

+        nfeatures = 25,

+        ...) {

+

         standardGeneric("celdaHeatmap")

     })

@@ -33,60 +33,72 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

     function(sce, useAssay = "counts", altExpName = "featureSubset",

         featureIx = NULL, nfeatures = 25, ...) {

-        if (celdaModel(sce, altExpName = altExpName) == "celda_C") {

-            g <- .celdaHeatmapCelda_C(sce = sce,

-                useAssay = useAssay,

-                altExpName = altExpName,

+        counts <- SummarizedExperiment::assay(sce, i = useAssay)

+        counts <- .processCounts(counts)

+        model <- celdaModel(sce, altExpName = altExpName)

+

+        if (model == "celda_C") {

+            z <- celdaClusters(sce, altExpName = altExpName)

+            g <- .celdaHeatmapCelda_C(

+                counts = counts,

+                z = z,

                 featureIx = featureIx,

                 ...)

-            return(g)

-        } else if (celdaModel(sce, altExpName = altExpName) == "celda_CG") {

-            g <- .celdaHeatmapCelda_CG(sce = sce,

-                useAssay = useAssay,

-                altExpName = altExpName,

+        } else if (model == "celda_CG") {

+            fm <- factorizeMatrix(x = sce, useAssay = useAssay,

+                altExpName = altExpName, type = "proportion")

+            z <- celdaClusters(sce, altExpName = altExpName)

+            y <- celdaModules(sce, altExpName = altExpName)

+            g <- .celdaHeatmapCelda_CG(

+                counts = counts,

+                fm = fm,

+                z = z,

+                y = y,

                 nfeatures = nfeatures,

                 ...)

-            return(g)

-        } else if (celdaModel(sce, altExpName = altExpName) == "celda_G") {

-            g <- .celdaHeatmapCelda_G(sce = sce,

-                useAssay = useAssay,

-                altExpName = altExpName,

+        } else if (model == "celda_G") {

+            fm <- factorizeMatrix(x = sce, useAssay = useAssay,

+                altExpName = altExpName, type = "proportion")

+            y <- celdaModules(sce, altExpName = altExpName)

+            g <- .celdaHeatmapCelda_G(counts,

+                fm,

+                y,

                 nfeatures = nfeatures,

                 ...)

-            return(g)

         } else {

             stop("S4Vectors::metadata(altExp(sce, altExpName))$",

                 "celda_parameters$model must be",

                 " one of 'celda_C', 'celda_G', or 'celda_CG'")

         }

+        return(g)

     }

 )

-.celdaHeatmapCelda_C <- function(sce,

-    useAssay, altExpName, featureIx, ...) {

+.celdaHeatmapCelda_C <- function(

+    counts,

+    z,

+    featureIx, ...) {

-    counts <- SummarizedExperiment::assay(sce, i = useAssay)

-    counts <- .processCounts(counts)

     norm <- normalizeCounts(counts,

         normalize = "proportion",

         transformationFun = sqrt)

     if (is.null(featureIx)) {

-        return(plotHeatmap(norm,

-            z = celdaClusters(sce, altExpName = altExpName), ...))

+        return(plotHeatmap(norm, z, ...))

     }

-

-    return(plotHeatmap(norm[featureIx, ],

-        z = celdaClusters(sce, altExpName = altExpName), ...))

+    return(plotHeatmap(norm[featureIx, ], z = z, ...))

 }

-.celdaHeatmapCelda_CG <- function(sce, useAssay, altExpName, nfeatures, ...) {

-    counts <- SummarizedExperiment::assay(sce, i = useAssay)

-    counts <- .processCounts(counts)

-    fm <- factorizeMatrix(x = sce, useAssay = useAssay,

-        altExpName = altExpName, type = "proportion")

+.celdaHeatmapCelda_CG <- function(

+    counts = counts,

+    fm = fm,

+    z = z,

+    y = y,

+    nfeatures,

+    ...) {

+

     top <- topRank(fm$proportions$module, n = nfeatures)

     ix <- unlist(top$index)

     rn <- unlist(top$names)

@@ -94,25 +106,20 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

         normalize = "proportion",

         transformationFun = sqrt)

     plt <- plotHeatmap(norm[rn, ],

-        z = celdaClusters(sce, altExpName = altExpName),

-        y = celdaModules(sce, altExpName = altExpName)[ix],

+        z = z,

+        y = y[ix],

         ...)

     return(plt)

 }

-.celdaHeatmapCelda_G <- function(sce, useAssay, altExpName, nfeatures, ...) {

-    counts <- SummarizedExperiment::assay(sce, i = useAssay)

-    counts <- .processCounts(counts)

-    fm <- factorizeMatrix(x = sce, useAssay = useAssay,

-        altExpName = altExpName, type = "proportion")

+.celdaHeatmapCelda_G <- function(counts, fm, y, nfeatures, ...) {

     top <- topRank(fm$proportions$module, n = nfeatures)

     ix <- unlist(top$index)

     rn <- unlist(top$names)

     norm <- normalizeCounts(counts,

         normalize = "proportion",

         transformationFun = sqrt)

-    plt <- plotHeatmap(norm[rn, ], y = celdaModules(sce,

-        altExpName = altExpName)[ix], ...)

+    plt <- plotHeatmap(norm[rn, ], y = y[ix], ...)

     return(plt)

 }

@@ -3,9 +3,9 @@

 #'  clustering results.

 #' @param sce A \link[SingleCellExperiment]{SingleCellExperiment} object

 #'  returned by \link{celda_C}, \link{celda_G}, or \link{celda_CG}.

-#' @param useAssay A string specifying which \link[SummarizedExperiment]{assay}

+#' @param useAssay A string specifying which \link{assay}

 #'  slot to use. Default "counts".

-#' @param altExpName The name for the \link[SingleCellExperiment]{altExp} slot

+#' @param altExpName The name for the \link{altExp} slot

 #'  to use. Default "featureSubset".

 #' @param featureIx Integer vector. Select features for display in heatmap. If

 #'  NULL, no subsetting will be performed. Default NULL. \strong{Only used for

@@ -97,7 +97,7 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

         z = celdaClusters(sce, altExpName = altExpName),

         y = celdaModules(sce, altExpName = altExpName)[ix],

         ...)

-    invisible(plt)

+    return(plt)

 }

@@ -114,5 +114,5 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

         transformationFun = sqrt)

     plt <- plotHeatmap(norm[rn, ], y = celdaModules(sce,

         altExpName = altExpName)[ix], ...)

-    invisible(plt)

+    return(plt)

 }

@@ -33,21 +33,21 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

     function(sce, useAssay = "counts", altExpName = "featureSubset",

         featureIx = NULL, nfeatures = 25, ...) {

-        if (celdaModel(sce) == "celda_C") {

+        if (celdaModel(sce, altExpName = altExpName) == "celda_C") {

             g <- .celdaHeatmapCelda_C(sce = sce,

                 useAssay = useAssay,

                 altExpName = altExpName,

                 featureIx = featureIx,

                 ...)

             return(g)

-        } else if (celdaModel(sce) == "celda_CG") {

+        } else if (celdaModel(sce, altExpName = altExpName) == "celda_CG") {

             g <- .celdaHeatmapCelda_CG(sce = sce,

                 useAssay = useAssay,

                 altExpName = altExpName,

                 nfeatures = nfeatures,

                 ...)

             return(g)

-        } else if (celdaModel(sce) == "celda_G") {

+        } else if (celdaModel(sce, altExpName = altExpName) == "celda_G") {

             g <- .celdaHeatmapCelda_G(sce = sce,

                 useAssay = useAssay,

                 altExpName = altExpName,

@@ -33,8 +33,6 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

     function(sce, useAssay = "counts", altExpName = "featureSubset",

         featureIx = NULL, nfeatures = 25, ...) {

-        aleExp <- SingleCellExperiment::altExp(sce, altExpName)

-

         if (celdaModel(sce) == "celda_C") {

             g <- .celdaHeatmapCelda_C(sce = sce,

                 useAssay = useAssay,

@@ -97,7 +95,7 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

         transformationFun = sqrt)

     plt <- plotHeatmap(norm[rn, ],

         z = celdaClusters(sce, altExpName = altExpName),

-        y = celdaModules(sce)[ix],

+        y = celdaModules(sce, altExpName = altExpName)[ix],

         ...)

     invisible(plt)

 }

@@ -114,6 +112,7 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

     norm <- normalizeCounts(counts,

         normalize = "proportion",

         transformationFun = sqrt)

-    plt <- plotHeatmap(norm[rn, ], y = celdaModules(sce)[ix], ...)

+    plt <- plotHeatmap(norm[rn, ], y = celdaModules(sce,

+        altExpName = altExpName)[ix], ...)

     invisible(plt)

 }

@@ -35,21 +35,21 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

         aleExp <- SingleCellExperiment::altExp(sce, altExpName)

-        if (celdaModel(aleExp) == "celda_C") {

+        if (celdaModel(sce) == "celda_C") {

             g <- .celdaHeatmapCelda_C(sce = sce,

                 useAssay = useAssay,

                 altExpName = altExpName,

                 featureIx = featureIx,

                 ...)

             return(g)

-        } else if (celdaModel(aleExp) == "celda_CG") {

+        } else if (celdaModel(sce) == "celda_CG") {

             g <- .celdaHeatmapCelda_CG(sce = sce,

                 useAssay = useAssay,

                 altExpName = altExpName,

                 nfeatures = nfeatures,

                 ...)

             return(g)

-        } else if (celdaModel(aleExp) == "celda_G") {

+        } else if (celdaModel(sce) == "celda_G") {

             g <- .celdaHeatmapCelda_G(sce = sce,

                 useAssay = useAssay,

                 altExpName = altExpName,

@@ -5,6 +5,8 @@

 #'  returned by \link{celda_C}, \link{celda_G}, or \link{celda_CG}.

 #' @param useAssay A string specifying which \link[SummarizedExperiment]{assay}

 #'  slot to use. Default "counts".

+#' @param altExpName The name for the \link[SingleCellExperiment]{altExp} slot

+#'  to use. Default "featureSubset".

 #' @param featureIx Integer vector. Select features for display in heatmap. If

 #'  NULL, no subsetting will be performed. Default NULL. \strong{Only used for

 #'  \code{sce} containing celda_C model result returned by \link{celda_C}.}

@@ -28,27 +30,35 @@ setGeneric("celdaHeatmap",

 #' celdaHeatmap(sceCeldaCG)

 #' @export

 setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

-    function(sce, useAssay = "counts", featureIx = NULL, nfeatures = 25, ...) {

-        if (celdaModel(sce) == "celda_C") {

+    function(sce, useAssay = "counts", altExpName = "featureSubset",

+        featureIx = NULL, nfeatures = 25, ...) {

+

+        aleExp <- SingleCellExperiment::altExp(sce, altExpName)

+

+        if (celdaModel(aleExp) == "celda_C") {

             g <- .celdaHeatmapCelda_C(sce = sce,

                 useAssay = useAssay,

+                altExpName = altExpName,

                 featureIx = featureIx,

                 ...)

             return(g)

-        } else if (celdaModel(sce) == "celda_CG") {

+        } else if (celdaModel(aleExp) == "celda_CG") {

             g <- .celdaHeatmapCelda_CG(sce = sce,

                 useAssay = useAssay,

+                altExpName = altExpName,

                 nfeatures = nfeatures,

                 ...)

             return(g)

-        } else if (celdaModel(sce) == "celda_G") {

+        } else if (celdaModel(aleExp) == "celda_G") {

             g <- .celdaHeatmapCelda_G(sce = sce,

                 useAssay = useAssay,

+                altExpName = altExpName,

                 nfeatures = nfeatures,

                 ...)

             return(g)

         } else {

-            stop("S4Vectors::metadata(sce)$celda_parameters$model must be",

+            stop("S4Vectors::metadata(altExp(sce, altExpName))$",

+                "celda_parameters$model must be",

                 " one of 'celda_C', 'celda_G', or 'celda_CG'")

         }

     }

@@ -56,7 +66,7 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

 .celdaHeatmapCelda_C <- function(sce,

-    useAssay, featureIx, ...) {

+    useAssay, altExpName, featureIx, ...) {

     counts <- SummarizedExperiment::assay(sce, i = useAssay)

     counts <- .processCounts(counts)

@@ -66,42 +76,44 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

     if (is.null(featureIx)) {

         return(plotHeatmap(norm,

-            z = celdaClusters(sce), ...))

+            z = celdaClusters(sce, altExpName = altExpName), ...))

     }

     return(plotHeatmap(norm[featureIx, ],

-        z = celdaClusters(sce), ...))

+        z = celdaClusters(sce, altExpName = altExpName), ...))

 }

-.celdaHeatmapCelda_CG <- function(sce, useAssay, nfeatures, ...) {

+.celdaHeatmapCelda_CG <- function(sce, useAssay, altExpName, nfeatures, ...) {

     counts <- SummarizedExperiment::assay(sce, i = useAssay)

     counts <- .processCounts(counts)

-    fm <- factorizeMatrix(x = sce, useAssay = useAssay, type = "proportion")

+    fm <- factorizeMatrix(x = sce, useAssay = useAssay,

+        altExpName = altExpName, type = "proportion")

     top <- topRank(fm$proportions$module, n = nfeatures)

     ix <- unlist(top$index)

+    rn <- unlist(top$names)

     norm <- normalizeCounts(counts,

         normalize = "proportion",

         transformationFun = sqrt)

-    plt <- plotHeatmap(norm[ix, ],

-        z = celdaClusters(sce),

+    plt <- plotHeatmap(norm[rn, ],

+        z = celdaClusters(sce, altExpName = altExpName),

         y = celdaModules(sce)[ix],

-        ...

-    )

+        ...)

     invisible(plt)

 }

-.celdaHeatmapCelda_G <- function(sce, useAssay, nfeatures, ...) {

+.celdaHeatmapCelda_G <- function(sce, useAssay, altExpName, nfeatures, ...) {

     counts <- SummarizedExperiment::assay(sce, i = useAssay)

     counts <- .processCounts(counts)

-    fm <- factorizeMatrix(x = sce, useAssay = useAssay, type = "proportion")

-    top <- celda::topRank(fm$proportions$module, n = nfeatures)

+    fm <- factorizeMatrix(x = sce, useAssay = useAssay,

+        altExpName = altExpName, type = "proportion")

+    top <- topRank(fm$proportions$module, n = nfeatures)

     ix <- unlist(top$index)

+    rn <- unlist(top$names)

     norm <- normalizeCounts(counts,

         normalize = "proportion",

-        transformationFun = sqrt

-    )

-    plt <- plotHeatmap(norm[ix, ], y = celdaModules(sce)[ix], ...)

+        transformationFun = sqrt)

+    plt <- plotHeatmap(norm[rn, ], y = celdaModules(sce)[ix], ...)

     invisible(plt)

 }

@@ -59,6 +59,7 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

     useAssay, featureIx, ...) {

     counts <- SummarizedExperiment::assay(sce, i = useAssay)

+    counts <- .processCounts(counts)

     norm <- normalizeCounts(counts,

         normalize = "proportion",

         transformationFun = sqrt)

@@ -75,6 +76,7 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

 .celdaHeatmapCelda_CG <- function(sce, useAssay, nfeatures, ...) {

     counts <- SummarizedExperiment::assay(sce, i = useAssay)

+    counts <- .processCounts(counts)

     fm <- factorizeMatrix(x = sce, useAssay = useAssay, type = "proportion")

     top <- topRank(fm$proportions$module, n = nfeatures)

     ix <- unlist(top$index)

@@ -92,6 +94,7 @@ setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

 .celdaHeatmapCelda_G <- function(sce, useAssay, nfeatures, ...) {

     counts <- SummarizedExperiment::assay(sce, i = useAssay)

+    counts <- .processCounts(counts)

     fm <- factorizeMatrix(x = sce, useAssay = useAssay, type = "proportion")

     top <- celda::topRank(fm$proportions$module, n = nfeatures)

     ix <- unlist(top$index)

@@ -14,9 +14,6 @@

 #'  \link{celda_G}.}

 #' @param ... Additional parameters passed to \link{plotHeatmap}.

 #' @seealso `celdaTsne()` for generating 2-dimensional tSNE coordinates

-#' @examples

-#' data(sceCeldaCG)

-#' celdaHeatmap(sceCeldaCG)

 #' @return list A list containing dendrogram information and the heatmap grob

 #' @export

 setGeneric("celdaHeatmap",

@@ -26,6 +23,9 @@ setGeneric("celdaHeatmap",

 #' @rdname celdaHeatmap

+#' @examples

+#' data(sceCeldaCG)

+#' celdaHeatmap(sceCeldaCG)

 #' @export

 setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

     function(sce, useAssay = "counts", featureIx = NULL, nfeatures = 25, ...) {

@@ -1,326 +1,104 @@

-#' @title Plots heatmap based on Celda model

-#' @description Renders a heatmap based on a matrix of counts where rows are

-#'  features and columns are cells.

-#' @param counts Numeric matrix. Normalized counts matrix where rows represent

-#'  features and columns represent cells. .

-#' @param z Numeric vector. Denotes cell population labels.

-#' @param y Numeric vector. Denotes feature module labels.

+#' @title Plot celda Heatmap

+#' @description Render a stylable heatmap of count data based on celda

+#'  clustering results.

+#' @param sce A \link[SingleCellExperiment]{SingleCellExperiment} object

+#'  returned by \link{celda_C}, \link{celda_G}, or \link{celda_CG}.

+#' @param useAssay A string specifying which \link[SummarizedExperiment]{assay}

+#'  slot to use. Default "counts".

 #' @param featureIx Integer vector. Select features for display in heatmap. If

-#'  NULL, no subsetting will be performed. Default NULL.

-#' @param cellIx Integer vector. Select cells for display in heatmap. If NULL,

-#'  no subsetting will be performed. Default NULL.

-#' @param scaleRow Function. A function to scale each individual row. Set to

-#'  NULL to disable. Occurs after normalization and log transformation. Defualt

-#'  is 'scale' and thus will Z-score transform each row.

-#' @param trim Numeric vector. Vector of length two that specifies the lower

-#'  and upper bounds for the data. This threshold is applied after row scaling.

-#'  Set to NULL to disable. Default c(-2,2).

-#' @param clusterFeature Logical. Determines whether rows should be clustered.

-#'  Default TRUE.

-#' @param clusterCell Logical. Determines whether columns should be clustered.

-#'  Default TRUE.

-#' @param annotationCell Data frame. Additional annotations for each cell will

-#'  be shown in the column color bars. The format of the data frame should be

-#'  one row for each cell and one column for each annotation. Numeric variables

-#'  will be displayed as continuous color bars and factors will be displayed as

-#'  discrete color bars. Default NULL.

-#' @param annotationFeature A data frame for the feature annotations (rows).

-#' @param annotationColor List. Contains color scheme for all annotations. See

-#'  `?pheatmap` for more details.

-#' @param colorScheme Character. One of "divergent" or "sequential". A

-#'  "divergent" scheme is best for highlighting relative data (denoted by

-#'  'colorSchemeCenter') such as gene expression data that has been normalized

-#'  and centered. A "sequential" scheme is best for highlighting data that

-#'  are ordered low to high such as raw counts or probabilities. Default

-#'  "divergent".

-#' @param colorSchemeSymmetric Logical. When the colorScheme is "divergent"

-#'  and the data contains both positive and negative numbers, TRUE indicates

-#'  that the color scheme should be symmetric from

-#'  \code{[-max(abs(data)), max(abs(data))]}. For example, if the data ranges

-#'  goes from -1.5 to 2, then setting this to TRUE will force the color scheme

-#'  to range from -2 to 2. Default TRUE.

-#' @param colorSchemeCenter Numeric. Indicates the center of a "divergent"

-#'  colorScheme. Default 0.

-#' @param col Color for the heatmap.

-#' @param breaks Numeric vector. A sequence of numbers that covers the range

-#'  of values in the normalized `counts`. Values in the normalized `matrix` are

-#'  assigned to each bin in `breaks`. Each break is assigned to a unique color

-#'  from `col`. If NULL, then breaks are calculated automatically. Default NULL.

-#' @param legend Logical. Determines whether legend should be drawn. Default

-#'  TRUE.

-#' @param annotationLegend Logical. Whether legend for all annotations should

-#'  be drawn. Default TRUE.

-#' @param annotationNamesFeature Logical. Whether the names for features should

-#'  be shown. Default TRUE.

-#' @param annotationNamesCell Logical. Whether the names for cells should be

-#'  shown. Default TRUE.

-#' @param showNamesFeature Logical. Specifies if feature names should be shown.

-#'  Default TRUE.

-#' @param showNamesCell Logical. Specifies if cell names should be shown.

-#'  Default FALSE.

-#' @param rowGroupOrder Vector. Specifies the order of feature clusters when

-#'  semisupervised clustering is performed on the \code{y} labels.

-#' @param colGroupOrder Vector. Specifies the order of cell clusters when

-#'  semisupervised clustering is performed on the \code{z} labels.

-#' @param hclustMethod Character. Specifies the method to use for the 'hclust'

-#'  function. See `?hclust` for possible values. Default "ward.D2".

-#' @param treeheightFeature Numeric. Width of the feature dendrogram. Set to 0

-#'  to disable plotting of this dendrogram. Default: if clusterFeature == TRUE,

-#'  then treeheightFeature = 50, else treeheightFeature = 0.

-#' @param treeheightCell Numeric. Height of the cell dendrogram. Set to 0 to

-#'  disable plotting of this dendrogram. Default: if clusterCell == TRUE, then

-#'  treeheightCell = 50, else treeheightCell = 0.

-#' @param silent Logical. Whether to plot the heatmap.

-#' @param ... Other arguments to be passed to underlying pheatmap function.

+#'  NULL, no subsetting will be performed. Default NULL. \strong{Only used for

+#'  \code{sce} containing celda_C model result returned by \link{celda_C}.}

+#' @param nfeatures Integer. Maximum number of features to select for each

+#'  gene module. Default 25. \strong{Only used for \code{sce} containing

+#'  celda_CG or celda_G model results returned by \link{celda_CG} or

+#'  \link{celda_G}.}

+#' @param ... Additional parameters passed to \link{plotHeatmap}.

+#' @seealso `celdaTsne()` for generating 2-dimensional tSNE coordinates

 #' @examples

-#' data(celdaCGSim, celdaCGMod)

-#' plotHeatmap(celdaCGSim$counts,

-#'   z = celdaCGMod@celdaClusters$z, y = celdaCGMod@celdaClusters$y

-#' )

+#' data(sceCeldaCG)

+#' celdaHeatmap(sceCeldaCG)

 #' @return list A list containing dendrogram information and the heatmap grob

-#' @import graphics

-#' @import grid

 #' @export

-plotHeatmap <- function(counts,

-                        z = NULL,

-                        y = NULL,

-                        scaleRow = scale,

-                        trim = c(-2, 2),

-                        featureIx = NULL,

-                        cellIx = NULL,

-                        clusterFeature = TRUE,

-                        clusterCell = TRUE,

-                        colorScheme = c("divergent", "sequential"),

-                        colorSchemeSymmetric = TRUE,

-                        colorSchemeCenter = 0,

-                        col = NULL,

-                        annotationCell = NULL,

-                        annotationFeature = NULL,

-                        annotationColor = NULL,

-                        breaks = NULL,

-                        legend = TRUE,

-                        annotationLegend = TRUE,

-                        annotationNamesFeature = TRUE,

-                        annotationNamesCell = TRUE,

-                        showNamesFeature = FALSE,

-                        showNamesCell = FALSE,

-                        rowGroupOrder = NULL,

-                        colGroupOrder = NULL,

-                        hclustMethod = "ward.D2",

-                        treeheightFeature = ifelse(clusterFeature, 50, 0),

-                        treeheightCell = ifelse(clusterCell, 50, 0),

-                        silent = FALSE,

-                        ...) {

-  # Check for same lengths for z and y group variables

-  if (!is.null(z) & length(z) != ncol(counts)) {

-    stop("Length of z must match number of columns in counts matrix")

-  }

+setGeneric("celdaHeatmap",

+    function(sce, ...) {

+        standardGeneric("celdaHeatmap")

+    })

-  if (!is.null(y) & length(y) != nrow(counts)) {

-    stop("Length of y must match number of rows in counts matrix")

-  }

-  colorScheme <- match.arg(colorScheme)

+#' @rdname celdaHeatmap

+#' @export

+setMethod("celdaHeatmap", signature(sce = "SingleCellExperiment"),

+    function(sce, useAssay = "counts", featureIx = NULL, nfeatures = 25, ...) {

+        if (celdaModel(sce) == "celda_C") {

+            g <- .celdaHeatmapCelda_C(sce = sce,

+                useAssay = useAssay,

+                featureIx = featureIx,

+                ...)

+            return(g)

+        } else if (celdaModel(sce) == "celda_CG") {

+            g <- .celdaHeatmapCelda_CG(sce = sce,

+                useAssay = useAssay,

+                nfeatures = nfeatures,

+                ...)

+            return(g)

+        } else if (celdaModel(sce) == "celda_G") {

+            g <- .celdaHeatmapCelda_G(sce = sce,

+                useAssay = useAssay,

+                nfeatures = nfeatures,

+                ...)

+            return(g)

+        } else {

+            stop("S4Vectors::metadata(sce)$celda_parameters$model must be",

+                " one of 'celda_C', 'celda_G', or 'celda_CG'")

+        }

+    }

+)

+

+

+.celdaHeatmapCelda_C <- function(sce,

+    useAssay, featureIx, ...) {

+

+    counts <- SummarizedExperiment::assay(sce, i = useAssay)

+    norm <- normalizeCounts(counts,

+        normalize = "proportion",

+        transformationFun = sqrt)

+

+    if (is.null(featureIx)) {

+        return(plotHeatmap(norm,

+            z = celdaClusters(sce), ...))

+    }

+

+    return(plotHeatmap(norm[featureIx, ],

+        z = celdaClusters(sce), ...))

+}

-  ## Create cell annotation

-  if (!is.null(annotationCell) & !is.null(z)) {

-    if (is.null(rownames(annotationCell))) {

-      rownames(annotationCell) <- colnames(counts)

-    } else {

-      if (any(rownames(annotationCell) != colnames(counts))) {

-        stop("Row names of 'annotationCell' are different than the

-             column names of 'counts'")

-      }

-    }

-    annotationCell <-

-      data.frame(cell = as.factor(z), annotationCell)

-  } else if (is.null(annotationCell) & !is.null(z)) {

-    annotationCell <- data.frame(cell = as.factor(z))

-    rownames(annotationCell) <- colnames(counts)

-  } else {

-    annotationCell <- NA

-  }

-  # Set feature annotation

-  if (!is.null(annotationFeature) & !is.null(y)) {

-    if (is.null(rownames(annotationFeature))) {

-      rownames(annotationFeature) <- rownames(counts)

-    } else {

-      if (any(rownames(annotationFeature) != rownames(counts))) {

-        stop("Row names of 'annotationFeature' are different than the

-             row names of 'counts'")

-      }

-    }

-    annotationFeature <- data.frame(

-      module = as.factor(y),

-      annotationFeature

+.celdaHeatmapCelda_CG <- function(sce, useAssay, nfeatures, ...) {

+    counts <- SummarizedExperiment::assay(sce, i = useAssay)

+    fm <- factorizeMatrix(x = sce, useAssay = useAssay, type = "proportion")

+    top <- topRank(fm$proportions$module, n = nfeatures)

+    ix <- unlist(top$index)

+    norm <- normalizeCounts(counts,

+        normalize = "proportion",

+        transformationFun = sqrt)

+    plt <- plotHeatmap(norm[ix, ],

+        z = celdaClusters(sce),

+        y = celdaModules(sce)[ix],

+        ...

     )

-  } else if (is.null(annotationFeature) & !is.null(y)) {

-    annotationFeature <- data.frame(module = as.factor(y))

-    rownames(annotationFeature) <- rownames(counts)

-  } else {

-    annotationFeature <- NA

-  }

-

-  ## Select subsets of features/cells

-  if (!is.null(featureIx)) {

-    counts <- counts[featureIx, , drop = FALSE]

-    if (!is.null(annotationFeature) &&

-      !is.null(ncol(annotationFeature))) {

-      annotationFeature <- annotationFeature[featureIx, , drop = FALSE]

-    }

-    if (!is.null(y)) {

-      y <- y[featureIx]

-    }

-  }

-

-  if (!is.null(cellIx)) {

-    counts <- counts[, cellIx, drop = FALSE]

-    if (!is.null(annotationCell) &&

-      !is.null(ncol(annotationCell))) {

-      annotationCell <- annotationCell[cellIx, , drop = FALSE]

-    }

-    if (!is.null(z)) {

-      z <- z[cellIx]

-    }

-  }

-

-  ## Set annotation colors

-  if (!is.null(z)) {

-    if (is.factor(z)) {

-      K <- levels(z)

-    } else {

-      K <- unique(z)

-    }

-    K <- stringr::str_sort(K, numeric = TRUE)

-    kCol <- distinctColors(length(K))

-    names(kCol) <- K

-

-

-    if (!is.null(annotationColor)) {

-      if (!("cell" %in% names(annotationColor))) {

-        annotationColor <- c(list(cell = kCol), annotationColor)

-      }

-    } else {

-      annotationColor <- list(cell = kCol)

-    }

-  }

-

-  if (!is.null(y)) {

-    if (is.factor(y)) {

-      L <- levels(y)

-    } else {

-      L <- unique(y)

-    }

-    L <- stringr::str_sort(L, numeric = TRUE)

-    lCol <- distinctColors(length(L))

-    names(lCol) <- L

-

-    if (!is.null(annotationColor)) {

-      if (!("module" %in% names(annotationColor))) {

-        annotationColor <- c(list(module = lCol), annotationColor)

-      }

-    } else {

-      annotationColor <- list(module = lCol)

-    }

-  }

-

-  # scale indivisual rows by scaleRow

-  if (!is.null(scaleRow)) {

-    if (is.function(scaleRow)) {

-      cn <- colnames(counts)

-      counts <- t(base::apply(counts, 1, scaleRow))

-      colnames(counts) <- cn

-    } else {

-      stop("'scaleRow' needs to be of class 'function'")

-    }

-  }

-

-  if (!is.null(trim)) {

-    if (length(trim) != 2) {

-      stop(

-        "'trim' should be a 2 element vector specifying the lower",

-        " and upper boundaries"

-      )

-    }

-    trim <- sort(trim)

-    counts[counts < trim[1]] <- trim[1]

-    counts[counts > trim[2]] <- trim[2]

-  }

-

-  ## Set color scheme and breaks

-  uBoundRange <- max(counts, na.rm = TRUE)

-  lboundRange <- min(counts, na.rm = TRUE)

-

-  if (colorScheme == "divergent") {

-    if (colorSchemeSymmetric == TRUE) {

-      uBoundRange <- max(abs(uBoundRange), abs(lboundRange))

-      lboundRange <- -uBoundRange

-    }

-    if (is.null(col)) {

-      col <- colorRampPalette(c("#1E90FF", "#FFFFFF", "#CD2626"),

-        space = "Lab"

-      )(100)

-    }

-    colLen <- length(col)

-    if (is.null(breaks)) {

-      breaks <- c(

-        seq(

-          lboundRange,

-          colorSchemeCenter,

-          length.out = round(colLen / 2) + 1

-        ),

-        seq(

-          colorSchemeCenter + 1e-6,

-          uBoundRange,

-          length.out = colLen - round(colLen / 2)

-        )

-      )

-    }

-  } else {

-    # Sequential color scheme

-    if (is.null(col)) {

-      col <- colorRampPalette(c("#FFFFFF", brewer.pal(

-        n = 9,

-        name = "Blues"

-      )))(100)

-    }

-    colLen <- length(col)

-    if (is.null(breaks)) {

-      breaks <- seq(lboundRange, uBoundRange, length.out = colLen)

-    }

-  }

-

-  sp <- semiPheatmap(

-    mat = counts,

-    color = col,

-    breaks = breaks,

-    clusterCols = clusterCell,

-    clusterRows = clusterFeature,

-    annotationRow = annotationFeature,

-    annotationCol = annotationCell,

-    annotationColors = annotationColor,

-    legend = legend,

-    annotationLegend = annotationLegend,

-    annotationNamesRow = annotationNamesFeature,

-    annotationNamesCol = annotationNamesCell,

-    showRownames = showNamesFeature,

-    showColnames = showNamesCell,

-    clusteringMethod = hclustMethod,

-    treeHeightRow = treeheightFeature,

-    treeHeightCol = treeheightCell,

-    rowLabel = y,

-    colLabel = z,

-    rowGroupOrder = rowGroupOrder,

-    colGroupOrder = colGroupOrder,

-    silent = TRUE,

-    ...

-  )

+    invisible(plt)

+}

-  if (!isTRUE(silent)) {

-    grid::grid.newpage()

-    grid::grid.draw(sp$gtable)

-  }

-  invisible(sp)

+.celdaHeatmapCelda_G <- function(sce, useAssay, nfeatures, ...) {

+    counts <- SummarizedExperiment::assay(sce, i = useAssay)

+    fm <- factorizeMatrix(x = sce, useAssay = useAssay, type = "proportion")

+    top <- celda::topRank(fm$proportions$module, n = nfeatures)

+    ix <- unlist(top$index)

+    norm <- normalizeCounts(counts,

+        normalize = "proportion",

+        transformationFun = sqrt

+    )

+    plt <- plotHeatmap(norm[ix, ], y = celdaModules(sce)[ix], ...)

+    invisible(plt)

 }