Added colorblind support and do_ColorBlindCheck function.

enblacar · Feb 1, 2025 · f2709b8 · f2709b8
1 parent f7d4929
commit f2709b8
Show file tree

Hide file tree

Showing 45 changed files with 699 additions and 129 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -8,14 +8,14 @@ export(do_BoxPlot)
 export(do_CNVHeatmap)
 export(do_CellularStatesPlot)
 export(do_ChordDiagramPlot)
+export(do_ColorBlindCheck)
 export(do_ColorPalette)
 export(do_CorrelationHeatmap)
 export(do_DimPlot)
 export(do_DotPlot)
 export(do_EnrichmentHeatmap)
 export(do_ExpressionHeatmap)
 export(do_FeaturePlot)
-export(do_GeyserPlot)
 export(do_GroupwiseDEHeatmap)
 export(do_LigandReceptorPlot)
 export(do_LoadingsHeatmap)
@@ -29,6 +29,7 @@ export(do_RidgePlot)
 export(do_SCEnrichmentHeatmap)
 export(do_SCExpressionHeatmap)
 export(do_SavePlot)
+export(do_StripPlot)
 export(do_TFActivityHeatmap)
 export(do_TermEnrichmentPlot)
 export(do_ViolinPlot)

diff --git a/NEWS.md b/NEWS.md
@@ -8,10 +8,12 @@
 ## General
 -   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 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.
+-   `do_ColorBlindCheck` to provide a comparative view of a given color paletter under different kinds of color blindness. This will allow to check for the suitability of a given set of colors for publication.
 
 ## Removed functions
 -   `do_FunctionalAnnotationPlot()`.
@@ -111,6 +113,7 @@ The reason of these modification is to allow for a much clearer and concise outp
 
 ## do_MetadataHeatmap()
 -   Modified the legend items to have a black border.
+-   Set `cluster = FALSE` as default.
 
 ## do_PathwayActivityHeatmap
 -   Changed legend title to "Z-Scored | <statistic> score", for consistency with other functions in the package.

