Added text support to heatmap-based functions. (WIP)

DESCRIPTION

@@ -84,4 +84,4 @@ Encoding: UTF-8
 LazyData: true
 LazyDataCompression: xz
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.3.2

NEWS.md

@@ -9,7 +9,8 @@
 -   Enhanced startup message for clarity. Not it guides the user to run `SCpubr::package_report(extended = TRUE)` to get an overview of the missing dependencies.
 -   Added black border to glyphs in legends.
 -   Whenever a categorical color scale is used, now you can set `colorblind = TRUE`, and it will pull from a collection of different published colorblind-safe palettes. If the length of the classes in the categorical variable matches the length of one of the palettes, that palettes is used. If not, a pool will be selected, with a total maximum of 85 categories allowed. If `colors.use` is used, `colorblind` has no effect (thus, check if your palette is colorblind-safe with `do_ColorBlindCheck()`). For continuous variables, `YlGnBu` is used. For divergent variables, `RdBu` is used. Both `YlGnBu` and `RdBu` are colorblind-safe. Since they are set as default, there is no need for `colorblind` parameter in the functions that only plot continuous/divergent variables.
-
+-  Added support to show the values as text in most heatmap-based functions. This is achieved by using `values.show = TRUE`.
+-  Aesthetics of the text labels can be tuned with `values.threshold`, `values.size` and `values.round`. 
 ## Added functions
 -   `do_WafflePlot()`: This function displays proportions as a pictogram grid of 10x10 tiles. It helps to visually see at a glance the proportions of your data. This fails to correctly convey decimal proportions and completely ignores heavily under-represented classes in your dataset. 
 -   `do_RankedExpressionHeatmap()` to plot expression values as a heatmap along a dimensional reduction component.
@@ -50,7 +51,7 @@ The reason of these modification is to allow for a much clearer and concise outp
 ## do_AlluvialPlot()
 -   Enforced a minimum version of `ggalluvial` to deal with deprecation of functions from `dplyr` and `tidyr` that were still used in `ggalluvial` functions.
 -   Modified the legend items to have a black border.
--   Changed default legend position to bottom.
+-   Changed default legend position to bottom and legend title to top and centered.
 
 ## do_BoxPlot()
 -   Added `legend.ncol`, `legend.nrow` and `legend.byrow` parameters to control legend behavior.
@@ -66,12 +67,12 @@ The reason of these modification is to allow for a much clearer and concise outp
 ## do_ChortDiagramPlot()
 -  Added `font.size` parameter to control the font size of the plot.
 
-## do_ColorPalette()
--  Changed "Wheel" to "Color wheel" when plotting the output without additional parameters.
-
 ## do_CNVHeatmap()
 -   Added `include_chr_arms` parameter to decide whether the heatmap should include a breakdown of the arms or just keep it by chromosomes.
 
+## do_ColorPalette()
+-  Changed "Wheel" to "Color wheel" when plotting the output without additional parameters.
+
 ## do_DimPlot()
 -   Fixed a bug caused by using `cells.highlight` with only one cell.
 -   Fixed a bug causing the "Combined" plot resulting of the use of `split.by` and `group.by` to have a different size than the rest of panels when `ncol` parameter was also used.
@@ -121,6 +122,7 @@ The reason of these modification is to allow for a much clearer and concise outp
 ## do_RidgePlot()
 -   Removed `size = 1.25` aesthetic from the call to `ggridges::geom_ridge...`.
 -   Set default legend position to bottom.
+-   Fixed a bug in which plot grid would not react properly to `flip`.
 
 ## do_SavePlot()
 -   Added `limitsize` parameter, that allows for very big ggplot2-based plots to be saved with big dimensions.
@@ -167,6 +169,7 @@ The reason of these modification is to allow for a much clearer and concise outp
 -   Changed default value of `legend.position` to `bottom`. 
 -   Fixed a bug in which the default color palette would not be applied when `plot_boxplots = FALSE`.
 -   Added `legend.title.position` parameter and set it up as `top` by default.
+-   Fixed a bug in which plot grid would not react properly to `flip`.
 
 # SCpubr v2.0.1 
 

R/do_ActivityHeatmap.R

