From b7da1ae96c9ad3ea2ea596d4ded64bb9020bf53e Mon Sep 17 00:00:00 2001 From: Grant McDermott Date: Wed, 21 May 2025 22:39:03 -0700 Subject: [PATCH 1/4] revamped palette logic and colour recycling --- R/by_aesthetics.R | 161 +++++++++++++++++++++++++++++++++------------- R/tinytheme.R | 2 +- 2 files changed, 119 insertions(+), 44 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index dd76f2ab..27477720 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -1,62 +1,108 @@ by_col = function(ngrps = 1L, col = NULL, palette = NULL, gradient = NULL, ordered = NULL, alpha = NULL) { - if (is.null(ordered)) ordered = FALSE if (is.null(alpha)) alpha = 1 + if (is.null(ordered)) ordered = FALSE if (is.null(gradient)) gradient = FALSE - if (isTRUE(gradient)) { + assert_logical(ordered) + assert_logical(gradient) + if (gradient) { ngrps = 100L } - - if (is.null(palette)) { - pal_qual = get_tpar("palette.qualitative", default = NULL) - if (ngrps <= max(c(length(pal_qual), 8))) { - palette = pal_qual - } else { - palette = get_tpar("palette.sequential", default = NULL) - } - } + + # pal_qual = get_tpar("palette.qualitative", default = NULL) + pal_theme = get_tpar("palette.qualitative", default = NULL) + theme_flag = !is.null(pal_theme) # palette = substitute(palette, env = parent.env(environment())) # special "by" convenience keyword (will treat as NULL & handle grouping below) if (!anyNA(col) && !is.null(col) && length(col) == 1 && col == "by") col = NULL - if (is.null(col) && is.null(palette)) { - col = seq_len(ngrps) + # + ## Base case: If no color or palette provided, pass colors as a sequence of + ## numbers (will inherit from / cycle over the user's default palette) + + if (is.null(col) && (is.null(palette) && !theme_flag)) { + if (ngrps <= length(palette()) && !ordered) { + col = palette()[seq_len(ngrps)] + if (alpha) col = adjustcolor(col, alpha.f = alpha) + } else { + # fallback to restricted viridis palette + col = colorRampPalette( + hcl.colors(n = 100, palette = "Viridis", alpha = alpha)[(100 * 0.1 + 1):(100 * 0.9)], + alpha = TRUE + )(ngrps) + } + if (gradient || ordered) col = rev(col) + return(col) } + # + ## Next simplest case: No palette, but color(s) provided directly. We do + ## some simple sanity checks, apply alpha transparency and return as-is. + if (is.atomic(col) && is.vector(col)) { if (length(col) == 1) { col = rep(col, ngrps) + if (alpha) col = adjustcolor(col, alpha.f = alpha) + return(col) } else if (length(col) != ngrps) { - if (isFALSE(gradient)) { + if (!gradient) { stop(sprintf("`col` must be of length 1 or %s.", ngrps), call. = FALSE) } else { # interpolate gradient colors col = colorRampPalette(colors = col, alpha = TRUE)(ngrps) } } - if (isTRUE(gradient)) { + if (gradient) { col = rev(col) } else if (!ordered && is.numeric(col)) { - col = palette()[col] + # col = palette()[col] + if (ngrps <= length(palette())) { + col = palette()[col] + # if (alpha) col = adjustcolor(col, alpha.f = alpha) + } else { + col = hcl.colors(max(col), alpha = alpha)[col] + } } if (anyNA(col) || is.character(col)) { if (alpha) col = adjustcolor(col, alpha.f = alpha) return(col) } } - + + + # + ## Theme case: No palette provided, but fallback to tinytheme palette + + # we need to fix palette string, determine if in palette.pals() and then + # determine no. of groups, before kicking over to sequential + if (is.null(palette) && theme_flag) { + if (length(pal_theme) == 1) { + qual_match = match_pal(pal_theme, palette.pals()) + if (!is.na(qual_match)) { + if (ngrps >= get_pal_lens(pal_theme) || ordered) { + pal_theme = get_tpar("palette.sequential", default = NULL) + } + } + } + if (length(pal_theme) == 1) { + palette_fun = gen_pal_fun(pal = pal_theme, gradient = gradient, alpha = alpha) + args = list(n = ngrps, palette = pal_theme, alpha = alpha) + } + palette = pal_theme + } + if (is.null(palette)) { - if (ngrps <= length(palette()) && isFALSE(ordered) && isFALSE(gradient)) { + if (ngrps <= length(palette()) && !ordered && !gradient) { palette_fun = function(alpha) adjustcolor(palette(), alpha) # must be function to avoid arg ambiguity args = list(alpha = alpha) } else { - if (ngrps <= 8 && isFALSE(ordered)) { # ngrps < 100 so we know gradient is FALSE too + if (ngrps <= 8 && !ordered) { # ngrps < 100 so we know gradient is FALSE too palette = "R4" palette_fun = palette.colors } else { palette = "Viridis" - if (isFALSE(gradient) && isFALSE(ordered)) { + if (!gradient && !ordered) { palette_fun = hcl.colors } else { palette_fun_gradient = function(n, palette, from = 0.1, to = 0.9, alpha = 1) { @@ -95,28 +141,7 @@ by_col = function(ngrps = 1L, col = NULL, palette = NULL, gradient = NULL, order } } } else { - fx = function(x) tolower(gsub("[-, _, \\,, (, ), \\ , \\.]", "", x)) - pal_match = charmatch(fx(palette), fx(palette.pals())) - if (!is.na(pal_match)) { - if (pal_match < 1L) stop("'palette' is ambiguous") - palette_fun = palette.colors - if (isTRUE(gradient)) { - palette_fun2 = function(n, palette, alpha) colorRampPalette(palette.colors(palette = palette, alpha = alpha))(n) - palette_fun = palette_fun2 - } - } else { - pal_match = charmatch(fx(palette), fx(hcl.pals())) - if (!is.na(pal_match)) { - if (pal_match < 1L) stop("'palette' is ambiguous") - palette_fun = hcl.colors - } else { - stop( - "\nPalette string not recogized. Must be a value produced by either", - "`palette.pals()` or `hcl.pals()`.\n", - call. = FALSE - ) - } - } + palette_fun = gen_pal_fun(palette, gradient = gradient, alpha = alpha, n = ngrps) args = list(n = ngrps, palette = palette, alpha = alpha) } } else if (class(palette) %in% c("call", "name")) { @@ -166,11 +191,61 @@ by_col = function(ngrps = 1L, col = NULL, palette = NULL, gradient = NULL, order if (length(cols) > ngrps) cols = cols[1:ngrps] # For gradient and ordered colors, we'll run high to low - if (isTRUE(gradient) || isTRUE(ordered)) cols = rev(cols) + if (gradient || ordered) cols = rev(cols) return(cols) } +# Some utility functions for palette matching, etc. + +match_pal = function(pal, pals) { + fx = function(x) tolower(gsub("[-, _, \\,, (, ), \\ , \\.]", "", x)) + charmatch(fx(pal), fx(pals)) +} + +get_pal_lens = function(pal) { + pal_lens = c( + R3 = 8L, R4 = 8L, ggplot2 = 8L, `Okabe-Ito` = 9L, Accent = 8L, + `Dark 2` = 8L, Paired = 12L, `Pastel 1` = 9L, `Pastel 2` = 8L, + `Set 1` = 9L, `Set 2` = 8L, `Set 3` = 12L, `Tableau 10` = 10L, + `Classic Tableau` = 10L, `Polychrome 36` = 36L, Alphabet = 26L + ) + pal_lens[pal] +} + +# take a character string, match to either palette.pals() pr hcl.pals(), and +# generate the corresponding function factor with alpha transparency +gen_pal_fun = function(pal, gradient = FALSE, alpha = NULL, n = NULL) { + pal_match = match_pal(pal, palette.pals()) + if (!is.na(pal_match)) { + if (pal_match < 1L) stop("'palette' is ambiguous") + pal_fun = palette.colors + if (!is.null(n) && n >= get_pal_lens(pal_match)) { + warning( + "\nFewer colours ", get_pal_lens(pal_match), " provided than than there are groups ", + n, ". Recycling to make up the shortfall." + ) + pal_fun = function(n, palette, alpha) palette.colors(n = n, palette = pal, alpha = alpha, recycle = TRUE) + } + if (gradient) { + pal_fun = function(n, palette, alpha) colorRampPalette(palette.colors(palette = pal, alpha = alpha))(n) + } + } else { + pal_match = match_pal(pal, hcl.pals()) + if (!is.na(pal_match)) { + if (pal_match < 1L) stop("'palette' is ambiguous") + pal_fun = hcl.colors + } else { + stop( + "\nPalette string not recogized. Must be a value produced by either", + "`palette.pals()` or `hcl.pals()`.\n", + call. = FALSE + ) + } + } + return(pal_fun) +} + by_pch = function(ngrps, type, pch = NULL) { no_pch = FALSE diff --git a/R/tinytheme.R b/R/tinytheme.R index 03579afd..23d2f90d 100644 --- a/R/tinytheme.R +++ b/R/tinytheme.R @@ -211,7 +211,7 @@ theme_default = list( mar = c(5.1, 4.1, 4.1, 2.1), ## test mgp = par("mgp"), # palette.qualitative = "R4", - # palette.sequential = "ag_Sunset", + # palette.sequential = "Viridis", pch = par("pch"), # 1, side.sub = 1, tck = NA, From 2cd33ef8f0bb4983b859dea1ef262e2e702e854c Mon Sep 17 00:00:00 2001 From: Grant McDermott Date: Thu, 22 May 2025 13:37:56 -0700 Subject: [PATCH 2/4] allow subsetting for cols >= ngrps --- R/by_aesthetics.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index 27477720..85267835 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -45,9 +45,9 @@ by_col = function(ngrps = 1L, col = NULL, palette = NULL, gradient = NULL, order col = rep(col, ngrps) if (alpha) col = adjustcolor(col, alpha.f = alpha) return(col) - } else if (length(col) != ngrps) { + } else if (length(col) < ngrps) { if (!gradient) { - stop(sprintf("`col` must be of length 1 or %s.", ngrps), call. = FALSE) + stop(sprintf("`col` must be of length 1, or greater or equal to %s.", ngrps), call. = FALSE) } else { # interpolate gradient colors col = colorRampPalette(colors = col, alpha = TRUE)(ngrps) From 0896a2c121f3587ba74d97e91adb25f8082d35f4 Mon Sep 17 00:00:00 2001 From: Grant McDermott Date: Thu, 22 May 2025 14:10:43 -0700 Subject: [PATCH 3/4] recycle manual cols --- R/by_aesthetics.R | 35 ++++++++++++++++++++++++++++------- 1 file changed, 28 insertions(+), 7 deletions(-) diff --git a/R/by_aesthetics.R b/R/by_aesthetics.R index 85267835..4e4d899f 100755 --- a/R/by_aesthetics.R +++ b/R/by_aesthetics.R @@ -46,12 +46,26 @@ by_col = function(ngrps = 1L, col = NULL, palette = NULL, gradient = NULL, order if (alpha) col = adjustcolor(col, alpha.f = alpha) return(col) } else if (length(col) < ngrps) { - if (!gradient) { - stop(sprintf("`col` must be of length 1, or greater or equal to %s.", ngrps), call. = FALSE) - } else { - # interpolate gradient colors + # if (!gradient) { + # stop(sprintf("`col` must be of length 1, or greater than or equal to %s.", ngrps), call. = FALSE) + # } else { + # # interpolate gradient colors + # col = colorRampPalette(colors = col, alpha = TRUE)(ngrps) + # } + # if manual colours < ngrps, either (1) interpolate for gradient + # colors, or (2) recycle for discrete colours + if (gradient) { col = colorRampPalette(colors = col, alpha = TRUE)(ngrps) + } else { + ncolsstr = paste0("(", length(col), ")") + ngrpsstr = paste0("(", ngrps, ")") + warning( + "\nFewer colours ", ncolsstr, " provided than than there are groups ", + ngrpsstr, ". Recycling to make up the shortfall." + ) + col = rep(col, length.out = ngrps) } + } if (gradient) { col = rev(col) @@ -145,9 +159,16 @@ by_col = function(ngrps = 1L, col = NULL, palette = NULL, gradient = NULL, order args = list(n = ngrps, palette = palette, alpha = alpha) } } else if (class(palette) %in% c("call", "name")) { - args = as.list(palette) - palette_fun = paste(args[[1]]) - args[[1]] = NULL + # catch for when using passes palette as named object (e.g, + # pal26 = palette.colors("Alphabet")) + if (class(palette) == "name" && is.character(eval(palette))) { + args = as.list(eval(palette)) + palette_fun = "c" + } else { + args = as.list(palette) + palette_fun = paste(args[[1]]) + args[[1]] = NULL + } # catch for direct vector or list if (palette_fun %in% c("c", "list")) { if (palette_fun == "list") palette_fun = "c" From 21dff81d1de3f2aabaede3d60835329ad12324ca Mon Sep 17 00:00:00 2001 From: Grant McDermott Date: Thu, 22 May 2025 14:34:47 -0700 Subject: [PATCH 4/4] news --- NEWS.md | 43 ++++++++++++++++++++++++++----------------- 1 file changed, 26 insertions(+), 17 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4f7575e2..e00947b9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,24 +20,35 @@ where the formatting is also better._ - `tinyplot(..., file = "*.pdf")` will now default to using `cairo_pdf()` if cairo graphics are supported on the user's machine. This should help to ensure better fidelity of (non-standard) fonts in PDFs. (#311 @grantmcdermott) -- The palette argument now accepts a vector or list of manual colours, e.g. +- The `palette` argument now accepts a vector or list of manual colours, e.g. `tinyplot(..., palette = c("cyan4", "hotpink, "purple4"))`, or `tinytheme("clean", palette = c("cyan4", "hotpink, "purple4"))` (#325 @grantmcdermott) - Two new sets of top-level arguments allow for greater axis customization: - - `xaxb`/`yaxb` control the manual break points of the axis tick marks, e.g. - `tinyplot(..., xaxb = c(1, 3, 7, 15))`. (#400 @grantmcdermott) + - `xaxb`/`yaxb` control the manual break points of the axis tick marks. (#400 @grantmcdermott) - `xaxl`/`yaxl` apply a formatting function to change the appearance of the - axis tick labels. Several convenience strings (symbols) are supported for - common cases, e.g., `tinyplot(..., yaxl = "percent")` or - `tinyplot(..., yaxl = "%")`, etc. (#363, #391 @grantmcdermott) + axis tick labels. (#363, #391 @grantmcdermott) - The `x/yaxb` and `x/yaxl` arguments can be used in complementary fashion; see - the new (lower-level) `tinylabel` function documentation. For example: + These `x/yaxb` and `x/yaxl` arguments can be used in complementary fashion; + see the new (lower-level) `tinylabel` function documentation. For example: ```r - tinyplot((0:10)/10, yaxl = "%", yaxb = c(.17, .33, .5, .67, .83)) + tinyplot((0:10)/10, yaxb = c(.17, .33, .5, .67, .83), yaxl = "%") ``` - - +- The `x/ymin` and `x/ymax` arguments can now be specified directly via the + `tinyplot.formula()` method thanks to better NSE processing. For example, + instead of having to write + ```r + with(dat, tinyplot(x = x, y = y, by = by ymin = lwr, ymax = upr)) + ``` + users can now do + ```r + tinyplot(y ~ x | by, dat, ymin = lwr, ymax = upr) + ``` + + Underneath the hood, this works by processing these NSE arguments as part of + formula `model.frame()` and reference against the provided dataset. We plan to + extend the same logic to other top-level formula arguments such as `weights` + and `subset` in a future version of tinyplot. + ### Bug fixes: - The `tinyplot(..., cex = )` argument should be respected when using @@ -69,6 +80,10 @@ where the formatting is also better._ - Fixed a bug that resulted in y-axis labels being coerced to numeric for `"p"`-alike plot types (including `"jitter"`) if `y` is a factor or character. (#387 @grantmcdermott) +- Fix a colour recycling regression introduced in v0.3.0. Coincidentally, we + have improved the consistency across `palette` and `col` arguments, + particularly with respect to recycling behaviour. Thanks to @eddelbuettel for + the report (#352) and @grantmcdermott for the fix (#410). ### Website: @@ -79,12 +94,6 @@ where the formatting is also better._ - Improved website theme and navigation layout, especially on mobile. (#395 @zeileis) -### Misc: - -- Simplify specification of `xmin`/`xmax`/`ymin`/`ymax` in formula method. - The arguments are now processed along with the `model.frame()` so that - `ymin = var` works if `var` is a variable in the `data`. - ### Internals: - The order of the nested loop for drawing interior plot elements has been