Browse code

fix error. Add alpha arg to perplexity plots

zhewa authored on 02/05/2021 14:45:48
Showing1 changed files
... ...
@@ -100,14 +100,14 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
100 100
             legend_height = grid::unit(6, "cm")),
101 101
         ...) {
102 102
 
103
-        altExp <- SingleCellExperiment::altExp(sce, altExpName)
104 103
         level <- match.arg(level)
105 104
         if (celdaModel(sce, altExpName = altExpName) == "celda_C") {
106 105
             if (level == "cellPopulation") {
107 106
                 warning("'level' has been set to 'sample'")
108 107
             }
109
-            pm <- .celdaProbabilityMapC(sce = altExp,
108
+            pm <- .celdaProbabilityMapC(sce = sce,
110 109
                 useAssay = useAssay,
110
+                altExpName = altExpName,
111 111
                 level = "sample",
112 112
                 ncols = ncols,
113 113
                 col2 = col2,
... ...
@@ -123,8 +123,9 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
123 123
                 heatmapLegendParam = heatmapLegendParam,
124 124
                 ...)
125 125
         } else if (celdaModel(sce, altExpName = altExpName) == "celda_CG") {
126
-            pm <- .celdaProbabilityMapCG(sce = altExp,
126
+            pm <- .celdaProbabilityMapCG(sce = sce,
127 127
                 useAssay = useAssay,
128
+                altExpName = altExpName,
128 129
                 level = level,
129 130
                 ncols = ncols,
130 131
                 col2 = col2,
... ...
@@ -151,6 +152,7 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
151 152
 
152 153
 .celdaProbabilityMapC <- function(sce,
153 154
     useAssay,
155
+    altExpName,
154 156
     level,
155 157
     ncols,
156 158
     col2,
... ...
@@ -166,12 +168,11 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
166 168
     heatmapLegendParam,
167 169
     ...) {
168 170
 
169
-    counts <- SummarizedExperiment::assay(sce, i = useAssay)
170
-    counts <- .processCounts(counts)
171
+    altExp <- SingleCellExperiment::altExp(sce, altExpName)
171 172
 
172 173
     zInclude <- which(tabulate(SummarizedExperiment::colData(
173
-        sce)$celda_cell_cluster,
174
-        S4Vectors::metadata(sce)$celda_parameters$K) > 0)
174
+        altExp)$celda_cell_cluster,
175
+        S4Vectors::metadata(altExp)$celda_parameters$K) > 0)
175 176
 
176 177
     factorized <- factorizeMatrix(x = sce, useAssay = useAssay,
177 178
         type = "proportion")
... ...
@@ -227,6 +228,7 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
227 228
 
228 229
 .celdaProbabilityMapCG <- function(sce,
229 230
     useAssay,
231
+    altExpName,
230 232
     level,
231 233
     ncols,
232 234
     col2,
... ...
@@ -242,17 +244,17 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
242 244
     heatmapLegendParam,
243 245
     ...) {
244 246
 
245
-    counts <- SummarizedExperiment::assay(sce, i = useAssay)
246
-    counts <- .processCounts(counts)
247
+    altExp <- SingleCellExperiment::altExp(sce, altExpName)
247 248
 
248 249
     factorized <- factorizeMatrix(x = sce, useAssay = useAssay,
250
+        altExpName = altExpName,
249 251
         type = c("counts", "proportion"))
250 252
     zInclude <- which(tabulate(SummarizedExperiment::colData(
251
-        sce)$celda_cell_cluster,
252
-        S4Vectors::metadata(sce)$celda_parameters$K) > 0)
253
+        altExp)$celda_cell_cluster,
254
+        S4Vectors::metadata(altExp)$celda_parameters$K) > 0)
253 255
     yInclude <- which(tabulate(SummarizedExperiment::rowData(
254
-        sce)$celda_feature_module,
255
-        S4Vectors::metadata(sce)$celda_parameters$L) > 0)
256
+        altExp)$celda_feature_module,
257
+        S4Vectors::metadata(altExp)$celda_parameters$L) > 0)
256 258
 
257 259
     if (level == "cellPopulation") {
258 260
         pop <- factorized$proportions$cellPopulation[yInclude,
Browse code

add arguments to generic functions

zhewa authored on 01/05/2021 20:59:26
Showing1 changed files
... ...
@@ -48,7 +48,26 @@
48 48
 #'  \link[ComplexHeatmap]{Heatmap-class} objects
49 49
 #' @export
50 50
 setGeneric("celdaProbabilityMap",
51
-    function(sce, ...) {
51
+    function(sce,
52
+        useAssay = "counts",
53
+        altExpName = "featureSubset",
54
+        level = c("cellPopulation", "sample"),
55
+        ncols = 100,
56
+        col2 = circlize::colorRamp2(c(-2, 0, 2),
57
+            c("#1E90FF", "#FFFFFF", "#CD2626")),
58
+        title1 = "Absolute probability",
59
+        title2 = "Relative expression",
60
+        showColumnNames = TRUE,
61
+        showRowNames = TRUE,
62
+        rowNamesgp = grid::gpar(fontsize = 8),
63
+        colNamesgp = grid::gpar(fontsize = 12),
64
+        clusterRows = FALSE,
65
+        clusterColumns = FALSE,
66
+        showHeatmapLegend = TRUE,
67
+        heatmapLegendParam = list(title = NULL,
68
+            legend_height = grid::unit(6, "cm")),
69
+        ...) {
70
+
52 71
         standardGeneric("celdaProbabilityMap")
53 72
     })
54 73
 
Browse code

update function calls

zhewa authored on 28/04/2021 02:58:15
Showing1 changed files
... ...
@@ -154,7 +154,7 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
154 154
         sce)$celda_cell_cluster,
155 155
         S4Vectors::metadata(sce)$celda_parameters$K) > 0)
156 156
 
