Browse code

Merge pull request #43 from federicomarini/better_colors

Better colors

Federico Marini authored on 07/10/2022 14:54:01 • GitHub committed on 07/10/2022 14:54:01
Showing 9 changed files

... ...
@@ -1,8 +1,8 @@
1 1
 Package: GeneTonic
2 2
 Title: Enjoy Analyzing And Integrating The Results From Differential Expression 
3 3
     Analysis And Functional Enrichment Analysis
4
-Version: 2.1.4
5
-Date: 2022-10-05
4
+Version: 2.1.5
5
+Date: 2022-10-07
6 6
 Authors@R: 
7 7
     c(
8 8
         person(
... ...
@@ -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")