Browse code

Finish up heatmap updates

Yichen Wang authored on 08/09/2022 01:41:38
Showing1 changed files
... ...
@@ -1,115 +1,3 @@
1
-#' Extract columns from row/colData and transfer to factors
2
-#' @param inSCE \linkS4class{SingleCellExperiment} inherited object.
3
-#' @param axis Choose from \code{"col"} or \code{"row"}.
4
-#' @param columns character vector. The columns needed to be extracted. If
5
-#' \code{NULL}, will return an empty \code{data.frame} with matched row
6
-#' names. Default \code{NULL}.
7
-#' @param index Valid index to subset the col/row.
8
-#' @return A \code{data.frame} object.
9
-#' @noRd
10
-.extractSCEAnnotation <- function(inSCE, axis = NULL, columns = NULL,
11
-                                  index = NULL){
12
-    if(is.null(axis) || !axis %in% c('col', 'row')){
13
-        stop("axis should be 'col' or 'row'.")
14
-    } else if(axis == 'col'){
15
-        data <- SummarizedExperiment::colData(inSCE)
16
-    } else if(axis == 'row'){
17
-        data <- SummarizedExperiment::rowData(inSCE)
18
-    }
19
-    if(!is.null(index)){
20
-        data <- data[index, , drop = FALSE]
21
-    }
22
-    if(is.null(columns)){
23
-        return(data.frame(row.names = rownames(data)))
24
-    } else {
25
-        df <- data[, columns, drop = FALSE]
26
-        for(i in colnames(df)){
27
-            if(is.character(df[[i]]) || is.logical(df[[i]])){
28
-                # Only converting character and logical columns, but not integer
29
-                # cluster labels..
30
-                df[[i]] <- as.factor(df[[i]])
31
-            }
32
-        }
33
-        return(df)
34
-    }
35
-}
36
-
37
-#' Generate distinct colors for all categorical col/rowData entries.
38
-#' Character columns will be considered as well as all-integer columns. Any
39
-#' column with all-distinct values will be excluded.
40
-#' @param inSCE \linkS4class{SingleCellExperiment} inherited object.
41
-#' @param axis Choose from \code{"col"} or \code{"row"}.
42
-#' @param colorGen A function that generates color code vector by giving an
43
-#' integer for the number of colors. Alternatively,
44
-#' \code{\link{rainbow}}. Default \code{\link{distinctColors}}.
45
-#' @return A \code{list} object containing distinct colors mapped to all
46
-#' possible categorical entries in \code{rowData(inSCE)} or
47
-#' \code{colData(inSCE)}.
48
-#' @author Yichen Wang
49
-#' @noRd
50
-dataAnnotationColor <- function(inSCE, axis = NULL,
51
-                                colorGen = distinctColors){
52
-    if(!is.null(axis) && axis == 'col'){
53
-        data <- SummarizedExperiment::colData(inSCE)
54
-    } else if(!is.null(axis) && axis == 'row'){
55
-        data <- SummarizedExperiment::rowData(inSCE)
56
-    } else {
57
-        stop('please specify "col" or "row"')
58
-    }
59
-    nColor <- 0
60
-    for(i in names(data)){
61
-        if(length(grep('counts', i)) > 0){
62
-            next
63
-        }
64
-        column <- stats::na.omit(data[[i]])
65
-        if(is.numeric(column)){
66
-            if(!all(as.integer(column) == column)){
67
-                # Temporarily the way to tell whether numeric categorical
68
-                next
69
-            }
70
-        }
71
-        if(is.factor(column)){
72
-            uniqLevel <- levels(column)
73
-        } else {
74
-            uniqLevel <- unique(column)
75
-        }
76
-        if(!length(uniqLevel) == nrow(data)){
77
-            # Don't generate color for all-uniq annotation (such as IDs/symbols)
78
-            nColor <- nColor + length(uniqLevel)
79
-        }
80
-    }
81
-    if (nColor == 0) {
82
-      return(list())
83
-    }
84
-    allColors <- colorGen(nColor)
85
-    nUsed <- 0
86
-    allColorMap <- list()
87
-    for(i in names(data)){
88
-        if(length(grep('counts', i)) > 0){
89
-            next
90
-        }
91
-        column <- stats::na.omit(data[[i]])
92
-        if(is.numeric(column)){
93
-            if(!all(as.integer(column) == column)){
94
-                # Temporarily the way to tell whether numeric categorical
95
-                next
96
-            }
97
-        }
98
-        if(is.factor(column)){
99
-            uniqLevel <- levels(column)
100
-        } else {
101
-            uniqLevel <- unique(column)
102
-        }
103
-        if(!length(uniqLevel) == nrow(data)){
104
-            subColors <- allColors[(nUsed+1):(nUsed+length(uniqLevel))]
105
-            names(subColors) <- uniqLevel
106
-            allColorMap[[i]] <- subColors
107
-            nUsed <- nUsed + length(uniqLevel)
108
-        }
109
-    }
110
-    return(allColorMap)
111
-}
112
-
113 1
 #' Plot heatmap of using data stored in SingleCellExperiment Object
114 2
 #' @rdname plotSCEHeatmap
115 3
 #' @param inSCE \linkS4class{SingleCellExperiment} inherited object.
... ...
@@ -142,6 +30,12 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
142 30
 #' \code{plotSCEDimReduceHeatmap}. Default \code{NULL}.
143 31
 #' @param colDataName character. The column name(s) in \code{colData} that need
144 32
 #' to be added to the annotation. Default \code{NULL}.
33
+#' @param aggregateRow Feature variable for aggregating the heatmap by row. Can
34
+#' be a vector or a \code{rowData} column name for feature variable. Multiple
35
+#' variables are allowed. Default \code{NULL}.
36
+#' @param aggregateCol Cell variable for aggregating the heatmap by column. Can
37
+#' be a vector or a \code{colData} column name for cell variable. Multiple
38
+#' variables are allowed. Default \code{NULL}.
145 39
 #' @param featureAnnotations \code{data.frame}, with \code{rownames} containing
146 40
 #' all the features going to be plotted. Character columns should be factors.
147 41
 #' Default \code{NULL}.
... ...
@@ -156,6 +50,8 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
156 50
 #' cell labeling. Should match the entries in the \code{cellAnnotations} or
157 51
 #' \code{colDataName}. For each entry, there should be a list/vector of colors
158 52
 #' named with categories. Default \code{NULL}.
53
+#' @param palette Choose from \code{"ggplot"}, \code{"celda"} or \code{"random"}
54
+#' to generate unique category colors.
159 55
 #' @param rowSplitBy character. Do semi-heatmap based on the grouping of
160 56
 #' this(these) annotation(s). Should exist in either \code{rowDataName} or
161 57
 #' \code{names(featureAnnotations)}. Default \code{NULL}.
... ...
@@ -197,76 +93,103 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
197 93
 #' @return A \code{\link[ggplot2]{ggplot}} object.
198 94
 #' @export
199 95
 #' @author Yichen Wang
