diff --git a/R/layer.R b/R/layer.R index eef800c584..d4396aeb4e 100644 --- a/R/layer.R +++ b/R/layer.R @@ -167,7 +167,7 @@ layer <- function(geom = NULL, stat = NULL, if (check.aes && length(extra_aes) > 0) { cli::cli_warn("Ignoring unknown aesthetics: {.field {extra_aes}}", call = call_env) } - aes_params$label <- normalise_label(aes_params$label) + aes_params[["label"]] <- normalise_label(aes_params[["label"]]) # adjust the legend draw key if requested geom <- set_draw_key(geom, key_glyph %||% params$key_glyph) @@ -974,7 +974,7 @@ normalise_label <- function(label) { if (obj_is_list(label)) { # Ensure that each element in the list has length 1 label[lengths(label) == 0] <- "" - labels <- lapply(labels, `[`, 1) + label <- lapply(label, `[`, 1) } if (is.expression(label)) { # Classed expressions, when converted to lists, retain their class. diff --git a/R/scale-.R b/R/scale-.R index c81ec83c38..d9837c8e15 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -124,7 +124,10 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam aesthetics <- standardise_aes_names(aesthetics) check_breaks_labels(breaks, labels, call = call) - check_fallback_palette(palette, fallback.palette, call = call) + fallback.palette <- validate_fallback_palette( + palette, fallback.palette, aesthetics, discrete = FALSE, + call = call + ) position <- arg_match0(position, c("left", "right", "top", "bottom")) @@ -227,7 +230,10 @@ discrete_scale <- function(aesthetics, scale_name = deprecated(), palette, name aesthetics <- standardise_aes_names(aesthetics) check_breaks_labels(breaks, labels, call = call) - check_fallback_palette(palette, fallback.palette, call = call) + fallback.palette <- validate_fallback_palette( + palette, fallback.palette, aesthetics, discrete = TRUE, + call = call + ) # Convert formula input to function if appropriate limits <- allow_lambda(limits) @@ -327,7 +333,10 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = aesthetics <- standardise_aes_names(aesthetics) check_breaks_labels(breaks, labels, call = call) - check_fallback_palette(palette, fallback.palette, call = call) + fallback.palette <- validate_fallback_palette( + palette, fallback.palette, aesthetics, discrete = FALSE, + call = call + ) position <- arg_match0(position, c("left", "right", "top", "bottom")) @@ -1786,16 +1795,54 @@ check_continuous_limits <- function(limits, ..., check_length(limits, 2L, arg = arg, call = call) } -check_fallback_palette <- function(pal, fallback, call = caller_env()) { +allow_lambda <- function(x) { + # we check the 'call' class to prevent interpreting `bquote()` calls as a function + if (is_formula(x, lhs = FALSE) && !inherits(x, "call")) as_function(x) else x +} + +validate_fallback_palette <- function(pal, fallback, aesthetic = "x", + discrete = FALSE, call = caller_env()) { if (!is.null(pal) || is.function(fallback)) { - return(invisible()) + return(pal %||% fallback) + } + aesthetic <- standardise_aes_names(aesthetic[1]) + if (discrete) { + pal <- fallback_palette_discrete(aesthetic) + } else { + pal <- fallback_palette_continuous(aesthetic) + } + if (!is.null(pal)) { + return(pal) } cli::cli_abort( "When {.code palette = NULL}, the {.arg fallback.palette} must be defined." ) } -allow_lambda <- function(x) { - # we check the 'call' class to prevent interpreting `bquote()` calls as a function - if (is_formula(x, lhs = FALSE) && !inherits(x, "call")) as_function(x) else x +fallback_palette_discrete <- function(aesthetic) { + switch( + aesthetic, + colour = , + fill = pal_hue(), + alpha = function(n) seq(0.1, 1, length.out = n), + linewidth = function(n) seq(2, 6, length.out = n), + linetype = pal_linetype(), + shape = pal_shape(), + size = function(n) sqrt(seq(4, 36, length.out = n)), + ggplot_global$theme_default[[paste0("palette.", aesthetic, ".discrete")]] + ) +} + +fallback_palette_continuous <- function(aesthetic) { + switch( + aesthetic, + colour = , + fill = pal_seq_gradient("#132B43", "#56B1F7"), + alpha = pal_rescale(c(0.1, 1)), + linewidth = pal_rescale(c(1, 6)), + linetype = pal_binned(pal_linetype()), + shape = pal_binned(pal_shape()), + size = pal_area(), + ggplot_global$theme_default[[paste0("palette.", aes, ".continuous")]] + ) }