From f2709b8211de2e052d7e2f992f312d4e0b885212 Mon Sep 17 00:00:00 2001 From: enblacar Date: Sat, 1 Feb 2025 20:48:15 +0100 Subject: [PATCH] Added colorblind support and do_ColorBlindCheck function. --- NAMESPACE | 3 +- NEWS.md | 3 + R/do_AlluvialPlot.R | 8 +- R/do_BarPlot.R | 6 +- R/do_BeeSwarmPlot.R | 6 +- R/do_BoxPlot.R | 8 +- R/do_CellularStatesPlot.R | 8 +- R/do_ChordDiagramPlot.R | 8 +- R/do_ColorBlindCheck.R | 177 ++++++++++++++++ R/do_ColorPalette.R | 7 +- R/do_DimPlot.R | 10 +- R/do_FeaturePlot.R | 6 +- R/do_GroupwiseDEHeatmap.R | 6 +- R/do_MetadataHeatmap.R | 18 +- R/do_RankedEnrichmentHeatmap.R | 6 +- R/do_RankedExpressionHeatmap.R | 6 +- R/do_RidgePlot.R | 6 +- R/do_SCEnrichmentHeatmap.R | 6 +- R/do_SCExpressionHeatmap.R | 6 +- R/do_StripPlot.R | 114 +++++----- R/do_ViolinPlot.R | 6 +- R/do_WafflePlot.R | 6 +- R/utils.R | 234 +++++++++++++++++++-- man/do_AlluvialPlot.Rd | 3 + man/do_BarPlot.Rd | 3 + man/do_BeeSwarmPlot.Rd | 3 + man/do_BoxPlot.Rd | 3 + man/do_CellularStatesPlot.Rd | 3 + man/do_ChordDiagramPlot.Rd | 3 + man/do_ColorBlindCheck.Rd | 63 ++++++ man/do_DimPlot.Rd | 3 + man/do_FeaturePlot.Rd | 3 + man/do_GroupwiseDEHeatmap.Rd | 3 + man/do_MetadataHeatmap.Rd | 5 +- man/do_RankedEnrichmentHeatmap.Rd | 3 + man/do_RankedExpressionHeatmap.Rd | 3 + man/do_RidgePlot.Rd | 3 + man/do_SCEnrichmentHeatmap.Rd | 3 + man/do_SCExpressionHeatmap.Rd | 3 + man/{do_GeyserPlot.Rd => do_StripPlot.Rd} | 24 +-- man/do_ViolinPlot.Rd | 3 + man/do_WafflePlot.Rd | 3 + man/doc_function.Rd | 2 + man/examples/examples_do_ColorBlindCheck.R | 14 ++ tests/testthat/test-do_ColorBlindCheck.R | 8 + 45 files changed, 699 insertions(+), 129 deletions(-) create mode 100644 R/do_ColorBlindCheck.R create mode 100644 man/do_ColorBlindCheck.Rd rename man/{do_GeyserPlot.Rd => do_StripPlot.Rd} (93%) create mode 100644 man/examples/examples_do_ColorBlindCheck.R create mode 100644 tests/testthat/test-do_ColorBlindCheck.R diff --git a/NAMESPACE b/NAMESPACE index 0917430..8c6c7e2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ export(do_BoxPlot) export(do_CNVHeatmap) export(do_CellularStatesPlot) export(do_ChordDiagramPlot) +export(do_ColorBlindCheck) export(do_ColorPalette) export(do_CorrelationHeatmap) export(do_DimPlot) @@ -15,7 +16,6 @@ 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 index c70017b..56e9322 100644 --- 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 | score", for consistency with other functions in the package. diff --git a/R/do_AlluvialPlot.R b/R/do_AlluvialPlot.R index 2372606..c22237c 100644 --- 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 index f622063..e31ddf6 100644 --- 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 index 22f4a08..5ea48da 100644 --- 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 index 4d5ce38..562c7db 100644 --- 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 index f98feb2..309b368 100644 --- 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 index e89bed4..f566e87 100644 --- 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") diff --git a/R/do_ColorBlindCheck.R b/R/do_ColorBlindCheck.R new file mode 100644 index 0000000..75af481 --- /dev/null +++ b/R/do_ColorBlindCheck.R @@ -0,0 +1,177 @@ +#' Generate colorblind variations of a given color palette. +#' +#' This function generate colorblind variations of a provided color palette in order to check if it is colorblind friendly. Variations are generated using colorspace package. +#' +#' @inheritParams doc_function +#' @param colors.use \strong{\code{\link[base]{character}}} | One color upon which generate the color scale. Can be a name or a HEX code. +#' @return A character vector with the desired color scale. +#' @export +#' @example man/examples/examples_do_ColorBlindCheck.R + +do_ColorBlindCheck <- function(colors.use, + flip = FALSE, + font.size = 14, + font.type = "sans", + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + grid.color = "white", + border.color = "black", + axis.text.x.angle = 45){ + + `%>%` <- magrittr::`%>%` + `:=` <- rlang::`:=` + + # Add lengthy error messages. + withr::local_options(.new = list("warning.length" = 8170)) + + check_suggests(function_name = "do_ColorPalette") + # Check logical parameters. + logical_list <- list("flip" = flip) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + + # Check numeric parameters. + numeric_list <- list("font.size", font.size, + "axis.text.x.angle" = axis.text.x.angle, + "font.size" = font.size) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + + # Check character parameters. + character_list <- list("colors.use" = colors.use, + "font.type" = font.type, + "grid.color" = grid.color, + "border.color" = border.color, + "plot.title.face" = plot.title.face, + "plot.subtitle.face" = plot.subtitle.face, + "plot.caption.face" = plot.caption.face, + "axis.title.face" = axis.title.face, + "axis.text.face" = axis.text.face) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + + # Check that the color provided is a valid color representation. + check_colors(colors.use, parameter_name = "colors.use") + check_colors(grid.color, parameter_name = "grid.color") + check_colors(border.color, parameter_name = "border.color") + + # Dicromatic view: + deutan.colors <- colorspace::deutan(colors.use) # Red-green (most common) + protan.colors <- colorspace::protan(colors.use) # Red-green (less common) + tritan.colors <- colorspace::tritan(colors.use) # Blue-yellow + + colors.use <- list("Normal" = colors.use, + "Protanopia" = protan.colors, + "Deuteranopia" = deutan.colors, + "Tritanopia" = tritan.colors) + + df <- as.data.frame(colors.use) + # df <- df[rev(seq(1, length(rownames(df)))),] + + list.heatmaps <- list() + metadata <- if(base::isFALSE(flip)){rev(colnames(df))} else {colnames(df)} + group.by <- "Colors" + + data.plot <- df %>% + dplyr::mutate("{group.by}" := .data$Normal) %>% + tidyr::pivot_longer(cols = -"Colors", + names_to = "Type", + values_to = "Color") %>% + dplyr::mutate("{group.by}" := factor(.data[[group.by]], levels = df$Normal)) + + # Get a list of predefined colors to then compute color wheels on for each metadata variable not covered. + counter <- 0 + for (name in metadata){ + counter <- counter + 1 + # Colors + colors.use.name <- df[, name] + names(colors.use.name) <- df$Normal + + # Handle axis + axis.parameters <- handle_axis(flip = flip, + group.by = rep("A", length(metadata)), + group = name, + counter = counter, + axis.text.x.angle = axis.text.x.angle, + plot.title.face = plot.title.face, + plot.subtitle.face = plot.subtitle.face, + plot.caption.face = plot.caption.face, + axis.title.face = axis.title.face, + axis.text.face = axis.text.face, + legend.title.face = "bold", + legend.text.face = "plain") + + + p <- data.plot %>% + dplyr::filter(.data$Type == name) %>% + # nocov start + ggplot2::ggplot(mapping = ggplot2::aes(x = if(base::isFALSE(flip)){.data[[group.by]]} else {.data$Type}, + y = if(base::isFALSE(flip)){.data$Type} else {.data[[group.by]]}, + fill = .data[[group.by]])) + + # nocov end + ggplot2::geom_tile(color = grid.color, linewidth = 0.5) + + ggplot2::scale_y_discrete(expand = c(0, 0)) + + ggplot2::scale_x_discrete(expand = c(0, 0), + position = "top") + + ggplot2::guides(y.sec = guide_axis_label_trans(~paste0(levels(.data$Type))), + x.sec = guide_axis_label_trans(~paste0(levels(.data[[group.by]])))) + + ggplot2::coord_equal() + + ggplot2::scale_fill_manual(values = colors.use.name, name = name, na.value = "grey75") + + ggplot2::xlab(NULL) + + ggplot2::ylab(NULL) + + ggplot2::theme_minimal(base_size = font.size) + + ggplot2::theme(axis.ticks.x.bottom = axis.parameters$axis.ticks.x.bottom, + axis.ticks.x.top = axis.parameters$axis.ticks.x.top, + axis.ticks.y.left = axis.parameters$axis.ticks.y.left, + axis.ticks.y.right = axis.parameters$axis.ticks.y.right, + axis.text.y.left = axis.parameters$axis.text.y.left, + axis.text.y.right = axis.parameters$axis.text.y.right, + axis.text.x.top = axis.parameters$axis.text.x.top, + axis.text.x.bottom = axis.parameters$axis.text.x.bottom, + axis.title.x.bottom = axis.parameters$axis.title.x.bottom, + axis.title.x.top = axis.parameters$axis.title.x.top, + axis.title.y.right = axis.parameters$axis.title.y.right, + axis.title.y.left = axis.parameters$axis.title.y.left, + strip.background = axis.parameters$strip.background, + strip.clip = axis.parameters$strip.clip, + strip.text = axis.parameters$strip.text, + legend.position = "none", + axis.line = ggplot2::element_blank(), + plot.title = ggplot2::element_text(face = plot.title.face, hjust = 0), + plot.subtitle = ggplot2::element_text(face = plot.subtitle.face, hjust = 0), + plot.caption = ggplot2::element_text(face = plot.caption.face, hjust = 1), + plot.title.position = "plot", + panel.grid = ggplot2::element_blank(), + panel.grid.minor.y = ggplot2::element_line(color = "white", linewidth = 1), + text = ggplot2::element_text(family = font.type), + plot.caption.position = "plot", + legend.text = ggplot2::element_text(face = "plain", size = font.size), + legend.title = ggplot2::element_text(face = "bold", size = font.size), + legend.justification = "center", + plot.margin = ggplot2::margin(t = 0, r = 0, b = 0, l = 0, unit = "mm"), + panel.border = ggplot2::element_rect(fill = NA, color = border.color, linewidth = 1), + panel.grid.major = ggplot2::element_blank(), + plot.background = ggplot2::element_rect(fill = "white", color = "white"), + panel.background = ggplot2::element_rect(fill = "white", color = "white"), + legend.background = ggplot2::element_rect(fill = "white", color = "white"), + legend.spacing = ggplot2::unit(0, "cm"), + panel.spacing.x = ggplot2::unit(0, "cm")) + list.heatmaps[[name]] <- p + } + + # Tweak Normal plot space. + list.heatmaps[["Normal"]] <- list.heatmaps[["Normal"]] + + ggplot2::theme(plot.margin = ggplot2::margin(t = 0, + r = if (base::isFALSE(flip)){0} else {5}, + b = if (base::isFALSE(flip)){5} else {0}, + l = 0, unit = "mm")) + + p <- patchwork::wrap_plots(list.heatmaps[if(base::isFALSE(flip)){rev(metadata)} else {metadata}], + ncol = if (base::isFALSE(flip)){1} else {NULL}, + nrow = if(isTRUE(flip)) {1} else {NULL}, + guides = "collect") + + + return(p) +} diff --git a/R/do_ColorPalette.R b/R/do_ColorPalette.R index 706afd3..fb71199 100644 --- a/R/do_ColorPalette.R +++ b/R/do_ColorPalette.R @@ -30,6 +30,9 @@ do_ColorPalette <- function(colors.use, plot = FALSE, font.size = 14, font.type = "sans"){ + `%>%` <- magrittr::`%>%` + `%*%` <- base::`%*%` + # Add lengthy error messages. withr::local_options(.new = list("warning.length" = 8170)) @@ -126,6 +129,7 @@ do_ColorPalette <- function(colors.use, alpha <- substr(colors.use, 8, 9) colors <- paste(colors, alpha, sep="") } + # If opposite is TRUE, select the first and middle colors. if (isTRUE(opposite)){ @@ -153,9 +157,10 @@ do_ColorPalette <- function(colors.use, if (isTRUE(plot) & base::isFALSE(complete_output)){ # Dummy df to plot. names(colors) <- colors + df <- data.frame("values" = rep(1, n), "names" = factor(colors, levels = names(colors))) - limits <- c(-5, 1.35) colors.use <- colors + limits <- c(-5, 1.35) # Define name for the center of the plot. if (isTRUE(opposite)){ diff --git a/R/do_DimPlot.R b/R/do_DimPlot.R index a9573cc..5debe09 100644 --- a/R/do_DimPlot.R +++ b/R/do_DimPlot.R @@ -17,6 +17,7 @@ do_DimPlot <- function(sample, split.by = NULL, split.by.combined = TRUE, colors.use = NULL, + colorblind = FALSE, shuffle = TRUE, order = NULL, raster = FALSE, @@ -96,7 +97,8 @@ do_DimPlot <- function(sample, "plot_density_contour" = plot_density_contour, "label.box" = label.box, "split.by.combined" = split.by.combined, - "legend.dot.border" = legend.dot.border) + "legend.dot.border" = legend.dot.border, + "colorblind" = colorblind) check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) # Check numeric parameters. numeric_list <- list("pt.size" = pt.size, @@ -263,7 +265,7 @@ do_DimPlot <- function(sample, highlighting_cells <- is.null(group.by) & is.null(split.by) & (!(is.null(cells.highlight)) | !(is.null(idents.highlight))) if (isTRUE(default_parameters)){ # Generate the color scale based on the levels assigned to the sample. - colors.use <- generate_color_scale(levels(sample)) + colors.use <- generate_color_scale(levels(sample), colorblind = colorblind) colors.use <- colors.use[levels(sample)] } else if (isTRUE(group_by_is_used) | isTRUE(group_by_and_split_by_used)){ # Retrieve the unique values in group.by metadata variable. @@ -271,7 +273,7 @@ do_DimPlot <- function(sample, # If the variable is a factor, use the levels as order. If not, order the values alphabetically. names.use <- if (is.factor(data.use[, 1])){levels(data.use[, 1])} else {sort(unique(data.use[, 1]))} # Generate the color scale to be used based on the unique values of group.by. - colors.use <- generate_color_scale(names.use) + colors.use <- generate_color_scale(names.use, colorblind = colorblind) colors.use <- colors.use[names.use] } else if (isTRUE(split_by_is_used)){ # Retrieve the unique values in split.by metadata variable. @@ -279,7 +281,7 @@ do_DimPlot <- function(sample, # If the variable is a factor, use the levels as order. If not, order the values alphabetically. names.use <- if (is.factor(data.use[, 1])){levels(data.use[, 1])} else {sort(unique(data.use[, 1]))} # Generate the color scale based on the unique values of split.by - colors.use <- generate_color_scale(names.use) + colors.use <- generate_color_scale(names.use, colorblind = colorblind) colors.use <- colors.use[names.use] } else if (isTRUE(highlighting_cells)){ # If the user wants to highlight some cells, use this color. diff --git a/R/do_FeaturePlot.R b/R/do_FeaturePlot.R index 8d0f572..cbe600f 100644 --- a/R/do_FeaturePlot.R +++ b/R/do_FeaturePlot.R @@ -30,6 +30,7 @@ do_FeaturePlot <- function(sample, order = FALSE, group.by = NULL, group.by.colors.use = NULL, + colorblind = FALSE, group.by.legend = NULL, group.by.show.dots = TRUE, group.by.dot.size = 8, @@ -130,7 +131,8 @@ do_FeaturePlot <- function(sample, "legend.byrow" = legend.byrow, "group.by.cell_borders" = group.by.cell_borders, "group.by.show.dots" = group.by.show.dots, - "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("pt.size" = pt.size, @@ -301,7 +303,7 @@ do_FeaturePlot <- function(sample, # If the variable is a factor, use the levels as order. If not, order the values alphabetically. names.use <- if (is.factor(data.use[, 1])){levels(data.use[, 1])} else {sort(unique(data.use[, 1]))} # Generate the color scale to be used based on the unique values of group.by. - group.by.colors.use <- generate_color_scale(names.use) + group.by.colors.use <- generate_color_scale(names.use, colorblind = colorblind) } } diff --git a/R/do_GroupwiseDEHeatmap.R b/R/do_GroupwiseDEHeatmap.R index eee6068..e0ab71f 100644 --- a/R/do_GroupwiseDEHeatmap.R +++ b/R/do_GroupwiseDEHeatmap.R @@ -26,6 +26,7 @@ do_GroupwiseDEHeatmap <- function(sample, ylab = NULL, use_viridis = FALSE, colors.use = NULL, + colorblind = FALSE, viridis.direction = -1, viridis.palette = "G", sequential.direction = 1, @@ -69,7 +70,8 @@ do_GroupwiseDEHeatmap <- function(sample, logical_list <- list("use_viridis" = use_viridis, "enforce_symmetry" = enforce_symmetry, "flip" = flip, - "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("number.breaks" = number.breaks, @@ -189,7 +191,7 @@ do_GroupwiseDEHeatmap <- function(sample, } 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_MetadataHeatmap.R b/R/do_MetadataHeatmap.R index 79aee39..3dd5073 100644 --- a/R/do_MetadataHeatmap.R +++ b/R/do_MetadataHeatmap.R @@ -24,7 +24,8 @@ do_MetadataHeatmap <- function(sample = NULL, from_df = FALSE, df = NULL, colors.use = NULL, - cluster = TRUE, + colorblind = FALSE, + cluster = FALSE, flip = TRUE, heatmap.gap = 1, axis.text.x.angle = 45, @@ -57,7 +58,8 @@ do_MetadataHeatmap <- function(sample = NULL, logical_list <- list("flip" = flip, "from_df" = from_df, "legend.byrow" = legend.byrow, - "cluster" = cluster) + "cluster" = cluster, + "colorblind" = colorblind) check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) # Check numeric parameters. @@ -178,7 +180,8 @@ do_MetadataHeatmap <- function(sample = NULL, list.heatmaps <- list() # Get a list of predefined colors to then compute color wheels on for each metadata variable not covered. - colors.pool <- get_SCpubr_colors() + colors.pool <- if (base::isFALSE(colorblind)){get_SCpubr_colors()} else {get_Colorblind_colors()[["Collection"]]} + counter <- 0 for (name in metadata){ # Colors @@ -187,8 +190,13 @@ do_MetadataHeatmap <- function(sample = NULL, counter <- counter + 1 values <- unique(data.plot %>% dplyr::pull(name)) - colors.use.name <- stats::setNames(do_ColorPalette(n = length(values), colors.use = colors.pool[counter]), - values) + if (base::isFALSE(colorblind)){ + colors.use.name <- stats::setNames(do_ColorPalette(n = length(values), colors.use = colors.pool[counter]), + values) + } else { + colors.use.name <- stats::setNames(colors.pool[1:length(values)], values) + } + } diff --git a/R/do_RankedEnrichmentHeatmap.R b/R/do_RankedEnrichmentHeatmap.R index 1c71292..8ea2caa 100644 --- a/R/do_RankedEnrichmentHeatmap.R +++ b/R/do_RankedEnrichmentHeatmap.R @@ -18,6 +18,7 @@ do_RankedEnrichmentHeatmap <- function(sample, reduction = NULL, group.by = NULL, colors.use = NULL, + colorblind = FALSE, raster = FALSE, interpolate = FALSE, nbin = 24, @@ -75,7 +76,8 @@ do_RankedEnrichmentHeatmap <- function(sample, "use_viridis" = use_viridis, "verbose" = verbose, "interpolate" = interpolate, - "raster" = raster) + "raster" = raster, + "colorblind" = colorblind) check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) # Check numeric parameters. @@ -350,7 +352,7 @@ do_RankedEnrichmentHeatmap <- function(sample, colors.use.iteration <- colors.use[[name]] } else { names.use <- if(is.factor(sample@meta.data[, name])){levels(sample@meta.data[, name])} else {sort(unique(sample@meta.data[, name]))} - colors.use.iteration <- generate_color_scale(names_use = names.use) + colors.use.iteration <- generate_color_scale(names_use = names.use, colorblind = colorblind) } # Generate the metadata heatmap. diff --git a/R/do_RankedExpressionHeatmap.R b/R/do_RankedExpressionHeatmap.R index ddd7e3f..74e6402 100644 --- a/R/do_RankedExpressionHeatmap.R +++ b/R/do_RankedExpressionHeatmap.R @@ -16,6 +16,7 @@ do_RankedExpressionHeatmap <- function(sample, reduction = NULL, group.by = NULL, colors.use = NULL, + colorblind = FALSE, raster = FALSE, interpolate = FALSE, nbin = 24, @@ -71,7 +72,8 @@ do_RankedExpressionHeatmap <- function(sample, "use_viridis" = use_viridis, "verbose" = verbose, "interpolate" = interpolate, - "raster" = raster) + "raster" = raster, + "colorblind" = colorblind) check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) # Check numeric parameters. @@ -328,7 +330,7 @@ do_RankedExpressionHeatmap <- function(sample, colors.use.iteration <- colors.use[[name]] } else { names.use <- if(is.factor(sample@meta.data[, name])){levels(sample@meta.data[, name])} else {sort(unique(sample@meta.data[, name]))} - colors.use.iteration <- generate_color_scale(names_use = names.use) + colors.use.iteration <- generate_color_scale(names_use = names.use, colorblind = colorblind) } # Generate the metadata heatmap. diff --git a/R/do_RidgePlot.R b/R/do_RidgePlot.R index 2c76a5f..e55ba14 100644 --- a/R/do_RidgePlot.R +++ b/R/do_RidgePlot.R @@ -35,6 +35,7 @@ do_RidgePlot <- function(sample, legend.tickcolor = "white", legend.type = "colorbar", colors.use = NULL, + colorblind = FALSE, font.size = 14, font.type = "sans", axis.text.x.angle = 45, @@ -84,7 +85,8 @@ do_RidgePlot <- function(sample, "plot.grid" = plot.grid, "flip" = flip, "legend.nrow" = legend.nrow, - "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("legend.width" = legend.width, @@ -295,7 +297,7 @@ do_RidgePlot <- function(sample, y = .data$group.by, fill = .data$group.by)) + ggridges::geom_density_ridges(color = "black") + - ggplot2::scale_fill_manual(values = if (is.null(colors.use)) {generate_color_scale(if (is.null(group.by)){levels(sample)} else {if(is.factor(sample@meta.data[, group.by])){levels(sample@meta.data[, group.by])} else {unique(sample@meta.data[, group.by])}})} else {colors.use}, + ggplot2::scale_fill_manual(values = if (is.null(colors.use)) {generate_color_scale(if (is.null(group.by)){levels(sample)} else {if(is.factor(sample@meta.data[, group.by])){levels(sample@meta.data[, group.by])} else {unique(sample@meta.data[, group.by])}}, colorblind = colorblind)} else {colors.use}, name = legend.title) + ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title, title.position = "top", diff --git a/R/do_SCEnrichmentHeatmap.R b/R/do_SCEnrichmentHeatmap.R index caf03f4..c7ce677 100644 --- a/R/do_SCEnrichmentHeatmap.R +++ b/R/do_SCEnrichmentHeatmap.R @@ -22,6 +22,7 @@ do_SCEnrichmentHeatmap <- function(sample, features.order = NULL, metadata = NULL, metadata.colors = NULL, + colorblind = FALSE, subsample = NA, cluster = TRUE, flavor = "Seurat", @@ -91,7 +92,8 @@ do_SCEnrichmentHeatmap <- function(sample, "cluster" = cluster, "storeRanks" = storeRanks, "return_object" = return_object, - "interpolate" = interpolate) + "interpolate" = interpolate, + "colorblind" = colorblind) check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) # Check numeric parameters. numeric_list <- list("font.size" = font.size, @@ -426,7 +428,7 @@ do_SCEnrichmentHeatmap <- function(sample, colors.use <- metadata.colors[[name]] } else { names.use <- if(is.factor(sample@meta.data[, name])){levels(sample@meta.data[, name])} else {sort(unique(sample@meta.data[, name]))} - colors.use <- generate_color_scale(names_use = names.use) + colors.use <- generate_color_scale(names_use = names.use, colorblind = colorblind) } p <- plot_data %>% ggplot2::ggplot(mapping = ggplot2::aes(x = .data$cell, diff --git a/R/do_SCExpressionHeatmap.R b/R/do_SCExpressionHeatmap.R index 66528c3..bf61e36 100644 --- a/R/do_SCExpressionHeatmap.R +++ b/R/do_SCExpressionHeatmap.R @@ -19,6 +19,7 @@ do_SCExpressionHeatmap <- function(sample, features.order = NULL, metadata = NULL, metadata.colors = NULL, + colorblind = FALSE, subsample = NA, cluster = TRUE, interpolate = FALSE, @@ -83,7 +84,8 @@ do_SCExpressionHeatmap <- function(sample, "legend.byrow" = legend.byrow, "use_viridis" = use_viridis, "cluster" = cluster, - "interpolate" = interpolate) + "interpolate" = interpolate, + "colorblind" = colorblind) check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) # Check numeric parameters. numeric_list <- list("font.size" = font.size, @@ -369,7 +371,7 @@ do_SCExpressionHeatmap <- function(sample, colors.use <- metadata.colors[[name]] } else { names.use <- if(is.factor(sample@meta.data[, name])){levels(sample@meta.data[, name])} else {sort(unique(sample@meta.data[, name]))} - colors.use <- generate_color_scale(names_use = names.use) + colors.use <- generate_color_scale(names_use = names.use, colorblind = colorblind) } p <- plot_data %>% ggplot2::ggplot(mapping = ggplot2::aes(x = .data$cell, diff --git a/R/do_StripPlot.R b/R/do_StripPlot.R index 8f89123..be87272 100644 --- a/R/do_StripPlot.R +++ b/R/do_StripPlot.R @@ -20,60 +20,61 @@ #' @example /man/examples/examples_do_StripPlot.R do_StripPlot <- function(sample, - features, - assay = NULL, - slot = "data", - group.by = NULL, - split.by = NULL, - enforce_symmetry = FALSE, - scale_type = "continuous", - order = TRUE, - plot_cell_borders = TRUE, - jitter = 0.45, - pt.size = 1, - border.size = 2, - border.color = "black", - legend.position = "bottom", - legend.width = 1, - legend.length = 20, - legend.framewidth = 0.5, - legend.tickwidth = 0.5, - legend.framecolor = "grey50", - legend.tickcolor = "white", - legend.type = "colorbar", - font.size = 14, - font.type = "sans", - axis.text.x.angle = 45, - viridis.palette = "G", - viridis.direction = 1, - colors.use = NULL, - na.value = "grey75", - legend.ncol = NULL, - legend.nrow = NULL, - legend.icon.size = 4, - legend.byrow = FALSE, - legend.title = NULL, - plot.title = NULL, - plot.subtitle = NULL, - plot.caption = NULL, - xlab = "Groups", - ylab = feature, - flip = FALSE, - min.cutoff = rep(NA, length(features)), - max.cutoff = rep(NA, length(features)), - number.breaks = 5, - diverging.palette = "RdBu", - diverging.direction = -1, - sequential.palette = "YlGnBu", - sequential.direction = 1, - use_viridis = FALSE, - plot.title.face = "bold", - plot.subtitle.face = "plain", - plot.caption.face = "italic", - axis.title.face = "bold", - axis.text.face = "plain", - legend.title.face = "bold", - legend.text.face = "plain"){ + features, + assay = NULL, + slot = "data", + group.by = NULL, + split.by = NULL, + enforce_symmetry = FALSE, + scale_type = "continuous", + order = TRUE, + plot_cell_borders = TRUE, + jitter = 0.45, + pt.size = 1, + border.size = 2, + border.color = "black", + legend.position = "bottom", + legend.width = 1, + legend.length = 20, + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.framecolor = "grey50", + legend.tickcolor = "white", + legend.type = "colorbar", + font.size = 14, + font.type = "sans", + axis.text.x.angle = 45, + viridis.palette = "G", + viridis.direction = 1, + colors.use = NULL, + colorblind = FALSE, + na.value = "grey75", + legend.ncol = NULL, + legend.nrow = NULL, + legend.icon.size = 4, + legend.byrow = FALSE, + legend.title = NULL, + plot.title = NULL, + plot.subtitle = NULL, + plot.caption = NULL, + xlab = "Groups", + ylab = feature, + flip = FALSE, + min.cutoff = rep(NA, length(features)), + max.cutoff = rep(NA, length(features)), + number.breaks = 5, + diverging.palette = "RdBu", + diverging.direction = -1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + use_viridis = FALSE, + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain"){ # Add lengthy error messages. withr::local_options(.new = list("warning.length" = 8170)) @@ -86,7 +87,8 @@ do_StripPlot <- function(sample, "order" = order, "plot_cell_borders" = plot_cell_borders, "flip" = flip, - "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("pt.size" = pt.size, @@ -249,7 +251,7 @@ do_StripPlot <- function(sample, levels(sample@meta.data[, group.by]) } else { sort(unique(sample@meta.data[, group.by])) - }) + }, colorblind = colorblind) } else { check_colors(colors.use) check_consistency_colors_and_names(sample, colors = colors.use, grouping_variable = group.by) diff --git a/R/do_ViolinPlot.R b/R/do_ViolinPlot.R index 99942ba..e5f397c 100644 --- a/R/do_ViolinPlot.R +++ b/R/do_ViolinPlot.R @@ -20,6 +20,7 @@ do_ViolinPlot <- function(sample, group.by = NULL, split.by = NULL, colors.use = NULL, + colorblind = FALSE, pt.size = 0, line_width = 0.5, y_cut = rep(NA, length(features)), @@ -72,7 +73,8 @@ do_ViolinPlot <- function(sample, "flip" = flip, "share.y.lims" = share.y.lims, "legend.byrow" = legend.byrow, - "order" = order) + "order" = order, + "colorblind" = colorblind) check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) # Check numeric parameters. numeric_list <- list("pt.size" = pt.size, @@ -188,7 +190,7 @@ do_ViolinPlot <- function(sample, } } - colors.use <- generate_color_scale(names.use) + colors.use <- generate_color_scale(names.use, colorblind = colorblind) } else { if (is.null(split.by)){ colors.use <- check_consistency_colors_and_names(sample = sample, colors = colors.use, grouping_variable = group.by) diff --git a/R/do_WafflePlot.R b/R/do_WafflePlot.R index 52a9dff..7262aab 100644 --- a/R/do_WafflePlot.R +++ b/R/do_WafflePlot.R @@ -12,6 +12,7 @@ do_WafflePlot <- function(sample, waffle.size = 2, flip = TRUE, colors.use = NULL, + colorblind = FALSE, na.value = "grey75", font.size = 14, font.type = "sans", @@ -42,7 +43,8 @@ do_WafflePlot <- function(sample, # Check logical parameters logical_list <- list("flip" = flip, - "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("waffle.size" = waffle.size, @@ -91,7 +93,7 @@ do_WafflePlot <- function(sample, check_colors(na.value, parameter_name = "na.value") 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/utils.R b/R/utils.R index fa3afb3..4bad4ba 100644 --- a/R/utils.R +++ b/R/utils.R @@ -174,6 +174,7 @@ #' @param interpolate \strong{\code{\link[base]{logical}}} | Smoothes the output heatmap, saving space on disk when saving the image. However, the image is not as crisp. #' @param order \strong{\code{\link[base]{logical}}} | Whether to order the boxplots by average values. Can not be used alongside split.by. #' @param dot.scale \strong{\code{\link[base]{numeric}}} | Scale the size of the dots. +#' @param colorblind \strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable. #' @usage NULL #' @return Nothing. This is a mock function. #' @keywords internal @@ -417,6 +418,7 @@ return_dependencies <- function(){ "do_CellularStatesPlot" = c("pbapply", "ggExtra", "ggplotify", "scattermore"), "do_ChordDiagramPlot" = "circlize", "do_ColorPalette" = NULL, + "do_ColorBlindCheck" = c("colorspace"), "do_CNVHeatmap" = "ggdist", "do_CorrelationHeatmap" = NULL, "do_DimPlot" = c("colorspace", "ggplotify", "scattermore"), @@ -466,7 +468,8 @@ check_suggests <- function(function_name, passive = FALSE){ non_seurat_functions <- c("do_SavePlot", "do_VolcanoPlot", "do_LigandReceptorPlot", - "do_ColorPalette") + "do_ColorPalette", + "do_ColorBlindPalette") if (function_name %in% non_seurat_functions){ pkgs <- pkgs[!(pkgs %in% c("Seurat", "SeuratObject"))] @@ -723,6 +726,12 @@ do_PackageReport <- function(startup = FALSE, tip_message <- paste0(cli::style_bold(cli::col_cyan(cli::symbol$info)), crayon_body(" To remove the white and black end from continuous palettes, use: "), cli::style_italic(crayon_key('options("SCpubr.ColorPaletteEnds" = FALSE)'))) + + tip_message2 <- paste0(cli::style_bold(cli::col_cyan(cli::symbol$info)), + crayon_body(" Colorblind-safe continuous/divergent color palettes are used by default.\n"), + cli::style_bold(cli::col_cyan(cli::symbol$info)), + crayon_body(" For categorical variables, you can use: "), + cli::style_italic(crayon_key('colorblind = TRUE'))) disable_message <- paste0(cli::style_bold(cli::col_red(cli::symbol$cross)), crayon_body(" To suppress this startup message, use: "), @@ -756,6 +765,7 @@ do_PackageReport <- function(startup = FALSE, tip_rule, "\n", "\n", ins_message, "\n", "\n", tip_message, "\n", "\n", + tip_message2, "\n", "\n", disable_message, "\n", "\n", end_rule) } else { @@ -769,6 +779,7 @@ do_PackageReport <- function(startup = FALSE, tip_rule, "\n", "\n", ins_message, "\n", "\n", tip_message, "\n", "\n", + tip_message2, "\n", "\n", disable_message, "\n", "\n", end_rule) } @@ -789,6 +800,7 @@ do_PackageReport <- function(startup = FALSE, tip_rule, "\n", "\n", ins_message, "\n", "\n", tip_message, "\n", "\n", + tip_message2, "\n", "\n", disable_message, "\n", "\n", end_rule) } else { @@ -802,6 +814,7 @@ do_PackageReport <- function(startup = FALSE, tip_rule, "\n", "\n", ins_message, "\n", "\n", tip_message, "\n", "\n", + tip_message2, "\n", "\n", disable_message, "\n", "\n", end_rule) } @@ -979,20 +992,71 @@ check_consistency_colors_and_names <- function(sample, colors, grouping_variable #' \donttest{ #' TBD #' } -generate_color_scale <- function(names_use){ - # Generate a vector of colors equal to the number of identities in the sample. - colors <- colorspace::qualitative_hcl(length(names_use), palette = "Dark 3") - colors <- grDevices::col2rgb(colors) - colors <- grDevices::rgb2hsv(colors) - colors["v", ] <- colors["v", ] - 0.1 - colors["s", ] <- colors["s", ] + 0.2 - colors["s", ][colors["s", ] > 1] <- 1 - colors <- grDevices::hsv(h = colors["h", ], - s = colors["s", ], - v = colors["v", ], - alpha = 1) - names(colors) <- names_use - return(colors) +generate_color_scale <- function(names_use, colorblind = FALSE){ + if (base::isFALSE(colorblind)){ + # Generate a vector of colors equal to the number of identities in the sample. + colors <- colorspace::qualitative_hcl(length(names_use), palette = "Dark 3") + colors <- grDevices::col2rgb(colors) + colors <- grDevices::rgb2hsv(colors) + colors["v", ] <- colors["v", ] - 0.1 + colors["s", ] <- colors["s", ] + 0.2 + colors["s", ][colors["s", ] > 1] <- 1 + colors <- grDevices::hsv(h = colors["h", ], + s = colors["s", ], + v = colors["v", ], + alpha = 1) + names(colors) <- names_use + return(colors) + } else { + colors.use <- get_Colorblind_colors() + + wong.colors <- colors.use[["Wong"]] + tol.bright.colors <- colors.use[["Tol_Bright"]] + tol.muted.colors <- colors.use[["Tol_Muted"]] + okabe.colors <- colors.use[["Okabe"]] + krz.8 <- colros.use[["Krz8"]] + krz.12 <- colros.use[["Krz12"]] + krz.15 <- colros.use[["Krz15"]] + krz.23 <- colros.use[["Krz24"]] + collection <- colros.use[["Collection"]] + + assertthat::assert_that(length(names_use) < length(collection), + msg = paste0(add_cross(), crayon_body("Please, select another variable that has less than "), + crayon_key(as.character(length(collection))), + crayon_body(" classes when using "), + crayon_key("colorblind = TRUE"), + crayon_body("."))) + + # N = 7 + if (length(names_use) == length(tol.bright.colors)){ + colors <- tol.bright.colors + # N = 8 + } else if (length(names_use) == length(wong.colors)){ + colors <- wong.colors + # N = 9 + } else if (length(names_use) == length(tol.muted.colors)){ + colors <- tol.muted.colors + # N = 12 + } else if (length(names_use) == length(krz.12)){ + colors <- krz.12 + # N = 15 + } else if (length(names_use) == length(krz.15)){ + colors <- krz.15 + # N = 24 + } else if (length(names_use) == length(krz.24)){ + colors <- krz.24 + # Less than 7 + } else if (length(names_use) < 7){ + colors <- wong.colors[1:length(names_use)] + # Remaining cases + } else { + length.use <- length(names_use) + colors <- collection[1:length.use] + } + names(colors) <- names_use + + return(colors) + } } @@ -3125,6 +3189,146 @@ get_SCpubr_colors <- function(){ } +#' Generate a list of colorblind-friendly colors that will be used for colorblind = TRUE plots. +#' +#' @return None +#' @noRd +#' @examples +#' \donttest{ +#' TBD +#' } +get_Colorblind_colors <- function(){ + + # Colorblind palettes from literature: + # Wong: https://www.nature.com/articles/nmeth.1618 + wong.colors <- c("#000000", + "#E69F00", + "#56B4E9", + "#009E73", + "#F0E442", + "#0072B2", + "#D55E00", + "#CC79A7") + + # Tol: https://personal.sron.nl/~pault/ + tol.muted.colors <- c("#dddddd", + "#332288", + "#117733", + "#44AA99", + "#88CCEE", + "#DDCC77", + "#CC6677", + "#AA4499", + "#882255") + + tol.bright.colors <- c("#bbbbbb", + "#4477aa", + "#218833", + "#66ccee", + "#cbbb45", + "#ee6577", + "#aa3377") + + + okabe.colors <- c("#000000", + "#009e73", + "#0071b2", + "#55b4e9", + "#efe441", + "#e69f00", + "#d55d00", + "#cb79a7") + + + # Krzywinski: https://mk.bcgsc.ca/colorblind/palettes.mhtml#projecthome + krz.8 <- c("#000000", + "#2271B2", + "#3DB7E9", + "#F748A5", + "#359B73", + "#d55e00", + "#e69f00", + "#f0e442") + + krz.12 <- c("#9F0162", + "#009F81", + "#FF5AAF", + "#00FCCF", + "#8400CD", + "#008DF9", + "#00C2F9", + "#FFB2FD", + "#A40122", + "#E20134", + "#FF6E3A", + "#FFC33B") + + krz.15 <- c("#68023F", + "#008169", + "#EF0096", + "#00DCB5", + "#FFCFE2", + "#003C86", + "#9400E6", + "#009FFA", + "#FF71FD", + "#7CFFFA", + "#6A0213", + "#008607", + "#F60239", + "#00E307", + "#FFDC3D") + + krz.24 <- c("#003D30", + "#005745", + "#00735C", + "#009175", + "#00AF8E", + "#00CBA7", + "#00EBC1", + "#86FFDE", + "#00306F", + "#00489E", + "#005FCC", + "#0079FA", + "#009FFA", + "#00C2F9", + "#00E5F8", + "#7CFFFA", + "#004002", + "#005A01", + "#007702", + "#009503", + "#00B408", + "#00D302", + "#00F407", + "#AFFF2A") + + collection <- c(wong.colors, + tol.muted.colors, + tol.bright.colors, + okabe.colors, + krz.8, + krz.12, + krz.15, + krz.24) + collection <- collection[!duplicated(collection)] + + out.colors <- list("Wong" = wong.colors, + "Tol_Muted" = tol.muted.colors, + "Tol_Bright" = tol.bright.colors, + "Okabe" = okabe.colors, + "Krz8" = krz.8, + "Krz12" = krz.12, + "Krz15" = krz.15, + "Krz24" = krz.24, + "Collection" = collection) + return(out.colors) +} + + + + #' Check the group.by parameter #' #' @param sample Seurat object. diff --git a/man/do_AlluvialPlot.Rd b/man/do_AlluvialPlot.Rd index dee491a..b1f7a40 100644 --- a/man/do_AlluvialPlot.Rd +++ b/man/do_AlluvialPlot.Rd @@ -10,6 +10,7 @@ do_AlluvialPlot( last_group, middle_groups = NULL, colors.use = NULL, + colorblind = FALSE, plot.title = NULL, plot.subtitle = NULL, plot.caption = NULL, @@ -61,6 +62,8 @@ do_AlluvialPlot( \item{colors.use}{\strong{\code{\link[base]{character}}} | Named list of colors corresponding to the unique values in fill.by (which defaults to last_group).} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{plot.title, plot.subtitle, plot.caption}{\strong{\code{\link[base]{character}}} | Title, subtitle or caption to use in the plot.} \item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} diff --git a/man/do_BarPlot.Rd b/man/do_BarPlot.Rd index f601ff2..27037fa 100644 --- a/man/do_BarPlot.Rd +++ b/man/do_BarPlot.Rd @@ -27,6 +27,7 @@ do_BarPlot( xlab = NULL, ylab = NULL, colors.use = NULL, + colorblind = colorblind, flip = FALSE, plot.title = NULL, plot.subtitle = NULL, @@ -104,6 +105,8 @@ do_BarPlot( \item{colors.use}{\strong{\code{\link[SCpubr]{named_vector}}} | Named vector of valid color representations (either name of HEX codes) with as many named colors as unique values of group.by. If group.by is not provided, defaults to the unique values of \link[Seurat]{Idents}. If not provided, a color scale will be set by default.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{flip}{\strong{\code{\link[base]{logical}}} | Whether to invert the axis of the displayed plot.} \item{plot.title, plot.subtitle, plot.caption}{\strong{\code{\link[base]{character}}} | Title, subtitle or caption to use in the plot.} diff --git a/man/do_BeeSwarmPlot.Rd b/man/do_BeeSwarmPlot.Rd index b33d9c0..9c23e27 100644 --- a/man/do_BeeSwarmPlot.Rd +++ b/man/do_BeeSwarmPlot.Rd @@ -14,6 +14,7 @@ do_BeeSwarmPlot( continuous_feature = FALSE, order = FALSE, colors.use = NULL, + colorblind = FALSE, legend.title = NULL, legend.type = "colorbar", legend.position = "bottom", @@ -79,6 +80,8 @@ do_BeeSwarmPlot( \item{colors.use}{\strong{\code{\link[SCpubr]{named_vector}}} | Named vector of valid color representations (either name of HEX codes) with as many named colors as unique values of group.by. If group.by is not provided, defaults to the unique values of \link[Seurat]{Idents}. If not provided, a color scale will be set by default.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{legend.title}{\strong{\code{\link[base]{character}}} | Title for the legend.} \item{legend.type}{\strong{\code{\link[base]{character}}} | Type of legend to display. One of: diff --git a/man/do_BoxPlot.Rd b/man/do_BoxPlot.Rd index af0dfe7..88bf856 100644 --- a/man/do_BoxPlot.Rd +++ b/man/do_BoxPlot.Rd @@ -15,6 +15,7 @@ do_BoxPlot( font.type = "sans", axis.text.x.angle = 45, colors.use = NULL, + colorblind = colorblind, na.value = "grey75", plot.title = NULL, plot.subtitle = NULL, @@ -77,6 +78,8 @@ do_BoxPlot( \item{colors.use}{\strong{\code{\link[SCpubr]{named_vector}}} | Named vector of valid color representations (either name of HEX codes) with as many named colors as unique values of group.by. If group.by is not provided, defaults to the unique values of \link[Seurat]{Idents}. If not provided, a color scale will be set by default.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{na.value}{\strong{\code{\link[base]{character}}} | Color value for NA.} \item{plot.title, plot.subtitle, plot.caption}{\strong{\code{\link[base]{character}}} | Title, subtitle or caption to use in the plot.} diff --git a/man/do_CellularStatesPlot.Rd b/man/do_CellularStatesPlot.Rd index fe86908..fafc110 100644 --- a/man/do_CellularStatesPlot.Rd +++ b/man/do_CellularStatesPlot.Rd @@ -13,6 +13,7 @@ do_CellularStatesPlot( y2 = NULL, group.by = NULL, colors.use = NULL, + colorblind = FALSE, legend.position = "bottom", legend.icon.size = 4, legend.ncol = NULL, @@ -76,6 +77,8 @@ do_CellularStatesPlot( \item{colors.use}{\strong{\code{\link[SCpubr]{named_vector}}} | Named vector of valid color representations (either name of HEX codes) with as many named colors as unique values of group.by. If group.by is not provided, defaults to the unique values of \link[Seurat]{Idents}. If not provided, a color scale will be set by default.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{legend.position}{\strong{\code{\link[base]{character}}} | Position of the legend in the plot. One of: \itemize{ \item \emph{\code{top}}: Top of the figure. diff --git a/man/do_ChordDiagramPlot.Rd b/man/do_ChordDiagramPlot.Rd index 487f8fc..18b3955 100644 --- a/man/do_ChordDiagramPlot.Rd +++ b/man/do_ChordDiagramPlot.Rd @@ -10,6 +10,7 @@ do_ChordDiagramPlot( to = NULL, colors.from = NULL, colors.to = NULL, + colorblind = colorblind, big.gap = 10, small.gap = 1, link.border.color = NA, @@ -39,6 +40,8 @@ do_ChordDiagramPlot( \item{colors.from, colors.to}{\strong{\code{\link[SCpubr]{named_vector}}} | Named vector of colors corresponding to the unique values of "from" and "to".} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{big.gap}{\strong{\code{\link[base]{numeric}}} | Space between the groups in "from" and "to".} \item{small.gap}{\strong{\code{\link[base]{numeric}}} | Space within the groups.} diff --git a/man/do_ColorBlindCheck.Rd b/man/do_ColorBlindCheck.Rd new file mode 100644 index 0000000..de42806 --- /dev/null +++ b/man/do_ColorBlindCheck.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/do_ColorBlindCheck.R +\name{do_ColorBlindCheck} +\alias{do_ColorBlindCheck} +\title{Generate colorblind variations of a given color palette.} +\usage{ +do_ColorBlindCheck( + colors.use, + flip = FALSE, + font.size = 14, + font.type = "sans", + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + grid.color = "white", + border.color = "black", + axis.text.x.angle = 45 +) +} +\arguments{ +\item{colors.use}{\strong{\code{\link[base]{character}}} | One color upon which generate the color scale. Can be a name or a HEX code.} + +\item{flip}{\strong{\code{\link[base]{logical}}} | Whether to invert the axis of the displayed plot.} + +\item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} + +\item{font.type}{\strong{\code{\link[base]{character}}} | Base font family for the plot. One of: +\itemize{ +\item \emph{\code{mono}}: Mono spaced font. +\item \emph{\code{serif}}: Serif font family. +\item \emph{\code{sans}}: Default font family. +}} + +\item{grid.color}{\strong{\code{\link[base]{character}}} | Color of the grid in the plot. In heatmaps, color of the border of the cells.} + +\item{border.color}{\strong{\code{\link[base]{character}}} | Color for the border of the heatmap body.} + +\item{axis.text.x.angle}{\strong{\code{\link[base]{numeric}}} | Degree to rotate the X labels. One of: 0, 45, 90.} +} +\value{ +A character vector with the desired color scale. +} +\description{ +This function generate colorblind variations of a provided color palette in order to check if it is colorblind friendly. Variations are generated using colorspace package. +} +\examples{ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_ColorBlindCheck", passive = TRUE) + + if (isTRUE(value)){ + # Generate a color wheel based on a single value. + colors <- c("red", "green", "blue") + p <- SCpubr::do_ColorBlindCheck(colors.use = colors) + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} +} diff --git a/man/do_DimPlot.Rd b/man/do_DimPlot.Rd index 19e5cdb..90f652a 100644 --- a/man/do_DimPlot.Rd +++ b/man/do_DimPlot.Rd @@ -11,6 +11,7 @@ do_DimPlot( split.by = NULL, split.by.combined = TRUE, colors.use = NULL, + colorblind = FALSE, shuffle = TRUE, order = NULL, raster = FALSE, @@ -79,6 +80,8 @@ do_DimPlot( \item{colors.use}{\strong{\code{\link[SCpubr]{named_vector}}} | Named vector of valid color representations (either name of HEX codes) with as many named colors as unique values of group.by. If group.by is not provided, defaults to the unique values of \link[Seurat]{Idents}. If not provided, a color scale will be set by default.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{shuffle}{\strong{\code{\link[base]{logical}}} | Whether to shuffle the cells or not, so that they are not plotted cluster-wise. Recommended.} \item{order}{\strong{\code{\link[base]{character}}} | Vector of identities to be plotted. Either one with all identities or just some, which will be plotted last.} diff --git a/man/do_FeaturePlot.Rd b/man/do_FeaturePlot.Rd index 4802579..46ec296 100644 --- a/man/do_FeaturePlot.Rd +++ b/man/do_FeaturePlot.Rd @@ -13,6 +13,7 @@ do_FeaturePlot( order = FALSE, group.by = NULL, group.by.colors.use = NULL, + colorblind = FALSE, group.by.legend = NULL, group.by.show.dots = TRUE, group.by.dot.size = 8, @@ -103,6 +104,8 @@ do_FeaturePlot( \item{group.by.colors.use}{\strong{\code{\link[base]{character}}} | Colors to use for the group dots.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{group.by.legend}{\strong{\code{\link[base]{character}}} | Title for the legend when \strong{\code{group.by}} is used. Use \strong{\code{NA}} to disable it and \strong{\code{NULL}} to use the default column title provided in \strong{\code{group.by}}.} \item{group.by.show.dots}{\strong{\code{\link[base]{logical}}} | Controls whether to place in the middle of the groups.} diff --git a/man/do_GroupwiseDEHeatmap.Rd b/man/do_GroupwiseDEHeatmap.Rd index 6519df0..40e2480 100644 --- a/man/do_GroupwiseDEHeatmap.Rd +++ b/man/do_GroupwiseDEHeatmap.Rd @@ -22,6 +22,7 @@ do_GroupwiseDEHeatmap( ylab = NULL, use_viridis = FALSE, colors.use = NULL, + colorblind = FALSE, viridis.direction = -1, viridis.palette = "G", sequential.direction = 1, @@ -86,6 +87,8 @@ do_GroupwiseDEHeatmap( \item{colors.use}{\strong{\code{\link[SCpubr]{named_vector}}} | Named vector of valid color representations (either name of HEX codes) with as many named colors as unique values of group.by. If group.by is not provided, defaults to the unique values of \link[Seurat]{Idents}. If not provided, a color scale will be set by default.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{viridis.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Controls how the gradient of viridis scale is formed.} \item{viridis.palette}{\strong{\code{\link[base]{character}}} | A capital letter from A to H or the scale name as in \link[viridis]{scale_fill_viridis}.} diff --git a/man/do_MetadataHeatmap.Rd b/man/do_MetadataHeatmap.Rd index c218bd7..3a5f646 100644 --- a/man/do_MetadataHeatmap.Rd +++ b/man/do_MetadataHeatmap.Rd @@ -11,7 +11,8 @@ do_MetadataHeatmap( from_df = FALSE, df = NULL, colors.use = NULL, - cluster = TRUE, + colorblind = FALSE, + cluster = FALSE, flip = TRUE, heatmap.gap = 1, axis.text.x.angle = 45, @@ -50,6 +51,8 @@ do_MetadataHeatmap( \item{colors.use}{\strong{\code{\link[SCpubr]{named_list}}} | A named list of named vectors. The names of the list correspond to the names of the values provided to metadata and the names of the items in the named vectors correspond to the unique values of that specific metadata variable. The values are the desired colors in HEX code for the values to plot. The used are pre-defined by the pacakge but, in order to get the most out of the plot, please provide your custom set of colors for each metadata column!} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{cluster}{\strong{\code{\link[base]{logical}}} | Whether to perform clustering of rows and columns.} \item{flip}{\strong{\code{\link[base]{logical}}} | Whether to invert the axis of the displayed plot.} diff --git a/man/do_RankedEnrichmentHeatmap.Rd b/man/do_RankedEnrichmentHeatmap.Rd index 5490c5d..300d663 100644 --- a/man/do_RankedEnrichmentHeatmap.Rd +++ b/man/do_RankedEnrichmentHeatmap.Rd @@ -15,6 +15,7 @@ do_RankedEnrichmentHeatmap( reduction = NULL, group.by = NULL, colors.use = NULL, + colorblind = FALSE, raster = FALSE, interpolate = FALSE, nbin = 24, @@ -78,6 +79,8 @@ do_RankedEnrichmentHeatmap( \item{colors.use}{\strong{\code{\link[base]{list}}} | A named list of named vectors. The names of the list correspond to the names of the values provided to metadata and the names of the items in the named vectors correspond to the unique values of that specific metadata variable. The values are the desired colors in HEX code for the values to plot. The used are pre-defined by the package but, in order to get the most out of the plot, please provide your custom set of colors for each metadata column!} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{raster}{\strong{\code{\link[base]{logical}}} | Whether to raster the resulting plot. This is recommendable if plotting a lot of cells.} \item{interpolate}{\strong{\code{\link[base]{logical}}} | Smoothes the output heatmap, saving space on disk when saving the image. However, the image is not as crisp.} diff --git a/man/do_RankedExpressionHeatmap.Rd b/man/do_RankedExpressionHeatmap.Rd index 085781c..e5f8e4d 100644 --- a/man/do_RankedExpressionHeatmap.Rd +++ b/man/do_RankedExpressionHeatmap.Rd @@ -14,6 +14,7 @@ do_RankedExpressionHeatmap( reduction = NULL, group.by = NULL, colors.use = NULL, + colorblind = FALSE, raster = FALSE, interpolate = FALSE, nbin = 24, @@ -74,6 +75,8 @@ do_RankedExpressionHeatmap( \item{colors.use}{\strong{\code{\link[base]{list}}} | A named list of named vectors. The names of the list correspond to the names of the values provided to metadata and the names of the items in the named vectors correspond to the unique values of that specific metadata variable. The values are the desired colors in HEX code for the values to plot. The used are pre-defined by the package but, in order to get the most out of the plot, please provide your custom set of colors for each metadata column!} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{raster}{\strong{\code{\link[base]{logical}}} | Whether to raster the resulting plot. This is recommendable if plotting a lot of cells.} \item{interpolate}{\strong{\code{\link[base]{logical}}} | Smoothes the output heatmap, saving space on disk when saving the image. However, the image is not as crisp.} diff --git a/man/do_RidgePlot.Rd b/man/do_RidgePlot.Rd index acfcea2..4d4924e 100644 --- a/man/do_RidgePlot.Rd +++ b/man/do_RidgePlot.Rd @@ -25,6 +25,7 @@ do_RidgePlot( legend.tickcolor = "white", legend.type = "colorbar", colors.use = NULL, + colorblind = FALSE, font.size = 14, font.type = "sans", axis.text.x.angle = 45, @@ -106,6 +107,8 @@ do_RidgePlot( \item{colors.use}{\strong{\code{\link[base]{character}}} | Named vector of colors to use. Has to match the unique values of group.by or color.by (if used) when scale_type is set to categorical.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} \item{font.type}{\strong{\code{\link[base]{character}}} | Base font family for the plot. One of: diff --git a/man/do_SCEnrichmentHeatmap.Rd b/man/do_SCEnrichmentHeatmap.Rd index 8de4890..bc6eb43 100644 --- a/man/do_SCEnrichmentHeatmap.Rd +++ b/man/do_SCEnrichmentHeatmap.Rd @@ -13,6 +13,7 @@ do_SCEnrichmentHeatmap( features.order = NULL, metadata = NULL, metadata.colors = NULL, + colorblind = FALSE, subsample = NA, cluster = TRUE, flavor = "Seurat", @@ -86,6 +87,8 @@ do_SCEnrichmentHeatmap( \item{metadata.colors}{\strong{\code{\link[SCpubr]{named_list}}} | Named list of valid colors for each of the variables defined in \strong{\code{metadata}}.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{subsample}{\strong{\code{\link[base]{numeric}}} | Number of cells to subset for the analysis. NA will use all. Cells are selected at random.} \item{cluster}{\strong{\code{\link[base]{logical}}} | Whether to perform clustering of rows and columns.} diff --git a/man/do_SCExpressionHeatmap.Rd b/man/do_SCExpressionHeatmap.Rd index 53baaed..6225748 100644 --- a/man/do_SCExpressionHeatmap.Rd +++ b/man/do_SCExpressionHeatmap.Rd @@ -13,6 +13,7 @@ do_SCExpressionHeatmap( features.order = NULL, metadata = NULL, metadata.colors = NULL, + colorblind = FALSE, subsample = NA, cluster = TRUE, interpolate = FALSE, @@ -80,6 +81,8 @@ do_SCExpressionHeatmap( \item{metadata.colors}{\strong{\code{\link[SCpubr]{named_list}}} | Named list of valid colors for each of the variables defined in \strong{\code{metadata}}.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{subsample}{\strong{\code{\link[base]{numeric}}} | Number of cells to subset for the analysis. NA will use all. Cells are selected at random.} \item{cluster}{\strong{\code{\link[base]{logical}}} | Whether to perform clustering of rows and columns.} diff --git a/man/do_GeyserPlot.Rd b/man/do_StripPlot.Rd similarity index 93% rename from man/do_GeyserPlot.Rd rename to man/do_StripPlot.Rd index 4e915bd..1b2294a 100644 --- a/man/do_GeyserPlot.Rd +++ b/man/do_StripPlot.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/do_GeyserPlot.R -\name{do_GeyserPlot} -\alias{do_GeyserPlot} -\title{Generate a Geyser plot.} +% Please edit documentation in R/do_StripPlot.R +\name{do_StripPlot} +\alias{do_StripPlot} +\title{Generate a Strip plot.} \usage{ -do_GeyserPlot( +do_StripPlot( sample, features, assay = NULL, @@ -33,6 +33,7 @@ do_GeyserPlot( viridis.palette = "G", viridis.direction = 1, colors.use = NULL, + colorblind = FALSE, na.value = "grey75", legend.ncol = NULL, legend.nrow = NULL, @@ -135,6 +136,8 @@ do_GeyserPlot( \item{colors.use}{\strong{\code{\link[base]{character}}} | Named vector of colors to use. Has to match the unique values of group.by when scale_type is set to categorical.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{na.value}{\strong{\code{\link[base]{character}}} | Color value for NA.} \item{legend.ncol}{\strong{\code{\link[base]{numeric}}} | Number of columns in the legend.} @@ -179,17 +182,14 @@ do_GeyserPlot( Either a plot of a list of plots, depending on the number of features provided. } \description{ -A Geyser plot is a custom plot in which we plot continuous values on the Y axis grouped by a categorical value in the X. This is plotted as a dot plot, jittered so that the dots span +A strip plot is a scatter plot in which we plot continuous values on the Y axis grouped by a categorical value in the X. This is plotted as a dot plot, jittered so that the dots span all the way to the other groups. On top of this, the mean and .66 and .95 of the data is plotted, depicting the overall distribution of the dots. The cells can, then, be colored by a continuous variable (same as Y axis or different) or a categorical one (same as X axis or different). } -\details{ -Special thanks to Christina Blume for coming up with the name of the plot. -} \examples{ \donttest{ # Check Suggests. - value <- SCpubr:::check_suggests(function_name = "do_GeyserPlot", passive = TRUE) + value <- SCpubr:::check_suggests(function_name = "do_StripPlot", passive = TRUE) if (isTRUE(value)){ # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ @@ -198,13 +198,13 @@ Special thanks to Christina Blume for coming up with the name of the plot. sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) # Geyser plot with categorical color scale. - p <- SCpubr::do_GeyserPlot(sample = sample, + p <- SCpubr::do_StripPlot(sample = sample, features = "nCount_RNA", scale_type = "categorical") p # Geyser plot with continuous color scale. - p <- SCpubr::do_GeyserPlot(sample = sample, + p <- SCpubr::do_StripPlot(sample = sample, features = "nCount_RNA", scale_type = "continuous") diff --git a/man/do_ViolinPlot.Rd b/man/do_ViolinPlot.Rd index 8553905..4061542 100644 --- a/man/do_ViolinPlot.Rd +++ b/man/do_ViolinPlot.Rd @@ -12,6 +12,7 @@ do_ViolinPlot( group.by = NULL, split.by = NULL, colors.use = NULL, + colorblind = FALSE, pt.size = 0, line_width = 0.5, y_cut = rep(NA, length(features)), @@ -62,6 +63,8 @@ do_ViolinPlot( \item{colors.use}{\strong{\code{\link[SCpubr]{named_vector}}} | Named vector of valid color representations (either name of HEX codes) with as many named colors as unique values of group.by. If group.by is not provided, defaults to the unique values of \link[Seurat]{Idents}. If not provided, a color scale will be set by default.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{pt.size}{\strong{\code{\link[base]{numeric}}} | Size of points in the Violin plot.} \item{line_width}{\strong{\code{\link[base]{numeric}}} | Width of the lines drawn in the plot. Defaults to 1.} diff --git a/man/do_WafflePlot.Rd b/man/do_WafflePlot.Rd index afd04a3..d699817 100644 --- a/man/do_WafflePlot.Rd +++ b/man/do_WafflePlot.Rd @@ -10,6 +10,7 @@ do_WafflePlot( waffle.size = 2, flip = TRUE, colors.use = NULL, + colorblind = FALSE, na.value = "grey75", font.size = 14, font.type = "sans", @@ -42,6 +43,8 @@ do_WafflePlot( \item{colors.use}{\strong{\code{\link[SCpubr]{named_vector}}} | Named vector of valid color representations (either name of HEX codes) with as many named colors as unique values of group.by. If group.by is not provided, defaults to the unique values of \link[Seurat]{Idents}. If not provided, a color scale will be set by default.} +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} + \item{na.value}{\strong{\code{\link[base]{character}}} | Color value for NA.} \item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} diff --git a/man/doc_function.Rd b/man/doc_function.Rd index 95caaab..8167b10 100644 --- a/man/doc_function.Rd +++ b/man/doc_function.Rd @@ -289,6 +289,8 @@ \item \emph{\code{bold}}: For text in bold. \item \emph{\code{bold.italic}}: For text both in itallic and bold. }} + +\item{colorblind}{\strong{\code{\link[base]{logical}}} | Whether to use colorblind-friendly colors for categorical variables. In place when \code{colors.use} is not used. Allows for a maximum of 85 different classes within a categorical variable.} } \value{ Nothing. This is a mock function. diff --git a/man/examples/examples_do_ColorBlindCheck.R b/man/examples/examples_do_ColorBlindCheck.R new file mode 100644 index 0000000..9303f31 --- /dev/null +++ b/man/examples/examples_do_ColorBlindCheck.R @@ -0,0 +1,14 @@ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_ColorBlindCheck", passive = TRUE) + + if (isTRUE(value)){ + # Generate a color wheel based on a single value. + colors <- c("red", "green", "blue") + p <- SCpubr::do_ColorBlindCheck(colors.use = colors) + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} diff --git a/tests/testthat/test-do_ColorBlindCheck.R b/tests/testthat/test-do_ColorBlindCheck.R new file mode 100644 index 0000000..a3ee371 --- /dev/null +++ b/tests/testthat/test-do_ColorBlindCheck.R @@ -0,0 +1,8 @@ +if (base::isFALSE(dep_check[["do_ColorBlindCheck"]])){ + testthat::test_that("do_ColorBlindCheck: PASS - color vectors", { + + p <- SCpubr::do_ColorBlindCheck(colors.use = c("red", "blue", "green")) + testthat::expect_type(p, "list") + + }) +} \ No newline at end of file