200
-plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
201
-    featureIndex = NULL, cellIndex = NULL,
202
-    scale = TRUE, trim = c(-2, 2),
203
-    featureIndexBy = 'rownames', cellIndexBy = 'rownames',
204
-    rowDataName = NULL, colDataName = NULL,
205
-    featureAnnotations = NULL, cellAnnotations = NULL,
206
-    featureAnnotationColor = NULL, cellAnnotationColor = NULL,
207
-    rowSplitBy = NULL, colSplitBy = NULL,
208
-    rowLabel = FALSE, colLabel = FALSE,
209
-    rowLabelSize = 8, colLabelSize = 8,
210
-    rowDend = TRUE, colDend = TRUE,
211
-    title = NULL, rowTitle = 'Genes', colTitle = 'Cells',
212
-    rowGap = grid::unit(0, 'mm'), colGap = grid::unit(0, 'mm'),
213
-    border = FALSE, colorScheme = NULL, ...){
214
-    # Check input
215
-    if(!inherits(inSCE, "SingleCellExperiment")){
216
-        stop('Input object is not a valid SingleCellExperiment object.')
217
-    }
218
-    if(!useAssay %in% expDataNames(inSCE)){
219
-        stop('Specified assay does not exist in input SCE object')
220
-    }
221
-    if(!all(rowDataName %in% names(SummarizedExperiment::rowData(inSCE)))){
222
-        notIn <- !rowDataName %in% names(SummarizedExperiment::rowData(inSCE))
223
-        notIn <- rowDataName[notIn]
224
-        stop('rowDataName - Specified columns: ', paste(notIn, collapse = ', '),
225
-             ', not found. ')
226
-    }
227
-    if(!all(colDataName %in% names(SummarizedExperiment::colData(inSCE)))){
228
-        notIn <- !colDataName %in% names(SummarizedExperiment::colData(inSCE))
229
-        notIn <- colDataName[notIn]
230
-        stop('colDataName - Specified columns: ', paste(notIn, collapse = ', '),
231
-             ', not found. ')
232
-    }
233
-    if(!is.null(rowSplitBy) &&
234
-       any(!rowSplitBy %in% c(rowDataName, names(featureAnnotations)))){
235
-        notIn <- !rowSplitBy %in% c(names(SummarizedExperiment::rowData(inSCE)),
236
-                                    featureAnnotations)
237
-        notIn <- rowSplitBy[notIn]
238
-        stop('rowSplitBy - Specified columns: ', paste(notIn, collapse = ', '),
239
-             ', not found. ')
240
-    }
241
-    if(!is.null(colSplitBy) &&
242
-       any(!colSplitBy %in% c(colDataName, names(cellAnnotations)))){
243
-        notIn <- !colSplitBy %in% c(names(SummarizedExperiment::colData(inSCE)),
244
-                                    cellAnnotations)
245
-        notIn <- colSplitBy[notIn]
246
-        stop('colSplitBy - Specified columns: ', paste(notIn, collapse = ', '),
247
-             ', not found. ')
248
-    }
96
+#' @importFrom scuttle aggregateAcrossCells aggregateAcrossFeatures
97
+#' @importFrom SingleCellExperiment SingleCellExperiment
98
+#' @importFrom SummarizedExperiment colData assayNames<-
99
+plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', useReducedDim = NULL,
100
+                           doLog = FALSE, featureIndex = NULL, cellIndex = NULL,
101
+                           scale = TRUE, trim = c(-2, 2),
102
+                           featureIndexBy = 'rownames',
103
+                           cellIndexBy = 'rownames',
104
+                           rowDataName = NULL, colDataName = NULL,
105
+                           aggregateRow = NULL, aggregateCol = NULL,
106
+                           featureAnnotations = NULL, cellAnnotations = NULL,
107
+                           featureAnnotationColor = NULL,
108
+                           cellAnnotationColor = NULL,
109
+                           palette = c("ggplot", "celda", "random"),
110
+                           rowSplitBy = NULL, colSplitBy = NULL,
111
+                           rowLabel = FALSE, colLabel = FALSE,
112
+                           rowLabelSize = 6, colLabelSize = 6,
113
+                           rowDend = TRUE, colDend = TRUE,
114
+                           title = NULL, rowTitle = 'Features',
115
+                           colTitle = 'Cells',
116
+                           rowGap = grid::unit(0, 'mm'),
117
+                           colGap = grid::unit(0, 'mm'),
118
+                           border = FALSE, colorScheme = NULL, ...){
119
+    palette <- match.arg(palette)
249 120
     # STAGE 1: Create clean SCE object with only needed information ####
250
-
251
-
252
-
253
-    # STAGE 2: Subset as needed ####
254
-    # Manage feature subsetting
255
-    if(is.null(featureIndex)){
256
-        featureIndex <- seq(nrow(inSCE))
257
-    } else if (is.character(featureIndex)) {
258
-        featureIndex <- retrieveSCEIndex(inSCE, featureIndex, axis = "row",
259
-                                         by = featureIndexBy)
260
-    } else if (is.logical(featureIndex)) {
261
-        if (length(featureIndex) != nrow(inSCE)) {
262
-            stop("Logical index length does not match nrow(inSCE)")
121
+    ## .selectSCEMatrix, .manageCellVar and .manageFeatureVar perform checks
122
+    useMat <- .selectSCEMatrix(inSCE, useAssay = useAssay,
123
+                               useReducedDim = useReducedDim,
124
+                               returnMatrix = TRUE, cellAsCol = TRUE)
125
+    useAssay <- useMat$names$useAssay
126
+    useReducedDim <- useMat$names$useReducedDim
127
+    useData <- ifelse(!is.null(useAssay), useAssay, useReducedDim)
128
+    ### cell annotation
129
+    colDataName <- unique(c(colDataName, aggregateCol))
130
+    colDataAnns <- lapply(colDataName, function(x) .manageCellVar(inSCE, x))
131
+    if (length(colDataName) > 0)
132
+        colDataAnns <- data.frame(colDataAnns, row.names = colnames(inSCE))
133
+    else
134
+        colDataAnns <- data.frame(row.names = colnames(inSCE))
135
+    colnames(colDataAnns) <- colDataName
136
+    cellAnnotations <- .mergeAnnotationDF(colDataAnns, cellAnnotations)
137
+    if (!is.null(colSplitBy) &&
138
+        any(!colSplitBy %in% colnames(cellAnnotations)))
139
+        stop('Specified `colSplitBy` variables not found.')
140
+    if (isTRUE(colLabel)) {
141
+        colLabelName <- colnames(inSCE)
142
+    } else if (isFALSE(colLabel)) {
143
+        colLabelName <- NULL
144
+    } else {
145
+        colLabelName <- .manageCellVar(inSCE, colLabel)
146
+        colLabel <- TRUE
147
+    }
148
+    ### feature annotation
149
+    rowDataAnns <- data.frame(row.names = rownames(useMat$mat))
150
+    if (!is.null(useAssay)) {
151
+        # When using reducedDim, no rowData can be applied
152
+        rowDataName <- unique(c(rowDataName, aggregateRow))
153
+        rowDataAnns <- lapply(rowDataName, function(x) .manageFeatureVar(inSCE, x))
154
+        if (length(rowDataName) > 0)
155
+            rowDataAnns <- data.frame(rowDataAnns, row.names = rownames(inSCE))
156
+        else
157
+            rowDataAnns <- data.frame(row.names = rownames(inSCE))
158
+        colnames(rowDataAnns) <- rowDataName
159
+    }
160
+    # But customized featureAnnotations should work
161
+    featureAnnotations <- .mergeAnnotationDF(rowDataAnns, featureAnnotations)
162
+    if (!is.null(rowSplitBy) &&
163
+        any(!rowSplitBy %in% colnames(featureAnnotations)))
164
+        stop('Specified `rowSplitBy` variables not found.')
165
+    if (isTRUE(rowLabel)) {
166
+        rowLabelName <- rownames(useMat$mat)
167
+    } else if (isFALSE(rowLabel)) {
168
+        rowLabelName <- NULL
169
+    } else {
170
+        if (!is.null(useAssay)) {
171
+            rowLabelName <- .manageFeatureVar(inSCE, rowLabel)
172
+            rowLabel <- TRUE
173
+        } else {
174
+            # Using customized rowLabel for reducedDim
175
+            if (length(rowLabel) != nrow(useMat$mat))
176
+                stop("Length of `rowLabel` does not match nrow of specified ",
177
+                     "`useReducedDim`")
178
+            rowLabelName <- rowLabel
179
+            rowLabel <- TRUE
263 180
         }
264
-        featureIndex <- which(featureIndex)
265 181
     }
182
+    ### create SCE object
183
+    SCE <- SingleCellExperiment(assay = list(useMat$mat),
184
+                                colData = cellAnnotations,
185
+                                rowData = featureAnnotations)
186
+    assayNames(SCE) <- useData
187
+    # STAGE 2: Subset SCE object as needed ####
266 188
     # Manage cell subsetting
267 189
     if(is.null(cellIndex)){
268
-        cellIndex <- seq(ncol(inSCE))
190
+        cellIndex <- seq(ncol(SCE))
269 191
     } else if (is.character(cellIndex)) {
192
+        # cellIndexBy not necessarily included in new "SCE"
270 193
         cellIndex <- retrieveSCEIndex(inSCE, cellIndex, axis = "col",
271 194
                                       by = cellIndexBy)
272 195
     } else if (is.logical(cellIndex)) {
... ...
@@ -275,206 +198,113 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
275 198
         }
276 199
         cellIndex <- which(cellIndex)
277 200
     }
278
-    ## Customized row text labeling
279
-    rowLabelText <- rownames(inSCE)[featureIndex]
280
-    if(!is.logical(rowLabel)){
281
-        if (is.null(rowLabel)) {
282
-            rowLabel <- FALSE
283
-        } else if (is.character(rowLabel) && length(rowLabel) == 1) {
284
-            if (!rowLabel %in% names(SummarizedExperiment::rowData(inSCE))) {
285
-                stop('"rowLabel": ', rowLabel, ' is not a column of ',
286
-                     'rowData(inSCE).')
287
-            }
288
-            rowLabelText <- SummarizedExperiment::rowData(inSCE)[featureIndex,
289
-                                                                 rowLabel]
290
-            rowLabel <- TRUE
291
-        } else if (length(rowLabel) == nrow(inSCE)) {
292
-            rowLabelText <- rowLabel[featureIndex]
293
-            rowLabel <- TRUE
294
-        } else if (length(rowLabel) == length(featureIndex)) {
295
-            rowLabelText <- rowLabel
296
-            rowLabel <- TRUE
297
-        } else {
298
-            stop('Invalid "rowLabel". Use TRUE/FALSE, a column name of ',
299
-                 'rowData(inSCE), or a vector as the same length of ',
300
-                 'nrow(inSCE) or the subsetted number of features.')
301
-        }
302
-    }
303
-    ## Customized col text labeling
304
-    colLabelText <- colnames(inSCE)[cellIndex]
305
-    if(!is.logical(colLabel)){
306
-        if(is.character(colLabel) && length(colLabel) == 1){
307
-            if(!colLabel %in% names(SummarizedExperiment::colData(inSCE))){
308
-                stop('"colLabel": ', colLabel, ' is not a column of ',
309
-                     'colData(inSCE).')
310
-            }
311
-            colLabelText <- SummarizedExperiment::colData(inSCE)[cellIndex,
312
-                                                                 colLabel]
313
-            colLabel <- TRUE
314
-        } else if(length(colLabel) == ncol(inSCE)){
315
-            colLabelText <- colLabel[cellIndex]
316
-            colLabel <- TRUE
317
-        } else if(length(colLabel) == length(cellIndex)){
318
-            colLabelText <- colLabel
319
-            colLabel <- TRUE
320
-        } else {
321
-            stop('Invalid "colLabel". Use TRUE/FALSE, a column name of ',
322
-                 'colData(inSCE), or a vector as the same length of ',
323
-                 'ncol(inSCE) or the subsetted number of cells.')
324
-        }
325
-    }
326
-
327
-    inSCE <- inSCE[featureIndex, cellIndex]
328
-
329
-    if (!is.null(trim) && length(trim) != 2) {
330
-        stop("'trim' should be a 2 element vector specifying the lower",
331
-             " and upper boundaries")
332
-    }
333
-    if(0 %in% dim(inSCE)){
334
-        stop('Given indices specified 0-dim')
335
-    }
336
-    if(!is.null(featureAnnotations)){
337
-        if(!all(rownames(inSCE) %in% rownames(featureAnnotations))){
338
-            stop('Incomplete feature names in `featureAnnotations')
339
-        } else {
340
-            featureAnnotations <-
341
-                featureAnnotations[rownames(inSCE), , drop = FALSE]
342
-        }
343
-    }
344
-    if(!is.null(cellAnnotations)){
345
-        if(!all(colnames(inSCE) %in% rownames(cellAnnotations))){
346
-            stop('Incomplete cell names in cellAnnotations')
347
-        } else {
348
-            cellAnnotations <- cellAnnotations[colnames(inSCE), , drop = FALSE]
201
+    # Manage feature subsetting
202
+    if(is.null(featureIndex)){
203
+        featureIndex <- seq(nrow(SCE))
204
+    } else if (is.character(featureIndex)) {
205
+        if (!is.null(useAssay))
206
+            featureIndex <- retrieveSCEIndex(inSCE, featureIndex, axis = "row",
207
+                                             by = featureIndexBy)
208
+        else
209
+            # When using reducedDim, can only go with "PC" names
210
+            # or customized "by"
211
+            featureIndex <- retrieveSCEIndex(SCE, featureIndex, axis = "row",
212
+                                             by = featureIndexBy)
213
+    } else if (is.logical(featureIndex)) {
214
+        if (length(featureIndex) != nrow(SCE)) {
215
+            stop("Logical index length does not match nrow(inSCE)")
349 216
         }
217
+        featureIndex <- which(featureIndex)
350 218
     }
351
-
352
-    # Extract
353
-    mat <- as.matrix(expData(inSCE, useAssay))
354
-    if (isTRUE(doLog)) {
355
-      mat <- log(mat + 1)
356
-    }
357
-    ## rowData info
358
-    rowDataExtract <- .extractSCEAnnotation(inSCE, 'row', rowDataName)
359
-    rowDataColor <- dataAnnotationColor(inSCE, 'row')
360
-    if(is.null(rowDataName)){
361
-        rowDataColor <- NULL
362
-    } else {
363
-        # Have to do an extraction because continuous values won't be in
364
-        # rowDataColor
365
-        rowDataColor <- rowDataColor[rowDataName[rowDataName %in%
366
-                                                     names(rowDataColor)]]
367
-    }
368
-    if(!is.null(featureAnnotationColor)){
369
-        add <- setdiff(names(rowDataColor), names(featureAnnotationColor))
370
-        featureAnnotationColor <- c(rowDataColor[add], featureAnnotationColor)
371
-    } else {
372
-        featureAnnotationColor <- rowDataColor
373
-    }
374
-    ## colData info
375
-    colDataExtract <- .extractSCEAnnotation(inSCE, 'col', colDataName)
376
-    colDataColor <- dataAnnotationColor(inSCE, 'col')
377
-    if(is.null(colDataName)){
378
-        colDataColor <- NULL
379
-    } else {
380
-        colDataColor <- colDataColor[colDataName[colDataName %in%
381
-                                                     names(colDataColor)]]
382
-    }
383
-    if(!is.null(cellAnnotationColor)){
384
-        add <- setdiff(names(colDataColor), names(cellAnnotationColor))
385
-        cellAnnotationColor <- c(colDataColor[add], cellAnnotationColor)
386
-    } else {
387
-        cellAnnotationColor <- colDataColor
388
-    }
389
-    ## Merge with extra annotations
390
-    if(is.null(featureAnnotations)){
391
-        featureAnnotations <- rowDataExtract
392
-    } else {
393
-        featureAnnotations <- data.frame(rowDataExtract, featureAnnotations)
394
-    }
395
-    if(is.null(cellAnnotations)){
396
-        cellAnnotations <- colDataExtract
397
-    } else {
398
-        cellAnnotations <- data.frame(colDataExtract, cellAnnotations)
399
-    }
400
-    # Data process
401
-    if(isTRUE(scale)){
402
-        mat <- as.matrix(computeZScore(mat))
403
-    }
404
-    if (!is.null(trim)) {
405
-        mat <- trimCounts(mat, trim)
406
-    }
407
-    # Plot
408
-    if(is.null(colorScheme)){
409
-        if(!is.null(trim)){
219
+    colnames(SCE) <- colLabelName
220
+    rownames(SCE) <- rowLabelName
221
+    SCE <- SCE[featureIndex, cellIndex]
222
+    ### Scaling should be done before aggregating
223
+    if (isTRUE(doLog)) assay(SCE) <- log1p(assay(SCE))
224
+    if (isTRUE(scale)) assay(SCE) <- as.matrix(computeZScore(assay(SCE)))
225
+    if (!is.null(trim)) assay(SCE) <- trimCounts(assay(SCE), trim)
226
+    # STAGE 3: Aggregate As needed ####
227
+    if (!is.null(aggregateCol)) {
228
+        # TODO: whether to also aggregate numeric variable that users want
229
+        # Might need to use "coldata.merge" in aggregate function
230
+        colIDS <- colData(SCE)[, aggregateCol]
231
+        origRowData <- rowData(SCE)
232
+        SCE <- aggregateAcrossCells(SCE, ids = colIDS,
233
+                                    use.assay.type = useData,
234
+                                    store.number = NULL, statistics = "mean")
235
+        # TODO: `aggregateAcrossCells` produce duplicated variables in colData
236
+        # and unwanted "ncell" variable even if I set `store.number = NULL`.
237
+        colData(SCE) <- colData(SCE)[,aggregateCol,drop=FALSE]
238
+        newColnames <- do.call(paste, c(colData(SCE), list(sep = "_")))
239
+        colnames(SCE) <- newColnames
240
+        rowData(SCE) <- origRowData
241
+    }
242
+    if (!is.null(aggregateRow)) {
243
+        # `aggregateAcrossFeatures` doesn't work by with multi-var
244
+        # Remake one single variable vector
245
+        rowIDS <- rowData(SCE)[, aggregateRow, drop = FALSE]
246
+        rowIDS <- do.call(paste, c(rowIDS, list(sep = "_")))
247
+        origColData <- colData(SCE)
248
+        SCE <- aggregateAcrossFeatures(SCE, ids = rowIDS, average = TRUE,
249
+                                       use.assay.type = useData)
250
+        colData(SCE) <- origColData
251
+    }
252
+    # STAGE 4: Other minor preparation for plotting ####
253
+    mat <- assay(SCE)
254
+    if (is.null(colorScheme)) {
255
+        if (!is.null(trim))
410 256
             colorScheme <- circlize::colorRamp2(c(trim[1], 0, trim[2]),
411 257
                                                 c('blue', 'white', 'red'))
412
-        } else {
258
+        else
413 259
             colorScheme <- circlize::colorRamp2(c(min(mat),
414 260
                                                   (max(mat) + min(mat))/2,
415 261
                                                   max(mat)),
416 262
                                                 c('blue', 'white', 'red'))
417
-        }
418
-
419 263
     } else {
420
-        if(!is.function(colorScheme)){
264
+        if (!is.function(colorScheme))
421 265
             stop('`colorScheme` must be a function generated by ',
422 266
                  'circlize::colorRamp2')
423
-        }
424 267
         breaks <- attr(colorScheme, 'breaks')
425
-        if(breaks[1] != min(trim) || breaks[length(breaks)] != max(trim)){
268
+        if (breaks[1] != min(trim) || breaks[length(breaks)] != max(trim))
426 269
             stop('Breaks of `colorScheme` do not match with `trim`.')
427
-        }
428
-    }
429
-    if(dim(featureAnnotations)[2] > 0){
430
-        ra <- ComplexHeatmap::rowAnnotation(df = featureAnnotations,
431
-                                            col = featureAnnotationColor)
432
-    } else {
433
-        ra <- NULL
434 270
     }
435
-    if(dim(cellAnnotations)[2] > 0){
436
-        ca <- ComplexHeatmap::HeatmapAnnotation(df = cellAnnotations,
271
+    ### Generate HeatmapAnnotation object
272
+    ca <- NULL
273
+    cellAnnotationColor <- .heatmapAnnColor(SCE, slot = "colData",
274
+                                            custom = cellAnnotationColor,
275
+                                            palette = palette)
276
+    if(dim(cellAnnotations)[2] > 0)
277
+        ca <- ComplexHeatmap::HeatmapAnnotation(df = colData(SCE),
437 278
                                                 col = cellAnnotationColor)
438
-    } else {
439
-        ca <- NULL
440
-    }
441
-    if(!is.null(rowSplitBy)){
442
-        rs <- featureAnnotations[rowSplitBy]
443
-    } else {
444
-        rs <- NULL
445
-    }
446
-    if(!is.null(colSplitBy)){
447
-        cs <- cellAnnotations[colSplitBy]
448
-    } else {
449
-        cs <- NULL
450
-    }
451
-    if(!is.null(rowGap)) {
452
-      if(inherits(rowGap, "unit")){
453
-        rowGap <- rowGap
454
-      } else if (is.numeric(rowGap)) {
455
-        warning("rowGap is given a numeric value. Using 'mm' as the unit")
456
-        rowGap <- grid::unit(rowGap, 'mm')
457
-      } else {
458
-        stop("Given value for 'rowGap' not understandable.")
459
-      }
460
-    } else {
461
-      rowGap <- grid::unit(0, 'mm')
462
-    }
463
-    if(!is.null(colGap)) {
464
-      if (inherits(colGap, "unit")) {
465
-        colGap <- colGap
466
-      } else if(is.numeric(colGap)){
467
-        warning("colGap is given a numeric value. Using 'mm' as the unit")
468
-        colGap <- grid::unit(colGap, 'mm')
469
-      } else {
470
-        stop("Given value for 'colGap' not understandable.")
471
-      }
472
-    } else {
473
-      colGap <- grid::unit(0, 'mm')
474
-    }
475
-    rownames(mat) <- rowLabelText
476
-    colnames(mat) <- colLabelText
477
-    hm <- ComplexHeatmap::Heatmap(mat, name = useAssay, left_annotation = ra,
279
+    ra <- NULL
280
+    featureAnnotationColor <- .heatmapAnnColor(SCE, slot = "rowData",
281
+                                               custom = featureAnnotationColor,
282
+                                               palette = palette)
283
+    if(ncol(rowData(SCE)) > 0)
284
+        ra <- ComplexHeatmap::rowAnnotation(df = rowData(SCE),
285
+                                            col = featureAnnotationColor)
286
+    ### Set split variable
287
+    cs <- NULL
288
+    if (!is.null(colSplitBy)) cs <- colData(SCE)[colSplitBy]
289
+    rs <- NULL
290
+    if (!is.null(rowSplitBy)) rs <- rowData(SCE)[rowSplitBy]
291
+    ###
292
+    if (!is.null(colGap)) {
293
+        if (!inherits(colGap, "unit"))
294
+            stop("`colGap` has to be 'unit' object. Try `grid::unit(", colGap,
295
+                 ", 'mm')`.")
296
+    }
297
+    else colGap <- grid::unit(0, 'mm')
298
+    if (!is.null(rowGap)) {
299
+        if (!inherits(rowGap, "unit"))
300
+            stop("`rowGap` has to be 'unit' object. Try `grid::unit(", rowGap,
301
+                 ", 'mm')`.")
302
+    }
303
+    else rowGap <- grid::unit(0, 'mm')
304
+
305
+    if (!is.null(useAssay)) name <- useAssay
306
+    else name <- useReducedDim
307
+    hm <- ComplexHeatmap::Heatmap(mat, name = name, left_annotation = ra,
478 308
                                   top_annotation = ca, col = colorScheme,
479 309
                                   row_split = rs, column_split = cs,
480 310
                                   row_title = rowTitle, column_title = colTitle,
... ...
@@ -487,73 +317,66 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
487 317
                                   row_gap = rowGap, column_gap = colGap,
488 318
                                   border = border,
489 319
                                   ...)
490
-    # The only way to add a main title with ComplexHeatmap was to use `draw()`
491
-    # However, it shows the plot even if we return it to a variable
492
-    # Therefore, turning to use cowplot to combine a text plot to the single hm
493
-    #HM <- ComplexHeatmap::draw(hm, column_title = title,
494
-    #                           column_title_gp = grid::gpar(fontsize = 16))
495
-    if (!is.null(title)) {
496
-      hmGrob <- grid::grid.grabExpr(ComplexHeatmap::draw(hm))
497
-      titleText <- cowplot::ggdraw() + cowplot::draw_text(title)
498
-      hm <- cowplot::plot_grid(titleText,
499
-                               hmGrob,
500
-                               ncol = 1,
501
-                               rel_heights = c(1,19))
502
-    } else {
503
-      hm <- cowplot::plot_grid(grid::grid.grabExpr(ComplexHeatmap::draw(hm)))
504
-    }
505 320
     return(hm)
506 321
 }
507 322
 
508
-#' @rdname plotSCEHeatmap
509
-#' @export
510
-plotSCEDimReduceHeatmap <- function(inSCE, useReducedDim,
511
-                                    featureIndex = NULL, cellIndex = NULL,
512
-                                    doLog = FALSE, scale = FALSE,
513
-                                    trim = c(-2, 2),
514
-                                    cellIndexBy = 'rownames',
515
-                                    colDataName = NULL,
516
-                                    featureAnnotations = NULL, cellAnnotations = NULL,
517
-                                    featureAnnotationColor = NULL, cellAnnotationColor = NULL,
518
-                                    rowSplitBy = NULL, colSplitBy = NULL,
519
-                                    rowLabel = FALSE, colLabel = FALSE,
520
-                                    rowLabelSize = 8, colLabelSize = 8,
521
-                                    rowDend = TRUE, colDend = TRUE,
522
-                                    title = NULL, rowTitle = 'Dimensions', colTitle = 'Cells',
523
-                                    rowGap = grid::unit(0, 'mm'), colGap = grid::unit(0, 'mm'),
524
-                                    border = FALSE, colorScheme = NULL, ...) {
525
-    mat <- t(expData(inSCE, useReducedDim))
526
-    assayList <- list(mat)
527
-    names(assayList) <- useReducedDim
528
-    tmpSCE <- SingleCellExperiment::SingleCellExperiment(assays = assayList)
529
-    SummarizedExperiment::colData(tmpSCE) <- SummarizedExperiment::colData(inSCE)
530
-    plotSCEHeatmap(inSCE = tmpSCE,
531
-                   useAssay = useReducedDim,
532
-                   featureIndex = featureIndex,
533
-                   cellIndex = cellIndex,
534
-                   doLog = doLog,
535
-                   scale = scale,
536
-                   trim = trim,
537
-                   cellIndexBy = cellIndexBy,
538
-                   colDataName = colDataName,
539
-                   featureAnnotations = featureAnnotations,
540
-                   cellAnnotations = cellAnnotations,
541
-                   featureAnnotationColor = featureAnnotationColor,
542
-                   cellAnnotationColor = cellAnnotationColor,
543
-                   rowSplitBy = rowSplitBy,
544
-                   colSplitBy = colSplitBy,
545
-                   rowLabel = rowLabel,
546
-                   colLabel = colLabel,
547
-                   rowLabelSize = rowLabelSize,
548
-                   colLabelSize = colLabelSize,
549
-                   rowDend = rowDend,
550
-                   colDend = colDend,
551
-                   title = title,
552
-                   rowTitle = rowTitle,
553
-                   colTitle = colTitle,
554
-                   rowGap = rowGap,
555
-                   colGap = colGap,
556
-                   border = border,
557
-                   colorScheme = colorScheme,
558
-                   ... = ...)
323
+.mergeAnnotationDF <- function(origin, external) {
324
+    if (!is.null(external)) {
325
+        external <- external[match(rownames(origin), rownames(external)), ,drop = FALSE]
326
+        origin <- cbind(origin, external)
327
+    }
328
+    return(origin)
329
+}
330
+
331
+.heatmapAnnColor <- function(inSCE, slot = c("colData", "rowData"),
332
+                          custom = NULL, palette = palette) {
333
+    slot <- match.arg(slot)
334
+    if (!is.null(custom) && !is.list(custom))
335
+        stop("'cellAnnotationColor' or 'featureAnnotationColor' must be a list.")
336
+    if (is.null(custom)) custom <- list()
337
+    if (slot == "colData") data <- SummarizedExperiment::colData(inSCE)
338
+    if (slot == "rowData") data <- SummarizedExperiment::rowData(inSCE)
339
+    todoNames <- colnames(data)
340
+    todoNames <- todoNames[!todoNames %in% names(custom)]
341
+    newColor <- lapply(todoNames, function(n) {
342
+        var <- data[[n]]
343
+        if (is.factor(var)) categories <- levels(var)
344
+        else categories <- unique(var)
345
+        colors <- discreteColorPalette(length(categories), palette = palette)
346
+        names(colors) <- categories
347
+        return(colors)
348
+    })
349
+    names(newColor) <- todoNames
350
+    custom <- c(custom, newColor)
351
+    return(custom)
352
+}
353
+# Test
354
+#logcounts(sceBatches) <- log1p(counts(sceBatches))
355
+#plotSCEHeatmap2(sceBatches, "logcounts",
356
+#                featureIndex = c("GCG1", "COX11", "INS1", "ND41"),
357
+#                featureIndexBy = rowData(sceBatches)$feature_name,
358
+#                cellIndex = c("reads.16087_", "Sample_1073_",
359
+#                              "reads.29330_", "Sample_801_"),
360
+#                cellIndexBy = paste0(colnames(sceBatches), "_"),
361
+#                rowLabel = "feature_name", rowDend = FALSE,
362
+#                cluster_rows = FALSE, colLabel = TRUE, cluster_columns = FALSE,
363
+#                colDataName = c("batch", "cell_type"), aggregateCol = c("cell_type", "batch"))
364
+#sce <-plotSCEHeatmap2(sceBatches, aggregateCol = "batch")
365
+#plotSCEHeatmap2(sceBatches, aggregateCol = c("cell_type", "batch"))
366
+#plotFindMarkerHeatmap(sce, log2fcThreshold = 0, minClustExprPerc = 0.4,
367
+#                      maxCtrlExprPerc = 0.5)
368
+#plotFindMarkerHeatmap(sce, log2fcThreshold = 0, minClustExprPerc = 0.4,
369
+#                      maxCtrlExprPerc = 0.5,
370
+#                      aggregateRow = "marker")
371
+#plotSCEDimReduceColData(sce, "cluster", "UMAP")
372
+CellVarColor <- function(inSCE, var,
373
+                            palette = c("ggplot", "random", "celda"),
374
+                            seed = 12345, ...) {
375
+    var <- .manageCellVar(inSCE, var = var)
376
+    palette <- match.arg(palette)
377
+    if (is.factor(var)) uniqVar <- levels(var)
378
+    else uniqVar <- unique(var)
379
+    colors <- discreteColorPalette(length(uniqVar), palette = palette, seed = seed, ...)
380
+    names(colors) <- uniqVar
381
+    return(colors)
559 382
 }
Browse code

Refactor plotSCEHeatmap (halfway)

Yichen Wang authored on 17/08/2022 23:08:51
Showing1 changed files
... ...
@@ -246,71 +246,40 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
246 246
         stop('colSplitBy - Specified columns: ', paste(notIn, collapse = ', '),
247 247
              ', not found. ')
248 248
     }
249
+    # STAGE 1: Create clean SCE object with only needed information ####
250
+
251
+
252
+
253
+    # STAGE 2: Subset as needed ####
254
+    # Manage feature subsetting
249 255
     if(is.null(featureIndex)){
250
-        featureIndex <- seq_len(nrow(inSCE))
251
-    } else {
252
-        if(is.character(featureIndexBy) && length(featureIndexBy) == 1){
253
-            if(!featureIndexBy == 'rownames'){
254
-                # Search by a column in rowData
255
-                featureIndex <- celda::retrieveFeatureIndex(featureIndex,
256
-                                                            inSCE,
257
-                                                            featureIndexBy)
258
-            }
259
-        } else if(length(featureIndexBy) == nrow(inSCE)){
260
-            # featureIndexBy is vector or single-col/row matrix
261
-            featureIndex <- celda::retrieveFeatureIndex(featureIndex,
262
-                                                        featureIndexBy,
263
-                                                        '')
264
-        } else {
265
-            stop('Given "featureIndexBy" not valid. Please give a single ',
266
-                 'character to specify a column in rowData(inSCE) or a vector ',
267
-                 'as long as nrow(inSCE) where you search for "featureIndex".')
256
+        featureIndex <- seq(nrow(inSCE))
257
+    } else if (is.character(featureIndex)) {
258
+        featureIndex <- retrieveSCEIndex(inSCE, featureIndex, axis = "row",
259
+                                         by = featureIndexBy)
260
+    } else if (is.logical(featureIndex)) {
261
+        if (length(featureIndex) != nrow(inSCE)) {
262
+            stop("Logical index length does not match nrow(inSCE)")
268 263
         }
269
-    }
270
-    ### Force index as numeric
271
-    if(is.character(featureIndex)){
272
-        featureIndex <- which(rownames(inSCE) %in% featureIndex)
273
-    } else if(is.logical(featureIndex)){
274 264
         featureIndex <- which(featureIndex)
275 265
     }
266
+    # Manage cell subsetting
276 267
     if(is.null(cellIndex)){
277
-        cellIndex <- seq_len(ncol(inSCE))
278
-    } else {
279
-        if(is.character(cellIndexBy) && length(cellIndexBy) == 1){
280
-            if(!cellIndexBy == 'rownames'){
281
-                # Search by a column in colData
282
-                if(!cellIndexBy %in%
283
-                   names(SummarizedExperiment::colData(inSCE))){
284
-                    stop('"cellIndexBy": ', cellIndexBy, ' is not a column of ',
285
-                         'colData(inSCE)')
286
-                }
287
-                searchIn <- SummarizedExperiment::colData(inSCE)[[cellIndexBy]]
288
-                cellIndex <- celda::retrieveFeatureIndex(cellIndex,
289
-                                                            searchIn,
290
-                                                            '')
291
-            }
292
-        } else if(length(cellIndexBy) == ncol(inSCE)){
293
-            # featureIndexBy is vector or single-col/row matrix
294
-            cellIndex <- celda::retrieveFeatureIndex(cellIndex,
295
-                                                        cellIndexBy,
296
-                                                        '')
297
-        } else {
298
-            stop('Given "cellIndexBy" not valid. Please give a single ',
299
-                 'character to specify a column in colData(inSCE) or a vector ',
300
-                 'as long as ncol(inSCE) where you search for "cellIndex".')
268
+        cellIndex <- seq(ncol(inSCE))
269
+    } else if (is.character(cellIndex)) {
270
+        cellIndex <- retrieveSCEIndex(inSCE, cellIndex, axis = "col",
271
+                                      by = cellIndexBy)
272
+    } else if (is.logical(cellIndex)) {
273
+        if (length(cellIndex) != ncol(inSCE)) {
274
+            stop("Logical index length does not match ncol(inSCE)")
301 275
         }
302
-    }
303
-    ### Force index as numeric
304
-    if(is.character(cellIndex)){
305
-        cellIndex <- which(colnames(inSCE) %in% cellIndex)
306
-    } else if (is.logical(cellIndex)){
307 276
         cellIndex <- which(cellIndex)
308 277
     }
309 278
     ## Customized row text labeling
310 279
     rowLabelText <- rownames(inSCE)[featureIndex]
311 280
     if(!is.logical(rowLabel)){
312 281
         if (is.null(rowLabel)) {
313
-          rowLabel <- FALSE
282
+            rowLabel <- FALSE
314 283
         } else if (is.character(rowLabel) && length(rowLabel) == 1) {
315 284
             if (!rowLabel %in% names(SummarizedExperiment::rowData(inSCE))) {
316 285
                 stop('"rowLabel": ', rowLabel, ' is not a column of ',
Browse code

new version 2.7.1

Yichen Wang authored on 29/06/2022 23:30:51
Showing1 changed files
... ...
@@ -6,6 +6,7 @@
6 6
 #' names. Default \code{NULL}.
7 7
 #' @param index Valid index to subset the col/row.
8 8
 #' @return A \code{data.frame} object.
9
+#' @noRd
9 10
 .extractSCEAnnotation <- function(inSCE, axis = NULL, columns = NULL,
10 11
                                   index = NULL){
11 12
     if(is.null(axis) || !axis %in% c('col', 'row')){
... ...
@@ -45,6 +46,7 @@
45 46
 #' possible categorical entries in \code{rowData(inSCE)} or
46 47
 #' \code{colData(inSCE)}.
47 48
 #' @author Yichen Wang
49
+#' @noRd
48 50
 dataAnnotationColor <- function(inSCE, axis = NULL,
49 51
                                 colorGen = distinctColors){
50 52
     if(!is.null(axis) && axis == 'col'){
... ...
@@ -130,13 +132,13 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
130 132
 #' trimmed to their nearst bound. Default \code{c(-2, 2)}
131 133
 #' @param featureIndexBy A single character specifying a column name of
132 134
 #' \code{rowData(inSCE)}, or a vector of the same length as \code{nrow(inSCE)},
133
-#' where we search for the non-rowname feature indices. Not applicable for 
134
-#' \code{plotSCEDimReduceHeatmap}. Default \code{"rownames"}. 
135
+#' where we search for the non-rowname feature indices. Not applicable for
136
+#' \code{plotSCEDimReduceHeatmap}. Default \code{"rownames"}.
135 137
 #' @param cellIndexBy A single character specifying a column name of
136 138
 #' \code{colData(inSCE)}, or a vector of the same length as \code{ncol(inSCE)},
137 139
 #' where we search for the non-rowname cell indices. Default \code{"rownames"}.
138 140
 #' @param rowDataName character. The column name(s) in \code{rowData} that need
139
-#' to be added to the annotation. Not applicable for 
141
+#' to be added to the annotation. Not applicable for
140 142
 #' \code{plotSCEDimReduceHeatmap}. Default \code{NULL}.
141 143
 #' @param colDataName character. The column name(s) in \code{colData} that need
142 144
 #' to be added to the annotation. Default \code{NULL}.
... ...
@@ -192,7 +194,7 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
192 194
 #' @examples
193 195
 #' data(scExample, package = "singleCellTK")
194 196
 #' plotSCEHeatmap(sce[1:3,1:3], useAssay = "counts")
195
-#' @return A \code{\link[ggplot2]{ggplot}} object. 
197
+#' @return A \code{\link[ggplot2]{ggplot}} object.
196 198
 #' @export
197 199
 #' @author Yichen Wang
198 200
 plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
... ...
@@ -536,9 +538,9 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
536 538
 
537 539
 #' @rdname plotSCEHeatmap
538 540
 #' @export
539
-plotSCEDimReduceHeatmap <- function(inSCE, useReducedDim, 
540
-                                    featureIndex = NULL, cellIndex = NULL, 
541
-                                    doLog = FALSE, scale = FALSE, 
541
+plotSCEDimReduceHeatmap <- function(inSCE, useReducedDim,
542
+                                    featureIndex = NULL, cellIndex = NULL,
543
+                                    doLog = FALSE, scale = FALSE,
542 544
                                     trim = c(-2, 2),
543 545
                                     cellIndexBy = 'rownames',
544 546
                                     colDataName = NULL,
... ...
@@ -556,33 +558,33 @@ plotSCEDimReduceHeatmap <- function(inSCE, useReducedDim,
556 558
     names(assayList) <- useReducedDim
557 559
     tmpSCE <- SingleCellExperiment::SingleCellExperiment(assays = assayList)
558 560
     SummarizedExperiment::colData(tmpSCE) <- SummarizedExperiment::colData(inSCE)
559
-    plotSCEHeatmap(inSCE = tmpSCE, 
561
+    plotSCEHeatmap(inSCE = tmpSCE,
560 562
                    useAssay = useReducedDim,
561
-                   featureIndex = featureIndex, 
563
+                   featureIndex = featureIndex,
562 564
                    cellIndex = cellIndex,
563 565
                    doLog = doLog,
564
-                   scale = scale, 
565
-                   trim = trim, 
566
-                   cellIndexBy = cellIndexBy, 
567
-                   colDataName = colDataName, 
568
-                   featureAnnotations = featureAnnotations, 
569
-                   cellAnnotations = cellAnnotations, 
570
-                   featureAnnotationColor = featureAnnotationColor, 
571
-                   cellAnnotationColor = cellAnnotationColor, 
572
-                   rowSplitBy = rowSplitBy, 
573
-                   colSplitBy = colSplitBy, 
574
-                   rowLabel = rowLabel, 
575
-                   colLabel = colLabel, 
576
-                   rowLabelSize = rowLabelSize, 
577
-                   colLabelSize = colLabelSize, 
578
-                   rowDend = rowDend, 
579
-                   colDend = colDend, 
580
-                   title = title, 
581
-                   rowTitle = rowTitle, 
582
-                   colTitle = colTitle, 
583
-                   rowGap = rowGap, 
584
-                   colGap = colGap, 
585
-                   border = border, 
586
-                   colorScheme = colorScheme, 
566
+                   scale = scale,
567
+                   trim = trim,
568
+                   cellIndexBy = cellIndexBy,
569
+                   colDataName = colDataName,
570
+                   featureAnnotations = featureAnnotations,
571
+                   cellAnnotations = cellAnnotations,
572
+                   featureAnnotationColor = featureAnnotationColor,
573
+                   cellAnnotationColor = cellAnnotationColor,
574
+                   rowSplitBy = rowSplitBy,
575
+                   colSplitBy = colSplitBy,
576
+                   rowLabel = rowLabel,
577
+                   colLabel = colLabel,
578
+                   rowLabelSize = rowLabelSize,
579
+                   colLabelSize = colLabelSize,
580
+                   rowDend = rowDend,
581
+                   colDend = colDend,
582
+                   title = title,
583
+                   rowTitle = rowTitle,
584
+                   colTitle = colTitle,
585
+                   rowGap = rowGap,
586
+                   colGap = colGap,
587
+                   border = border,
588
+                   colorScheme = colorScheme,
587 589
                    ... = ...)
588 590
 }
Browse code

apply global displayFeature setting to DEG heatmap

Yichen Wang authored on 13/05/2022 20:07:00
Showing1 changed files
... ...
@@ -307,18 +307,20 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
307 307
     ## Customized row text labeling
308 308
     rowLabelText <- rownames(inSCE)[featureIndex]
309 309
     if(!is.logical(rowLabel)){
310
-        if(is.character(rowLabel) && length(rowLabel) == 1){
311
-            if(!rowLabel %in% names(SummarizedExperiment::rowData(inSCE))){
310
+        if (is.null(rowLabel)) {
311
+          rowLabel <- FALSE
312
+        } else if (is.character(rowLabel) && length(rowLabel) == 1) {
313
+            if (!rowLabel %in% names(SummarizedExperiment::rowData(inSCE))) {
312 314
                 stop('"rowLabel": ', rowLabel, ' is not a column of ',
313 315
                      'rowData(inSCE).')
314 316
             }
315 317
             rowLabelText <- SummarizedExperiment::rowData(inSCE)[featureIndex,
316 318
                                                                  rowLabel]
317 319
             rowLabel <- TRUE
318
-        } else if(length(rowLabel) == nrow(inSCE)){
320
+        } else if (length(rowLabel) == nrow(inSCE)) {
319 321
             rowLabelText <- rowLabel[featureIndex]
320 322
             rowLabel <- TRUE
321
-        } else if(length(rowLabel) == length(featureIndex)){
323
+        } else if (length(rowLabel) == length(featureIndex)) {
322 324
             rowLabelText <- rowLabel
323 325
             rowLabel <- TRUE
324 326
         } else {
Browse code

Fix plotSCEHeatmap bug; add unit test for pathway

Yichen Wang authored on 26/03/2022 03:07:20
Showing1 changed files
... ...
@@ -174,8 +174,7 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
174 174
 #' \code{8}
175 175
 #' @param rowDend Whether to display row dendrogram. Default \code{TRUE}.
176 176
 #' @param colDend Whether to display column dendrogram. Default \code{TRUE}.
177
-#' @param title Deprecated. The main title of the whole plot. Default 
178
-#' \code{NULL}.
177
+#' @param title The main title of the whole plot. Default \code{NULL}.
179 178
 #' @param rowTitle The subtitle for the rows. Default \code{"Genes"}.
180 179
 #' @param colTitle The subtitle for the columns. Default \code{"Cells"}.
181 180
 #' @param rowGap A numeric value or a \code{\link[grid]{unit}} object. For the
... ...
@@ -193,8 +192,7 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
193 192
 #' @examples
194 193
 #' data(scExample, package = "singleCellTK")
195 194
 #' plotSCEHeatmap(sce[1:3,1:3], useAssay = "counts")
196
-#' @return A \code{\link[ComplexHeatmap]{Heatmap}} object if \code{title} is not
197
-#' set, otherwise, \code{\link[ggplot2]{ggplot}} object. 
195
+#' @return A \code{\link[ggplot2]{ggplot}} object. 
198 196
 #' @export
199 197
 #' @author Yichen Wang
200 198
 plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
... ...
@@ -516,18 +514,21 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
516 514
                                   row_gap = rowGap, column_gap = colGap,
517 515
                                   border = border,
518 516
                                   ...)
517
+    # The only way to add a main title with ComplexHeatmap was to use `draw()`
518
+    # However, it shows the plot even if we return it to a variable
519
+    # Therefore, turning to use cowplot to combine a text plot to the single hm
519 520
     #HM <- ComplexHeatmap::draw(hm, column_title = title,
520 521
     #                           column_title_gp = grid::gpar(fontsize = 16))
521
-    #if (!is.null(title)) {
522
-    #  hmGrob <- grid::grid.grabExpr(ComplexHeatmap::draw(hm))
523
-    #  titleText <- cowplot::ggdraw() + cowplot::draw_text(title)
524
-    #  hm <- cowplot::plot_grid(titleText,
525
-    #                           hmGrob,
526
-    #                           ncol = 1,
527
-    #                           rel_heights = c(1,19))
528
-    #} else {
529
-    #  hm <- cowplot::plot_grid(grid::grid.grabExpr(ComplexHeatmap::draw(hm)))
530
-    #}
522
+    if (!is.null(title)) {
523
+      hmGrob <- grid::grid.grabExpr(ComplexHeatmap::draw(hm))
524
+      titleText <- cowplot::ggdraw() + cowplot::draw_text(title)
525
+      hm <- cowplot::plot_grid(titleText,
526
+                               hmGrob,
527
+                               ncol = 1,
528
+                               rel_heights = c(1,19))
529
+    } else {
530
+      hm <- cowplot::plot_grid(grid::grid.grabExpr(ComplexHeatmap::draw(hm)))
531
+    }
531 532
     return(hm)
532 533
 }
533 534
 
Browse code

Fix plotSCEHeatmap bug

Yichen Wang authored on 25/03/2022 13:33:42
Showing1 changed files
... ...
@@ -174,7 +174,8 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
174 174
 #' \code{8}
175 175
 #' @param rowDend Whether to display row dendrogram. Default \code{TRUE}.
176 176
 #' @param colDend Whether to display column dendrogram. Default \code{TRUE}.
177
-#' @param title The main title of the whole plot. Default \code{"SCE Heatmap"}
177
+#' @param title Deprecated. The main title of the whole plot. Default 
178
+#' \code{NULL}.
178 179
 #' @param rowTitle The subtitle for the rows. Default \code{"Genes"}.
179 180
 #' @param colTitle The subtitle for the columns. Default \code{"Cells"}.
180 181
 #' @param rowGap A numeric value or a \code{\link[grid]{unit}} object. For the
... ...
@@ -192,7 +193,8 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
192 193
 #' @examples
193 194
 #' data(scExample, package = "singleCellTK")
194 195
 #' plotSCEHeatmap(sce[1:3,1:3], useAssay = "counts")
195
-#' @return A \code{\link[ComplexHeatmap]{Heatmap}} object
196
+#' @return A \code{\link[ComplexHeatmap]{Heatmap}} object if \code{title} is not
197
+#' set, otherwise, \code{\link[ggplot2]{ggplot}} object. 
196 198
 #' @export
197 199
 #' @author Yichen Wang
198 200
 plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
... ...
@@ -206,7 +208,7 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
206 208
     rowLabel = FALSE, colLabel = FALSE,
207 209
     rowLabelSize = 8, colLabelSize = 8,
208 210
     rowDend = TRUE, colDend = TRUE,
209
-    title = 'SCE Heatmap', rowTitle = 'Genes', colTitle = 'Cells',
211
+    title = NULL, rowTitle = 'Genes', colTitle = 'Cells',
210 212
     rowGap = grid::unit(0, 'mm'), colGap = grid::unit(0, 'mm'),
211 213
     border = FALSE, colorScheme = NULL, ...){
212 214
     # Check input
... ...
@@ -514,9 +516,19 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
514 516
                                   row_gap = rowGap, column_gap = colGap,
515 517
                                   border = border,
516 518
                                   ...)
517
-    HM <- ComplexHeatmap::draw(hm, column_title = title,
518
-                               column_title_gp = grid::gpar(fontsize = 16))
519
-    return(HM)
519
+    #HM <- ComplexHeatmap::draw(hm, column_title = title,
520
+    #                           column_title_gp = grid::gpar(fontsize = 16))
521
+    #if (!is.null(title)) {
522
+    #  hmGrob <- grid::grid.grabExpr(ComplexHeatmap::draw(hm))
523
+    #  titleText <- cowplot::ggdraw() + cowplot::draw_text(title)
524
+    #  hm <- cowplot::plot_grid(titleText,
525
+    #                           hmGrob,
526
+    #                           ncol = 1,
527
+    #                           rel_heights = c(1,19))
528
+    #} else {
529
+    #  hm <- cowplot::plot_grid(grid::grid.grabExpr(ComplexHeatmap::draw(hm)))
530
+    #}
531
+    return(hm)
520 532
 }
521 533
 
522 534
 #' @rdname plotSCEHeatmap
... ...
@@ -533,7 +545,7 @@ plotSCEDimReduceHeatmap <- function(inSCE, useReducedDim,
533 545
                                     rowLabel = FALSE, colLabel = FALSE,
534 546
                                     rowLabelSize = 8, colLabelSize = 8,
535 547
                                     rowDend = TRUE, colDend = TRUE,
536
-                                    title = 'SCE Heatmap', rowTitle = 'Dimensions', colTitle = 'Cells',
548
+                                    title = NULL, rowTitle = 'Dimensions', colTitle = 'Cells',
537 549
                                     rowGap = grid::unit(0, 'mm'), colGap = grid::unit(0, 'mm'),
538 550
                                     border = FALSE, colorScheme = NULL, ...) {
539 551
     mat <- t(expData(inSCE, useReducedDim))
Browse code

Finalized useReducedDim for DE

Yichen Wang authored on 17/03/2022 21:32:01
Showing1 changed files
... ...
@@ -109,9 +109,12 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
109 109
 }
110 110
 
111 111
 #' Plot heatmap of using data stored in SingleCellExperiment Object
112
+#' @rdname plotSCEHeatmap
112 113
 #' @param inSCE \linkS4class{SingleCellExperiment} inherited object.
113 114
 #' @param useAssay character. A string indicating the assay name that
114
-#' provides the expression level to plot.
115
+#' provides the expression level to plot. Only for \code{plotSCEHeatmap}.
116
+#' @param useReducedDim character. A string indicating the reducedDim name that
117
+#' provides the expression level to plot. Only for \code{plotSCEDimReduceHeatmap}.
115 118
 #' @param doLog Logical scalar. Whether to do \code{log(assay + 1)}
116 119
 #' transformation on the assay indicated by \code{useAssay}. Default
117 120
 #' \code{FALSE}.
... ...
@@ -127,13 +130,14 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
127 130
 #' trimmed to their nearst bound. Default \code{c(-2, 2)}
128 131
 #' @param featureIndexBy A single character specifying a column name of
129 132
 #' \code{rowData(inSCE)}, or a vector of the same length as \code{nrow(inSCE)},
130
-#' where we search for the non-rowname feature indices. Default
131
-#' \code{"rownames"}.
133
+#' where we search for the non-rowname feature indices. Not applicable for 
134
+#' \code{plotSCEDimReduceHeatmap}. Default \code{"rownames"}. 
132 135
 #' @param cellIndexBy A single character specifying a column name of
133 136
 #' \code{colData(inSCE)}, or a vector of the same length as \code{ncol(inSCE)},
134 137
 #' where we search for the non-rowname cell indices. Default \code{"rownames"}.
135 138
 #' @param rowDataName character. The column name(s) in \code{rowData} that need
136
-#' to be added to the annotation. Default \code{NULL}.
139
+#' to be added to the annotation. Not applicable for 
140
+#' \code{plotSCEDimReduceHeatmap}. Default \code{NULL}.
137 141
 #' @param colDataName character. The column name(s) in \code{colData} that need
138 142
 #' to be added to the annotation. Default \code{NULL}.
139 143
 #' @param featureAnnotations \code{data.frame}, with \code{rownames} containing
... ...
@@ -514,3 +518,56 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
514 518
                                column_title_gp = grid::gpar(fontsize = 16))
515 519
     return(HM)
516 520
 }
521
+
522
+#' @rdname plotSCEHeatmap
523
+#' @export
524
+plotSCEDimReduceHeatmap <- function(inSCE, useReducedDim, 
525
+                                    featureIndex = NULL, cellIndex = NULL, 
526
+                                    doLog = FALSE, scale = FALSE, 
527
+                                    trim = c(-2, 2),
528
+                                    cellIndexBy = 'rownames',
529
+                                    colDataName = NULL,
530
+                                    featureAnnotations = NULL, cellAnnotations = NULL,
531
+                                    featureAnnotationColor = NULL, cellAnnotationColor = NULL,
532
+                                    rowSplitBy = NULL, colSplitBy = NULL,
533
+                                    rowLabel = FALSE, colLabel = FALSE,
534
+                                    rowLabelSize = 8, colLabelSize = 8,
535
+                                    rowDend = TRUE, colDend = TRUE,
536
+                                    title = 'SCE Heatmap', rowTitle = 'Dimensions', colTitle = 'Cells',
537
+                                    rowGap = grid::unit(0, 'mm'), colGap = grid::unit(0, 'mm'),
538
+                                    border = FALSE, colorScheme = NULL, ...) {
539
+    mat <- t(expData(inSCE, useReducedDim))
540
+    assayList <- list(mat)
541
+    names(assayList) <- useReducedDim
542
+    tmpSCE <- SingleCellExperiment::SingleCellExperiment(assays = assayList)
543
+    SummarizedExperiment::colData(tmpSCE) <- SummarizedExperiment::colData(inSCE)
544
+    plotSCEHeatmap(inSCE = tmpSCE, 
545
+                   useAssay = useReducedDim,
546
+                   featureIndex = featureIndex, 
547
+                   cellIndex = cellIndex,
548
+                   doLog = doLog,
549
+                   scale = scale, 
550
+                   trim = trim, 
551
+                   cellIndexBy = cellIndexBy, 
552
+                   colDataName = colDataName, 
553
+                   featureAnnotations = featureAnnotations, 
554
+                   cellAnnotations = cellAnnotations, 
555
+                   featureAnnotationColor = featureAnnotationColor, 
556
+                   cellAnnotationColor = cellAnnotationColor, 
557
+                   rowSplitBy = rowSplitBy, 
558
+                   colSplitBy = colSplitBy, 
559
+                   rowLabel = rowLabel, 
560
+                   colLabel = colLabel, 
561
+                   rowLabelSize = rowLabelSize, 
562
+                   colLabelSize = colLabelSize, 
563
+                   rowDend = rowDend, 
564
+                   colDend = colDend, 
565
+                   title = title, 
566
+                   rowTitle = rowTitle, 
567
+                   colTitle = colTitle, 
568
+                   rowGap = rowGap, 
569
+                   colGap = colGap, 
570
+                   border = border, 
571
+                   colorScheme = colorScheme, 
572
+                   ... = ...)
573
+}
Browse code

Minor tweak in heatmap plotting

Yichen Wang authored on 15/09/2021 21:11:03
Showing1 changed files
... ...
@@ -502,15 +502,15 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
502 502
                                   row_split = rs, column_split = cs,
503 503
                                   row_title = rowTitle, column_title = colTitle,
504 504
                                   show_row_names = rowLabel,
505
-                                  row_names_gp = gpar(fontsize = rowLabelSize),
505
+                                  row_names_gp = grid::gpar(fontsize = rowLabelSize),
506 506
                                   show_row_dend = rowDend,
507 507
                                   show_column_names = colLabel,
508
-                                  column_names_gp = gpar(fontsize = colLabelSize),
508
+                                  column_names_gp = grid::gpar(fontsize = colLabelSize),
509 509
                                   show_column_dend = colDend,
510 510
                                   row_gap = rowGap, column_gap = colGap,
511 511
                                   border = border,
512 512
                                   ...)
513 513
     HM <- ComplexHeatmap::draw(hm, column_title = title,
514
-                               column_title_gp = gpar(fontsize = 16))
514
+                               column_title_gp = grid::gpar(fontsize = 16))
515 515
     return(HM)
516 516
 }
Browse code

Add row/col label fontsize option for heatmap; minor bug fix; canceled marker heatmap default dendrogram

Yichen Wang authored on 15/09/2021 20:05:21
Showing1 changed files
... ...
@@ -76,6 +76,9 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
76 76
             nColor <- nColor + length(uniqLevel)
77 77
         }
78 78
     }
79
+    if (nColor == 0) {
80
+      return(list())
81
+    }
79 82
     allColors <- colorGen(nColor)
80 83
     nUsed <- 0
81 84
     allColorMap <- list()
... ...
@@ -118,6 +121,10 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
118 121
 #' @param cellIndex A vector that can subset the input SCE object by columns
119 122
 #' (cells). Alternatively, it can be a vector identifying cells in another
120 123
 #' cell list indicated by \code{featureIndexBy}. Default \code{NULL}.
124
+#' @param scale Whether to perform z-score scaling on each row. Default
125
+#' \code{TRUE}.
126
+#' @param trim A 2-element numeric vector. Values outside of this range will be
127
+#' trimmed to their nearst bound. Default \code{c(-2, 2)}
121 128
 #' @param featureIndexBy A single character specifying a column name of
122 129
 #' \code{rowData(inSCE)}, or a vector of the same length as \code{nrow(inSCE)},
123 130
 #' where we search for the non-rowname feature indices. Default
... ...
@@ -125,6 +132,10 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
125 132
 #' @param cellIndexBy A single character specifying a column name of
126 133
 #' \code{colData(inSCE)}, or a vector of the same length as \code{ncol(inSCE)},
127 134
 #' where we search for the non-rowname cell indices. Default \code{"rownames"}.
135
+#' @param rowDataName character. The column name(s) in \code{rowData} that need
136
+#' to be added to the annotation. Default \code{NULL}.
137
+#' @param colDataName character. The column name(s) in \code{colData} that need
138
+#' to be added to the annotation. Default \code{NULL}.
128 139
 #' @param featureAnnotations \code{data.frame}, with \code{rownames} containing
129 140
 #' all the features going to be plotted. Character columns should be factors.
130 141
 #' Default \code{NULL}.
... ...
@@ -139,10 +150,6 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
139 150
 #' cell labeling. Should match the entries in the \code{cellAnnotations} or
140 151
 #' \code{colDataName}. For each entry, there should be a list/vector of colors
141 152
 #' named with categories. Default \code{NULL}.
142
-#' @param rowDataName character. The column name(s) in \code{rowData} that need
143
-#' to be added to the annotation. Default \code{NULL}.
144
-#' @param colDataName character. The column name(s) in \code{colData} that need
145
-#' to be added to the annotation. Default \code{NULL}.
146 153
 #' @param rowSplitBy character. Do semi-heatmap based on the grouping of
147 154
 #' this(these) annotation(s). Should exist in either \code{rowDataName} or
148 155
 #' \code{names(featureAnnotations)}. Default \code{NULL}.
... ...
@@ -157,12 +164,12 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
157 164
 #' single character to display a column of \code{colData(inSCE)} annotation,
158 165
 #' a vector of the same length as full/subset \code{ncol(inSCE)} to display
159 166
 #' customized info. Default \code{FALSE}.
167
+#' @param rowLabelSize A number for the font size of feature names. Default
168
+#' \code{8}
169
+#' @param colLabelSize A number for the font size of cell names. Default
170
+#' \code{8}
160 171
 #' @param rowDend Whether to display row dendrogram. Default \code{TRUE}.
161 172
 #' @param colDend Whether to display column dendrogram. Default \code{TRUE}.
162
-#' @param scale Whether to perform z-score scaling on each row. Default
163
-#' \code{TRUE}.
164
-#' @param trim A 2-element numeric vector. Values outside of this range will be
165
-#' trimmed to their nearst bound. Default \code{c(-2, 2)}
166 173
 #' @param title The main title of the whole plot. Default \code{"SCE Heatmap"}
167 174
 #' @param rowTitle The subtitle for the rows. Default \code{"Genes"}.
168 175
 #' @param colTitle The subtitle for the columns. Default \code{"Cells"}.
... ...
@@ -185,16 +192,19 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
185 192
 #' @export
186 193
 #' @author Yichen Wang
187 194
 plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
188
-                           featureIndex = NULL,
189
-    cellIndex = NULL, featureIndexBy = 'rownames', cellIndexBy = 'rownames',
195
+    featureIndex = NULL, cellIndex = NULL,
196
+    scale = TRUE, trim = c(-2, 2),
197
+    featureIndexBy = 'rownames', cellIndexBy = 'rownames',
198
+    rowDataName = NULL, colDataName = NULL,
190 199
     featureAnnotations = NULL, cellAnnotations = NULL,
191 200
     featureAnnotationColor = NULL, cellAnnotationColor = NULL,
192
-    rowDataName = NULL, colDataName = NULL, rowSplitBy = NULL,
193
-    colSplitBy = NULL, rowLabel = FALSE, colLabel = FALSE, rowDend = TRUE,
194
-    colDend = TRUE, scale = TRUE, trim = c(-2, 2),
201
+    rowSplitBy = NULL, colSplitBy = NULL,
202
+    rowLabel = FALSE, colLabel = FALSE,
203
+    rowLabelSize = 8, colLabelSize = 8,
204
+    rowDend = TRUE, colDend = TRUE,
195 205
     title = 'SCE Heatmap', rowTitle = 'Genes', colTitle = 'Cells',
196
-    rowGap = grid::unit(0, 'mm'), colGap = grid::unit(0, 'mm'), border = FALSE,
197
-    colorScheme = NULL, ...){
206
+    rowGap = grid::unit(0, 'mm'), colGap = grid::unit(0, 'mm'),
207
+    border = FALSE, colorScheme = NULL, ...){
198 208
     # Check input
199 209
     if(!inherits(inSCE, "SingleCellExperiment")){
200 210
         stop('Input object is not a valid SingleCellExperiment object.')
... ...
@@ -492,12 +502,15 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
492 502
                                   row_split = rs, column_split = cs,
493 503
                                   row_title = rowTitle, column_title = colTitle,
494 504
                                   show_row_names = rowLabel,
505
+                                  row_names_gp = gpar(fontsize = rowLabelSize),
495 506
                                   show_row_dend = rowDend,
496 507
                                   show_column_names = colLabel,
508
+                                  column_names_gp = gpar(fontsize = colLabelSize),
497 509
                                   show_column_dend = colDend,
498 510
                                   row_gap = rowGap, column_gap = colGap,
499 511
                                   border = border,
500 512
                                   ...)
501
-    #HM <- ComplexHeatmap::draw(hm, column_title = title)
502
-    return(hm)
513
+    HM <- ComplexHeatmap::draw(hm, column_title = title,
514
+                               column_title_gp = gpar(fontsize = 16))
515
+    return(HM)
503 516
 }
Browse code

Final updates to tagging system

Irzam Sarfraz authored on 25/02/2021 00:13:12
Showing1 changed files
... ...
@@ -199,7 +199,7 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
199 199
     if(!inherits(inSCE, "SingleCellExperiment")){
200 200
         stop('Input object is not a valid SingleCellExperiment object.')
201 201
     }
202
-    if(!useAssay %in% sctkAssayNames(inSCE)){
202
+    if(!useAssay %in% expDataNames(inSCE)){
203 203
         stop('Specified assay does not exist in input SCE object')
204 204
     }
205 205
     if(!all(rowDataName %in% names(SummarizedExperiment::rowData(inSCE)))){
... ...
@@ -363,7 +363,7 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
363 363
     }
364 364
 
365 365
     # Extract
366
-    mat <- as.matrix(sctkAssay(inSCE, useAssay))
366
+    mat <- as.matrix(expData(inSCE, useAssay))
367 367
     if (isTRUE(doLog)) {
368 368
       mat <- log(mat + 1)
369 369
     }
Browse code

Updates to sctkTagging

Irzam Sarfraz authored on 07/02/2021 16:04:14
Showing1 changed files
... ...
@@ -199,7 +199,7 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
199 199
     if(!inherits(inSCE, "SingleCellExperiment")){
200 200
         stop('Input object is not a valid SingleCellExperiment object.')
201 201
     }
202
-    if(!useAssay %in% SummarizedExperiment::assayNames(inSCE)){
202
+    if(!useAssay %in% sctkAssayNames(inSCE)){
203 203
         stop('Specified assay does not exist in input SCE object')
204 204
     }
205 205
     if(!all(rowDataName %in% names(SummarizedExperiment::rowData(inSCE)))){
... ...
@@ -363,7 +363,7 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
363 363
     }
364 364
 
365 365
     # Extract
366
-    mat <- as.matrix(SummarizedExperiment::assay(inSCE, useAssay))
366
+    mat <- as.matrix(sctkAssay(inSCE, useAssay))
367 367
     if (isTRUE(doLog)) {
368 368
       mat <- log(mat + 1)
369 369
     }
Browse code

Edit links to documentation

unknown authored on 22/10/2020 03:39:09
Showing1 changed files
... ...
@@ -40,7 +40,7 @@
40 40
 #' @param axis Choose from \code{"col"} or \code{"row"}.
41 41
 #' @param colorGen A function that generates color code vector by giving an
42 42
 #' integer for the number of colors. Alternatively,
43
-#' \code{\link[grDevices]{rainbow}}. Default \code{\link{distinctColors}}.
43
+#' \code{\link{rainbow}}. Default \code{\link{distinctColors}}.
44 44
 #' @return A \code{list} object containing distinct colors mapped to all
45 45
 #' possible categorical entries in \code{rowData(inSCE)} or
46 46
 #' \code{colData(inSCE)}.
Browse code

better DE vis

Yichen Wang authored on 19/10/2020 15:42:20
Showing1 changed files
... ...
@@ -109,6 +109,9 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
109 109
 #' @param inSCE \linkS4class{SingleCellExperiment} inherited object.
110 110
 #' @param useAssay character. A string indicating the assay name that
111 111
 #' provides the expression level to plot.
112
+#' @param doLog Logical scalar. Whether to do \code{log(assay + 1)}
113
+#' transformation on the assay indicated by \code{useAssay}. Default
114
+#' \code{FALSE}.
112 115
 #' @param featureIndex A vector that can subset the input SCE object by rows
113 116
 #' (features). Alternatively, it can be a vector identifying features in
114 117
 #' another feature list indicated by \code{featureIndexBy}. Default \code{NULL}.
... ...
@@ -181,7 +184,8 @@ dataAnnotationColor <- function(inSCE, axis = NULL,
181 184
 #' @return A \code{\link[ComplexHeatmap]{Heatmap}} object
182 185
 #' @export
183 186
 #' @author Yichen Wang
184
-plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', featureIndex = NULL,
187
+plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', doLog = FALSE,
188
+                           featureIndex = NULL,
185 189
     cellIndex = NULL, featureIndexBy = 'rownames', cellIndexBy = 'rownames',
186 190
     featureAnnotations = NULL, cellAnnotations = NULL,
187 191
     featureAnnotationColor = NULL, cellAnnotationColor = NULL,
... ...
@@ -360,6 +364,9 @@ plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', featureIndex = NULL,
360 364
 
361 365
     # Extract
362 366
     mat <- as.matrix(SummarizedExperiment::assay(inSCE, useAssay))
367
+    if (isTRUE(doLog)) {
368
+      mat <- log(mat + 1)
369
+    }