@@ -21,6 +21,10 @@ do_ActivityHeatmap <- function(sample,
                                slot = NULL,
                                statistic = "ulm",
                                number.breaks = 5,
+                               values.show = FALSE,
+                               values.threshold = NULL,
+                               values.size = 3,
+                               values.round = 1,
                                use_viridis = FALSE,
                                viridis.palette = "G",
                                viridis.direction = -1,
@@ -73,7 +77,8 @@ do_ActivityHeatmap <- function(sample,
   logical_list <- list("verbose" = verbose,
                        "flip" = flip,
                        "enforce_symmetry" = enforce_symmetry,
-                       "use_viridis" = use_viridis)
+                       "use_viridis" = use_viridis,
+                       "values.show" = values.show)
   check_type(parameters = logical_list, required_type = "logical", test_function = is.logical)
   # Check numeric parameters.
   numeric_list <- list("font.size" = font.size,
@@ -90,7 +95,10 @@ do_ActivityHeatmap <- function(sample,
                        "sequential.direction" = sequential.direction,
                        "nbin" = nbin,
                        "ctrl" = ctrl,
-                       "diverging.direction" = diverging.direction)
+                       "diverging.direction" = diverging.direction,
+                       "values.threshold" = values.threshold,
+                       "values.size" = values.size,
+                       "values.round" = values.round)
   check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric)
   # Check character parameters.
   character_list <- list("group.by" = group.by,
@@ -195,7 +203,17 @@ do_ActivityHeatmap <- function(sample,
                                        crayon_body(" have at least "),
                                        crayon_key("five genes"),
                                        crayon_body(" each.")))
