Palettes for discrete scales (#5771)

* Discrete position scales use palette

* Plumbing for `palette` argument

* discrete range derived from mapped limits

* adjust test

* add tests

* palettes take `n` just like other scales

* reoxygenate

* rephrase palette arg

* add news bullet

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

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,

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)
  },

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,25 +201,28 @@ 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) {
  expand_limits_continuous_trans(c(0, 1), expand, coord_limits, trans)
  } 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(

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"
+ )
+})
+

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)
  )
 })