Better colors
... | ... |
@@ -3,13 +3,15 @@ |
3 | 3 |
## New features |
4 | 4 |
|
5 | 5 |
* `gs_heatmap` gains the `winsorize_threshold` parameter, to control the behavior of the geneset heatmap in presence of extreme values, either negative or positive ones. If not specified, the heatmap is not introducing any winsorization. |
6 |
+* `map2color()` has a behavior that better accounts for asymmetric ranges of values. This propagates to some of the functions that use it for mapping to colors, such as `enrichment_map()`, or `ggs_backbone()`. |
|
6 | 7 |
|
7 | 8 |
## Other notes |
8 | 9 |
|
9 | 10 |
* Fixed the behavior of the reactive elements after uploading the `GeneTonicList` object at runtime. |
10 | 11 |
* Fixed the label namings for the `gs_heatmap` function |
11 | 12 |
* The `enhance_table()` function can handle the case where a gene is in the enrichment results table but not present in the annotation (e.g. annotations are updated, so some correspondences might get lost). It also presents an informative message on which genesets/genes are potentially responsible for the behavior. |
12 |
- |
|
13 |
+* Some additional checks are in place for controlling the cases where the `z_score` of a geneset is detected as NA (e.g. because there was a mismatch between gene names and identifiers in the annotation). |
|
14 |
+ |
|
13 | 15 |
# GeneTonic 2.0.0 |
14 | 16 |
|
15 | 17 |
## New features |
... | ... |
@@ -549,6 +549,9 @@ styleColorBar_divergent <- function(data, |
549 | 549 |
#' be converted to a vector of colors |
550 | 550 |
#' @param pal A vector of characters specifying the definition of colors for the |
551 | 551 |
#' palette, e.g. obtained via \code{\link{brewer.pal}} |
552 |
+#' @param symmetric Logical value, whether to return a palette which is symmetrical |
|
553 |
+#' with respect to the minimum and maximum values - "respecting" the zero. |
|
554 |
+#' Defaults to `TRUE`. |
|
552 | 555 |
#' @param limits A vector containing the limits of the values to be mapped. If |
553 | 556 |
#' not specified, defaults to the range of values in the `x` vector. |
554 | 557 |
#' |
... | ... |
@@ -567,16 +570,24 @@ styleColorBar_divergent <- function(data, |
567 | 570 |
#' RColorBrewer::brewer.pal(name = "RdYlBu", 11) |
568 | 571 |
#' )(50) |
569 | 572 |
#' plot(b, col = map2color(b, pal2), pch = 20, cex = 3) |
570 |
-map2color <- function(x, pal, limits = NULL) { |
|
573 |
+map2color <- function(x, pal, symmetric = TRUE, limits = NULL) { |
|
571 | 574 |
if (is.null(limits)) { |
572 | 575 |
limits <- range(x) |
573 | 576 |
} |
574 |
- pal[findInterval(x, seq(limits[1], |
|
577 |
+ |
|
578 |
+ if (symmetric) { |
|
579 |
+ max_val <- max(limits) |
|
580 |
+ limits[1] <- -max_val |
|
581 |
+ limits[2] <- max_val |
|
582 |
+ } |
|
583 |
+ |
|
584 |
+ pal_ret <- pal[findInterval(x, seq(limits[1], |
|
575 | 585 |
limits[2], |
576 | 586 |
length.out = length(pal) + 1 |
577 | 587 |
), |
578 | 588 |
all.inside = TRUE |
579 | 589 |
)] |
590 |
+ return(pal_ret) |
|
580 | 591 |
} |
581 | 592 |
|
582 | 593 |
|
... | ... |
@@ -170,9 +170,20 @@ enrichment_map <- function(res_enrich, |
170 | 170 |
mypal_select <- (scales::alpha( |
171 | 171 |
colorRampPalette(RColorBrewer::brewer.pal(name = "YlOrRd", 9))(50), 1 |
172 | 172 |
)) |
173 |
+ |
|
174 |
+ V(emg)$color.background <- map2color(col_var, mypal, symmetric = FALSE, |
|
175 |
+ limits = range(na.omit(col_var))) |
|
176 |
+ V(emg)$color.highlight <- map2color(col_var, mypal_select, symmetric = FALSE, |
|
177 |
+ limits = range(na.omit(col_var))) |
|
178 |
+ V(emg)$color.hover <- map2color(col_var, mypal_hover, symmetric = FALSE, |
|
179 |
+ limits = range(na.omit(col_var))) |
|
180 |
+ |
|
181 |
+ V(emg)$color.background[is.na(V(emg)$color.background)] <- "lightgrey" |
|
182 |
+ V(emg)$color.highlight[is.na(V(emg)$color.highlight)] <- "lightgrey" |
|
183 |
+ V(emg)$color.hover[is.na(V(emg)$color.hover)] <- "lightgrey" |
|
173 | 184 |
} else { |
174 | 185 |
# e.g. using z_score or aggregated value |
175 |
- if (prod(range(col_var)) >= 0) { |
|
186 |
+ if (prod(range(na.omit(col_var))) >= 0) { |
|
176 | 187 |
# gradient palette |
177 | 188 |
mypal <- (scales::alpha( |
178 | 189 |
colorRampPalette(RColorBrewer::brewer.pal(name = "Oranges", 9))(50), 0.8 |
... | ... |
@@ -183,6 +194,17 @@ enrichment_map <- function(res_enrich, |
183 | 194 |
mypal_select <- (scales::alpha( |
184 | 195 |
colorRampPalette(RColorBrewer::brewer.pal(name = "Oranges", 9))(50), 1 |
185 | 196 |
)) |
197 |
+ |
|
198 |
+ V(emg)$color.background <- map2color(col_var, mypal, symmetric = FALSE, |
|
199 |
+ limits = range(na.omit(col_var))) |
|
200 |
+ V(emg)$color.highlight <- map2color(col_var, mypal_select, symmetric = FALSE, |
|
201 |
+ limits = range(na.omit(col_var))) |
|
202 |
+ V(emg)$color.hover <- map2color(col_var, mypal_hover, symmetric = FALSE, |
|
203 |
+ limits = range(na.omit(col_var))) |
|
204 |
+ V(emg)$color.background[is.na(V(emg)$color.background)] <- "lightgrey" |
|
205 |
+ V(emg)$color.highlight[is.na(V(emg)$color.highlight)] <- "lightgrey" |
|
206 |
+ V(emg)$color.hover[is.na(V(emg)$color.hover)] <- "lightgrey" |
|
207 |
+ |
|
186 | 208 |
} else { |
187 | 209 |
# divergent palette to be used |
188 | 210 |
mypal <- rev(scales::alpha( |
... | ... |
@@ -194,14 +216,20 @@ enrichment_map <- function(res_enrich, |
194 | 216 |
mypal_select <- rev(scales::alpha( |
195 | 217 |
colorRampPalette(RColorBrewer::brewer.pal(name = "RdYlBu", 11))(50), 1 |
196 | 218 |
)) |
219 |
+ |
|
220 |
+ V(emg)$color.background <- map2color(col_var, mypal, symmetric = TRUE, |
|
221 |
+ limits = range(na.omit(col_var))) |
|
222 |
+ V(emg)$color.highlight <- map2color(col_var, mypal_select, symmetric = TRUE, |
|
223 |
+ limits = range(na.omit(col_var))) |
|
224 |
+ V(emg)$color.hover <- map2color(col_var, mypal_hover, symmetric = TRUE, |
|
225 |
+ limits = range(na.omit(col_var))) |
|
226 |
+ |
|
227 |
+ V(emg)$color.background[is.na(V(emg)$color.background)] <- "lightgrey" |
|
228 |
+ V(emg)$color.highlight[is.na(V(emg)$color.highlight)] <- "lightgrey" |
|
229 |
+ V(emg)$color.hover[is.na(V(emg)$color.hover)] <- "lightgrey" |
|
197 | 230 |
} |
198 | 231 |
} |
199 | 232 |
|
200 |
- # V(g)$color <- map2color(colVar,mypal,limits = range(colVar)) |
|
201 |
- V(emg)$color.background <- map2color(col_var, mypal, limits = range(col_var)) |
|
202 |
- V(emg)$color.highlight <- map2color(col_var, mypal_select, limits = range(col_var)) |
|
203 |
- V(emg)$color.hover <- map2color(col_var, mypal_hover, limits = range(col_var)) |
|
204 |
- |
|
205 | 233 |
V(emg)$color.border <- "black" |
206 | 234 |
|
207 | 235 |
# additional specification of edge colors |
... | ... |
@@ -437,9 +437,16 @@ ggs_backbone <- function(res_enrich, |
437 | 437 |
colorRampPalette(RColorBrewer::brewer.pal(name = "RdYlBu", 11))(50), 1 |
438 | 438 |
)) |
439 | 439 |
|
440 |
- V(bbgraph)$color.background <- map2color(col_var, mypal, limits = range(col_var)) |
|
441 |
- V(bbgraph)$color.highlight <- map2color(col_var, mypal_select, limits = range(col_var)) |
|
442 |
- V(bbgraph)$color.hover <- map2color(col_var, mypal_hover, limits = range(col_var)) |
|
440 |
+ V(bbgraph)$color.background <- map2color(col_var, mypal, symmetric = TRUE, |
|
441 |
+ limits = range(na.omit(col_var))) |
|
442 |
+ V(bbgraph)$color.highlight <- map2color(col_var, mypal_select, symmetric = TRUE, |
|
443 |
+ limits = range(na.omit(col_var))) |
|
444 |
+ V(bbgraph)$color.hover <- map2color(col_var, mypal_hover, symmetric = TRUE, |
|
445 |
+ limits = range(na.omit(col_var))) |
|
446 |
+ |
|
447 |
+ V(bbgraph)$color.background[is.na(V(bbgraph)$color.background)] <- "lightgrey" |
|
448 |
+ V(bbgraph)$color.highlight[is.na(V(bbgraph)$color.highlight)] <- "lightgrey" |
|
449 |
+ V(bbgraph)$color.hover[is.na(V(bbgraph)$color.hover)] <- "lightgrey" |
|
443 | 450 |
|
444 | 451 |
V(bbgraph)$color.border <- "black" |
445 | 452 |
|
... | ... |
@@ -461,10 +468,17 @@ ggs_backbone <- function(res_enrich, |
461 | 468 |
colorRampPalette(RColorBrewer::brewer.pal(name = "RdYlBu", 11))(50), 1 |
462 | 469 |
)) |
463 | 470 |
|
464 |
- V(bbgraph)$color.background <- map2color(col_var, mypal, limits = range(col_var)) |
|
465 |
- V(bbgraph)$color.highlight <- map2color(col_var, mypal_select, limits = range(col_var)) |
|
466 |
- V(bbgraph)$color.hover <- map2color(col_var, mypal_hover, limits = range(col_var)) |
|
467 |
- |
|
471 |
+ V(bbgraph)$color.background <- map2color(col_var, mypal, |
|
472 |
+ limits = range(na.omit(col_var))) |
|
473 |
+ V(bbgraph)$color.highlight <- map2color(col_var, mypal_select, |
|
474 |
+ limits = range(na.omit(col_var))) |
|
475 |
+ V(bbgraph)$color.hover <- map2color(col_var, mypal_hover, |
|
476 |
+ limits = range(na.omit(col_var))) |
|
477 |
+ |
|
478 |
+ V(bbgraph)$color.background[is.na(V(bbgraph)$color.background)] <- "lightgrey" |
|
479 |
+ V(bbgraph)$color.highlight[is.na(V(bbgraph)$color.highlight)] <- "lightgrey" |
|
480 |
+ V(bbgraph)$color.hover[is.na(V(bbgraph)$color.hover)] <- "lightgrey" |
|
481 |
+ |
|
468 | 482 |
V(bbgraph)$color.border <- "black" |
469 | 483 |
|
470 | 484 |
# additional specification of edge colors |
... | ... |
@@ -141,8 +141,39 @@ gs_dendro <- function(res_enrich, |
141 | 141 |
# setup color |
142 | 142 |
mypal <- rev(scales::alpha(colorRampPalette(RColorBrewer::brewer.pal(name = "RdYlBu", 11))(50), 1)) |
143 | 143 |
col_var <- res_enrich[gs_to_use, color_leaves_by] |
144 |
- leaves_col <- map2color(col_var, mypal, limits = range(col_var))[dend_idx] |
|
145 |
- |
|
144 |
+ |
|
145 |
+ if (all(col_var <= 1) & all(col_var > 0)) { # likely p-values... |
|
146 |
+ col_var <- -log10(col_var) |
|
147 |
+ mypal <- (scales::alpha( |
|
148 |
+ colorRampPalette(RColorBrewer::brewer.pal(name = "YlOrRd", 9))(50), 0.8 |
|
149 |
+ )) |
|
150 |
+ leaves_col <- map2color(col_var, mypal, symmetric = FALSE, |
|
151 |
+ limits = range(na.omit(col_var)))[dend_idx] |
|
152 |
+ |
|
153 |
+ } else { |
|
154 |
+ # e.g. using z_score or aggregated value |
|
155 |
+ if (prod(range(na.omit(col_var))) >= 0) { |
|
156 |
+ # gradient palette |
|
157 |
+ mypal <- (scales::alpha( |
|
158 |
+ colorRampPalette(RColorBrewer::brewer.pal(name = "Oranges", 9))(50), 0.8 |
|
159 |
+ )) |
|
160 |
+ leaves_col <- map2color(col_var, mypal, symmetric = FALSE, |
|
161 |
+ limits = range(na.omit(col_var)))[dend_idx] |
|
162 |
+ |
|
163 |
+ } else { |
|
164 |
+ # divergent palette to be used |
|
165 |
+ mypal <- rev(scales::alpha( |
|
166 |
+ colorRampPalette(RColorBrewer::brewer.pal(name = "RdYlBu", 11))(50), 0.8 |
|
167 |
+ )) |
|
168 |
+ leaves_col <- map2color(col_var, mypal, symmetric = TRUE, |
|
169 |
+ limits = range(na.omit(col_var)))[dend_idx] |
|
170 |
+ |
|
171 |
+ } |
|
172 |
+ } |
|
173 |
+ |
|
174 |
+ # set NA values to light grey to prevent errors in assigning colors |
|
175 |
+ leaves_col[is.na(leaves_col)] <- "lightgrey" |
|
176 |
+ |
|
146 | 177 |
my_dend <- set(my_dend, "leaves_col", leaves_col) |
147 | 178 |
} |
148 | 179 |
|
... | ... |
@@ -4,7 +4,7 @@ |
4 | 4 |
\alias{map2color} |
5 | 5 |
\title{Maps numeric values to color values} |
6 | 6 |
\usage{ |
7 |
-map2color(x, pal, limits = NULL) |
|
7 |
+map2color(x, pal, symmetric = TRUE, limits = NULL) |
|
8 | 8 |
} |
9 | 9 |
\arguments{ |
10 | 10 |
\item{x}{A character vector of numeric values (e.g. log2FoldChange values) to |
... | ... |
@@ -13,6 +13,10 @@ be converted to a vector of colors} |
13 | 13 |
\item{pal}{A vector of characters specifying the definition of colors for the |
14 | 14 |
palette, e.g. obtained via \code{\link{brewer.pal}}} |
15 | 15 |
|
16 |
+\item{symmetric}{Logical value, whether to return a palette which is symmetrical |
|
17 |
+with respect to the minimum and maximum values - "respecting" the zero. |
|
18 |
+Defaults to \code{TRUE}.} |
|
19 |
+ |
|
16 | 20 |
\item{limits}{A vector containing the limits of the values to be mapped. If |
17 | 21 |
not specified, defaults to the range of values in the \code{x} vector.} |
18 | 22 |
} |
... | ... |
@@ -34,7 +34,7 @@ test_that("Graph is generated", { |
34 | 34 |
) |
35 | 35 |
expect_is(g2, "igraph") |
36 | 36 |
|
37 |
- res_pos_z <- res_enrich_withscores[res_enrich_withscores$z_score >= 0, ] |
|
37 |
+ res_pos_z <- na.omit(res_enrich_withscores[res_enrich_withscores$z_score >= 0, ]) |
|
38 | 38 |
g3 <- enrichment_map( |
39 | 39 |
res_enrich = res_pos_z, |
40 | 40 |
res_de = res_macrophage_IFNg_vs_naive, |
... | ... |
@@ -54,7 +54,7 @@ stopifnot(requireNamespace("htmltools")) |
54 | 54 |
htmltools::tagList(rmarkdown::html_dependency_font_awesome()) |
55 | 55 |
``` |
56 | 56 |
|
57 |
+<hr> |
|
57 | 58 |
|
58 | 59 |
# Introduction {#introduction} |
59 | 60 |
|
... | ... |
@@ -499,6 +499,7 @@ Plot an enrichment map of the enrichment results, where you can choose with `n_g |
499 | 499 |
em <- enrichment_map(res_enrich_macrophage, |
500 | 500 |
res_macrophage_IFNg_vs_naive, |
501 | 501 |
n_gs = 30, |
502 |
+ color_by = "z_score", |
|
502 | 503 |
anno_df) |
503 | 504 |
library("igraph") |
504 | 505 |
library("visNetwork") |