Browse code

Revert "Revert "fixes check fails""

This reverts commit b28f2c418152b0e4bc225b527cf7cca1ded14159.

Ashastry2 authored on 07/10/2024 20:45:45
Showing 6 changed files

... ...
@@ -62,6 +62,7 @@ Imports:
62 62
     ggrepel,
63 63
     ggtree,
64 64
     gridExtra,
65
+    grid,
65 66
     GSVA (>= 1.50.0),
66 67
     GSVAdata,
67 68
     igraph,
... ...
@@ -85,6 +86,7 @@ Imports:
85 86
     shiny,
86 87
     shinyjs,
87 88
     SingleR,
89
+    stringr,
88 90
     SoupX,
89 91
     sva,
90 92
     reshape2,
... ...
@@ -98,6 +100,7 @@ Imports:
98 100
     reticulate (>= 1.14),
99 101
     tools,
100 102
     tximport,
103
+    tidyr,
101 104
     eds,
102 105
     withr,
103 106
     GSEABase,
... ...
@@ -128,7 +131,6 @@ Suggests:
128 131
     lintr,
129 132
     spelling,
130 133
     org.Mm.eg.db,
131
-    stringr,
132 134
     kableExtra,
133 135
     shinythemes,
134 136
     shinyBS,
... ...
@@ -294,8 +294,16 @@ importFrom(SummarizedExperiment,assays)
294 294
 importFrom(SummarizedExperiment,colData)
295 295
 importFrom(SummarizedExperiment,rowData)
296 296
 importFrom(dplyr,"%>%")
297
+importFrom(dplyr,arrange)
298
+importFrom(dplyr,count)
299
+importFrom(dplyr,desc)
297 300
 importFrom(dplyr,group_by)
301
+importFrom(dplyr,mutate)
302
+importFrom(dplyr,one_of)
303
+importFrom(dplyr,select)
298 304
 importFrom(dplyr,summarize)
305
+importFrom(dplyr,ungroup)
306
+importFrom(grid,gpar)
299 307
 importFrom(magrittr,"%>%")
300 308
 importFrom(methods,slot)
301 309
 importFrom(reshape2,melt)
... ...
@@ -306,7 +314,12 @@ importFrom(rlang,.data)
306 314
 importFrom(scuttle,aggregateAcrossCells)
307 315
 importFrom(scuttle,aggregateAcrossFeatures)
308 316
 importFrom(stats,filter)
317
+importFrom(stats,prcomp)
318
+importFrom(stats,quantile)
319
+importFrom(stringr,str_c)
320
+importFrom(stringr,str_replace_all)
309 321
 importFrom(tibble,tibble)
322
+importFrom(tidyr,spread)
310 323
 importFrom(tools,file_ext)
311 324
 importFrom(utils,head)
312 325
 importFrom(utils,packageVersion)
... ...
@@ -234,9 +234,7 @@ plotFindMarkerHeatmap <- function(inSCE, orderBy = 'size',
234 234
                        featureAnnotations = featureAnnotations,
235 235
                        cellAnnotations = cellAnnotations,
236 236
                        featureAnnotationColor = featureAnnotationColor,
237
-                       cellAnnotationColor = cellAnnotationColor,
238
-                       cluster_row_slices = FALSE, rowLabel = rowLabel,
239
-                       cluster_column_slices = FALSE,
237
+                       cellAnnotationColor = cellAnnotationColor, rowLabel = rowLabel,
240 238
                        rowDend = rowDend, colDend = colDend, title = title, ...)
241 239
   return(hm)
242 240
 }
