diff --git a/NEWS.md b/NEWS.md index 633a46172b..4e8216504e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* Discrete position scales now expose the `palette` argument, which can be used + to customise spacings between levels (@teunbrand, #5770). * The default `se` parameter in layers with `geom = "smooth"` will be `TRUE` when the data has `ymin` and `ymax` parameters and `FALSE` if these are absent. Note that this does not affect the default of `geom_smooth()` or diff --git a/R/coord-transform.R b/R/coord-transform.R index 81f06afad3..83ffd7b9ee 100644 --- a/R/coord-transform.R +++ b/R/coord-transform.R @@ -198,7 +198,7 @@ view_scales_from_scale_with_coord_trans <- function(scale, coord_limits, trans, if (scale$is_discrete()) { continuous_ranges <- expand_limits_discrete_trans( - scale_limits, + scale$map(scale_limits), expansion, coord_limits, trans, diff --git a/R/scale-discrete-.R b/R/scale-discrete-.R index 60bcc3f8b7..b957b97b97 100644 --- a/R/scale-discrete-.R +++ b/R/scale-discrete-.R @@ -12,6 +12,9 @@ #' #' @inheritDotParams discrete_scale -scale_name #' @inheritParams discrete_scale +#' @param palette A palette function that when called with a single integer +#' argument (the number of levels in the scale) returns the numerical values +#' that they should take. #' @param sec.axis [dup_axis()] is used to specify a secondary axis. #' @rdname scale_discrete #' @family position scales @@ -64,12 +67,12 @@ #' geom_point() + #' scale_x_discrete(labels = abbreviate) #' } -scale_x_discrete <- function(name = waiver(), ..., expand = waiver(), - guide = waiver(), position = "bottom", - sec.axis = waiver()) { +scale_x_discrete <- function(name = waiver(), ..., palette = seq_len, + expand = waiver(), guide = waiver(), + position = "bottom", sec.axis = waiver()) { sc <- discrete_scale( aesthetics = c("x", "xmin", "xmax", "xend"), name = name, - palette = identity, ..., + palette = palette, ..., expand = expand, guide = guide, position = position, super = ScaleDiscretePosition ) @@ -79,12 +82,12 @@ scale_x_discrete <- function(name = waiver(), ..., expand = waiver(), } #' @rdname scale_discrete #' @export -scale_y_discrete <- function(name = waiver(), ..., expand = waiver(), - guide = waiver(), position = "left", - sec.axis = waiver()) { +scale_y_discrete <- function(name = waiver(), ..., palette = seq_len, + expand = waiver(), guide = waiver(), + position = "left", sec.axis = waiver()) { sc <- discrete_scale( aesthetics = c("y", "ymin", "ymax", "yend"), name = name, - palette = identity, ..., + palette = palette, ..., expand = expand, guide = guide, position = position, super = ScaleDiscretePosition ) @@ -137,7 +140,21 @@ ScaleDiscretePosition <- ggproto("ScaleDiscretePosition", ScaleDiscrete, map = function(self, x, limits = self$get_limits()) { if (is.discrete(x)) { - x <- seq_along(limits)[match(as.character(x), limits)] + values <- self$palette(length(limits)) + if (!is.numeric(values)) { + cli::cli_abort( + "The {.arg palette} function must return a {.cls numeric} vector.", + call = self$call + ) + } + if (length(values) < length(limits)) { + cli::cli_abort( + "The {.arg palette} function must return at least \\ + {length(limits)} values.", + call = self$call + ) + } + x <- values[match(as.character(x), limits)] } mapped_discrete(x) }, diff --git a/R/scale-expansion.R b/R/scale-expansion.R index 9ede4c1400..8ec72c2a78 100644 --- a/R/scale-expansion.R +++ b/R/scale-expansion.R @@ -137,7 +137,7 @@ expand_limits_scale <- function(scale, expand = expansion(0, 0), limits = waiver if (scale$is_discrete()) { coord_limits <- coord_limits %||% c(NA_real_, NA_real_) expand_limits_discrete( - limits, + scale$map(limits), expand, coord_limits, range_continuous = scale$range_c$range @@ -201,14 +201,17 @@ expand_limits_continuous_trans <- function(limits, expand = expansion(0, 0), expand_limits_discrete_trans <- function(limits, expand = expansion(0, 0), coord_limits = c(NA, NA), trans = transform_identity(), range_continuous = NULL) { - if (is.discrete(limits)) { - n_discrete_limits <- length(limits) - } else { - n_discrete_limits <- 0 + discrete_limits <- NULL + if (length(limits) > 0) { + if (is.discrete(limits)) { + discrete_limits <- c(1, length(limits)) # for backward compatibility + } else { + discrete_limits <- range(limits) + } } is_empty <- is.null(limits) && is.null(range_continuous) - is_only_continuous <- n_discrete_limits == 0 + is_only_continuous <- is.null(discrete_limits) is_only_discrete <- is.null(range_continuous) if (is_empty) { @@ -216,10 +219,10 @@ expand_limits_discrete_trans <- function(limits, expand = expansion(0, 0), } else if (is_only_continuous) { expand_limits_continuous_trans(range_continuous, expand, coord_limits, trans) } else if (is_only_discrete) { - expand_limits_continuous_trans(c(1, n_discrete_limits), expand, coord_limits, trans) + expand_limits_continuous_trans(discrete_limits, expand, coord_limits, trans) } else { # continuous and discrete - limit_info_discrete <- expand_limits_continuous_trans(c(1, n_discrete_limits), expand, coord_limits, trans) + limit_info_discrete <- expand_limits_continuous_trans(discrete_limits, expand, coord_limits, trans) # don't expand continuous range if there is also a discrete range limit_info_continuous <- expand_limits_continuous_trans( diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd index e92179a921..381c09254e 100644 --- a/man/scale_discrete.Rd +++ b/man/scale_discrete.Rd @@ -8,6 +8,7 @@ scale_x_discrete( name = waiver(), ..., + palette = seq_len, expand = waiver(), guide = waiver(), position = "bottom", @@ -17,6 +18,7 @@ scale_x_discrete( scale_y_discrete( name = waiver(), ..., + palette = seq_len, expand = waiver(), guide = waiver(), position = "left", @@ -32,9 +34,6 @@ omitted.} \item{...}{ Arguments passed on to \code{\link[=discrete_scale]{discrete_scale}} \describe{ - \item{\code{palette}}{A palette function that when called with a single integer -argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks @@ -79,6 +78,10 @@ notation. \item{\code{super}}{The super class to use for the constructed scale} }} +\item{palette}{A palette function that when called with a single integer +argument (the number of levels in the scale) returns the numerical values +that they should take.} + \item{expand}{For position scales, a vector of range expansion constants used to add some padding around the data to ensure that they are placed some distance away from the axes. Use the convenience function \code{\link[=expansion]{expansion()}} diff --git a/tests/testthat/test-scale-discrete.R b/tests/testthat/test-scale-discrete.R index d9ce98c494..cd8c2da933 100644 --- a/tests/testthat/test-scale-discrete.R +++ b/tests/testthat/test-scale-discrete.R @@ -162,3 +162,45 @@ test_that("mapped_discrete vectors behaves as predicted", { x[5:7] <- mapped_discrete(seq_len(3)) expect_s3_class(x, "mapped_discrete") }) + +# Palettes ---------------------------------------------------------------- + +test_that("palettes work for discrete scales", { + + df <- data.frame(x = c("A", "B", "C"), y = 1:3) + values <- c(1, 10, 100) + + p <- ggplot(df, aes(x, y)) + + geom_point() + + scale_x_discrete(palette = function(x) values) + + # Check limits are translated to correct values + ld <- layer_data(p) + expect_equal(ld$x, values, ignore_attr = TRUE) + + # Check discsrete expansion is applied + b <- ggplot_build(p) + expect_equal( + b$layout$panel_params[[1]]$x.range, + range(values) + c(-0.6, 0.6) + ) +}) + +test_that("invalid palettes trigger errors", { + + df <- data.frame(x = c("A", "B", "C"), y = 1:3) + + p <- ggplot(df, aes(x, y)) + + geom_point() + + expect_error( + ggplot_build(p + scale_x_discrete(palette = function(x) LETTERS[1:3])), + "must return a .+ vector\\." + ) + + expect_error( + ggplot_build(p + scale_x_discrete(palette = function(x) 1:2)), + "must return at least 3 values" + ) +}) + diff --git a/tests/testthat/test-scale-expansion.R b/tests/testthat/test-scale-expansion.R index 7d1b5b30ae..26d25abfdc 100644 --- a/tests/testthat/test-scale-expansion.R +++ b/tests/testthat/test-scale-expansion.R @@ -116,6 +116,6 @@ test_that("expand_limits_scale_discrete() begrudgingly handles numeric limits", coord_limits = c(NA, NA), range_continuous = c(-15, -2) ), - c(-15, -2) + c(-16, -1) ) })