From 01395fdfd7377b8c3993c3fff859a835f65e44a3 Mon Sep 17 00:00:00 2001 From: "Brenton M. Wiernik" Date: Tue, 13 Aug 2024 10:46:43 -0400 Subject: [PATCH 01/10] Start adding palette_tol() --- R/scale_color_okabeito.R | 5 +- R/scale_color_tol.R | 237 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 240 insertions(+), 2 deletions(-) create mode 100644 R/scale_color_tol.R diff --git a/R/scale_color_okabeito.R b/R/scale_color_okabeito.R index 08710170e..9cc297e25 100644 --- a/R/scale_color_okabeito.R +++ b/R/scale_color_okabeito.R @@ -22,6 +22,7 @@ #' #' The Okabe-Ito palette is only available as a discrete palette. #' For color-accessible continuous variables, consider +#' [Paul Tol's palettes][scale_color_tol()] or #' [the viridis palettes][ggplot2::scale_colour_viridis_d()]. #' #' @inheritParams palette_okabeito @@ -179,7 +180,7 @@ okabeito_palettes <- list( #' Okabe-Ito color palette #' -#' The palette based proposed by Okabe and Ito (2008). +#' The palette based on Okabe and Ito (2008). #' #' @inheritParams palette_flat #' @param order A vector of numbers from 1 to 9 indicating the order of colors to use @@ -191,7 +192,7 @@ okabeito_palettes <- list( #' https://jfly.uni-koeln.de/color/#pallet (Original work published 2002) #' #' @details This function is usually not called directly, but from within -#' [`scale_color_material()`][scale_color_material]. +#' [`scale_color_okabeito()`][scale_color_okabeito]. #' #' @export palette_okabeito <- function(palette = "full_amber", reverse = FALSE, order = 1:9, ...) { diff --git a/R/scale_color_tol.R b/R/scale_color_tol.R new file mode 100644 index 000000000..fd700e98b --- /dev/null +++ b/R/scale_color_tol.R @@ -0,0 +1,237 @@ +#' Paul Tol color palettes +#' +#' Tol (2021) presents a series of palettes built with mathematical principles that +#' are appropriate for diverse types of data. The colors in these schemes are: +#' - Visually distinct for all people, including viewers with color vision deficiencies +#' - Distinct from black and white +#' - Distinct on screen and paper, +#' - Cohesive; that is, they match well together +#' +#' Tol provides palettes appropriate to the 3 main types of data: +#' 1. Qualitative data – nominal or categorical data, where magnitude differences are not relevant. +#' 2. Diverging data – data ordered between two extremes where the midpoint is important. +#' 3. Sequential data – data ordered from low to high. +#' +#' Available palettes for each type of data are: +#' - Qualitative: bright, high-contrast, vibrant, muted, medium-contrast, pale, dark, light, ground_cover +#' - Diverging: sunset, BuRd, PRGn +#' - Sequential: YlOrBr, iridescent, rainbow_discrete, rainbow_smooth +#' +#' +#' +#' +#' +#' ## Colors for missing or invalid data +#' +#' A useful feature of Tol's diverging and sequential palettes is that he +#' provides a recommended color to use for data that fall outside the data +#' range represented by the color scale (e.g., for invalid or missing data). +#' These colors are chosen to be highly distinct from the main color palette. +#' +#' @inheritParams palette_tol +#' @inheritParams scale_color_flat +#' +#' @references +#' Tol, P. (2021). Colour schemes (SRON/EPS Technical Note No. 09-002; Version 3.2). +#' SRON. https://personal.sron.nl/~pault/data/colourschemes.pdf (Original work published 2009) +#' +#' @examples +#' library(ggplot2) +#' library(see) +#' +#' ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) + +#' geom_boxplot() + +#' theme_modern() + +#' scale_fill_okabeito() +#' +#' ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) + +#' geom_violin() + +#' theme_modern() + +#' scale_fill_oi(palette = "black_first") +#' +#' # for the original brighter yellow color suggested by Okabe and Ito +#' ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) + +#' geom_violin() + +#' theme_modern() + +#' scale_fill_oi(palette = "full") +#' +#' ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) + +#' geom_violin() + +#' theme_modern() + +#' scale_fill_oi(order = c(1, 5, 6, 2, 4, 3, 7)) +#' @export +scale_color_okabeito <- function(palette = "full", reverse = FALSE, order = 1:9, aesthetics = "color", ...) { + discrete_scale( + aesthetics = aesthetics, + palette = palette_okabeito(palette = palette, reverse = reverse, order = order), + ... + ) +} + +# Fill -------------------------------------------------------------------- + +#' @rdname scale_color_okabeito +#' @export +scale_fill_okabeito <- function(palette = "full", reverse = FALSE, order = 1:9, aesthetics = "fill", ...) { + discrete_scale( + aesthetics = aesthetics, + palette = palette_okabeito(palette = palette, reverse = reverse, order = order), + ... + ) +} + +# Aliases ----------------------------------------------------------------- + +#' @rdname scale_color_okabeito +#' @export +scale_colour_okabeito <- scale_color_okabeito + +#' @rdname scale_color_okabeito +#' @export +scale_colour_oi <- scale_color_okabeito + +#' @rdname scale_color_okabeito +#' @export +scale_color_oi <- scale_color_okabeito + +#' @rdname scale_color_okabeito +#' @export +scale_fill_oi <- scale_fill_okabeito + + + +# Palette -------------------------------------------------------------------- + +# The palette from: https://jfly.uni-koeln.de/color/#pallet +okabeito_colors_list <- c( + `orange` = "#E69F00", + `light blue` = "#56B4E9", + `green` = "#009E73", + `yellow` = "#F0E442", + `blue` = "#0072B2", + `red` = "#D55E00", + `purple` = "#CC79A7", + `grey` = "#999999", + `black` = "#000000", + `sky blue` = "#56B4E9", + `bluish green` = "#009E73", + `vermillion` = "#D55E00", + `reddish purple` = "#CC79A7", + `dark yellow` = "#F5C710", + `amber` = "#F5C710" +) + + +#' Extract Okabe-Ito colors as hex codes +#' +#' Can be used to get the hex code of specific colors from the Okabe-Ito palette. +#' Use `okabeito_colors()` to see all available colors. +#' +#' @inheritParams flat_colors +#' @param original_names Logical. Should the colors be named using the original +#' names used by Okabe and Ito (2008), such as "vermillion" (`TRUE`), or +#' simplified names, such as "red" (`FALSE`, default)? +#' Only used if no colors are specified (to see all available colors). +#' @param black_first Logical. Should black be first (`TRUE`) or last (`FALSE`, default) +#' in the color palette? Only used if no colors are specified (to see all +#' available colors). +#' @param amber If amber color should replace yellow in the palette. +#' +#' @return A character vector with color-codes. +#' +#' @examples +#' okabeito_colors() +#' +#' okabeito_colors(c("red", "light blue", "orange")) +#' +#' okabeito_colors(original_names = TRUE) +#' +#' okabeito_colors(black_first = TRUE) +#' @export +okabeito_colors <- function(..., original_names = FALSE, black_first = FALSE, amber = TRUE) { + cols <- c(...) + + if (!is.null(cols)) { + return(okabeito_colors_list[cols]) + } + + yellow_col <- if (isTRUE(amber)) "amber" else "yellow" + + if (isTRUE(original_names)) { + cols <- c("orange", "sky blue", "bluish green", yellow_col, "blue", "vermillion", "reddish purple", "grey", "black") + } else { + cols <- c("orange", "light blue", "green", yellow_col, "blue", "red", "purple", "grey", "black") + } + + if (isTRUE(black_first)) cols <- union("black", cols) + + okabeito_colors_list[cols] +} + +#' @rdname okabeito_colors +#' @export +oi_colors <- okabeito_colors + +okabeito_palettes <- list( + `full` = okabeito_colors(black_first = FALSE, amber = TRUE), + `black_first` = okabeito_colors(black_first = TRUE, amber = TRUE), + `full_original` = okabeito_colors(black_first = FALSE, amber = FALSE), + `black_original` = okabeito_colors(black_first = TRUE, amber = FALSE) +) + + +#' Paul Tol's color palettes +#' +#' The palettes based proposed by Okabe and Ito (2008). +#' +#' @inheritParams palette_flat +#' @param order A vector of numbers from 1 to 9 indicating the order of colors to use +#' (default: `1:9`) +#' +#' @references +#' Tol, P. (2021). Colour schemes (SRON/EPS Technical Note No. 09-002; Version 3.2). +#' SRON. https://personal.sron.nl/~pault/data/colourschemes.pdf (Original work published 2009) +#' +#' @details This function is usually not called directly, but from within +#' [`scale_color_tol()`][scale_color_tol]. +#' +#' @export +palette_tol <- function(palette = "full_amber", reverse = FALSE, order = 1:9, ...) { + if (!palette %in% names(tol_palettes)) { + msg <- c(paste0( + "Palette name not available. `palette` must be one of ", + datawizard::text_concatenate(names(okabeito_palettes), last = " or ", enclose = "`"), + "." + ), "Using default palette now.") + insight::format_warning(msg) + palette <- "full" + } + + pal <- okabeito_palettes[[palette]] + + stopifnot( + "`order` must be a vector of integers." = is.numeric(order), + "All elements of `order` must be greater than 0 and less than 10." = all(order > 0 & order <= 9) + ) + pal <- pal[order] + + if (reverse) pal <- rev(pal) + + function(n) { + if (n > length(pal)) { + insight::format_warning( + "The number of colors requested `n` is too large.", + paste0("The maximum number of colors is ", length(pal), "."), + paste0("Returning a palette with ", length(pal), " colors.") + ) + n <- length(pal) + } + unname(pal[seq_len(n)]) + } +} + +#' @rdname palette_okabeito +#' @export +palette_oi <- palette_okabeito From d7c7bb1fe5318b2b7c26b07849b8c634a7d7494b Mon Sep 17 00:00:00 2001 From: "Brenton M. Wiernik" Date: Tue, 15 Oct 2024 16:25:26 -0400 Subject: [PATCH 02/10] Add values for qual palettes --- R/scale_color_tol.R | 122 +++++++++++++++++++++----------------------- 1 file changed, 59 insertions(+), 63 deletions(-) diff --git a/R/scale_color_tol.R b/R/scale_color_tol.R index fd700e98b..91ce10430 100644 --- a/R/scale_color_tol.R +++ b/R/scale_color_tol.R @@ -62,95 +62,91 @@ #' theme_modern() + #' scale_fill_oi(order = c(1, 5, 6, 2, 4, 3, 7)) #' @export -scale_color_okabeito <- function(palette = "full", reverse = FALSE, order = 1:9, aesthetics = "color", ...) { +scale_color_tol_discrete <- function(palette = "bright", reverse = FALSE, order = NULL, aesthetics = "color", ...) { discrete_scale( aesthetics = aesthetics, - palette = palette_okabeito(palette = palette, reverse = reverse, order = order), + palette = palette_tol_discrete(palette = palette, reverse = reverse, order = order), ... ) } # Fill -------------------------------------------------------------------- -#' @rdname scale_color_okabeito +#' @rdname scale_color_tol #' @export -scale_fill_okabeito <- function(palette = "full", reverse = FALSE, order = 1:9, aesthetics = "fill", ...) { +scale_fill_tol_discrete <- function(palette = "bright", reverse = FALSE, order = NULL, aesthetics = "fill", ...) { discrete_scale( aesthetics = aesthetics, - palette = palette_okabeito(palette = palette, reverse = reverse, order = order), + palette = palette_tol_discrete(palette = palette, reverse = reverse, order = order), ... ) } # Aliases ----------------------------------------------------------------- -#' @rdname scale_color_okabeito +#' @rdname scale_color_tol #' @export -scale_colour_okabeito <- scale_color_okabeito - -#' @rdname scale_color_okabeito -#' @export -scale_colour_oi <- scale_color_okabeito - -#' @rdname scale_color_okabeito -#' @export -scale_color_oi <- scale_color_okabeito - -#' @rdname scale_color_okabeito -#' @export -scale_fill_oi <- scale_fill_okabeito - +scale_colour_tol_discrete <- scale_color_tol_discrete # Palette -------------------------------------------------------------------- -# The palette from: https://jfly.uni-koeln.de/color/#pallet -okabeito_colors_list <- c( - `orange` = "#E69F00", - `light blue` = "#56B4E9", - `green` = "#009E73", - `yellow` = "#F0E442", - `blue` = "#0072B2", - `red` = "#D55E00", - `purple` = "#CC79A7", - `grey` = "#999999", - `black` = "#000000", - `sky blue` = "#56B4E9", - `bluish green` = "#009E73", - `vermillion` = "#D55E00", - `reddish purple` = "#CC79A7", - `dark yellow` = "#F5C710", - `amber` = "#F5C710" +tol_colors_discrete_list <- list( + bright = c(blue = "#4477AA", red = "#EE6677", green = "#228833", yellow = "#CCBB44", cyan = "#66CCEE", purple = "#AA3377", grey = "#BBBBBB"), + `high-contrast` = c(blue = "#004488", yellow = "#DDAA33", red = "#BB5566", black = "#000000", white = "#FFFFFF"), + vibrant = c(orange = "#EE7733", blue = "#0077BB", cyan = "#33BBEE", magenta = "#EE3377", red = "#CC3311", teal = "#009988", grey = "#BBBBBB"), + muted = c(rose = "#CC6677", indigo = "#332288", sand = "#DDCC77", green = "#117733", cyan = "#88CCEE", wine = "#882255", teal = "#44AA99", olive = "#999933", purple = "#AA4499", grey = "#DDDDDD"), + `medium-contrast` = c("light blue" = "#6699CC", "dark blue" = "#004488", "light yellow" = "#EECC66", "dark red" = "#994455", "dark yellow" = "#997700", "light red" = "#EE99AA", black = "#000000", white = "#FFFFFF"), + pale = c(blue = "#BBCCEE", cyan = "#CCEEFF", green = "#CCDDAA", yellow = "#EEEEBB", red = "#FFCCCC", grey = "#DDDDDD"), + dark = c(blue = "#222255", cyan = "#225555", green = "#225522", yellow = "#666633", red = "#663333", grey = "#555555"), + light = c(blue = "#77AADD", orange = "#EE8866", yellow = "#EEDD88", pink = "#FFAABB", cyan = "#99DDFF", mint = "#44BB99", pear = "#BBCC33", olive = "#AAAA00", grey = "#DDDDDD"), + # TODO: Finish rainbow color schemes + rainbow14 = c('3', '6', '9', '10', '12', '14', '15', '16', '17', '18', '20', '22', '24', '26' = "#DC050C", 'grey'), + rainbow23 = c('1', '2', '4', '5', '7', '8', '9', '10', '11', '13', '14', '15', '16', '17', '18', '19', '21', '23', '25', '26' = "#DC050C", '27' = "#A5170E", '28' = "#72190E", '29' = "#42150A", 'grey' = '#777777'), + ground_cover = c( + water = "#5566AA", "evergreen needleleaf forest" = "#117733", "deciduous needleleaf forest" = "#44AA66", + "mixed forest" = "#55AA22", "evergreen broadleaf forest" = "#668822", "deciduous broadleaf forest" = "#88BB55", + "woodland" = "#558877", "wooded grassland" = "#88BBAA", "grassland" = "#AADDCC", "cropland" = "#44AA88", + "closed shrubland" = "#DDCC66", "open shrubland" = "#FFDD44", "bare ground" = "#FFEE88", "urband and built up" = "#BB0011" + ) +) + +tol_colors_smooth_list <- list( + # Diverging + sunset = c("#"), + BuRd = c(), + PRGn = c(), + # Sequential + YlOrBr = c(), + iridescent = c(), + rainbow = c() ) -#' Extract Okabe-Ito colors as hex codes +#' Extract Paul Tol colors as hex codes #' -#' Can be used to get the hex code of specific colors from the Okabe-Ito palette. -#' Use `okabeito_colors()` to see all available colors. +#' Can be used to get the hex code of specific colors from the Paul Tol palettes. +#' Use `tol_colors()` and specify `palette` to see all available colors. +#' Note that for sequential palettes, only original (non-interpolated) colors are shown. #' -#' @inheritParams flat_colors -#' @param original_names Logical. Should the colors be named using the original -#' names used by Okabe and Ito (2008), such as "vermillion" (`TRUE`), or -#' simplified names, such as "red" (`FALSE`, default)? -#' Only used if no colors are specified (to see all available colors). -#' @param black_first Logical. Should black be first (`TRUE`) or last (`FALSE`, default) -#' in the color palette? Only used if no colors are specified (to see all -#' available colors). -#' @param amber If amber color should replace yellow in the palette. +#' @param ... Character names of colors. +#' @param palette Character name of palette. Can be: +#' - Qualitative: `"bright"`, `"high-contrast"`, `"vibrant"`, `"muted"`,` "medium-contrast"`, `"pale"`, `"dark"`, `"light"`, `"ground_cover"` +#' - Diverging: `"sunset"`, `"BuRd"`, `"PRGn"` +#' - Sequential: `"YlOrBr"`, `"iridescent"`, `"rainbow_discrete"`, `"rainbow_smooth"` #' #' @return A character vector with color-codes. #' #' @examples -#' okabeito_colors() +#' tol_colors() #' -#' okabeito_colors(c("red", "light blue", "orange")) +#' tol_colors(c("red", "light blue", "yellow")) #' -#' okabeito_colors(original_names = TRUE) +#' tol_colors(palette = "muted") #' -#' okabeito_colors(black_first = TRUE) +#' tol_colors(c("red", "light blue", "yellow"), palette = "muted") #' @export -okabeito_colors <- function(..., original_names = FALSE, black_first = FALSE, amber = TRUE) { +tol_colors <- function(..., palette = "bright") { cols <- c(...) if (!is.null(cols)) { @@ -184,11 +180,15 @@ okabeito_palettes <- list( #' Paul Tol's color palettes #' -#' The palettes based proposed by Okabe and Ito (2008). +#' The palettes proposed by Tol (2021). #' -#' @inheritParams palette_flat -#' @param order A vector of numbers from 1 to 9 indicating the order of colors to use -#' (default: `1:9`) +#' @param palette Character name of palette. Can be: +#' - Qualitative: `"bright"`, `"high-contrast"`, `"vibrant"`, `"muted"`,` "medium-contrast"`, `"pale"`, `"dark"`, `"light"`, `"ground_cover"` +#' - Diverging: `"sunset"`, `"BuRd"`, `"PRGn"` +#' - Sequential: `"YlOrBr"`, `"iridescent"`, `"rainbow_discrete"`, `"rainbow_smooth"` +#' @param reverse Boolean indicating whether the palette should be reversed. +#' @param order A vector of numbers indicating the order of colors to use (default: `NULL` indicating to use all available colors in order). +#' @parem ... For sequential palettes other than `rainbow_discrete`, additional arguments to pass to [`colorRampPalette()`][colorRampPalette]. #' #' @references #' Tol, P. (2021). Colour schemes (SRON/EPS Technical Note No. 09-002; Version 3.2). @@ -198,7 +198,7 @@ okabeito_palettes <- list( #' [`scale_color_tol()`][scale_color_tol]. #' #' @export -palette_tol <- function(palette = "full_amber", reverse = FALSE, order = 1:9, ...) { +palette_tol_discrete <- function(palette = "bright", reverse = FALSE, order = NULL, ...) { if (!palette %in% names(tol_palettes)) { msg <- c(paste0( "Palette name not available. `palette` must be one of ", @@ -231,7 +231,3 @@ palette_tol <- function(palette = "full_amber", reverse = FALSE, order = 1:9, .. unname(pal[seq_len(n)]) } } - -#' @rdname palette_okabeito -#' @export -palette_oi <- palette_okabeito From 77c0a0317545fd522813a695bd460c60f5e2499d Mon Sep 17 00:00:00 2001 From: "Brenton M. Wiernik" Date: Tue, 15 Oct 2024 16:41:10 -0400 Subject: [PATCH 03/10] Update scale_color_tol.R --- R/scale_color_tol.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/scale_color_tol.R b/R/scale_color_tol.R index 91ce10430..278ae3471 100644 --- a/R/scale_color_tol.R +++ b/R/scale_color_tol.R @@ -1,4 +1,4 @@ -#' Paul Tol color palettes +#' Paul Tol discrete/qualitative color palettes #' #' Tol (2021) presents a series of palettes built with mathematical principles that #' are appropriate for diverse types of data. The colors in these schemes are: @@ -12,6 +12,7 @@ #' 2. Diverging data – data ordered between two extremes where the midpoint is important. #' 3. Sequential data – data ordered from low to high. #' +#' This function provides the qualitative palettes, as well as discrete rainbow sequential palettes. #' Available palettes for each type of data are: #' - Qualitative: bright, high-contrast, vibrant, muted, medium-contrast, pale, dark, light, ground_cover #' - Diverging: sunset, BuRd, PRGn From 6227a46c92b610d282057bc1bf91f1480bbbbf99 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 25 Oct 2024 11:02:33 +0200 Subject: [PATCH 04/10] lintr --- DESCRIPTION | 4 +- NAMESPACE | 5 ++ R/scale_color_okabeito.R | 31 ++++++----- R/scale_color_tol.R | 39 +++++-------- man/palette_okabeito.Rd | 4 +- man/palette_tol_discrete.Rd | 33 +++++++++++ man/scale_color_okabeito.Rd | 1 + man/scale_color_tol_discrete.Rd | 98 +++++++++++++++++++++++++++++++++ man/see-package.Rd | 12 ++-- man/tol_colors.Rd | 36 ++++++++++++ 10 files changed, 213 insertions(+), 50 deletions(-) create mode 100644 man/palette_tol_discrete.Rd create mode 100644 man/scale_color_tol_discrete.Rd create mode 100644 man/tol_colors.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 3651c6bf6..80421fe40 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,8 +41,7 @@ Authors@R: person(given = "Matthew", family = "Smith", role = "rev", - email = "M.Smith3@napier.ac.uk", - comment = c(Twitter = "@SmithMatt90")), + email = "M.Smith3@napier.ac.uk"), person(given = "Jakob", family = "Bossek", role = "rev", @@ -121,4 +120,3 @@ Config/testthat/edition: 3 Config/testthat/parallel: true Config/Needs/website: easystats/easystatstemplate Config/rcmdcheck/ignore-inconsequential-notes: true -Remotes: easystats/performance, easystats/parameters diff --git a/NAMESPACE b/NAMESPACE index 7f5dce91b..793ca3c70 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -110,6 +110,7 @@ export(palette_okabeito) export(palette_pizza) export(palette_see) export(palette_social) +export(palette_tol_discrete) export(pizza_colors) export(plots) export(scale_color_bluebrown) @@ -138,6 +139,7 @@ export(scale_color_see_d) export(scale_color_social) export(scale_color_social_c) export(scale_color_social_d) +export(scale_color_tol_discrete) export(scale_colour_bluebrown) export(scale_colour_bluebrown_c) export(scale_colour_bluebrown_d) @@ -164,6 +166,7 @@ export(scale_colour_see_d) export(scale_colour_social) export(scale_colour_social_c) export(scale_colour_social_d) +export(scale_colour_tol_discrete) export(scale_fill_bluebrown) export(scale_fill_bluebrown_c) export(scale_fill_bluebrown_d) @@ -190,6 +193,7 @@ export(scale_fill_see_d) export(scale_fill_social) export(scale_fill_social_c) export(scale_fill_social_d) +export(scale_fill_tol_discrete) export(see_colors) export(social_colors) export(theme_abyss) @@ -198,4 +202,5 @@ export(theme_lucid) export(theme_modern) export(theme_radar) export(theme_radar_dark) +export(tol_colors) import(ggplot2) diff --git a/R/scale_color_okabeito.R b/R/scale_color_okabeito.R index 9cc297e25..51c6b57cc 100644 --- a/R/scale_color_okabeito.R +++ b/R/scale_color_okabeito.R @@ -101,22 +101,23 @@ scale_fill_oi <- scale_fill_okabeito # Palette -------------------------------------------------------------------- # The palette from: https://jfly.uni-koeln.de/color/#pallet +# or grDevices::palette.colors() okabeito_colors_list <- c( - `orange` = "#E69F00", + orange = "#E69F00", `light blue` = "#56B4E9", - `green` = "#009E73", - `yellow` = "#F0E442", - `blue` = "#0072B2", - `red` = "#D55E00", - `purple` = "#CC79A7", - `grey` = "#999999", - `black` = "#000000", + green = "#009E73", + yellow = "#F0E442", + blue = "#0072B2", + red = "#D55E00", + purple = "#CC79A7", + grey = "#999999", + black = "#000000", `sky blue` = "#56B4E9", `bluish green` = "#009E73", - `vermillion` = "#D55E00", + vermillion = "#D55E00", `reddish purple` = "#CC79A7", `dark yellow` = "#F5C710", - `amber` = "#F5C710" + amber = "#F5C710" ) @@ -171,10 +172,10 @@ okabeito_colors <- function(..., original_names = FALSE, black_first = FALSE, am oi_colors <- okabeito_colors okabeito_palettes <- list( - `full` = okabeito_colors(black_first = FALSE, amber = TRUE), - `black_first` = okabeito_colors(black_first = TRUE, amber = TRUE), - `full_original` = okabeito_colors(black_first = FALSE, amber = FALSE), - `black_original` = okabeito_colors(black_first = TRUE, amber = FALSE) + full = okabeito_colors(black_first = FALSE, amber = TRUE), + black_first = okabeito_colors(black_first = TRUE, amber = TRUE), + full_original = okabeito_colors(black_first = FALSE, amber = FALSE), + black_original = okabeito_colors(black_first = TRUE, amber = FALSE) ) @@ -210,7 +211,7 @@ palette_okabeito <- function(palette = "full_amber", reverse = FALSE, order = 1: stopifnot( "`order` must be a vector of integers." = is.numeric(order), - "All elements of `order` must be greater than 0 and less than 10." = all(order > 0 & order <= 9) + "All elements of `order` must be greater than 0 and less than 10." = order > 0 & order <= 9 ) pal <- pal[order] diff --git a/R/scale_color_tol.R b/R/scale_color_tol.R index 278ae3471..c3fec30b3 100644 --- a/R/scale_color_tol.R +++ b/R/scale_color_tol.R @@ -102,25 +102,25 @@ tol_colors_discrete_list <- list( dark = c(blue = "#222255", cyan = "#225555", green = "#225522", yellow = "#666633", red = "#663333", grey = "#555555"), light = c(blue = "#77AADD", orange = "#EE8866", yellow = "#EEDD88", pink = "#FFAABB", cyan = "#99DDFF", mint = "#44BB99", pear = "#BBCC33", olive = "#AAAA00", grey = "#DDDDDD"), # TODO: Finish rainbow color schemes - rainbow14 = c('3', '6', '9', '10', '12', '14', '15', '16', '17', '18', '20', '22', '24', '26' = "#DC050C", 'grey'), - rainbow23 = c('1', '2', '4', '5', '7', '8', '9', '10', '11', '13', '14', '15', '16', '17', '18', '19', '21', '23', '25', '26' = "#DC050C", '27' = "#A5170E", '28' = "#72190E", '29' = "#42150A", 'grey' = '#777777'), + rainbow14 = c("3", "6", "9", "10", "12", "14", "15", "16", "17", "18", "20", "22", "24", "26" = "#DC050C", "grey"), + rainbow23 = c("1", "2", "4", "5", "7", "8", "9", "10", "11", "13", "14", "15", "16", "17", "18", "19", "21", "23", "25", "26" = "#DC050C", "27" = "#A5170E", "28" = "#72190E", "29" = "#42150A", grey = "#777777"), ground_cover = c( water = "#5566AA", "evergreen needleleaf forest" = "#117733", "deciduous needleleaf forest" = "#44AA66", "mixed forest" = "#55AA22", "evergreen broadleaf forest" = "#668822", "deciduous broadleaf forest" = "#88BB55", - "woodland" = "#558877", "wooded grassland" = "#88BBAA", "grassland" = "#AADDCC", "cropland" = "#44AA88", + woodland = "#558877", "wooded grassland" = "#88BBAA", grassland = "#AADDCC", cropland = "#44AA88", "closed shrubland" = "#DDCC66", "open shrubland" = "#FFDD44", "bare ground" = "#FFEE88", "urband and built up" = "#BB0011" ) ) tol_colors_smooth_list <- list( # Diverging - sunset = c("#"), - BuRd = c(), - PRGn = c(), + sunset = "#", + BuRd = NULL, + PRGn = NULL, # Sequential - YlOrBr = c(), - iridescent = c(), - rainbow = c() + YlOrBr = NULL, + iridescent = NULL, + rainbow = NULL ) @@ -132,9 +132,11 @@ tol_colors_smooth_list <- list( #' #' @param ... Character names of colors. #' @param palette Character name of palette. Can be: -#' - Qualitative: `"bright"`, `"high-contrast"`, `"vibrant"`, `"muted"`,` "medium-contrast"`, `"pale"`, `"dark"`, `"light"`, `"ground_cover"` +#' - Qualitative: `"bright"`, `"high-contrast"`, `"vibrant"`, `"muted"`,` +#' "medium-contrast"`, `"pale"`, `"dark"`, `"light"`, `"ground_cover"` #' - Diverging: `"sunset"`, `"BuRd"`, `"PRGn"` -#' - Sequential: `"YlOrBr"`, `"iridescent"`, `"rainbow_discrete"`, `"rainbow_smooth"` +#' - Sequential: `"YlOrBr"`, `"iridescent"`, `"rainbow_discrete"`, +#' `"rainbow_smooth"` #' #' @return A character vector with color-codes. #' @@ -167,17 +169,6 @@ tol_colors <- function(..., palette = "bright") { okabeito_colors_list[cols] } -#' @rdname okabeito_colors -#' @export -oi_colors <- okabeito_colors - -okabeito_palettes <- list( - `full` = okabeito_colors(black_first = FALSE, amber = TRUE), - `black_first` = okabeito_colors(black_first = TRUE, amber = TRUE), - `full_original` = okabeito_colors(black_first = FALSE, amber = FALSE), - `black_original` = okabeito_colors(black_first = TRUE, amber = FALSE) -) - #' Paul Tol's color palettes #' @@ -189,7 +180,7 @@ okabeito_palettes <- list( #' - Sequential: `"YlOrBr"`, `"iridescent"`, `"rainbow_discrete"`, `"rainbow_smooth"` #' @param reverse Boolean indicating whether the palette should be reversed. #' @param order A vector of numbers indicating the order of colors to use (default: `NULL` indicating to use all available colors in order). -#' @parem ... For sequential palettes other than `rainbow_discrete`, additional arguments to pass to [`colorRampPalette()`][colorRampPalette]. +#' @param ... For sequential palettes other than `rainbow_discrete`, additional arguments to pass to [`colorRampPalette()`][colorRampPalette]. #' #' @references #' Tol, P. (2021). Colour schemes (SRON/EPS Technical Note No. 09-002; Version 3.2). @@ -214,7 +205,7 @@ palette_tol_discrete <- function(palette = "bright", reverse = FALSE, order = NU stopifnot( "`order` must be a vector of integers." = is.numeric(order), - "All elements of `order` must be greater than 0 and less than 10." = all(order > 0 & order <= 9) + "All elements of `order` must be greater than 0 and less than 10." = order > 0 & order <= 9 ) pal <- pal[order] diff --git a/man/palette_okabeito.Rd b/man/palette_okabeito.Rd index 776dd388c..642b0e6f7 100644 --- a/man/palette_okabeito.Rd +++ b/man/palette_okabeito.Rd @@ -23,11 +23,11 @@ or \code{black_first_original}.} \item{...}{Additional arguments to pass to \code{\link[=colorRampPalette]{colorRampPalette()}}.} } \description{ -The palette based proposed by Okabe and Ito (2008). +The palette based on Okabe and Ito (2008). } \details{ This function is usually not called directly, but from within -\code{\link[=scale_color_material]{scale_color_material()}}. +\code{\link[=scale_color_okabeito]{scale_color_okabeito()}}. } \references{ Okabe, M., & Ito, K. (2008). Color universal design (CUD): diff --git a/man/palette_tol_discrete.Rd b/man/palette_tol_discrete.Rd new file mode 100644 index 000000000..9c6578b54 --- /dev/null +++ b/man/palette_tol_discrete.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale_color_tol.R +\name{palette_tol_discrete} +\alias{palette_tol_discrete} +\title{Paul Tol's color palettes} +\usage{ +palette_tol_discrete(palette = "bright", reverse = FALSE, order = NULL, ...) +} +\arguments{ +\item{palette}{Character name of palette. Can be: +\itemize{ +\item Qualitative: \code{"bright"}, \code{"high-contrast"}, \code{"vibrant"}, \code{"muted"},\code{ "medium-contrast"}, \code{"pale"}, \code{"dark"}, \code{"light"}, \code{"ground_cover"} +\item Diverging: \code{"sunset"}, \code{"BuRd"}, \code{"PRGn"} +\item Sequential: \code{"YlOrBr"}, \code{"iridescent"}, \code{"rainbow_discrete"}, \code{"rainbow_smooth"} +}} + +\item{reverse}{Boolean indicating whether the palette should be reversed.} + +\item{order}{A vector of numbers indicating the order of colors to use (default: \code{NULL} indicating to use all available colors in order).} + +\item{...}{For sequential palettes other than \code{rainbow_discrete}, additional arguments to pass to \code{\link[=colorRampPalette]{colorRampPalette()}}.} +} +\description{ +The palettes proposed by Tol (2021). +} +\details{ +This function is usually not called directly, but from within +\code{\link[=scale_color_tol]{scale_color_tol()}}. +} +\references{ +Tol, P. (2021). Colour schemes (SRON/EPS Technical Note No. 09-002; Version 3.2). +SRON. https://personal.sron.nl/~pault/data/colourschemes.pdf (Original work published 2009) +} diff --git a/man/scale_color_okabeito.Rd b/man/scale_color_okabeito.Rd index a5bcb4e7f..f8f3bb460 100644 --- a/man/scale_color_okabeito.Rd +++ b/man/scale_color_okabeito.Rd @@ -96,6 +96,7 @@ palettes \code{"full_original"} or \code{"black_first_original"}. The Okabe-Ito palette is only available as a discrete palette. For color-accessible continuous variables, consider +\link[=scale_color_tol]{Paul Tol's palettes} or \link[ggplot2:scale_viridis]{the viridis palettes}. } \examples{ diff --git a/man/scale_color_tol_discrete.Rd b/man/scale_color_tol_discrete.Rd new file mode 100644 index 000000000..f14f485f2 --- /dev/null +++ b/man/scale_color_tol_discrete.Rd @@ -0,0 +1,98 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale_color_tol.R +\name{scale_color_tol_discrete} +\alias{scale_color_tol_discrete} +\title{Paul Tol discrete/qualitative color palettes} +\usage{ +scale_color_tol_discrete( + palette = "bright", + reverse = FALSE, + order = NULL, + aesthetics = "color", + ... +) +} +\arguments{ +\item{palette}{Character name of palette. Depending on the color scale, can +be \code{"full"}, \code{"ice"}, \code{"rainbow"}, \code{"complement"}, +\code{"contrast"}, \code{"light"} (for dark themes), \code{"black_first"}, \code{full_original}, +or \code{black_first_original}.} + +\item{reverse}{Boolean indicating whether the palette should be reversed.} + +\item{aesthetics}{A vector of names of the aesthetics that this scale +should be applied to (e.g., \code{c('color', 'fill')}).} + +\item{...}{Additional arguments passed to \code{discrete_scale()} when \code{discrete} +is \code{TRUE} or to \code{scale_color_gradientn()} when \code{discrete} is \code{FALSE}.} +} +\description{ +Tol (2021) presents a series of palettes built with mathematical principles that +are appropriate for diverse types of data. The colors in these schemes are: +\itemize{ +\item Visually distinct for all people, including viewers with color vision deficiencies +\item Distinct from black and white +\item Distinct on screen and paper, +\item Cohesive; that is, they match well together +} +} +\details{ +Tol provides palettes appropriate to the 3 main types of data: +\enumerate{ +\item Qualitative data – nominal or categorical data, where magnitude differences are not relevant. +\item Diverging data – data ordered between two extremes where the midpoint is important. +\item Sequential data – data ordered from low to high. +} + +This function provides the qualitative palettes, as well as discrete rainbow sequential palettes. +Available palettes for each type of data are: +\itemize{ +\item Qualitative: bright, high-contrast, vibrant, muted, medium-contrast, pale, dark, light, ground_cover +\item Diverging: sunset, BuRd, PRGn +\item Sequential: YlOrBr, iridescent, rainbow_discrete, rainbow_smooth +}\if{html}{\out{ + +}} +\if{html}{\out{ + +}} + +\subsection{Colors for missing or invalid data}{ + +A useful feature of Tol's diverging and sequential palettes is that he +provides a recommended color to use for data that fall outside the data +range represented by the color scale (e.g., for invalid or missing data). +These colors are chosen to be highly distinct from the main color palette. +} +} +\examples{ +library(ggplot2) +library(see) + +ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) + + geom_boxplot() + + theme_modern() + + scale_fill_okabeito() + +ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) + + geom_violin() + + theme_modern() + + scale_fill_oi(palette = "black_first") + +# for the original brighter yellow color suggested by Okabe and Ito +ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) + + geom_violin() + + theme_modern() + + scale_fill_oi(palette = "full") + +ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) + + geom_violin() + + theme_modern() + + scale_fill_oi(order = c(1, 5, 6, 2, 4, 3, 7)) +} +\references{ +Tol, P. (2021). Colour schemes (SRON/EPS Technical Note No. 09-002; Version 3.2). +SRON. https://personal.sron.nl/~pault/data/colourschemes.pdf (Original work published 2009) +} diff --git a/man/see-package.Rd b/man/see-package.Rd index 33bc37094..4e2cea88a 100644 --- a/man/see-package.Rd +++ b/man/see-package.Rd @@ -25,13 +25,13 @@ Useful links: } \author{ -\strong{Maintainer}: Indrajeet Patil \email{patilindrajeet.science@gmail.com} (\href{https://orcid.org/0000-0003-1995-6531}{ORCID}) (@patilindrajeets) +\strong{Maintainer}: Indrajeet Patil \email{patilindrajeet.science@gmail.com} (\href{https://orcid.org/0000-0003-1995-6531}{ORCID}) Authors: \itemize{ - \item Daniel Lüdecke \email{d.luedecke@uke.de} (\href{https://orcid.org/0000-0002-8895-3206}{ORCID}) (@strengejacke) [contributor] - \item Dominique Makowski \email{dom.makowski@gmail.com} (\href{https://orcid.org/0000-0001-5375-9967}{ORCID}) (@Dom_Makowski) [inventor] - \item Mattan S. Ben-Shachar \email{matanshm@post.bgu.ac.il} (\href{https://orcid.org/0000-0002-4287-4801}{ORCID}) (@mattansb) [contributor] + \item Daniel Lüdecke \email{d.luedecke@uke.de} (\href{https://orcid.org/0000-0002-8895-3206}{ORCID}) [contributor] + \item Dominique Makowski \email{dom.makowski@gmail.com} (\href{https://orcid.org/0000-0001-5375-9967}{ORCID}) [inventor] + \item Mattan S. Ben-Shachar \email{matanshm@post.bgu.ac.il} (\href{https://orcid.org/0000-0002-4287-4801}{ORCID}) [contributor] \item Brenton M. Wiernik \email{brenton@wiernik.org} (\href{https://orcid.org/0000-0001-9560-6336}{ORCID}) [contributor] \item Philip Waggoner \email{philip.waggoner@gmail.com} (\href{https://orcid.org/0000-0002-7825-7573}{ORCID}) [contributor] } @@ -39,8 +39,8 @@ Authors: Other contributors: \itemize{ \item Jeffrey R. Stevens \email{jeffrey.r.stevens@gmail.com} (\href{https://orcid.org/0000-0003-2375-1360}{ORCID}) [contributor] - \item Matthew Smith \email{M.Smith3@napier.ac.uk} (@SmithMatt90) [reviewer] - \item Jakob Bossek \email{bossek@wi.uni-muenster.de} (@BossekJakob) [reviewer] + \item Matthew Smith \email{M.Smith3@napier.ac.uk} [reviewer] + \item Jakob Bossek \email{bossek@wi.uni-muenster.de} [reviewer] } } diff --git a/man/tol_colors.Rd b/man/tol_colors.Rd new file mode 100644 index 000000000..a8859a00a --- /dev/null +++ b/man/tol_colors.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scale_color_tol.R +\name{tol_colors} +\alias{tol_colors} +\title{Extract Paul Tol colors as hex codes} +\usage{ +tol_colors(..., palette = "bright") +} +\arguments{ +\item{...}{Character names of colors.} + +\item{palette}{Character name of palette. Can be: +\itemize{ +\item Qualitative: \code{"bright"}, \code{"high-contrast"}, \code{"vibrant"}, \code{"muted"},\code{ "medium-contrast"}, \code{"pale"}, \code{"dark"}, \code{"light"}, \code{"ground_cover"} +\item Diverging: \code{"sunset"}, \code{"BuRd"}, \code{"PRGn"} +\item Sequential: \code{"YlOrBr"}, \code{"iridescent"}, \code{"rainbow_discrete"}, +\code{"rainbow_smooth"} +}} +} +\value{ +A character vector with color-codes. +} +\description{ +Can be used to get the hex code of specific colors from the Paul Tol palettes. +Use \code{tol_colors()} and specify \code{palette} to see all available colors. +Note that for sequential palettes, only original (non-interpolated) colors are shown. +} +\examples{ +tol_colors() + +tol_colors(c("red", "light blue", "yellow")) + +tol_colors(palette = "muted") + +tol_colors(c("red", "light blue", "yellow"), palette = "muted") +} From 5718d288a68b32b3f9763e8161954e3afcfa52f5 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 25 Oct 2024 11:07:26 +0200 Subject: [PATCH 05/10] fixes --- R/scale_color_metro.R | 7 ++-- R/scale_color_okabeito.R | 2 +- R/scale_color_tol.R | 47 ++++++++++++++---------- man/palette_tol_discrete.Rd | 9 +++-- man/scale_color_metro.Rd | 4 +-- man/scale_color_okabeito.Rd | 2 +- man/scale_color_tol_discrete.Rd | 63 ++++++++++++++++++++++++--------- 7 files changed, 87 insertions(+), 47 deletions(-) diff --git a/R/scale_color_metro.R b/R/scale_color_metro.R index bc04ed6c4..7ac14ccc0 100644 --- a/R/scale_color_metro.R +++ b/R/scale_color_metro.R @@ -1,9 +1,8 @@ #' Metro color palette #' -#' The palette based on Metro [Metro -#' colors](https://materialui.co/metrocolors). -#' Use `scale_color_metro_d` for *discrete* categories and -#' `scale_color_metro_c` for a *continuous* scale. +#' The palette based on Metro [Metro colors](https://materialui.co/metrocolors). +#' Use `scale_color_metro_d` for *discrete* categories and `scale_color_metro_c` +#' for a *continuous* scale. #' #' @inheritParams palette_metro #' @inheritParams scale_color_flat diff --git a/R/scale_color_okabeito.R b/R/scale_color_okabeito.R index 51c6b57cc..b1d20330a 100644 --- a/R/scale_color_okabeito.R +++ b/R/scale_color_okabeito.R @@ -22,7 +22,7 @@ #' #' The Okabe-Ito palette is only available as a discrete palette. #' For color-accessible continuous variables, consider -#' [Paul Tol's palettes][scale_color_tol()] or +#' [Paul Tol's palettes][scale_color_tol_discrete()] or #' [the viridis palettes][ggplot2::scale_colour_viridis_d()]. #' #' @inheritParams palette_okabeito diff --git a/R/scale_color_tol.R b/R/scale_color_tol.R index c3fec30b3..f22c53961 100644 --- a/R/scale_color_tol.R +++ b/R/scale_color_tol.R @@ -1,20 +1,25 @@ #' Paul Tol discrete/qualitative color palettes #' -#' Tol (2021) presents a series of palettes built with mathematical principles that -#' are appropriate for diverse types of data. The colors in these schemes are: -#' - Visually distinct for all people, including viewers with color vision deficiencies +#' Tol (2021) presents a series of palettes built with mathematical principles +#' that are appropriate for diverse types of data. The colors in these schemes +#' are: +#' - Visually distinct for all people, including viewers with color vision +#' deficiencies #' - Distinct from black and white #' - Distinct on screen and paper, #' - Cohesive; that is, they match well together #' #' Tol provides palettes appropriate to the 3 main types of data: -#' 1. Qualitative data – nominal or categorical data, where magnitude differences are not relevant. -#' 2. Diverging data – data ordered between two extremes where the midpoint is important. +#' 1. Qualitative data – nominal or categorical data, where magnitude +#' differences are not relevant. +#' 2. Diverging data – data ordered between two extremes where the midpoint is +#' important. #' 3. Sequential data – data ordered from low to high. #' -#' This function provides the qualitative palettes, as well as discrete rainbow sequential palettes. -#' Available palettes for each type of data are: -#' - Qualitative: bright, high-contrast, vibrant, muted, medium-contrast, pale, dark, light, ground_cover +#' This function provides the qualitative palettes, as well as discrete rainbow +#' sequential palettes. Available palettes for each type of data are: +#' - Qualitative: bright, high-contrast, vibrant, muted, medium-contrast, pale, +#' dark, light, ground_cover #' - Diverging: sunset, BuRd, PRGn #' - Sequential: YlOrBr, iridescent, rainbow_discrete, rainbow_smooth #' @@ -27,11 +32,11 @@ #' ## Colors for missing or invalid data #' #' A useful feature of Tol's diverging and sequential palettes is that he -#' provides a recommended color to use for data that fall outside the data -#' range represented by the color scale (e.g., for invalid or missing data). -#' These colors are chosen to be highly distinct from the main color palette. +#' provides a recommended color to use for data that fall outside the data range +#' represented by the color scale (e.g., for invalid or missing data). These +#' colors are chosen to be highly distinct from the main color palette. #' -#' @inheritParams palette_tol +#' @inheritParams palette_tol_discrete #' @inheritParams scale_color_flat #' #' @references @@ -73,7 +78,7 @@ scale_color_tol_discrete <- function(palette = "bright", reverse = FALSE, order # Fill -------------------------------------------------------------------- -#' @rdname scale_color_tol +#' @rdname scale_color_tol_discrete #' @export scale_fill_tol_discrete <- function(palette = "bright", reverse = FALSE, order = NULL, aesthetics = "fill", ...) { discrete_scale( @@ -85,7 +90,7 @@ scale_fill_tol_discrete <- function(palette = "bright", reverse = FALSE, order = # Aliases ----------------------------------------------------------------- -#' @rdname scale_color_tol +#' @rdname scale_color_tol_discrete #' @export scale_colour_tol_discrete <- scale_color_tol_discrete @@ -175,19 +180,23 @@ tol_colors <- function(..., palette = "bright") { #' The palettes proposed by Tol (2021). #' #' @param palette Character name of palette. Can be: -#' - Qualitative: `"bright"`, `"high-contrast"`, `"vibrant"`, `"muted"`,` "medium-contrast"`, `"pale"`, `"dark"`, `"light"`, `"ground_cover"` +#' - Qualitative: `"bright"`, `"high-contrast"`, `"vibrant"`, `"muted"`,` +#' "medium-contrast"`, `"pale"`, `"dark"`, `"light"`, `"ground_cover"` #' - Diverging: `"sunset"`, `"BuRd"`, `"PRGn"` -#' - Sequential: `"YlOrBr"`, `"iridescent"`, `"rainbow_discrete"`, `"rainbow_smooth"` +#' - Sequential: `"YlOrBr"`, `"iridescent"`, `"rainbow_discrete"`, +#' - `"rainbow_smooth"` #' @param reverse Boolean indicating whether the palette should be reversed. -#' @param order A vector of numbers indicating the order of colors to use (default: `NULL` indicating to use all available colors in order). -#' @param ... For sequential palettes other than `rainbow_discrete`, additional arguments to pass to [`colorRampPalette()`][colorRampPalette]. +#' @param order A vector of numbers indicating the order of colors to use +#' (default: `NULL` indicating to use all available colors in order). +#' @param ... For sequential palettes other than `rainbow_discrete`, additional +#' arguments to pass to [`colorRampPalette()`][colorRampPalette]. #' #' @references #' Tol, P. (2021). Colour schemes (SRON/EPS Technical Note No. 09-002; Version 3.2). #' SRON. https://personal.sron.nl/~pault/data/colourschemes.pdf (Original work published 2009) #' #' @details This function is usually not called directly, but from within -#' [`scale_color_tol()`][scale_color_tol]. +#' [`scale_color_tol()`]. #' #' @export palette_tol_discrete <- function(palette = "bright", reverse = FALSE, order = NULL, ...) { diff --git a/man/palette_tol_discrete.Rd b/man/palette_tol_discrete.Rd index 9c6578b54..a3f186151 100644 --- a/man/palette_tol_discrete.Rd +++ b/man/palette_tol_discrete.Rd @@ -11,14 +11,17 @@ palette_tol_discrete(palette = "bright", reverse = FALSE, order = NULL, ...) \itemize{ \item Qualitative: \code{"bright"}, \code{"high-contrast"}, \code{"vibrant"}, \code{"muted"},\code{ "medium-contrast"}, \code{"pale"}, \code{"dark"}, \code{"light"}, \code{"ground_cover"} \item Diverging: \code{"sunset"}, \code{"BuRd"}, \code{"PRGn"} -\item Sequential: \code{"YlOrBr"}, \code{"iridescent"}, \code{"rainbow_discrete"}, \code{"rainbow_smooth"} +\item Sequential: \code{"YlOrBr"}, \code{"iridescent"}, \code{"rainbow_discrete"}, +\item \code{"rainbow_smooth"} }} \item{reverse}{Boolean indicating whether the palette should be reversed.} -\item{order}{A vector of numbers indicating the order of colors to use (default: \code{NULL} indicating to use all available colors in order).} +\item{order}{A vector of numbers indicating the order of colors to use +(default: \code{NULL} indicating to use all available colors in order).} -\item{...}{For sequential palettes other than \code{rainbow_discrete}, additional arguments to pass to \code{\link[=colorRampPalette]{colorRampPalette()}}.} +\item{...}{For sequential palettes other than \code{rainbow_discrete}, additional +arguments to pass to \code{\link[=colorRampPalette]{colorRampPalette()}}.} } \description{ The palettes proposed by Tol (2021). diff --git a/man/scale_color_metro.Rd b/man/scale_color_metro.Rd index 464e04152..f53a21eb9 100644 --- a/man/scale_color_metro.Rd +++ b/man/scale_color_metro.Rd @@ -101,8 +101,8 @@ should be applied to (e.g., \code{c('color', 'fill')}).} } \description{ The palette based on Metro \href{https://materialui.co/metrocolors}{Metro colors}. -Use \code{scale_color_metro_d} for \emph{discrete} categories and -\code{scale_color_metro_c} for a \emph{continuous} scale. +Use \code{scale_color_metro_d} for \emph{discrete} categories and \code{scale_color_metro_c} +for a \emph{continuous} scale. } \examples{ library(ggplot2) diff --git a/man/scale_color_okabeito.Rd b/man/scale_color_okabeito.Rd index f8f3bb460..e5ed09c2a 100644 --- a/man/scale_color_okabeito.Rd +++ b/man/scale_color_okabeito.Rd @@ -96,7 +96,7 @@ palettes \code{"full_original"} or \code{"black_first_original"}. The Okabe-Ito palette is only available as a discrete palette. For color-accessible continuous variables, consider -\link[=scale_color_tol]{Paul Tol's palettes} or +\link[=scale_color_tol_discrete]{Paul Tol's palettes} or \link[ggplot2:scale_viridis]{the viridis palettes}. } \examples{ diff --git a/man/scale_color_tol_discrete.Rd b/man/scale_color_tol_discrete.Rd index f14f485f2..0f0ee8d04 100644 --- a/man/scale_color_tol_discrete.Rd +++ b/man/scale_color_tol_discrete.Rd @@ -2,6 +2,8 @@ % Please edit documentation in R/scale_color_tol.R \name{scale_color_tol_discrete} \alias{scale_color_tol_discrete} +\alias{scale_fill_tol_discrete} +\alias{scale_colour_tol_discrete} \title{Paul Tol discrete/qualitative color palettes} \usage{ scale_color_tol_discrete( @@ -11,26 +13,50 @@ scale_color_tol_discrete( aesthetics = "color", ... ) + +scale_fill_tol_discrete( + palette = "bright", + reverse = FALSE, + order = NULL, + aesthetics = "fill", + ... +) + +scale_colour_tol_discrete( + palette = "bright", + reverse = FALSE, + order = NULL, + aesthetics = "color", + ... +) } \arguments{ -\item{palette}{Character name of palette. Depending on the color scale, can -be \code{"full"}, \code{"ice"}, \code{"rainbow"}, \code{"complement"}, -\code{"contrast"}, \code{"light"} (for dark themes), \code{"black_first"}, \code{full_original}, -or \code{black_first_original}.} +\item{palette}{Character name of palette. Can be: +\itemize{ +\item Qualitative: \code{"bright"}, \code{"high-contrast"}, \code{"vibrant"}, \code{"muted"},\code{ "medium-contrast"}, \code{"pale"}, \code{"dark"}, \code{"light"}, \code{"ground_cover"} +\item Diverging: \code{"sunset"}, \code{"BuRd"}, \code{"PRGn"} +\item Sequential: \code{"YlOrBr"}, \code{"iridescent"}, \code{"rainbow_discrete"}, +\item \code{"rainbow_smooth"} +}} \item{reverse}{Boolean indicating whether the palette should be reversed.} +\item{order}{A vector of numbers indicating the order of colors to use +(default: \code{NULL} indicating to use all available colors in order).} + \item{aesthetics}{A vector of names of the aesthetics that this scale should be applied to (e.g., \code{c('color', 'fill')}).} -\item{...}{Additional arguments passed to \code{discrete_scale()} when \code{discrete} -is \code{TRUE} or to \code{scale_color_gradientn()} when \code{discrete} is \code{FALSE}.} +\item{...}{For sequential palettes other than \code{rainbow_discrete}, additional +arguments to pass to \code{\link[=colorRampPalette]{colorRampPalette()}}.} } \description{ -Tol (2021) presents a series of palettes built with mathematical principles that -are appropriate for diverse types of data. The colors in these schemes are: +Tol (2021) presents a series of palettes built with mathematical principles +that are appropriate for diverse types of data. The colors in these schemes +are: \itemize{ -\item Visually distinct for all people, including viewers with color vision deficiencies +\item Visually distinct for all people, including viewers with color vision +deficiencies \item Distinct from black and white \item Distinct on screen and paper, \item Cohesive; that is, they match well together @@ -39,15 +65,18 @@ are appropriate for diverse types of data. The colors in these schemes are: \details{ Tol provides palettes appropriate to the 3 main types of data: \enumerate{ -\item Qualitative data – nominal or categorical data, where magnitude differences are not relevant. -\item Diverging data – data ordered between two extremes where the midpoint is important. +\item Qualitative data – nominal or categorical data, where magnitude +differences are not relevant. +\item Diverging data – data ordered between two extremes where the midpoint is +important. \item Sequential data – data ordered from low to high. } -This function provides the qualitative palettes, as well as discrete rainbow sequential palettes. -Available palettes for each type of data are: +This function provides the qualitative palettes, as well as discrete rainbow +sequential palettes. Available palettes for each type of data are: \itemize{ -\item Qualitative: bright, high-contrast, vibrant, muted, medium-contrast, pale, dark, light, ground_cover +\item Qualitative: bright, high-contrast, vibrant, muted, medium-contrast, pale, +dark, light, ground_cover \item Diverging: sunset, BuRd, PRGn \item Sequential: YlOrBr, iridescent, rainbow_discrete, rainbow_smooth }\if{html}{\out{ @@ -62,9 +91,9 @@ Available palettes for each type of data are: \subsection{Colors for missing or invalid data}{ A useful feature of Tol's diverging and sequential palettes is that he -provides a recommended color to use for data that fall outside the data -range represented by the color scale (e.g., for invalid or missing data). -These colors are chosen to be highly distinct from the main color palette. +provides a recommended color to use for data that fall outside the data range +represented by the color scale (e.g., for invalid or missing data). These +colors are chosen to be highly distinct from the main color palette. } } \examples{ From 3f7e64dfd84c3cf51aee7adf96c3aa30fe656d23 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 25 Oct 2024 11:12:06 +0200 Subject: [PATCH 06/10] fix --- R/scale_color_metro.R | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/R/scale_color_metro.R b/R/scale_color_metro.R index 7ac14ccc0..576918b73 100644 --- a/R/scale_color_metro.R +++ b/R/scale_color_metro.R @@ -157,18 +157,18 @@ scale_fill_metro_c <- function(palette = "complement", # The palette based on metro design colors: https://www.materialui.co/metrocolors metro_colors_list <- c( - `red` = "#e51400", + red = "#e51400", `dark red` = "#a20025", - `purple` = "#aa00ff", + purple = "#aa00ff", `deep purple` = "#76608a", - `blue` = "#0050ef", + blue = "#0050ef", `light blue` = "#1ba1e2", - `teal` = "#00aba9", - `green` = "#008a00", + teal = "#00aba9", + green = "#008a00", `light green` = "#60a917", - `yellow` = "#e3c800", - `amber` = "#f0a30a", - `orange` = "#fa6800", + yellow = "#e3c800", + amber = "#f0a30a", + orange = "#fa6800", `deep orange` = "#a0522d", `blue grey` = "#647687" ) @@ -202,9 +202,9 @@ metro_colors <- function(...) { metro_palettes <- list( - `full` = metro_colors(), - `ice` = metro_colors("purple", "deep purple", "blue", "light blue"), - `rainbow` = metro_colors( + full = metro_colors(), + ice = metro_colors("purple", "deep purple", "blue", "light blue"), + rainbow = metro_colors( "purple", "deep purple", "blue", @@ -216,9 +216,9 @@ metro_palettes <- list( "deep orange", "red" ), - `contrast` = metro_colors("blue", "green", "amber", "purple", "red"), - `light` = material_colors("light blue", "red", "yellow", "light green", "orange"), - `complement` = metro_colors( + contrast = metro_colors("blue", "green", "amber", "purple", "red"), + light = material_colors("light blue", "red", "yellow", "light green", "orange"), + complement = metro_colors( "blue grey", "blue", "light blue", From cdab2859d75e6b540c514f58ac6ad1382467288f Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 25 Oct 2024 11:15:29 +0200 Subject: [PATCH 07/10] rd --- R/scale_color_okabeito.R | 10 +++++----- man/okabeito_colors.Rd | 10 +++++----- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/scale_color_okabeito.R b/R/scale_color_okabeito.R index b1d20330a..1176978c1 100644 --- a/R/scale_color_okabeito.R +++ b/R/scale_color_okabeito.R @@ -129,11 +129,11 @@ okabeito_colors_list <- c( #' @inheritParams flat_colors #' @param original_names Logical. Should the colors be named using the original #' names used by Okabe and Ito (2008), such as "vermillion" (`TRUE`), or -#' simplified names, such as "red" (`FALSE`, default)? -#' Only used if no colors are specified (to see all available colors). -#' @param black_first Logical. Should black be first (`TRUE`) or last (`FALSE`, default) -#' in the color palette? Only used if no colors are specified (to see all -#' available colors). +#' simplified names, such as "red" (`FALSE`, default)? Only used if no colors +#' are specified (to see all available colors). +#' @param black_first Logical. Should black be first (`TRUE`) or last (`FALSE`, +#' default) in the color palette? Only used if no colors are specified (to see +#' all available colors). #' @param amber If amber color should replace yellow in the palette. #' #' @return A character vector with color-codes. diff --git a/man/okabeito_colors.Rd b/man/okabeito_colors.Rd index 9ed503327..a936dccd7 100644 --- a/man/okabeito_colors.Rd +++ b/man/okabeito_colors.Rd @@ -14,12 +14,12 @@ oi_colors(..., original_names = FALSE, black_first = FALSE, amber = TRUE) \item{original_names}{Logical. Should the colors be named using the original names used by Okabe and Ito (2008), such as "vermillion" (\code{TRUE}), or -simplified names, such as "red" (\code{FALSE}, default)? -Only used if no colors are specified (to see all available colors).} +simplified names, such as "red" (\code{FALSE}, default)? Only used if no colors +are specified (to see all available colors).} -\item{black_first}{Logical. Should black be first (\code{TRUE}) or last (\code{FALSE}, default) -in the color palette? Only used if no colors are specified (to see all -available colors).} +\item{black_first}{Logical. Should black be first (\code{TRUE}) or last (\code{FALSE}, +default) in the color palette? Only used if no colors are specified (to see +all available colors).} \item{amber}{If amber color should replace yellow in the palette.} } From 5aa13cfad08fda2a37bb02260c316efdbd607170 Mon Sep 17 00:00:00 2001 From: Daniel Date: Fri, 25 Oct 2024 11:22:37 +0200 Subject: [PATCH 08/10] docs, spelling --- R/scale_color_tol.R | 8 ++++---- inst/WORDLIST | 4 ++++ man/scale_color_tol_discrete.Rd | 8 ++++---- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/R/scale_color_tol.R b/R/scale_color_tol.R index f22c53961..c07f86fff 100644 --- a/R/scale_color_tol.R +++ b/R/scale_color_tol.R @@ -18,10 +18,10 @@ #' #' This function provides the qualitative palettes, as well as discrete rainbow #' sequential palettes. Available palettes for each type of data are: -#' - Qualitative: bright, high-contrast, vibrant, muted, medium-contrast, pale, -#' dark, light, ground_cover -#' - Diverging: sunset, BuRd, PRGn -#' - Sequential: YlOrBr, iridescent, rainbow_discrete, rainbow_smooth +#' - Qualitative: `bright`, `high-contrast`, `vibrant`, `muted`, +#' `medium-contrast`, `pale`, `dark`, `light`, `ground_cover` +#' - Diverging: `sunset`, `BuRd`, `PRGn` +#' - Sequential: `YlOrBr`, `iridescent`, `rainbow_discrete`, `rainbow_smooth` #' #'