This reverts commit b28f2c418152b0e4bc225b527cf7cca1ded14159.
... | ... |
@@ -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}.} |