Add value matching to breaks in manual_scale (#3579)

Author: idno0001

NEWS.md

@@ -103,6 +103,12 @@
 
 * `geom_sf()` now applies alpha to linestring geometries (#3589, @yutannihilation).
 
+* `manual_scale()` now matches `values` with the order of `breaks` whenever
+  `values` is an unnamed vector. Previously, unnamed `values` would match with
+  the limits of the scale and ignore the order of any `breaks` provided. Note
+  that this may change the appearance of plots that previously relied on the
+  unordered behaviour (#2429, @idno0001).
+
 # ggplot2 3.2.1
 
 This is a patch release fixing a few regressions introduced in 3.2.0 as well as

R/scale-manual.r

@@ -17,11 +17,17 @@
 #'   name(s) of the aesthetic(s) that this scale works with. This can be useful, for
 #'   example, to apply colour settings to the `colour` and `fill` aesthetics at the
 #'   same time, via `aesthetics = c("colour", "fill")`.
-#' @param values a set of aesthetic values to map data values to. If this
-#'   is a named vector, then the values will be matched based on the names.
-#'   If unnamed, values will be matched in order (usually alphabetical) with
-#'   the limits of the scale. Any data values that don't match will be
-#'   given `na.value`.
+#' @param values a set of aesthetic values to map data values to. The values
+#'   will be matched in order (usually alphabetical) with the limits of the
+#'   scale, or with `breaks` if provided. If this is a named vector, then the
+#'   values will be matched based on the names instead. Data values that don't
+#'   match will be given `na.value`.
+#' @param breaks One of:
+#'   - `NULL` for no breaks
+#'   - `waiver()` for the default breaks (the scale limits)
+#'   - A character vector of breaks
+#'   - A function that takes the limits as input and returns breaks
+#'     as output
 #' @section Color Blindness:
 #' Many color palettes derived from RGB combinations (like the "rainbow" color
 #' palette) are not suitable to support all viewers, especially those with
@@ -74,48 +80,48 @@ NULL
 
 #' @rdname scale_manual
 #' @export
-scale_colour_manual <- function(..., values, aesthetics = "colour") {
-  manual_scale(aesthetics, values, ...)
+scale_colour_manual <- function(..., values, aesthetics = "colour", breaks = waiver()) {
+  manual_scale(aesthetics, values, breaks, ...)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_fill_manual <- function(..., values, aesthetics = "fill") {
-  manual_scale(aesthetics, values, ...)
+scale_fill_manual <- function(..., values, aesthetics = "fill", breaks = waiver()) {
+  manual_scale(aesthetics, values, breaks, ...)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_size_manual <- function(..., values) {
-  manual_scale("size", values, ...)
+scale_size_manual <- function(..., values, breaks = waiver()) {
+  manual_scale("size", values, breaks, ...)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_shape_manual <- function(..., values) {
-  manual_scale("shape", values, ...)
+scale_shape_manual <- function(..., values, breaks = waiver()) {
+  manual_scale("shape", values, breaks, ...)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_linetype_manual <- function(..., values) {
-  manual_scale("linetype", values, ...)
+scale_linetype_manual <- function(..., values, breaks = waiver()) {
+  manual_scale("linetype", values, breaks, ...)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_alpha_manual <- function(..., values) {
-  manual_scale("alpha", values, ...)
+scale_alpha_manual <- function(..., values, breaks = waiver()) {
+  manual_scale("alpha", values, breaks, ...)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_discrete_manual <- function(aesthetics, ..., values) {
-  manual_scale(aesthetics, values, ...)
+scale_discrete_manual <- function(aesthetics, ..., values, breaks = waiver()) {
+  manual_scale(aesthetics, values, breaks, ...)
 }
 
 
-manual_scale <- function(aesthetic, values = NULL, ...) {
+manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), ...) {
   # check for missing `values` parameter, in lieu of providing
   # a default to all the different scale_*_manual() functions
   if (is_missing(values)) {
@@ -124,12 +130,23 @@ manual_scale <- function(aesthetic, values = NULL, ...) {
     force(values)
   }
 
+  # order values according to breaks
+  if (is.vector(values) && is.null(names(values)) && !is.waive(breaks) &&
+      !is.null(breaks)) {
+    if (length(breaks) != length(values)) {
+      stop("Differing number of values and breaks in manual scale. ",
+           length(values), " values provided compared to ", length(breaks),
+           " breaks.", call. = FALSE)
+    }
+    names(values) <- breaks
+  }
+
   pal <- function(n) {
     if (n > length(values)) {
       stop("Insufficient values in manual scale. ", n, " needed but only ",
         length(values), " provided.", call. = FALSE)
     }
     values
   }
-  discrete_scale(aesthetic, "manual", pal, ...)
+  discrete_scale(aesthetic, "manual", pal, breaks = breaks, ...)
 }

man/scale_manual.Rd

@@ -67,3 +67,21 @@ test_that("generic scale can be used in place of aesthetic-specific scales", {
 
   expect_equal(layer_data(p1), layer_data(p2))
 })
+
+test_that("named values do not match with breaks in manual scales", {
+  s <- scale_fill_manual(
+    values = c("data_red" = "red", "data_black" = "black"),
+    breaks = c("data_black", "data_red")
+  )
+  s$train(c("data_black", "data_red"))
+  expect_equal(s$map(c("data_red", "data_black")), c("red", "black"))
+})
+
+test_that("unnamed values match breaks in manual scales", {
+  s <- scale_fill_manual(
+    values = c("red", "black"),
+    breaks = c("data_red", "data_black")
+  )
+  s$train(c("data_red", "data_black"))
+  expect_equal(s$map(c("data_red", "data_black")), c("red", "black"))
+})