157
-    factorized <- .factorizeMatrixCelda_C(sce, useAssay = useAssay,
157
+    factorized <- factorizeMatrix(x = sce, useAssay = useAssay,
158 158
         type = "proportion")
159 159
 
160 160
     samp <- factorized$proportions$sample[zInclude, , drop = FALSE]
... ...
@@ -226,7 +226,7 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
226 226
     counts <- SummarizedExperiment::assay(sce, i = useAssay)
227 227
     counts <- .processCounts(counts)
228 228
 
229
-    factorized <- .factorizeMatrixCelda_CG(sce, useAssay,
229
+    factorized <- factorizeMatrix(x = sce, useAssay = useAssay,
230 230
         type = c("counts", "proportion"))
231 231
     zInclude <- which(tabulate(SummarizedExperiment::colData(
232 232
         sce)$celda_cell_cluster,
Browse code

remove leftAnnotation options in moduleHeatmap, add row title

zhewa authored on 07/11/2020 22:45:47
Showing1 changed files
... ...
@@ -78,7 +78,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
78 78
         clusterColumns = FALSE,
79 79
         showHeatmapLegend = TRUE,
80 80
         heatmapLegendParam = list(title = NULL,
81
-            legend_height = grid::unit(6, "cm"))) {
81
+            legend_height = grid::unit(6, "cm")),
82
+        ...) {
82 83
 
83 84
         altExp <- SingleCellExperiment::altExp(sce, altExpName)
84 85
         level <- match.arg(level)
... ...
@@ -100,7 +101,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
100 101
                 clusterRows = clusterRows,
101 102
                 clusterColumns = clusterColumns,
102 103
                 showHeatmapLegend = showHeatmapLegend,
103
-                heatmapLegendParam = heatmapLegendParam)
104
+                heatmapLegendParam = heatmapLegendParam,
105
+                ...)
104 106
         } else if (celdaModel(sce, altExpName = altExpName) == "celda_CG") {
105 107
             pm <- .celdaProbabilityMapCG(sce = altExp,
106 108
                 useAssay = useAssay,
... ...
@@ -116,7 +118,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
116 118
                 clusterRows = clusterRows,
117 119
                 clusterColumns = clusterColumns,
118 120
                 showHeatmapLegend = showHeatmapLegend,
119
-                heatmapLegendParam = heatmapLegendParam)
121
+                heatmapLegendParam = heatmapLegendParam,
122
+                ...)
120 123
         } else {
121 124
             stop("S4Vectors::metadata(altExp(sce,",
122 125
                 " altExpName))$celda_parameters$model must be",
... ...
@@ -141,7 +144,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
141 144
     clusterRows,
142 145
     clusterColumns,
143 146
     showHeatmapLegend,
144
-    heatmapLegendParam) {
147
+    heatmapLegendParam,
148
+    ...) {
145 149
 
146 150
     counts <- SummarizedExperiment::assay(sce, i = useAssay)
147 151
     counts <- .processCounts(counts)
... ...
@@ -174,7 +178,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
174 178
         cluster_rows = clusterRows,
175 179
         cluster_columns = clusterColumns,
176 180
         show_heatmap_legend = showHeatmapLegend,
177
-        heatmap_legend_param = heatmapLegendParam)
181
+        heatmap_legend_param = heatmapLegendParam,
182
+        ...)
178 183
 
179 184
     if (ncol(samp) > 1) {
180 185
         sampNorm <- normalizeCounts(samp,
... ...
@@ -192,7 +197,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
192 197
             cluster_rows = clusterRows,
193 198
             cluster_columns = clusterColumns,
194 199
             show_heatmap_legend = showHeatmapLegend,
195
-            heatmap_legend_param = heatmapLegendParam)
200
+            heatmap_legend_param = heatmapLegendParam,
201
+            ...)
196 202
         return(g1 + g2)
197 203
     } else {
198 204
         return(g1)
... ...
@@ -214,7 +220,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
214 220
     clusterRows,
215 221
     clusterColumns,
216 222
     showHeatmapLegend,
217
-    heatmapLegendParam) {
223
+    heatmapLegendParam,
224
+    ...) {
218 225
 
219 226
     counts <- SummarizedExperiment::assay(sce, i = useAssay)
220 227
     counts <- .processCounts(counts)
... ...
@@ -256,7 +263,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
256 263
             cluster_rows = clusterRows,
257 264
             cluster_columns = clusterColumns,
258 265
             show_heatmap_legend = showHeatmapLegend,
259
-            heatmap_legend_param = heatmapLegendParam)
266
+            heatmap_legend_param = heatmapLegendParam,
267
+            ...)
260 268
         g2 <- ComplexHeatmap::Heatmap(matrix = popNorm,
261 269
             col = col2,
262 270
             column_title = title2,
... ...
@@ -267,7 +275,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
267 275
             cluster_rows = clusterRows,
268 276
             cluster_columns = clusterColumns,
269 277
             show_heatmap_legend = showHeatmapLegend,
270
-            heatmap_legend_param = heatmapLegendParam)
278
+            heatmap_legend_param = heatmapLegendParam,
279
+            ...)
271 280
         return(g1 + g2)
272 281
     } else {
273 282
         samp <- factorized$proportions$sample
... ...
@@ -293,7 +302,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
293 302
             cluster_rows = clusterRows,
294 303
             cluster_columns = clusterColumns,
295 304
             show_heatmap_legend = showHeatmapLegend,
296
-            heatmap_legend_param = heatmapLegendParam)
305
+            heatmap_legend_param = heatmapLegendParam,
306
+            ...)
297 307
 
298 308
         if (ncol(samp) > 1) {
299 309
             sampNorm <- normalizeCounts(factorized$counts$sample,
... ...
@@ -310,7 +320,8 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
310 320
                 cluster_rows = clusterRows,
311 321
                 cluster_columns = clusterColumns,
312 322
                 show_heatmap_legend = showHeatmapLegend,
313
-                heatmap_legend_param = heatmapLegendParam)
323
+                heatmap_legend_param = heatmapLegendParam,
324
+                ...)
314 325
             return(g1 + g2)