diff --git a/R/do_AlluvialPlot.R b/R/do_AlluvialPlot.R
@@ -36,6 +36,7 @@ do_AlluvialPlot <- function(sample,
                             last_group,
                             middle_groups = NULL,
                             colors.use = NULL,
+                            colorblind = FALSE,
                             plot.title = NULL,
                             plot.subtitle = NULL,
                             plot.caption = NULL,
@@ -90,7 +91,8 @@ do_AlluvialPlot <- function(sample,
                        "plot.grid" = plot.grid,
                        "repel" = repel,
                        "use_geom_flow" = use_geom_flow,
-                       "use_viridis" = use_viridis)
+                       "use_viridis" = use_viridis,
+                       "colorblind" = colorblind)
   check_type(parameters = logical_list, required_type = "logical", test_function = is.logical)
   # Check numeric parameters.
   numeric_list <- list("stratum.width" = stratum.width,
@@ -234,9 +236,9 @@ do_AlluvialPlot <- function(sample,
   # COLORS.
   if (is.null(colors.use)){
     if (is.factor(data[[fill.by]])){
-      colors.use <- generate_color_scale(levels(data[[fill.by]]))
+      colors.use <- generate_color_scale(levels(data[[fill.by]]), colorblind = colorblind)
     } else {
-      colors.use <- generate_color_scale(sort(unique(data[[fill.by]])))
+      colors.use <- generate_color_scale(sort(unique(data[[fill.by]])), colorblind = colorblind)
     }
   } else {
     check_colors(colors.use)

diff --git a/R/do_BarPlot.R b/R/do_BarPlot.R
@@ -43,6 +43,7 @@ do_BarPlot <- function(sample,
                        xlab = NULL,
                        ylab = NULL,
                        colors.use = NULL,
+                       colorblind = colorblind,
                        flip = FALSE,
                        plot.title = NULL,
                        plot.subtitle = NULL,
@@ -74,7 +75,8 @@ do_BarPlot <- function(sample,
                        "plot.grid" = plot.grid,
                        "legend.byrow" = legend.byrow,
                        "add.n" = add.n,
-                       "return_data" = return_data)
+                       "return_data" = return_data,
+                       "colorblind" = colorblind)
   check_type(parameters = logical_list, required_type = "logical", test_function = is.logical)
   # Check numeric parameters.
   numeric_list <- list("font.size" = font.size,
@@ -158,7 +160,7 @@ do_BarPlot <- function(sample,
                                        crayon_body(".")))
 
   if (is.null(colors.use)){
-    colors.use <- generate_color_scale(names_use = if (is.factor(sample@meta.data[, group.by])) {levels(sample@meta.data[, group.by])} else {sort(unique(sample@meta.data[, group.by]))})
+    colors.use <- generate_color_scale(names_use = if (is.factor(sample@meta.data[, group.by])) {levels(sample@meta.data[, group.by])} else {sort(unique(sample@meta.data[, group.by]))}, colorblind = colorblind)
   } else {
     check_colors(colors.use, parameter_name = "colors.use")
     check_consistency_colors_and_names(sample = sample, colors = colors.use, grouping_variable = group.by)

diff --git a/R/do_BeeSwarmPlot.R b/R/do_BeeSwarmPlot.R
@@ -18,6 +18,7 @@ do_BeeSwarmPlot <- function(sample,
                             continuous_feature = FALSE,
                             order = FALSE,
                             colors.use = NULL,
+                            colorblind = FALSE,
                             legend.title = NULL,
                             legend.type = "colorbar",
                             legend.position = "bottom",
@@ -91,7 +92,8 @@ do_BeeSwarmPlot <- function(sample,
                        "raster" = raster,
                        "plot_cell_borders" = plot_cell_borders,
                        "use_viridis" = use_viridis,
-                       "order" = order)
+                       "order" = order,
+                       "colorblind" = colorblind)
   check_type(parameters = logical_list, required_type = "logical", test_function = is.logical)
   # Check numeric parameters.
   numeric_list <- list("font.size" = font.size,
@@ -312,7 +314,7 @@ do_BeeSwarmPlot <- function(sample,
                                   legend.tickwidth = legend.tickwidth)
   } else if (continuous_feature == FALSE) {
     if (is.null(colors.use)){
-      colors.use <- generate_color_scale(levels(sample))
+      colors.use <- generate_color_scale(levels(sample), colorblind = colorblind)
     } else {
       colors.use <- check_consistency_colors_and_names(sample = sample, colors = colors.use, grouping_variable = group.by)
     }

diff --git a/R/do_BoxPlot.R b/R/do_BoxPlot.R
@@ -27,6 +27,7 @@ do_BoxPlot <- function(sample,
                        font.type = "sans",
                        axis.text.x.angle = 45,
                        colors.use = NULL,
+                       colorblind = colorblind,
                        na.value = "grey75",
                        plot.title = NULL,
                        plot.subtitle = NULL,
@@ -79,7 +80,8 @@ do_BoxPlot <- function(sample,
                        "plot.grid" = plot.grid,
                        "order" = order,
                        "use_silhouette" = use_silhouette,
-                       "legend.byrow" = legend.byrow)
+                       "legend.byrow" = legend.byrow,
+                       "colorblind" = colorblind)
   check_type(parameters = logical_list, required_type = "logical", test_function = is.logical)
   # Check numeric parameters.
   numeric_list <- list("font.size" = font.size,
@@ -182,9 +184,9 @@ do_BoxPlot <- function(sample,
         levels(sample@meta.data[, group.by])
       } else {
         sort(unique(sample@meta.data[, group.by]))
-      })
+      }, colorblind = colorblind)
     } else {
-      colors.use <- generate_color_scale(names_use = if (is.factor(sample@meta.data[, split.by])) {levels(sample@meta.data[, split.by])} else {sort(unique(sample@meta.data[, split.by]))})
+      colors.use <- generate_color_scale(names_use = if (is.factor(sample@meta.data[, split.by])) {levels(sample@meta.data[, split.by])} else {sort(unique(sample@meta.data[, split.by]))}, colorblind = colorblind)
     }
   } else {
     check_colors(colors.use, parameter_name = "colors.use")

diff --git a/R/do_CellularStatesPlot.R b/R/do_CellularStatesPlot.R
@@ -34,6 +34,7 @@ do_CellularStatesPlot <- function(sample,
                                   y2 = NULL,
                                   group.by = NULL,
                                   colors.use = NULL,
+                                  colorblind = FALSE,
                                   legend.position = "bottom",
                                   legend.icon.size = 4,
                                   legend.ncol = NULL,
@@ -97,7 +98,8 @@ do_CellularStatesPlot <- function(sample,
                          "raster" = raster,
                          "plot_features" = plot_features,
                          "plot_enrichment_scores" = plot_enrichment_scores,
-                         "use_viridis" = use_viridis)
+                         "use_viridis" = use_viridis,
+                         "colorblind" = colorblind)
     check_type(parameters = logical_list, required_type = "logical", test_function = is.logical)
     # Check numeric parameters.
     numeric_list <- list("font.size" = font.size,
@@ -149,11 +151,11 @@ do_CellularStatesPlot <- function(sample,
     if (is.null(colors.use)){
       colors.use <- {
         if (is.null(group.by)){
-          generate_color_scale(levels(sample))
+          generate_color_scale(levels(sample), colorblind = colorblind)
         } else if (!(is.null(group.by))){
           data.use <- sample[[]][, group.by, drop = FALSE]
           names.use <- if (is.factor(data.use[, 1])){levels(data.use[, 1])} else {sort(unique(data.use[, 1]))}
-          generate_color_scale(names.use)
+          generate_color_scale(names.use, colorblind = colorblind)
         }
       }
     } else {

diff --git a/R/do_ChordDiagramPlot.R b/R/do_ChordDiagramPlot.R
@@ -53,6 +53,7 @@ do_ChordDiagramPlot <- function(sample = NULL,
                                 to = NULL,
                                 colors.from = NULL,
                                 colors.to = NULL,
+                                colorblind = colorblind,
                                 big.gap = 10,
                                 small.gap = 1,
                                 link.border.color = NA,
@@ -82,7 +83,8 @@ do_ChordDiagramPlot <- function(sample = NULL,
   logical_list <- list("link.decreasing" = link.decreasing,
                        "z_index" = z_index,
                        "symmetric" = symmetric,
-                       "scale" = scale)
+                       "scale" = scale,
+                       "colorblind" = colorblind)
   check_type(parameters = logical_list, required_type = "logical", test_function = is.logical)
   # Check numeric parameters.
   numeric_list <- list("big.gap" = big.gap,
@@ -269,9 +271,9 @@ do_ChordDiagramPlot <- function(sample = NULL,
                                        grouping_variable = from)
   } else {
     if (is.factor(data[["from"]])){
-      colors.from <- generate_color_scale(names_use = levels(data[["from"]]))
+      colors.from <- generate_color_scale(names_use = levels(data[["from"]]), colorblind = colorblind)
     } else {
-      colors.from <- generate_color_scale(names_use = sort(unique(data[["from"]])))
+      colors.from <- generate_color_scale(names_use = sort(unique(data[["from"]])), colorblind = colorblind)
     }
   }
   names(colors.from) <- stringr::str_pad(names(colors.from), width = max_char, side = "both")