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

Author: teunbrand

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(

man/scale_discrete.Rd

@@ -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-discrete.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)
   )
 })