315 326
         } else {
316 327
             return(g1 + g2)
Browse code

fix doc warning file link in package does not exist and so has been treated as a topic

zhewa authored on 16/10/2020 21:36:32
Showing1 changed files
... ...
@@ -4,9 +4,9 @@
4 4
 #'  populations and samples).
5 5
 #' @param sce A \link[SingleCellExperiment]{SingleCellExperiment} object
6 6
 #'  returned by \link{celda_C}, \link{celda_G}, or \link{celda_CG}.
7
-#' @param useAssay A string specifying which \link[SummarizedExperiment]{assay}
7
+#' @param useAssay A string specifying which \link{assay}
8 8
 #'  slot to use. Default "counts".
9
-#' @param altExpName The name for the \link[SingleCellExperiment]{altExp} slot
9
+#' @param altExpName The name for the \link{altExp} slot
10 10
 #'  to use. Default "featureSubset".
11 11
 #' @param level Character. One of "cellPopulation" or "Sample".
12 12
 #'  "cellPopulation" will display the absolute probabilities and relative
Browse code

fix doc, add import circlize

zhewa authored on 13/10/2020 01:52:03
Showing1 changed files
... ...
@@ -78,7 +78,7 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
78 78
         clusterColumns = FALSE,
79 79
         showHeatmapLegend = TRUE,
80 80
         heatmapLegendParam = list(title = NULL,
81
-            legend_height = unit(6, "cm"))) {
81
+            legend_height = grid::unit(6, "cm"))) {
82 82
 
83 83
         altExp <- SingleCellExperiment::altExp(sce, altExpName)
84 84
         level <- match.arg(level)
Browse code

fix doc

zhewa authored on 13/10/2020 01:49:03
Showing1 changed files
... ...
@@ -15,7 +15,7 @@
15 15
 #'  objects}. "sample" will display the absolute probabilities and relative
16 16
 #'  normalized abundance of each cell population in each sample. Default
17 17
 #'  "cellPopulation".
18
-#' @param ncols The number of colors (\ge 1) to be in the color palette of
18
+#' @param ncols The number of colors (>1) to be in the color palette of
19 19
 #'  the absolute probability heatmap.
20 20
 #' @param col2 Passed to \code{col} argument of \link[ComplexHeatmap]{Heatmap}.
21 21
 #'  Set color boundaries and colors for the relative expression heatmap.
Browse code

upgrade probabilityMap

zhewa authored on 13/10/2020 00:14:45
Showing1 changed files
... ...
@@ -15,10 +15,37 @@
15 15
 #'  objects}. "sample" will display the absolute probabilities and relative
16 16
 #'  normalized abundance of each cell population in each sample. Default
17 17
 #'  "cellPopulation".
18
-#' @param ... Additional parameters.
18
+#' @param ncols The number of colors (\ge 1) to be in the color palette of
19
+#'  the absolute probability heatmap.
20
+#' @param col2 Passed to \code{col} argument of \link[ComplexHeatmap]{Heatmap}.
21
+#'  Set color boundaries and colors for the relative expression heatmap.
22
+#' @param title1 Passed to \code{column_title} argument of
23
+#'  \link[ComplexHeatmap]{Heatmap}. Figure title for the absolute probability
24
+#'  heatmap.
25
+#' @param title2 Passed to \code{column_title} argument of
26
+#'  \link[ComplexHeatmap]{Heatmap}. Figure title for the relative expression
27
+#'  heatmap.
28
+#' @param showColumnNames Passed to \code{show_column_names} argument of
29
+#'  \link[ComplexHeatmap]{Heatmap}. Show column names.
30
+#' @param showRowNames Passed to \code{show_row_names} argument of
31
+#'  \link[ComplexHeatmap]{Heatmap}. Show row names.
32
+#' @param rowNamesgp Passed to \code{row_names_gp} argument of
33
+#'  \link[ComplexHeatmap]{Heatmap}. Set row name font.
34
+#' @param colNamesgp Passed to \code{column_names_gp} argument of
35
+#'  \link[ComplexHeatmap]{Heatmap}. Set column name font.
36
+#' @param clusterRows Passed to \code{cluster_rows} argument of
37
+#'  \link[ComplexHeatmap]{Heatmap}. Cluster rows.
38
+#' @param clusterColumns Passed to \code{cluster_columns} argument of
39
+#'  \link[ComplexHeatmap]{Heatmap}. Cluster columns.
40
+#' @param showHeatmapLegend Passed to \code{show_heatmap_legend} argument of
41
+#'  \link[ComplexHeatmap]{Heatmap}. Show heatmap legend.
42
+#' @param heatmapLegendParam Passed to \code{heatmap_legend_param} argument of
43
+#'  \link[ComplexHeatmap]{Heatmap}. Heatmap legend parameters.
44
+#' @param ... Additional parameters passed to \link[ComplexHeatmap]{Heatmap}.
19 45
 #' @seealso \link{celda_C} for clustering cells. \link{celda_CG} for
20 46
 #'  clustering features and cells
21
-#' @return A grob containing the specified plots
47
+#' @return A \link[ComplexHeatmap]{HeatmapList} object containing 2
48
+#'  \link[ComplexHeatmap]{Heatmap-class} objects
22 49
 #' @export
23 50
 setGeneric("celdaProbabilityMap",
24 51
     function(sce, ...) {
... ...
@@ -27,7 +54,6 @@ setGeneric("celdaProbabilityMap",
27 54
 
28 55
 
29 56
 #' @rdname celdaProbabilityMap
30
-#' @importFrom gridExtra grid.arrange
31 57
 #' @importFrom RColorBrewer brewer.pal
32 58
 #' @importFrom grDevices colorRampPalette
33 59
 #' @examples
... ...
@@ -35,8 +61,24 @@ setGeneric("celdaProbabilityMap",
35 61
 #' celdaProbabilityMap(sceCeldaCG)
36 62
 #' @export
37 63
 setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
38
-    function(sce, useAssay = "counts", altExpName = "featureSubset",
39
-        level = c("cellPopulation", "sample")) {
64
+    function(sce,
65
+        useAssay = "counts",
66
+        altExpName = "featureSubset",
67
+        level = c("cellPopulation", "sample"),
68
+        ncols = 100,
69
+        col2 = circlize::colorRamp2(c(-2, 0, 2),
70
+            c("#1E90FF", "#FFFFFF", "#CD2626")),
71
+        title1 = "Absolute probability",
72
+        title2 = "Relative expression",
73
+        showColumnNames = TRUE,
74
+        showRowNames = TRUE,
75
+        rowNamesgp = grid::gpar(fontsize = 8),
76
+        colNamesgp = grid::gpar(fontsize = 12),
77
+        clusterRows = FALSE,
78
+        clusterColumns = FALSE,
79
+        showHeatmapLegend = TRUE,
80
+        heatmapLegendParam = list(title = NULL,
81
+            legend_height = unit(6, "cm"))) {
40 82
 
41 83
         altExp <- SingleCellExperiment::altExp(sce, altExpName)
42 84
         level <- match.arg(level)
... ...
@@ -44,11 +86,37 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
44 86
             if (level == "cellPopulation") {
45 87
                 warning("'level' has been set to 'sample'")
46 88
             }
47
-            pm <- .celdaProbabilityMapC(sce = altExp, useAssay = useAssay,
48
-                level = "sample")
89
+            pm <- .celdaProbabilityMapC(sce = altExp,
90
+                useAssay = useAssay,
91
+                level = "sample",
92
+                ncols = ncols,
93
+                col2 = col2,
94
+                title1 = title1,
95
+                title2 = title2,
96
+                showColumnNames = showColumnNames,
97
+                showRowNames = showRowNames,
98
+                rowNamesgp = rowNamesgp,
99
+                colNamesgp = colNamesgp,
100
+                clusterRows = clusterRows,
101
+                clusterColumns = clusterColumns,
102
+                showHeatmapLegend = showHeatmapLegend,
103
+                heatmapLegendParam = heatmapLegendParam)
49 104
         } else if (celdaModel(sce, altExpName = altExpName) == "celda_CG") {
50
-            pm <- .celdaProbabilityMapCG(sce = altExp, useAssay = useAssay,
51
-                level = level)
105
+            pm <- .celdaProbabilityMapCG(sce = altExp,
106
+                useAssay = useAssay,
107
+                level = level,
108
+                ncols = ncols,
109
+                col2 = col2,
110
+                title1 = title1,
111
+                title2 = title2,
112
+                showColumnNames = showColumnNames,
113
+                showRowNames = showRowNames,
114
+                rowNamesgp = rowNamesgp,
115
+                colNamesgp = colNamesgp,
116
+                clusterRows = clusterRows,
117
+                clusterColumns = clusterColumns,
118
+                showHeatmapLegend = showHeatmapLegend,
119
+                heatmapLegendParam = heatmapLegendParam)
52 120
         } else {
53 121
             stop("S4Vectors::metadata(altExp(sce,",
54 122
                 " altExpName))$celda_parameters$model must be",
... ...
@@ -59,7 +127,22 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
59 127
 )
60 128
 
61 129
 
62
-.celdaProbabilityMapC <- function(sce, useAssay, level) {
130
+.celdaProbabilityMapC <- function(sce,
131
+    useAssay,
132
+    level,
133
+    ncols,
134
+    col2,
135
+    title1,
136
+    title2,
137
+    showColumnNames,
138
+    showRowNames,
139
+    rowNamesgp,
140
+    colNamesgp,
141
+    clusterRows,
142
+    clusterColumns,
143
+    showHeatmapLegend,
144
+    heatmapLegendParam) {
145
+
63 146
     counts <- SummarizedExperiment::assay(sce, i = useAssay)
64 147
     counts <- .processCounts(counts)
65 148
 
... ...
@@ -71,46 +154,68 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
71 154
         type = "proportion")
72 155
 
73 156
     samp <- factorized$proportions$sample[zInclude, , drop = FALSE]
74
-    col <- grDevices::colorRampPalette(c("white",
157
+    col1 <- grDevices::colorRampPalette(c("white",
75 158
         "blue",
76
-        "#08306B",
77
-        "#006D2C",
159
+        "midnightblue",
160
+        "springgreen4",
78 161
         "yellowgreen",
79 162
         "yellow",
80 163
         "orange",
81 164
         "red"))(100)
82
-    breaks <- seq(0, 1, length.out = length(col))
83
-    g1 <- plotHeatmap(samp,
84
-        colorScheme = "sequential",
85
-        scaleRow = NULL,
86
-        clusterCell = FALSE,
87
-        clusterFeature = FALSE,
88
-        showNamesCell = TRUE,
89
-        showNamesFeature = TRUE,
90
-        breaks = breaks,
91
-        col = col,
92
-        main = "Absolute Probability")
165
+    breaks <- seq(0, 1, length.out = length(col1))
166
+
167
+    g1 <- ComplexHeatmap::Heatmap(matrix = samp,
168
+        col = circlize::colorRamp2(breaks, col1),
169
+        column_title = title1,
170
+        show_column_names = showColumnNames,
171
+        show_row_names = showRowNames,
172
+        row_names_gp = rowNamesgp,
173
+        column_names_gp = colNamesgp,
174
+        cluster_rows = clusterRows,
175
+        cluster_columns = clusterColumns,
176
+        show_heatmap_legend = showHeatmapLegend,
177
+        heatmap_legend_param = heatmapLegendParam)
93 178
 
94 179
     if (ncol(samp) > 1) {
95 180
         sampNorm <- normalizeCounts(samp,
96 181
             normalize = "proportion",
97 182
             transformationFun = sqrt,
98 183
             scaleFun = base::scale)
99
-        g2 <- plotHeatmap(sampNorm,
100
-            colorScheme = "divergent",
101
-            clusterCell = FALSE,
102
-            clusterFeature = FALSE,
103
-            showNamesCell = TRUE,
104
-            showNamesFeature = TRUE,
105
-            main = "Relative Abundance")
106
-        return(gridExtra::grid.arrange(g1, g2, ncol = 2))
184
+
185
+        g2 <- ComplexHeatmap::Heatmap(matrix = sampNorm,
186
+            col = col2,
187
+            column_title = title2,
188
+            show_column_names = showColumnNames,
189
+            show_row_names = showRowNames,
190
+            row_names_gp = rowNamesgp,
191
+            column_names_gp = colNamesgp,
192
+            cluster_rows = clusterRows,
193
+            cluster_columns = clusterColumns,
194
+            show_heatmap_legend = showHeatmapLegend,
195
+            heatmap_legend_param = heatmapLegendParam)
196
+        return(g1 + g2)
107 197
     } else {
108
-        return(gridExtra::grid.arrange(g1))
198
+        return(g1)
109 199
     }
110 200
 }
111 201
 
112 202
 
113
-.celdaProbabilityMapCG <- function(sce, useAssay, level) {
203
+.celdaProbabilityMapCG <- function(sce,
204
+    useAssay,
205
+    level,
206
+    ncols,
207
+    col2,
208
+    title1,
209
+    title2,
210
+    showColumnNames,
211
+    showRowNames,
212
+    rowNamesgp,
213
+    colNamesgp,
214
+    clusterRows,
215
+    clusterColumns,
216
+    showHeatmapLegend,
217
+    heatmapLegendParam) {
218
+
114 219
     counts <- SummarizedExperiment::assay(sce, i = useAssay)
115 220
     counts <- .processCounts(counts)
116 221
 
... ...
@@ -133,41 +238,40 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
133 238
             scaleFun = base::scale)
134 239
 
135 240
         percentile9 <- round(stats::quantile(pop, .9), digits = 2) * 100
136
-        col1 <- grDevices::colorRampPalette(c(
137
-            "#FFFFFF",
138
-            RColorBrewer::brewer.pal(n = 9, name = "Blues")
139
-        ))(percentile9)
140
-        col2 <- grDevices::colorRampPalette(c(
141
-            "#08306B",
142
-            c(
143
-                "#006D2C", "Yellowgreen", "Yellow", "Orange",
144
-                "Red"
145
-            )
146
-        ))(100 - percentile9)
147
-        col <- c(col1, col2)
148
-        breaks <- seq(0, 1, length.out = length(col))
149
-
150
-        g1 <- plotHeatmap(pop,
151
-            colorScheme = "sequential",
152
-            scaleRow = NULL,
153
-            clusterCell = FALSE,
154
-            clusterFeature = FALSE,
155
-            showNamesCell = TRUE,
156
-            showNamesFeature = TRUE,
157
-            breaks = breaks,
158
-            col = col,
159
-            main = "Absolute Probability")
160
-        g2 <- plotHeatmap(popNorm,
161
-            colorScheme = "divergent",
162
-            clusterCell = FALSE,
163
-            clusterFeature = FALSE,
164
-            showNamesCell = TRUE,
165
-            showNamesFeature = TRUE,
166
-            main = "Relative Expression")
167
-        gridExtra::grid.arrange(g1, g2, ncol = 2)
241
+        cols11 <- grDevices::colorRampPalette(c("white",
242
+            RColorBrewer::brewer.pal(n = 9, name = "Blues")))(percentile9)
243
+        cols12 <- grDevices::colorRampPalette(c("midnightblue",
244
+            c("springgreen4", "Yellowgreen", "Yellow", "Orange",
245
+                "Red")))(ncols - percentile9)
246
+        col1 <- c(cols11, cols12)
247
+        breaks <- seq(0, 1, length.out = length(col1))
248
+
249
+        g1 <- ComplexHeatmap::Heatmap(matrix = pop,
250
+            col = circlize::colorRamp2(breaks, col1),
251
+            column_title = title1,
252
+            show_column_names = showColumnNames,
253
+            show_row_names = showRowNames,
254
+            row_names_gp = rowNamesgp,
255
+            column_names_gp = colNamesgp,
256
+            cluster_rows = clusterRows,
257
+            cluster_columns = clusterColumns,
258
+            show_heatmap_legend = showHeatmapLegend,
259
+            heatmap_legend_param = heatmapLegendParam)
260
+        g2 <- ComplexHeatmap::Heatmap(matrix = popNorm,
261
+            col = col2,
262
+            column_title = title2,
263
+            show_column_names = showColumnNames,
264
+            show_row_names = showRowNames,
265
+            row_names_gp = rowNamesgp,
266
+            column_names_gp = colNamesgp,
267
+            cluster_rows = clusterRows,
268
+            cluster_columns = clusterColumns,
269
+            show_heatmap_legend = showHeatmapLegend,
270
+            heatmap_legend_param = heatmapLegendParam)
271
+        return(g1 + g2)
168 272
     } else {
169 273
         samp <- factorized$proportions$sample
170
-        col <- grDevices::colorRampPalette(c(
274
+        col1 <- grDevices::colorRampPalette(c(
171 275
             "white",
172 276
             "blue",
173 277
             "#08306B",
... ...
@@ -177,34 +281,39 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
177 281
             "orange",
178 282
             "red"
179 283
         ))(100)
180
-        breaks <- seq(0, 1, length.out = length(col))
181
-        g1 <- plotHeatmap(samp,
182
-            colorScheme = "sequential",
183
-            scaleRow = NULL,
184
-            clusterCell = FALSE,
185
-            clusterFeature = FALSE,
186
-            showNamesCell = TRUE,
187
-            showNamesFeature = TRUE,
188
-            breaks = breaks,
189
-            col = col,
190
-            main = "Absolute Probability")
284
+        breaks <- seq(0, 1, length.out = length(col1))
285
+
286
+        g1 <- ComplexHeatmap::Heatmap(matrix = samp,
287
+            col = circlize::colorRamp2(breaks, col1),
288
+            column_title = title1,
289
+            show_column_names = showColumnNames,
290
+            show_row_names = showRowNames,
291
+            row_names_gp = rowNamesgp,
292
+            column_names_gp = colNamesgp,
293
+            cluster_rows = clusterRows,
294
+            cluster_columns = clusterColumns,
295
+            show_heatmap_legend = showHeatmapLegend,
296
+            heatmap_legend_param = heatmapLegendParam)
191 297
 
192 298
         if (ncol(samp) > 1) {
193 299
             sampNorm <- normalizeCounts(factorized$counts$sample,
194 300
                 normalize = "proportion",
195 301
                 transformationFun = sqrt,
196
-                scaleFun = base::scale
197
-            )
198
-            g2 <- plotHeatmap(sampNorm,
199
-                colorScheme = "divergent",
200
-                clusterCell = FALSE,
201
-                clusterFeature = FALSE,
202
-                showNamesCell = TRUE,
203
-                showNamesFeature = TRUE,
204
-                main = "Relative Abundance")
205
-            gridExtra::grid.arrange(g1, g2, ncol = 2)
302
+                scaleFun = base::scale)
303
+            g2 <- ComplexHeatmap::Heatmap(matrix = sampNorm,
304
+                col = col2,
305
+                column_title = title2,
306
+                show_column_names = showColumnNames,
307
+                show_row_names = showRowNames,
308
+                row_names_gp = rowNamesgp,
309
+                column_names_gp = colNamesgp,
310
+                cluster_rows = clusterRows,
311
+                cluster_columns = clusterColumns,
312
+                show_heatmap_legend = showHeatmapLegend,
313
+                heatmap_legend_param = heatmapLegendParam)
314
+            return(g1 + g2)
206 315
         } else {
207
-            gridExtra::grid.arrange(g1)
316
+            return(g1 + g2)
208 317
         }
209 318
     }
210 319
 }
Browse code

multiple moduleHeatmap on same page. remove blank page

zhewa authored on 16/09/2020 15:50:01
Showing1 changed files
... ...
@@ -89,8 +89,7 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
89 89
         showNamesFeature = TRUE,
90 90
         breaks = breaks,
91 91
         col = col,
92
-        main = "Absolute Probability",
93
-        silent = TRUE)
92
+        main = "Absolute Probability")
94 93
 
95 94
     if (ncol(samp) > 1) {
96 95
         sampNorm <- normalizeCounts(samp,
... ...
@@ -103,11 +102,10 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
103 102
             clusterFeature = FALSE,
104 103
             showNamesCell = TRUE,
105 104
             showNamesFeature = TRUE,
106
-            main = "Relative Abundance",
107
-            silent = TRUE)
108
-        return(gridExtra::grid.arrange(g1$gtable, g2$gtable, ncol = 2))
105
+            main = "Relative Abundance")
106
+        return(gridExtra::grid.arrange(g1, g2, ncol = 2))
109 107
     } else {
110
-        return(gridExtra::grid.arrange(g1$gtable))
108
+        return(gridExtra::grid.arrange(g1))
111 109
     }
112 110
 }
113 111
 
... ...
@@ -158,19 +156,15 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
158 156
             showNamesFeature = TRUE,
159 157
             breaks = breaks,
160 158
             col = col,
161
-            main = "Absolute Probability",
162
-            silent = TRUE
163
-        )
159
+            main = "Absolute Probability")
164 160
         g2 <- plotHeatmap(popNorm,
165 161
             colorScheme = "divergent",
166 162
             clusterCell = FALSE,
167 163
             clusterFeature = FALSE,
168 164
             showNamesCell = TRUE,
169 165
             showNamesFeature = TRUE,
170
-            main = "Relative Expression",
171
-            silent = TRUE
172
-        )
173
-        gridExtra::grid.arrange(g1$gtable, g2$gtable, ncol = 2)
166
+            main = "Relative Expression")
167
+        gridExtra::grid.arrange(g1, g2, ncol = 2)
174 168
     } else {
175 169
         samp <- factorized$proportions$sample
176 170
         col <- grDevices::colorRampPalette(c(
... ...
@@ -193,9 +187,7 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
193 187
             showNamesFeature = TRUE,
194 188
             breaks = breaks,
195 189
             col = col,
196
-            main = "Absolute Probability",
197
-            silent = TRUE
198
-        )
190
+            main = "Absolute Probability")
199 191
 
200 192
         if (ncol(samp) > 1) {
201 193
             sampNorm <- normalizeCounts(factorized$counts$sample,
... ...
@@ -209,12 +201,10 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
209 201
                 clusterFeature = FALSE,
210 202
                 showNamesCell = TRUE,
211 203
                 showNamesFeature = TRUE,
212
-                main = "Relative Abundance",
213
-                silent = TRUE
214
-            )
215
-            gridExtra::grid.arrange(g1$gtable, g2$gtable, ncol = 2)
204
+                main = "Relative Abundance")
205
+            gridExtra::grid.arrange(g1, g2, ncol = 2)
216 206
         } else {
217
-            gridExtra::grid.arrange(g1$gtable)
207
+            gridExtra::grid.arrange(g1)
218 208
         }
219 209
     }