-
+
+
+  if (base::isTRUE(values.show)){
+    assertthat::assert_that(is.numeric(values.threshold),
+                            msg = paste0(add_cross(), crayon_body("Please provide a value to "),
+                                         crayon_key("values.threshold"),
+                                         crayon_body(" when setting "),
+                                         crayon_key("values.show = TRUE"),
+                                         crayon_body(".")))
+  }
+
   # Add fake genes until all lists have the same length so that it can be converted into a tibble.
   gene_list <- lapply(input_gene_list, function(x){
     if (length(x) != max_value){
@@ -344,7 +362,24 @@ do_ActivityHeatmap <- function(sample,
                                                 y = if (isTRUE(flip)){.data$target} else {.data$source},
                                                 fill = .data$mean)) +
          # nocov end
-         ggplot2::geom_tile(color = grid.color, linewidth = 0.5, na.rm = TRUE) +
+         ggplot2::geom_tile(color = grid.color, linewidth = 0.5, na.rm = TRUE)
+
+    if (base::isTRUE(values.show)){
+      if (base::isTRUE(enforce_symmetry)){
+        p <- p + 
+          ggplot2::geom_text(ggplot2::aes(label = round(.data$mean, values.round), 
+                                          color = ifelse(abs(.data$mean) > values.threshold, "white", "black")), 
+                             size = values.size)
+      } else {
+        p <- p + 
+          ggplot2::geom_text(ggplot2::aes(label = round(.data$mean, values.round), 
+                                          color = ifelse(.data$mean > values.threshold, "white", "black")), 
+                             size = values.size)
+      }
+      p <- p + ggplot2::scale_color_identity()
+    }
+
+    p <- p + 
          ggplot2::scale_y_discrete(expand = c(0, 0)) +
          ggplot2::scale_x_discrete(expand = c(0, 0),
                                    position = "top") +

R/do_AlluvialPlot.R

@@ -296,9 +296,6 @@ do_AlluvialPlot <- function(sample,
        ggplot2::labs(title = plot.title,
                      subtitle = plot.subtitle,
                      caption = plot.caption) +
-       ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title,
-                                                    override.aes = list(color = "black",
-                                                                        shape = 22))) +
        ggplot2::theme_minimal(base_size = font.size) +
        ggplot2::theme(axis.title = ggplot2::element_text(color = "black",
                                                          face = axis.title.face),
@@ -328,6 +325,13 @@ do_AlluvialPlot <- function(sample,
                       legend.background = ggplot2::element_rect(fill = "white", color = "white"),
                       strip.text =ggplot2::element_text(color = "black", face = "bold"))
 
+  p <- p +
+       ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title,
+                                                    title.position = "top",
+                                                    title.hjust = 0.5,
+                                                    override.aes = list(color = "black",
+                                                                        shape = 22))) 
+
 
   if (isTRUE(flip)){
     p <- p + ggplot2::coord_flip()

R/do_BarPlot.R

@@ -43,7 +43,7 @@ do_BarPlot <- function(sample,
                        xlab = NULL,
                        ylab = NULL,
                        colors.use = NULL,
-                       colorblind = colorblind,
+                       colorblind = FALSE,
                        flip = FALSE,
                        plot.title = NULL,
                        plot.subtitle = NULL,

R/do_BoxPlot.R

@@ -27,7 +27,7 @@ do_BoxPlot <- function(sample,
                        font.type = "sans",
                        axis.text.x.angle = 45,
                        colors.use = NULL,
-                       colorblind = colorblind,
+                       colorblind = FALSE,
                        na.value = "grey75",
                        plot.title = NULL,
                        plot.subtitle = NULL,

R/do_CNVHeatmap.R

@@ -19,6 +19,10 @@ do_CNVHeatmap <- function(sample,
                           using_metacells = FALSE,
                           metacell_mapping = NULL,
                           include_chr_arms = FALSE,
+                          values.show = FALSE,
+                          values.threshold = NULL,
+                          values.size = 3,
+                          values.round = 1,
                           legend.type = "colorbar",
                           legend.position = "bottom",
                           legend.length = 20,
@@ -65,7 +69,8 @@ do_CNVHeatmap <- function(sample,
   logical_list <- list("using_metacells" = using_metacells,
                        "enforce_symmetry" = enforce_symmetry,
                        "use_viridis" = use_viridis,
-                       "include_chr_arms" = include_chr_arms)
+                       "include_chr_arms" = include_chr_arms,
+                       "values.show" = values.show)
   check_type(parameters = logical_list, required_type = "logical", test_function = is.logical)
   # Check numeric parameters.
   numeric_list <- list("font.size" = font.size,
@@ -80,7 +85,10 @@ do_CNVHeatmap <- function(sample,
                        "max.cutoff" = max.cutoff,
                        "number.breaks" = number.breaks,
                        "sequential.direction" = sequential.direction,
-                       "diverging.direction" = diverging.direction)
+                       "diverging.direction" = diverging.direction,
+                       "values.threshold" = values.threshold,
+                       "values.size" = values.size,
+                       "values.round" = values.round)
   check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric)
   # Check character parameters.
   character_list <- list("group.by" = group.by,
@@ -155,7 +163,18 @@ do_CNVHeatmap <- function(sample,
                                                   direction = ifelse(isTRUE(use_viridis), viridis.direction, sequential.direction),
                                                   enforce_symmetry = enforce_symmetry)
   }
-
+
+
+  if (base::isTRUE(values.show)){
+    assertthat::assert_that(is.numeric(values.threshold),
+                            msg = paste0(add_cross(), crayon_body("Please provide a value to "),
+                                         crayon_key("values.threshold"),
+                                         crayon_body(" when setting "),
+                                         crayon_key("values.show = TRUE"),
+                                         crayon_body(".")))
+  }
+
+
   # Retrieve the genes.
   genes <- infercnv_object@gene_order
 
@@ -346,7 +365,24 @@ do_CNVHeatmap <- function(sample,
                                                 y = if(base::isFALSE(flip)){.data[[group]]} else {.data$Event},
                                                 fill = .data$mean)) +
          # nocov end
-         ggplot2::geom_tile(color = grid.color, linewidth = 0.5) +
+         ggplot2::geom_tile(color = grid.color, linewidth = 0.5)
+
+    if (base::isTRUE(values.show)){
+      if (base::isTRUE(enforce_symmetry)){
+        p <- p + 
+          ggplot2::geom_text(ggplot2::aes(label = round(.data$mean, values.round), 
+                                          color = ifelse(abs(.data$mean) > values.threshold, "white", "black")), 
+                             size = values.size)
+      } else {
+        p <- p + 
+          ggplot2::geom_text(ggplot2::aes(label = round(.data$mean, values.round), 
+                                          color = ifelse(.data$mean > values.threshold, "white", "black")), 
+                             size = values.size)
+      }
+      p <- p + ggplot2::scale_color_identity()
+    }
+
+    p <- p +
          ggplot2::scale_y_discrete(expand = c(0, 0)) +
          ggplot2::scale_x_discrete(expand = c(0, 0),
                                    position = "top") +

R/do_ChordDiagramPlot.R

@@ -53,7 +53,7 @@ do_ChordDiagramPlot <- function(sample = NULL,
                                 to = NULL,
                                 colors.from = NULL,
                                 colors.to = NULL,
-                                colorblind = colorblind,
+                                colorblind = FALSE,
                                 big.gap = 10,
                                 small.gap = 1,
                                 link.border.color = NA,

R/do_CorrelationHeatmap.R

@@ -13,6 +13,10 @@ do_CorrelationHeatmap <- function(sample = NULL,
                                cluster = TRUE,
                                remove.diagonal = TRUE,
                                mode = "hvg",
+                               values.show = FALSE,
+                               values.threshold = NULL,
+                               values.size = 3,
+                               values.round = 1,
                                assay = NULL,
                                group.by = NULL,
                                legend.title = "Pearson coef.",
@@ -61,7 +65,8 @@ do_CorrelationHeatmap <- function(sample = NULL,
   # Check logical parameters.
   logical_list <- list("enforce_symmetry" = enforce_symmetry,
                        "cluster" = cluster,
-                       "remove.diagonal" = remove.diagonal)
+                       "remove.diagonal" = remove.diagonal,
+                       "values.show" = values.show)
   check_type(parameters = logical_list, required_type = "logical", test_function = is.logical)
   # Check numeric parameters.
   numeric_list <- list("min.cutoff" = min.cutoff,
@@ -75,7 +80,10 @@ do_CorrelationHeatmap <- function(sample = NULL,
                        "axis.text.x.angle" = axis.text.x.angle,
                        "sequential.direction" = sequential.direction,
                        "viridis.direction" = viridis.direction,
-                       "diverging.direction" = diverging.direction)
+                       "diverging.direction" = diverging.direction,
+                       "values.threshold" = values.threshold,
+                       "values.size" = values.size,
+                       "values.round" = values.round)
   check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric)
   # Check character parameters.
   character_list <- list("mode" = mode,
@@ -138,7 +146,15 @@ do_CorrelationHeatmap <- function(sample = NULL,
                                                   direction = ifelse(isTRUE(use_viridis), viridis.direction, sequential.direction),
                                                   enforce_symmetry = enforce_symmetry)
   }
-
+
+  if (base::isTRUE(values.show)){
+    assertthat::assert_that(is.numeric(values.threshold),
+                            msg = paste0(add_cross(), crayon_body("Please provide a value to "),
+                                         crayon_key("values.threshold"),
+                                         crayon_body(" when setting "),
+                                         crayon_key("values.show = TRUE"),
+                                         crayon_body(".")))
+  }
 
   if (mode == "hvg"){
     # Check if the sample provided is a Seurat object.
@@ -255,7 +271,16 @@ do_CorrelationHeatmap <- function(sample = NULL,
                          mapping = ggplot2::aes(x = .data$x,
                                                 y = .data$y,
                                                 fill = .data$score)) +
-         ggplot2::geom_tile(color = grid.color, linewidth = 0.5) +
+         ggplot2::geom_tile(color = grid.color, linewidth = 0.5)
+
+    if (base::isTRUE(values.show)){
+      p <- p + 
+           ggplot2::geom_text(ggplot2::aes(label = round(.data$score, values.round), 
+                                           color = ifelse(abs(.data$score) > values.threshold, "white", "black")), 
+                              size = values.size) + 
+           ggplot2::scale_color_identity()
+    }
+    p <- p + 
          ggplot2::scale_y_discrete(expand = c(0, 0)) +
          ggplot2::scale_x_discrete(expand = c(0, 0),
                                    position = "top") +
@@ -412,6 +437,10 @@ do_CorrelationHeatmap <- function(sample = NULL,
                                                 y = .data$y,
                                                 fill = .data$score)) +
          ggplot2::geom_tile(color = grid.color, linewidth = 0.5, na.rm = TRUE) +
+         ggplot2::geom_text(ggplot2::aes(label = round(.data$score, values.round), 
+                                         color = ifelse(.data$score > values.threshold, "white", "black")), 
+                            size = values.size) + 
+         ggplot2::scale_color_identity() + 
          ggplot2::scale_y_discrete(expand = c(0, 0)) +
          ggplot2::scale_x_discrete(expand = c(0, 0),
                                    position = "top") +