243 241
deleted file mode 100644
... ...
@@ -1,564 +0,0 @@
1
-#' Plot heatmap of using data stored in SingleCellExperiment Object
2
-#' @rdname plotSCEHeatmap
3
-#' @param inSCE \linkS4class{SingleCellExperiment} inherited object.
4
-#' @param useAssay character. A string indicating the assay name that
5
-#' provides the expression level to plot. Only for \code{plotSCEHeatmap}.
6
-#' @param useReducedDim character. A string indicating the reducedDim name that
7
-#' provides the expression level to plot. Only for \code{plotSCEDimReduceHeatmap}.
8
-#' @param doLog Logical scalar. Whether to do \code{log(assay + 1)}
9
-#' transformation on the assay indicated by \code{useAssay}. Default
10
-#' \code{FALSE}.
11
-#' @param featureIndex A vector that can subset the input SCE object by rows
12
-#' (features). Alternatively, it can be a vector identifying features in
13
-#' another feature list indicated by \code{featureIndexBy}. Default \code{NULL}.
14
-#' @param cellIndex A vector that can subset the input SCE object by columns
15
-#' (cells). Alternatively, it can be a vector identifying cells in another
16
-#' cell list indicated by \code{featureIndexBy}. Default \code{NULL}.
17
-#' @param scale Whether to perform z-score scaling on each row. Default
18
-#' \code{TRUE}.
19
-#' @param trim A 2-element numeric vector. Values outside of this range will be
20
-#' trimmed to their nearst bound. Default \code{c(-2, 2)}
21
-#' @param featureIndexBy A single character specifying a column name of
22
-#' \code{rowData(inSCE)}, or a vector of the same length as \code{nrow(inSCE)},
23
-#' where we search for the non-rowname feature indices. Not applicable for
24
-#' \code{plotSCEDimReduceHeatmap}. Default \code{"rownames"}.
25
-#' @param cellIndexBy A single character specifying a column name of
26
-#' \code{colData(inSCE)}, or a vector of the same length as \code{ncol(inSCE)},
27
-#' where we search for the non-rowname cell indices. Default \code{"rownames"}.
28
-#' @param rowDataName character. The column name(s) in \code{rowData} that need
29
-#' to be added to the annotation. Not applicable for
30
-#' \code{plotSCEDimReduceHeatmap}. Default \code{NULL}.
31
-#' @param colDataName character. The column name(s) in \code{colData} that need
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}.
39
-#' @param featureAnnotations \code{data.frame}, with \code{rownames} containing
40
-#' all the features going to be plotted. Character columns should be factors.
41
-#' Default \code{NULL}.
42
-#' @param cellAnnotations \code{data.frame}, with \code{rownames} containing
43
-#' all the cells going to be plotted. Character columns should be factors.
44
-#' Default \code{NULL}.
45
-#' @param featureAnnotationColor A named list. Customized color settings for
46
-#' feature labeling. Should match the entries in the \code{featureAnnotations}
47
-#' or \code{rowDataName}. For each entry, there should be a list/vector of
48
-#' colors named with categories. Default \code{NULL}.
49
-#' @param cellAnnotationColor A named list. Customized color settings for
50
-#' cell labeling. Should match the entries in the \code{cellAnnotations} or
51
-#' \code{colDataName}. For each entry, there should be a list/vector of colors
52
-#' named with categories. Default \code{NULL}.
53
-#' @param annotationPalette Choose from \code{"ggplot"}, \code{"celda"} or \code{"random"}
54
-#' to generate unique category colors.
55
-<<<<<<< HEAD
56
-#' @param palette Choose from \code{"sequential"}, \code{"diverging"} or supply custom palette with colorScheme
57
-=======
58
-#' @param heatmapPalette Choose from \code{"sequential"}, \code{"diverging"} or supply custom palette with colorScheme
59
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
60
-#' to generate unique category colors. Default is \code{"sequential"}
61
-#' @param addCellSummary Add summary barplots to column annotation. Supply the name of the column in colData as a character. This option will add summary for categorical variables 
62
-#' as stacked barplots.
63
-#' @param rowSplitBy character. Do semi-heatmap based on the grouping of
64
-#' this(these) annotation(s). Should exist in either \code{rowDataName} or
65
-#' \code{names(featureAnnotations)}. Default \code{NULL}.
66
-#' @param colSplitBy character. Do semi-heatmap based on the grouping of
67
-#' this(these) annotation(s). Should exist in either \code{colDataName} or
68
-#' \code{names(cellAnnotations)}. Default \code{NULL}.
69
-#' @param rowLabel Use a logical for whether to display all the feature names,
70
-#' a single character to display a column of \code{rowData(inSCE)} annotation,
71
-#' a vector of the same length as full/subset \code{nrow(inSCE)} to display
72
-#' customized info. Default \code{FALSE}.
73
-#' @param colLabel Use a logical for whether to display all the cell names, a
74
-#' single character to display a column of \code{colData(inSCE)} annotation,
75
-#' a vector of the same length as full/subset \code{ncol(inSCE)} to display
76
-#' customized info. Default \code{FALSE}.
77
-#' @param rowLabelSize A number for the font size of feature names. Default
78
-#' \code{8}
79
-#' @param colLabelSize A number for the font size of cell names. Default
80
-#' \code{8}
81
-#' @param rowDend Whether to display row dendrogram. Default \code{TRUE}.
82
-#' @param colDend Whether to display column dendrogram. Default \code{TRUE}.
83
-#' @param title The main title of the whole plot. Default \code{NULL}.
84
-#' @param rowTitle The subtitle for the rows. Default \code{"Genes"}.
85
-#' @param colTitle The subtitle for the columns. Default \code{"Cells"}.
86
-#' @param rowGap A numeric value or a \code{\link[grid]{unit}} object. For the
87
-#' gap size between rows of the splitted heatmap. Default
88
-#' \code{grid::unit(0, 'mm')}.
89
-#' @param colGap A numeric value or a \code{\link[grid]{unit}} object. For the
90
-#' gap size between columns of the splitted heatmap. Default
91
-#' \code{grid::unit(0, 'mm')}.
92
-#' @param border A logical scalar. Whether to show the border of the heatmap or
93
-#' splitted heatmaps. Default \code{TRUE}.
94
-#' @param colorScheme function. A function that generates color code by giving
95
-#' a value. Can be generated by \code{\link[circlize]{colorRamp2}}.
96
-#' Default \code{NULL}.
97
-#' @param ... Other arguments passed to \code{\link[ComplexHeatmap]{Heatmap}}.
98
-#' @examples
99
-#' data(scExample, package = "singleCellTK")
100
-#' plotSCEHeatmap(sce[1:3,1:3], useAssay = "counts")
101
-#' @return A \code{\link[ggplot2]{ggplot}} object.
102
-#' @export
103
-#' @author Yichen Wang
104
-#' @importFrom scuttle aggregateAcrossCells aggregateAcrossFeatures
105
-#' @importFrom SingleCellExperiment SingleCellExperiment
106
-#' @importFrom SummarizedExperiment colData assayNames<-
107
-#' @importFrom stringr str_replace_all str_c
108
-#' @importFrom stats prcomp quantile
109
-#' @importFrom dplyr select arrange group_by count ungroup mutate one_of desc
110
-#' @importFrom tidyr spread
111
-#' @importFrom grid gpar
112
-plotSCEHeatmap <- function(inSCE, useAssay = 'logcounts', useReducedDim = NULL,
113
-                           doLog = FALSE, featureIndex = NULL, cellIndex = NULL,
114
-                           scale = TRUE, trim = c(-2,2),
115
-                           featureIndexBy = 'rownames',
116
-                           cellIndexBy = 'rownames',
117
-                           rowDataName = NULL, colDataName = NULL,
118
-                           aggregateRow = NULL, aggregateCol = NULL,
119
-                           featureAnnotations = NULL, cellAnnotations = NULL,
120
-                           featureAnnotationColor = NULL,
121
-                           cellAnnotationColor = NULL,
122
-<<<<<<< HEAD
123
-                           annotationPalette = c("ggplot", "celda", "random"),
124
-                           palette = c("sequential","diverging"),
125
-=======
126
-                           palette = c("ggplot", "celda", "random"),
127
-                           heatmapPalette = c("sequential","diverging"),
128
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
129
-                           addCellSummary = NULL,
130
-                           rowSplitBy = NULL, colSplitBy = NULL,
131
-                           rowLabel = FALSE, colLabel = FALSE,
132
-                           rowLabelSize = 6, colLabelSize = 6,
133
-                           rowDend = TRUE, colDend = TRUE,
134
-                           title = NULL, rowTitle = 'Features',
135
-                           colTitle = 'Cells',
136
-                           rowGap = grid::unit(0, 'mm'),
137
-                           colGap = grid::unit(0, 'mm'),
138
-                           border = FALSE, colorScheme = NULL, ...){
139
-<<<<<<< HEAD
140
-  annotationPalette<-match.arg(annotationPalette)
141
-  palette<-match.arg(palette)
142
-=======
143
-  palette<-match.arg(palette)
144
-  heatmapPalette<-match.arg(heatmapPalette)
145
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
146
-  # STAGE 1: Create clean SCE object with only needed information ####
147
-  ## .selectSCEMatrix, .manageCellVar and .manageFeatureVar perform checks
148
-  useMat <- .selectSCEMatrix(inSCE, useAssay = useAssay,
149
-                             useReducedDim = useReducedDim,
150
-                             returnMatrix = TRUE, cellAsCol = TRUE)
151
-  useAssay <- useMat$names$useAssay
152
-  useReducedDim <- useMat$names$useReducedDim
153
-  useData <- ifelse(!is.null(useAssay), useAssay, useReducedDim)
154
-  ### cell annotation
155
-  oldColData <- colData(inSCE)
156
-  colDataName <- unique(c(colDataName, aggregateCol))
157
-  colDataAnns <- lapply(colDataName, function(x) .manageCellVar(inSCE, x))
158
-  if (length(colDataName) > 0)
159
-    colDataAnns <- data.frame(colDataAnns, row.names = colnames(inSCE))
160
-  else
161
-    colDataAnns <- data.frame(row.names = colnames(inSCE))
162
-  colnames(colDataAnns) <- colDataName
163
-  cellAnnotations <- .mergeAnnotationDF(colDataAnns, cellAnnotations)
164
-  if (!is.null(colSplitBy) &&
165
-      any(!colSplitBy %in% colnames(cellAnnotations)))
166
-    stop('Specified `colSplitBy` variables not found.')
167
-  if (isTRUE(colLabel)) {
168
-    colLabelName <- colnames(inSCE)
169
-  } else if (isFALSE(colLabel)) {
170
-    colLabelName <- NULL
171
-  } else {
172
-    colLabelName <- .manageCellVar(inSCE, colLabel)
173
-    colLabel <- TRUE
174
-  }
175
-  ### feature annotation
176
-  rowDataAnns <- data.frame(row.names = rownames(useMat$mat))
177
-  if (!is.null(useAssay)) {
178
-    # When using reducedDim, no rowData can be applied
179
-    rowDataName <- unique(c(rowDataName, aggregateRow))
180
-    rowDataAnns <- lapply(rowDataName, function(x) .manageFeatureVar(inSCE, x))
181
-    if (length(rowDataName) > 0)
182
-      rowDataAnns <- data.frame(rowDataAnns, row.names = rownames(inSCE))
183
-    else
184
-      rowDataAnns <- data.frame(row.names = rownames(inSCE))
185
-    colnames(rowDataAnns) <- rowDataName
186
-  }
187
-  # But customized featureAnnotations should work
188
-  featureAnnotations <- .mergeAnnotationDF(rowDataAnns, featureAnnotations)
189
-  if (!is.null(rowSplitBy) &&
190
-      any(!rowSplitBy %in% colnames(featureAnnotations)))
191
-    stop('Specified `rowSplitBy` variables not found.')
192
-  if (isTRUE(rowLabel)) {
193
-    rowLabelName <- rownames(useMat$mat)
194
-  } else if (isFALSE(rowLabel)) {
195
-    rowLabelName <- NULL
196
-  } else {
197
-    if (!is.null(useAssay)) {
198
-      rowLabelName <- .manageFeatureVar(inSCE, rowLabel)
199
-      rowLabel <- TRUE
200
-    } else {
201
-      # Using customized rowLabel for reducedDim
202
-      if (length(rowLabel) != nrow(useMat$mat))
203
-        stop("Length of `rowLabel` does not match nrow of specified ",
204
-             "`useReducedDim`")
205
-      rowLabelName <- rowLabel
206
-      rowLabel <- TRUE
207
-    }
208
-  }
209
-  ### create SCE object
210
-  SCE <- SingleCellExperiment(assay = list(useMat$mat),
211
-                              colData = cellAnnotations,
212
-                              rowData = featureAnnotations)
213
-  assayNames(SCE) <- useData
214
-  
215
-  .minmax<-function(mat){
216
-    min_max<- function(x) {
217
-      new_x =  (x - min(x))/ (max(x) - min(x))
218
-      return(new_x)}
219
-    new_mat<-as.matrix(apply(mat,FUN = min_max,MARGIN = 2))
220
-    return(new_mat)
221
-    }
222
-  
223
-  # STAGE 2: Subset SCE object as needed ####
224
-  # Manage cell subsetting
225
-  if(is.null(cellIndex)){
226
-    cellIndex <- seq(ncol(SCE))
227
-  } else if (is.character(cellIndex)) {
228
-    # cellIndexBy not necessarily included in new "SCE"
229
-    cellIndex <- retrieveSCEIndex(inSCE, cellIndex, axis = "col",
230
-                                  by = cellIndexBy)
231
-  } else if (is.logical(cellIndex)) {
232
-    if (length(cellIndex) != ncol(inSCE)) {
233
-      stop("Logical index length does not match ncol(inSCE)")
234
-    }
235
-    cellIndex <- which(cellIndex)
236
-  }
237
-  # Manage feature subsetting
238
-  if(is.null(featureIndex)){
239
-    featureIndex <- seq(nrow(SCE))
240
-  } else if (is.character(featureIndex)) {
241
-    if (!is.null(useAssay))
242
-      featureIndex <- retrieveSCEIndex(inSCE, featureIndex, axis = "row",
243
-                                       by = featureIndexBy)
244
-    else
245
-      # When using reducedDim, can only go with "PC" names
246
-      # or customized "by"
247
-      featureIndex <- retrieveSCEIndex(SCE, featureIndex, axis = "row",
248
-                                       by = featureIndexBy)
249
-  } else if (is.logical(featureIndex)) {
250
-    if (length(featureIndex) != nrow(SCE)) {
251
-      stop("Logical index length does not match nrow(inSCE)")
252
-    }
253
-    featureIndex <- which(featureIndex)
254
-  }
255
-  colnames(SCE) <- colLabelName
256
-  rownames(SCE) <- rowLabelName
257
-  SCE <- SCE[featureIndex, cellIndex]
258
-  ### Scaling should be done before aggregating
259
-  if (isTRUE(doLog)) assay(SCE) <- log1p(assay(SCE))
260
-  if(isTRUE(scale)) scale <- "zscore"
261
-  if ((scale == "zscore")) {
262
-    assay(SCE) <- as.matrix(scale(assay(SCE)))
263
-  } else if (scale ==  "min_max") {
264
-    assay(SCE) <- as.matrix(.minmax(assay(SCE)))
265
-  }    
266
-  
267
-  
268
-  # STAGE 3: Aggregate As needed ####
269
-  if (!is.null(aggregateCol)) {
270
-    # TODO: whether to also aggregate numeric variable that users want
271
-    # Might need to use "coldata.merge" in aggregate function
272
-    colIDS <- colData(SCE)[, aggregateCol]
273
-    origRowData <- rowData(SCE)
274
-    SCE <- aggregateAcrossCells(SCE, ids = colIDS,
275
-                                use.assay.type = useData,
276
-                                store.number = NULL, statistics = "mean")
277
-    # TODO: `aggregateAcrossCells` produce duplicated variables in colData
278
-    # and unwanted "ncell" variable even if I set `store.number = NULL`.
279
-    colData(SCE) <- colData(SCE)[,c(aggregateCol),drop=FALSE] ##change
280
-    newColnames <- do.call(paste, c(colData(SCE), list(sep = "_")))
281
-    colnames(SCE) <- newColnames
282
-    rowData(SCE) <- origRowData
283
-  }
284
-  if (!is.null(aggregateRow)) {
285
-    # `aggregateAcrossFeatures` doesn't work by with multi-var
286
-    # Remake one single variable vector
287
-    rowIDS <- rowData(SCE)[, aggregateRow, drop = FALSE]
288
-    rowIDS <- do.call(paste, c(rowIDS, list(sep = "_")))
289
-    origColData <- colData(SCE)
290
-    SCE <- aggregateAcrossFeatures(SCE, ids = rowIDS, average = TRUE,
291
-                                   use.assay.type = useData)
292
-    colData(SCE) <- origColData
293
-  }
294
-  # STAGE 4: Other minor preparation for plotting ####
295
-
296
-  # Create a function that sorts the matrix by PC1
297
-  .orderMatrix<-function(mat){
298
-    # Adding extra character to rownames because presence of some char gets a "." if I don't
299
-    mat2<-data.frame(t(mat))
300
-<<<<<<< HEAD
301
-    rownames(mat2)<-str_c("K_",rownames(mat2))
302
-    pca_mat<-prcomp(mat2,center = TRUE, scale. = FALSE)
303
-    kl<-arrange(data.frame(pca_mat$x)["PC1"],desc(PC1))
304
-    mat<-data.frame(t(mat2)) %>% dplyr::select(rownames(kl))
305
-    colnames(mat)<-str_replace_all(colnames(mat),"K_","")
306
-=======
307
-    rownames(mat2)<-stringr::str_c("K_",rownames(mat2))
308
-    pca_mat<-stats::prcomp(mat2,center = TRUE, scale. = FALSE)
309
-    kl<-dplyr::arrange(data.frame(pca_mat$x)["PC1"],desc(PC1))
310
-    mat<-data.frame(t(mat2)) %>% dplyr::select(rownames(kl))
311
-    colnames(mat)<-stringr::str_replace_all(colnames(mat),"K_","")
312
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
313
-    return(as.matrix(mat))
314
-  }
315
-  
316
-  # Prepare
317
-<<<<<<< HEAD
318
-    mat <- assay(SCE)
319
-    mat <- .orderMatrix(mat)
320
-=======
321
-  if(useAssay == "reducedDim"){
322
-    mat <- assay(SCE)
323
-    mat <- .orderMatrix(mat)
324
-    
325
-  } else{
326
-    mat<- assay(SCE)
327
-  }
328
-   
329
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
330
- 
331
-  
332
-  if (!is.null(trim) & scale == "zscore") {
333
-    assay(SCE) <- trimCounts(assay(SCE), trim)  
334
-<<<<<<< HEAD
335
-    print(quantile(assay(SCE)))
336
-=======
337
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
338
-  }    
339
-  
340
-  
341
-  if (is.null(colorScheme)) {
342
-    if (isFALSE(scale)){
343
-<<<<<<< HEAD
344
-      if (palette == "sequential"){
345
-        colorScheme <- circlize::colorRamp2(quantile(mat),
346
-                                            c('white', "#fecc5c",'#fdae61',"#f03b20","#bd0026"))
347
-      }
348
-      else if (palette == "diverging"){
349
-=======
350
-      if (heatmapPalette == "sequential"){
351
-        colorScheme <- circlize::colorRamp2(quantile(mat,na.rm=TRUE),
352
-                                            c('white', "#fecc5c",'#fdae61',"#f03b20","#bd0026"))
353
-      }
354
-      else if (heatmapPalette == "diverging"){
355
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
356
-      colorScheme <- circlize::colorRamp2(c(min(mat),
357
-                                            (max(mat) + min(mat))/2,
358
-                                            max(mat)),
359
-                                          c('blue', 'white', 'red'))
360
-      }
361
-    }
362
-    else if (scale == "zscore"){
363
-<<<<<<< HEAD
364
-      colorScheme <- circlize::colorRamp2(quantile(assay(SCE)),
365
-                                          c('#2c7bb6','#abd9e9','#ffffbf','#fdae61','#d7191c'))
366
-    }
367
-    else if (scale == "min_max"){
368
-      if(palette == "sequential"){
369
-=======
370
-      colorScheme <- circlize::colorRamp2(quantile(assay(SCE), na.rm = TRUE),
371
-                                          c('#2c7bb6','#abd9e9','#ffffbf','#fdae61','#d7191c'))
372
-    }
373
-    else if (scale == "min_max"){
374
-      if(heatmapPalette == "sequential"){
375
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
376
-        colorScheme <- circlize::colorRamp2(c(0,0.3,0.6,0.8,1),
377
-                                            c('white', "#fecc5c",'#fdae61',"#f03b20","#bd0026")) 
378
-        
379
-      }
380
-<<<<<<< HEAD
381
-      else if (palette == "diverging") {
382
-=======
383
-      else if (heatmapPalette == "diverging") {
384
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
385
-      colorScheme <- circlize::colorRamp2(c(0,0.3,0.6,0.8,1),
386
-                                          c('#2c7bb6','#abd9e9','#ffffbf','#fdae61','#d7191c'))     
387
-      }
388
-    }
389
-  } else {
390
-    if (!is.function(colorScheme))
391
-      stop('`colorScheme` must be a function generated by ',
392
-           'circlize::colorRamp2')
393
-    breaks <- attr(colorScheme, 'breaks')
394
-    if (breaks[1] != min(trim) || breaks[length(breaks)] != max(trim))
395
-      stop('Breaks of `colorScheme` do not match with `trim`.')
396
-  }
397
-  ### Generate HeatmapAnnotation object
398
-  ca <- NULL
399
-  cellAnnotationColor <- .heatmapAnnColor(SCE, slot = "colData",
400
-                                          custom = cellAnnotationColor,
401
-<<<<<<< HEAD
402
-                                          palette = annotationPalette)
403
-=======
404
-                                          palette = palette)
405
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
406
-  if(dim(cellAnnotations)[2] > 0)
407
-    if(is.null(addCellSummary)){
408
-      ca <- ComplexHeatmap::HeatmapAnnotation(df = colData(SCE),
409
-                                              col = cellAnnotationColor)
410
-    }
411
-  else if (!addCellSummary %in% colnames(oldColData)){
412
-    stop(addCellSummary,
413
-         "' not found in colData")
414
-  }
415
-  else if (addCellSummary %in% colnames(oldColData)){
416
-    oldColData %>%
417
-      as.data.frame() %>%
418
-      group_by(!!!rlang::syms(aggregateCol),!!!rlang::syms(addCellSummary)) %>%
419
-      count() %>%
420
-      ungroup() %>%
421
-      group_by(!!! rlang::syms(aggregateCol)) %>%
422
-      mutate(sum = sum(n)) %>%
423
-      mutate(value = n/sum) %>%
424
-<<<<<<< HEAD
425
-      select(-n,sum) %>%
426
-      spread(one_of(addCellSummary),value) %>%
427
-      ungroup() %>%
428
-      select(-one_of(aggregateCol),-sum) -> boxdata
429
-=======
430
-      dplyr::select(-n,sum) %>%
431
-      spread(one_of(addCellSummary),value) %>%
432
-      ungroup() %>%
433
-      dplyr::select(-one_of(aggregateCol),-sum) -> boxdata
434
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
435
-    
436
-    
437
-    boxdata[is.na(boxdata)]  <- 0
438
-    boxdata<-as.matrix(boxdata)
439
-    ca <- ComplexHeatmap::HeatmapAnnotation(addCellSummary = anno_barplot(boxdata,
440
-                                                                         gp = gpar(fill = 2:5)),
441
-                                            annotation_label = addCellSummary,
442
-                                            col = cellAnnotationColor)
443
-  }
444
-  ra <- NULL
445
-  featureAnnotationColor <- .heatmapAnnColor(SCE, slot = "rowData",
446
-                                             custom = featureAnnotationColor,
447
-<<<<<<< HEAD
448
-                                             palette = annotationPalette)
449
-=======
450
-                                             palette = palette)
451
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
452
-  if(ncol(rowData(SCE)) > 0)
453
-    ra <- ComplexHeatmap::rowAnnotation(df = rowData(SCE),
454
-                                        col = featureAnnotationColor)
455
-  ### Set split variable
456
-  cs <- NULL
457
-  if (!is.null(colSplitBy)) cs <- colData(SCE)[colSplitBy]
458
-  rs <- NULL
459
-  if (!is.null(rowSplitBy)) rs <- rowData(SCE)[rowSplitBy]
460
-  ###
461
-  if (!is.null(colGap)) {
462
-    if (!inherits(colGap, "unit"))
463
-      stop("`colGap` has to be 'unit' object. Try `grid::unit(", colGap,
464
-           ", 'mm')`.")
465
-  }
466
-  else colGap <- grid::unit(0, 'mm')
467
-  if (!is.null(rowGap)) {
468
-    if (!inherits(rowGap, "unit"))
469
-      stop("`rowGap` has to be 'unit' object. Try `grid::unit(", rowGap,
470
-           ", 'mm')`.")
471
-  }
472
-  else rowGap <- grid::unit(0, 'mm')
473
-  
474
-  if (!is.null(useAssay)) name <- useAssay
475
-  else name <- useReducedDim
476
-  hm <- ComplexHeatmap::Heatmap(mat, name = name, left_annotation = ra,
477
-                                top_annotation = ca, col = colorScheme,
478
-                                row_split = rs, column_split = cs,
479
-                                row_title = rowTitle, column_title = colTitle,
480
-                                show_row_names = rowLabel,
481
-                                row_names_gp = grid::gpar(fontsize = rowLabelSize),
482
-                                show_row_dend = rowDend,
483
-                                row_dend_reorder = TRUE,
484
-                                cluster_columns = FALSE,
485
-                                show_column_names = colLabel,
486
-                                column_names_gp = grid::gpar(fontsize = colLabelSize),
487
-                                row_gap = rowGap, column_gap = colGap,
488
-                                border = border,
489
-                                ...)
490
-  return(hm)
491
-}
492
-
493
-.mergeAnnotationDF <- function(origin, external) {
494
-  if (!is.null(external)) {
495
-    external <- external[match(rownames(origin), rownames(external)), ,drop = FALSE]
496
-    origin <- cbind(origin, external)
497
-  }
498
-  return(origin)
499
-}
500
-
501
-.heatmapAnnColor <- function(inSCE, slot = c("colData", "rowData"),
502
-<<<<<<< HEAD
503
-                             custom = NULL, palette = annotationPalette) {
504
-=======
505
-                             custom = NULL, palette = palette) {
506
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
507
-  slot <- match.arg(slot)
508
-  if (!is.null(custom) && !is.list(custom))
509
-    stop("'cellAnnotationColor' or 'featureAnnotationColor' must be a list.")
510
-  if (is.null(custom)) custom <- list()
511
-  if (slot == "colData") data <- SummarizedExperiment::colData(inSCE)
512
-  if (slot == "rowData") data <- SummarizedExperiment::rowData(inSCE)
513
-  todoNames <- colnames(data)
514
-  todoNames <- todoNames[!todoNames %in% names(custom)]
515
-  newColor <- lapply(todoNames, function(n) {
516
-    var <- data[[n]]
517
-    if (is.factor(var)) categories <- levels(var)
518
-    else categories <- unique(var)
519
-    colors <- discreteColorPalette(length(categories), palette = palette)
520
-    names(colors) <- categories
521
-    return(colors)
522
-  })
523
-  names(newColor) <- todoNames
524
-  custom <- c(custom, newColor)
525
-  return(custom)
526
-}
527
-# Test
528
-#logcounts(sceBatches) <- log1p(counts(sceBatches))
529
-#plotSCEHeatmap2(sceBatches, "logcounts",
530
-#                featureIndex = c("GCG1", "COX11", "INS1", "ND41"),
531
-#                featureIndexBy = rowData(sceBatches)$feature_name,
532
-#                cellIndex = c("reads.16087_", "Sample_1073_",
533
-#                              "reads.29330_", "Sample_801_"),
534
-#                cellIndexBy = paste0(colnames(sceBatches), "_"),
535
-#                rowLabel = "feature_name", rowDend = FALSE,
536
-#                cluster_rows = FALSE, colLabel = TRUE, cluster_columns = FALSE,
537
-#                colDataName = c("batch", "cell_type"), aggregateCol = c("cell_type", "batch"))
538
-#sce <-plotSCEHeatmap2(sceBatches, aggregateCol = "batch")
539
-#plotSCEHeatmap2(sceBatches, aggregateCol = c("cell_type", "batch"))
540
-#plotFindMarkerHeatmap(sce, log2fcThreshold = 0, minClustExprPerc = 0.4,
541
-#                      maxCtrlExprPerc = 0.5)
542
-#plotFindMarkerHeatmap(sce, log2fcThreshold = 0, minClustExprPerc = 0.4,
543
-#                      maxCtrlExprPerc = 0.5,
544
-#                      aggregateRow = "marker")
545
-#plotSCEDimReduceColData(sce, "cluster", "UMAP")
546
-CellVarColor <- function(inSCE, var,
547
-<<<<<<< HEAD
548
-                         annotationPalette = c("ggplot", "random", "celda"),
549
-                         seed = 12345, ...) {
550
-  var <- .manageCellVar(inSCE, var = var)
551
-  palette <- match.arg(annotationPalette)
552
-=======
553
-                         palette = c("ggplot", "random", "celda"),
554
-                         seed = 12345, ...) {
555
-  var <- .manageCellVar(inSCE, var = var)
556
-  palette <- match.arg(palette)
557
->>>>>>> 40527afd2e58e14451aae655c0d8fae4a7a0f54b
558
-  if (is.factor(var)) uniqVar <- levels(var)
559
-  else uniqVar <- unique(var)
560
-  colors <- discreteColorPalette(length(uniqVar), palette = palette, seed = seed, ...)
561
-  names(colors) <- uniqVar
562
-  return(colors)
563
-}
564
-
... ...
@@ -427,7 +427,6 @@ plotTSCANPseudotimeHeatmap <- function(inSCE,
427 427
                    featureIndex = genes,
428 428
                    colDend = FALSE,
429 429
                    rowDend = FALSE,
430
-                   cluster_columns = FALSE, cluster_rows = TRUE,
431 430
                    colDataName = c("TSCAN_clusters", colPathPseudo),
432 431
                    rowLabel = rowLabel,
433 432
                    featureAnnotations = direction.df,
... ...
@@ -24,6 +24,8 @@ plotSCEHeatmap(
24 24
   featureAnnotationColor = NULL,
25 25
   cellAnnotationColor = NULL,
26 26
   palette = c("ggplot", "celda", "random"),
27
+  heatmapPalette = c("sequential", "diverging"),
28
+  addCellSummary = NULL,
27 29
   rowSplitBy = NULL,
28 30
   colSplitBy = NULL,
29 31
   rowLabel = FALSE,
... ...
@@ -114,6 +116,12 @@ named with categories. Default \code{NULL}.}
114 116
 \item{palette}{Choose from \code{"ggplot"}, \code{"celda"} or \code{"random"}
115 117
 to generate unique category colors.}
116 118
 
119
+\item{heatmapPalette}{Choose from \code{"sequential"}, \code{"diverging"} or supply custom palette with colorScheme
120
+to generate unique category colors. Default is \code{"sequential"}}
121
+
122
+\item{addCellSummary}{Add summary barplots to column annotation. Supply the name of the column in colData as a character. This option will add summary for categorical variables 
123
+as stacked barplots.}
124
+
117 125
 \item{rowSplitBy}{character. Do semi-heatmap based on the grouping of
118 126
 this(these) annotation(s). Should exist in either \code{rowDataName} or
119 127
 \code{names(featureAnnotations)}. Default \code{NULL}.}