220 210
 }
Browse code

celdaModel(sce, altExpName = altExpName)

zhewa authored on 14/07/2020 07:13:00
Showing1 changed files
... ...
@@ -40,13 +40,13 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
40 40
 
41 41
         altExp <- SingleCellExperiment::altExp(sce, altExpName)
42 42
         level <- match.arg(level)
43
-        if (celdaModel(sce) == "celda_C") {
43
+        if (celdaModel(sce, altExpName = altExpName) == "celda_C") {
44 44
             if (level == "cellPopulation") {
45 45
                 warning("'level' has been set to 'sample'")
46 46
             }
47 47
             pm <- .celdaProbabilityMapC(sce = altExp, useAssay = useAssay,
48 48
                 level = "sample")
49
-        } else if (celdaModel(sce) == "celda_CG") {
49
+        } else if (celdaModel(sce, altExpName = altExpName) == "celda_CG") {
50 50
             pm <- .celdaProbabilityMapCG(sce = altExp, useAssay = useAssay,
51 51
                 level = level)
52 52
         } else {
Browse code

fix travis errors

zhewa authored on 14/07/2020 05:00:58
Showing1 changed files
... ...
@@ -67,7 +67,7 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
67 67
         sce)$celda_cell_cluster,
68 68
         S4Vectors::metadata(sce)$celda_parameters$K) > 0)
69 69
 
70
-    factorized <- .factorizeMatrixCelda_C(x = sce, useAssay = useAssay,
70
+    factorized <- .factorizeMatrixCelda_C(sce, useAssay = useAssay,
71 71
         type = "proportion")
72 72
 
73 73
     samp <- factorized$proportions$sample[zInclude, , drop = FALSE]
Browse code

fix bug

zhewa authored on 13/07/2020 08:38:07
Showing1 changed files
... ...
@@ -38,7 +38,7 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
38 38
     function(sce, useAssay = "counts", altExpName = "featureSubset",
39 39
         level = c("cellPopulation", "sample")) {
40 40
 
41
-        altExp <- SingleCellExperiment::altExp(x, altExpName)
41
+        altExp <- SingleCellExperiment::altExp(sce, altExpName)
42 42
         level <- match.arg(level)
43 43
         if (celdaModel(sce) == "celda_C") {
44 44
             if (level == "cellPopulation") {
Browse code

add altExpName = "featureSubset". Store results in altExp(sce)

zhewa authored on 13/07/2020 06:58:29
Showing1 changed files
... ...
@@ -6,6 +6,8 @@
6 6
 #'  returned by \link{celda_C}, \link{celda_G}, or \link{celda_CG}.
7 7
 #' @param useAssay A string specifying which \link[SummarizedExperiment]{assay}
8 8
 #'  slot to use. Default "counts".
9
+#' @param altExpName The name for the \link[SingleCellExperiment]{altExp} slot
10
+#'  to use. Default "featureSubset".
9 11
 #' @param level Character. One of "cellPopulation" or "Sample".
10 12
 #'  "cellPopulation" will display the absolute probabilities and relative
11 13
 #'  normalized expression of each module in each cell population.
... ...
@@ -33,19 +35,23 @@ setGeneric("celdaProbabilityMap",
33 35
 #' celdaProbabilityMap(sceCeldaCG)
34 36
 #' @export
35 37
 setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
36
-    function(sce, useAssay = "counts", level = c("cellPopulation", "sample")) {
38
+    function(sce, useAssay = "counts", altExpName = "featureSubset",
39
+        level = c("cellPopulation", "sample")) {
40
+
41
+        altExp <- SingleCellExperiment::altExp(x, altExpName)
37 42
         level <- match.arg(level)
38 43
         if (celdaModel(sce) == "celda_C") {
39 44
             if (level == "cellPopulation") {
40 45
                 warning("'level' has been set to 'sample'")
41 46
             }
42
-            pm <- .celdaProbabilityMapC(sce = sce, useAssay = useAssay,
47
+            pm <- .celdaProbabilityMapC(sce = altExp, useAssay = useAssay,
43 48
                 level = "sample")
44 49
         } else if (celdaModel(sce) == "celda_CG") {
45
-            pm <- .celdaProbabilityMapCG(sce = sce, useAssay = useAssay,
50
+            pm <- .celdaProbabilityMapCG(sce = altExp, useAssay = useAssay,
46 51
                 level = level)
47 52
         } else {
48
-            stop("S4Vectors::metadata(sce)$celda_parameters$model must be",
53
+            stop("S4Vectors::metadata(altExp(sce,",
54
+                " altExpName))$celda_parameters$model must be",
49 55
                 " one of 'celda_C', or 'celda_CG'!")
50 56
         }
51 57
         return(pm)
... ...
@@ -57,10 +63,12 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
57 63
     counts <- SummarizedExperiment::assay(sce, i = useAssay)
58 64
     counts <- .processCounts(counts)
59 65
 
60
-    zInclude <- which(tabulate(celdaClusters(sce),
66
+    zInclude <- which(tabulate(SummarizedExperiment::colData(
67
+        sce)$celda_cell_cluster,
61 68
         S4Vectors::metadata(sce)$celda_parameters$K) > 0)
62 69
 
63
-    factorized <- factorizeMatrix(x = sce, useAssay = useAssay)
70
+    factorized <- .factorizeMatrixCelda_C(x = sce, useAssay = useAssay,
71
+        type = "proportion")
64 72
 
65 73
     samp <- factorized$proportions$sample[zInclude, , drop = FALSE]
66 74
     col <- grDevices::colorRampPalette(c("white",
... ...
@@ -108,22 +116,23 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
108 116
     counts <- SummarizedExperiment::assay(sce, i = useAssay)
109 117
     counts <- .processCounts(counts)
110 118
 
111
-    factorized <- factorizeMatrix(sce, useAssay)
112
-    zInclude <- which(tabulate(celdaClusters(sce),
119
+    factorized <- .factorizeMatrixCelda_CG(sce, useAssay,
120
+        type = c("counts", "proportion"))
121
+    zInclude <- which(tabulate(SummarizedExperiment::colData(
122
+        sce)$celda_cell_cluster,
113 123
         S4Vectors::metadata(sce)$celda_parameters$K) > 0)
114
-    yInclude <- which(tabulate(celdaModules(sce),
124
+    yInclude <- which(tabulate(SummarizedExperiment::rowData(
125
+        sce)$celda_feature_module,
115 126
         S4Vectors::metadata(sce)$celda_parameters$L) > 0)
116 127
 
117 128
     if (level == "cellPopulation") {
118 129
         pop <- factorized$proportions$cellPopulation[yInclude,
119 130
             zInclude,
120
-            drop = FALSE
121
-            ]
131
+            drop = FALSE]
122 132
         popNorm <- normalizeCounts(pop,
123 133
             normalize = "proportion",
124 134
             transformationFun = sqrt,
125
-            scaleFun = base::scale
126
-        )
135
+            scaleFun = base::scale)
127 136
 
128 137
         percentile9 <- round(stats::quantile(pop, .9), digits = 2) * 100
129 138
         col1 <- grDevices::colorRampPalette(c(
Browse code

fix lint

zhewa authored on 25/05/2020 08:01:18
Showing1 changed files
... ...
@@ -209,4 +209,3 @@ setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
209 209
         }
210 210
     }
211 211
 }
212
-
Browse code

use reducedDim for DR results, update examples

zhewa authored on 24/05/2020 08:14:12
Showing1 changed files
... ...
@@ -16,9 +16,6 @@
16 16
 #' @param ... Additional parameters.
17 17
 #' @seealso \link{celda_C} for clustering cells. \link{celda_CG} for
18 18
 #'  clustering features and cells
19
-#' @examples
20
-#' data(sceCeldaCG)
21
-#' celdaProbabilityMap(sceCeldaCG)
22 19
 #' @return A grob containing the specified plots
23 20
 #' @export
24 21
 setGeneric("celdaProbabilityMap",
... ...
@@ -31,6 +28,9 @@ setGeneric("celdaProbabilityMap",
31 28
 #' @importFrom gridExtra grid.arrange
32 29
 #' @importFrom RColorBrewer brewer.pal
33 30
 #' @importFrom grDevices colorRampPalette
31
+#' @examples
32
+#' data(sceCeldaCG)
33
+#' celdaProbabilityMap(sceCeldaCG)
34 34
 #' @export
35 35
 setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
36 36
     function(sce, useAssay = "counts", level = c("cellPopulation", "sample")) {
Browse code

sce vignettes

zhewa authored on 23/05/2020 07:26:57
Showing1 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,212 @@
1
+#' @title Probability map for a celda model
2
+#' @description Renders probability and relative expression heatmaps to
3
+#'  visualize the relationship between features and cell populations (or cell
4
+#'  populations and samples).
5
+#' @param sce A \link[SingleCellExperiment]{SingleCellExperiment} object
6
+#'  returned by \link{celda_C}, \link{celda_G}, or \link{celda_CG}.
7
+#' @param useAssay A string specifying which \link[SummarizedExperiment]{assay}
8
+#'  slot to use. Default "counts".
9
+#' @param level Character. One of "cellPopulation" or "Sample".
10
+#'  "cellPopulation" will display the absolute probabilities and relative
11
+#'  normalized expression of each module in each cell population.
12
+#'  \strong{\code{level = "cellPopulation"} only works for celda_CG \code{sce}
13
+#'  objects}. "sample" will display the absolute probabilities and relative
14
+#'  normalized abundance of each cell population in each sample. Default
15
+#'  "cellPopulation".
16
+#' @param ... Additional parameters.
17
+#' @seealso \link{celda_C} for clustering cells. \link{celda_CG} for
18
+#'  clustering features and cells
19
+#' @examples
20
+#' data(sceCeldaCG)
21
+#' celdaProbabilityMap(sceCeldaCG)
22
+#' @return A grob containing the specified plots
23
+#' @export
24
+setGeneric("celdaProbabilityMap",
25
+    function(sce, ...) {
26
+        standardGeneric("celdaProbabilityMap")
27
+    })
28
+
29
+
30
+#' @rdname celdaProbabilityMap
31
+#' @importFrom gridExtra grid.arrange
32
+#' @importFrom RColorBrewer brewer.pal
33
+#' @importFrom grDevices colorRampPalette
34
+#' @export
35
+setMethod("celdaProbabilityMap", signature(sce = "SingleCellExperiment"),
36
+    function(sce, useAssay = "counts", level = c("cellPopulation", "sample")) {
37
+        level <- match.arg(level)
38
+        if (celdaModel(sce) == "celda_C") {
39
+            if (level == "cellPopulation") {
40
+                warning("'level' has been set to 'sample'")
41
+            }
42
+            pm <- .celdaProbabilityMapC(sce = sce, useAssay = useAssay,
43
+                level = "sample")
44
+        } else if (celdaModel(sce) == "celda_CG") {
45
+            pm <- .celdaProbabilityMapCG(sce = sce, useAssay = useAssay,
46
+                level = level)
47
+        } else {
48
+            stop("S4Vectors::metadata(sce)$celda_parameters$model must be",
49
+                " one of 'celda_C', or 'celda_CG'!")
50
+        }
51
+        return(pm)
52
+    }
53
+)
54
+
55
+
56
+.celdaProbabilityMapC <- function(sce, useAssay, level) {
57
+    counts <- SummarizedExperiment::assay(sce, i = useAssay)
58
+    counts <- .processCounts(counts)
59
+
60
+    zInclude <- which(tabulate(celdaClusters(sce),
61
+        S4Vectors::metadata(sce)$celda_parameters$K) > 0)
62
+
63
+    factorized <- factorizeMatrix(x = sce, useAssay = useAssay)
64
+
65
+    samp <- factorized$proportions$sample[zInclude, , drop = FALSE]
66
+    col <- grDevices::colorRampPalette(c("white",
67
+        "blue",
68
+        "#08306B",
69
+        "#006D2C",
70
+        "yellowgreen",
71
+        "yellow",
72
+        "orange",
73
+        "red"))(100)
74
+    breaks <- seq(0, 1, length.out = length(col))
75
+    g1 <- plotHeatmap(samp,
76
+        colorScheme = "sequential",
77
+        scaleRow = NULL,
78
+        clusterCell = FALSE,
79
+        clusterFeature = FALSE,
80
+        showNamesCell = TRUE,
81
+        showNamesFeature = TRUE,
82
+        breaks = breaks,
83
+        col = col,
84
+        main = "Absolute Probability",
85
+        silent = TRUE)
86
+
87
+    if (ncol(samp) > 1) {
88
+        sampNorm <- normalizeCounts(samp,
89
+            normalize = "proportion",
90
+            transformationFun = sqrt,
91
+            scaleFun = base::scale)
92
+        g2 <- plotHeatmap(sampNorm,
93
+            colorScheme = "divergent",
94
+            clusterCell = FALSE,
95
+            clusterFeature = FALSE,
96
+            showNamesCell = TRUE,
97
+            showNamesFeature = TRUE,
98
+            main = "Relative Abundance",
99
+            silent = TRUE)
100
+        return(gridExtra::grid.arrange(g1$gtable, g2$gtable, ncol = 2))
101
+    } else {
102
+        return(gridExtra::grid.arrange(g1$gtable))
103
+    }
104
+}
105
+
106
+
107
+.celdaProbabilityMapCG <- function(sce, useAssay, level) {
108
+    counts <- SummarizedExperiment::assay(sce, i = useAssay)
109
+    counts <- .processCounts(counts)
110
+
111
+    factorized <- factorizeMatrix(sce, useAssay)
112
+    zInclude <- which(tabulate(celdaClusters(sce),
113
+        S4Vectors::metadata(sce)$celda_parameters$K) > 0)
114
+    yInclude <- which(tabulate(celdaModules(sce),
115
+        S4Vectors::metadata(sce)$celda_parameters$L) > 0)
116
+
117
+    if (level == "cellPopulation") {
118
+        pop <- factorized$proportions$cellPopulation[yInclude,
119
+            zInclude,
120
+            drop = FALSE
121
+            ]
122
+        popNorm <- normalizeCounts(pop,
123
+            normalize = "proportion",
124
+            transformationFun = sqrt,
125
+            scaleFun = base::scale
126
+        )
127
+
128
+        percentile9 <- round(stats::quantile(pop, .9), digits = 2) * 100
129
+        col1 <- grDevices::colorRampPalette(c(
130
+            "#FFFFFF",
131
+            RColorBrewer::brewer.pal(n = 9, name = "Blues")
132
+        ))(percentile9)
133
+        col2 <- grDevices::colorRampPalette(c(
134
+            "#08306B",
135
+            c(
136
+                "#006D2C", "Yellowgreen", "Yellow", "Orange",
137
+                "Red"
138
+            )
139
+        ))(100 - percentile9)
140
+        col <- c(col1, col2)
141
+        breaks <- seq(0, 1, length.out = length(col))
142
+
143
+        g1 <- plotHeatmap(pop,
144
+            colorScheme = "sequential",
145
+            scaleRow = NULL,
146
+            clusterCell = FALSE,
147
+            clusterFeature = FALSE,
148
+            showNamesCell = TRUE,
149
+            showNamesFeature = TRUE,
150
+            breaks = breaks,
151
+            col = col,
152
+            main = "Absolute Probability",
153
+            silent = TRUE
154
+        )
155
+        g2 <- plotHeatmap(popNorm,
156
+            colorScheme = "divergent",
157
+            clusterCell = FALSE,
158
+            clusterFeature = FALSE,
159
+            showNamesCell = TRUE,
160
+            showNamesFeature = TRUE,
161
+            main = "Relative Expression",
162
+            silent = TRUE
163
+        )
164
+        gridExtra::grid.arrange(g1$gtable, g2$gtable, ncol = 2)
165
+    } else {
166
+        samp <- factorized$proportions$sample
167
+        col <- grDevices::colorRampPalette(c(
168
+            "white",
169
+            "blue",
170
+            "#08306B",
171
+            "#006D2C",
172
+            "yellowgreen",
173
+            "yellow",
174
+            "orange",
175
+            "red"
176
+        ))(100)
177
+        breaks <- seq(0, 1, length.out = length(col))
178
+        g1 <- plotHeatmap(samp,
179
+            colorScheme = "sequential",
180
+            scaleRow = NULL,
181
+            clusterCell = FALSE,
182
+            clusterFeature = FALSE,
183
+            showNamesCell = TRUE,
184
+            showNamesFeature = TRUE,
185
+            breaks = breaks,
186
+            col = col,
187
+            main = "Absolute Probability",
188
+            silent = TRUE
189
+        )
190
+
191
+        if (ncol(samp) > 1) {
192
+            sampNorm <- normalizeCounts(factorized$counts$sample,
193
+                normalize = "proportion",
194
+                transformationFun = sqrt,
195
+                scaleFun = base::scale
196
+            )
197
+            g2 <- plotHeatmap(sampNorm,
198
+                colorScheme = "divergent",
199
+                clusterCell = FALSE,
200
+                clusterFeature = FALSE,
201
+                showNamesCell = TRUE,
202
+                showNamesFeature = TRUE,
203
+                main = "Relative Abundance",
204
+                silent = TRUE
205
+            )
206
+            gridExtra::grid.arrange(g1$gtable, g2$gtable, ncol = 2)
207
+        } else {
208
+            gridExtra::grid.arrange(g1$gtable)
209
+        }
210
+    }
211
+}
212
+