From 6f8e22f5069a7794a3384004a914c8926608eb3c Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 20 Sep 2024 12:24:16 +0200
Subject: [PATCH 1/4] sprinkle vctrs over `ScaleDiscrete$map()`

---
 R/scale-.R | 29 +++++++++++++++++++----------
 1 file changed, 19 insertions(+), 10 deletions(-)

diff --git a/R/scale-.R b/R/scale-.R
index fd0bbd444f..64393e25a4 100644
--- a/R/scale-.R
+++ b/R/scale-.R
@@ -954,10 +954,10 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
   transform = identity,
 
   map = function(self, x, limits = self$get_limits()) {
-    limits <- limits[!is.na(limits)]
-    n <- length(limits)
+    limits <- vec_slice(limits, !is.na(limits))
+    n <- vec_size(limits)
     if (n < 1) {
-      return(rep(self$na.value, length(x)))
+      return(vec_rep(self$na.value, vec_size(x)))
     }
     if (!is.null(self$n.breaks.cache) && self$n.breaks.cache == n) {
       pal <- self$palette.cache
@@ -973,21 +973,30 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
       self$n.breaks.cache <- n
     }
 
-    na_value <- if (self$na.translate) self$na.value else NA
-    pal_names <- names(pal)
+    na_value <- NA
+    if (self$na.translate) {
+      na_value <- self$na.value
+      if (obj_is_list(pal) && !obj_is_list(na_value)) {
+        # We prevent a casting error that occurs when mapping grid patterns
+        na_value <- list(na_value)
+      }
+    }
+
+    pal_names <- vec_names(pal)
 
     if (!is_null(pal_names)) {
       # if pal is named, limit the pal by the names first,
       # then limit the values by the pal
-      pal[is.na(match(pal_names, limits))] <- na_value
-      pal <- unname(pal)
+      vec_slice(pal, is.na(match(pal_names, limits))) <- na_value
+      pal <- vec_set_names(pal, NULL)
       limits <- pal_names
     }
-    pal <- c(pal, na_value)
-    pal_match <- pal[match(as.character(x), limits, nomatch = length(pal))]
+    pal <- vec_c(pal, na_value)
+    pal_match <-
+      vec_slice(pal, match(as.character(x), limits, nomatch = vec_size(pal)))
 
     if (!is.na(na_value)) {
-      pal_match[is.na(x)] <- na_value
+      vec_slice(pal_match, is.na(x)) <- na_value
     }
     pal_match
   },

From c6181fd63ccd3bdcee956038ce9c516016085bd2 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 20 Sep 2024 12:24:21 +0200
Subject: [PATCH 2/4] add test

---
 tests/testthat/test-scales.R | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R
index 0ba2989e39..9b52ed02e4 100644
--- a/tests/testthat/test-scales.R
+++ b/tests/testthat/test-scales.R
@@ -755,3 +755,32 @@ test_that("discrete scales work with NAs in arbitrary positions", {
   expect_equal(test, output)
 
 })
+
+test_that("discrete scales can map to 2D structures", {
+
+  p <- ggplot(mtcars, aes(disp, mpg, colour = factor(cyl))) +
+    geom_point()
+
+  # Test it can map to a vctrs rcrd class
+  rcrd <- new_rcrd(list(a = LETTERS[1:3], b = 3:1))
+
+  ld <- layer_data(p + scale_colour_manual(values = rcrd, na.value = NA))
+  expect_s3_class(ld$colour, "vctrs_rcrd")
+  expect_length(ld$colour, nrow(mtcars))
+
+  # Test it can map to data.frames
+  df <- data_frame0(a = LETTERS[1:3], b = 3:1)
+  my_pal <- function(n) vec_slice(df, seq_len(n))
+
+  ld <- layer_data(p + discrete_scale("colour", palette = my_pal))
+  expect_s3_class(ld$colour, "data.frame")
+  expect_equal(dim(ld$colour), c(nrow(mtcars), ncol(df)))
+
+  # Test it can map to matrices
+  mtx <- cbind(a = LETTERS[1:3], b = LETTERS[4:6])
+  my_pal <- function(n) vec_slice(mtx, seq_len(n))
+
+  ld <- layer_data(p + discrete_scale("colour", palette = my_pal))
+  expect_true(is.matrix(ld$colour))
+  expect_equal(dim(ld$colour), c(nrow(mtcars), ncol(df)))
+})

From 84cc9642e2fac551a1b0985cb3fc269190de246d Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 20 Sep 2024 12:24:36 +0200
Subject: [PATCH 3/4] prevent guide from clogging up

---
 R/guide-.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/guide-.R b/R/guide-.R
index 4cb77ee7bb..b55950a2ca 100644
--- a/R/guide-.R
+++ b/R/guide-.R
@@ -227,7 +227,7 @@ Guide <- ggproto(
       labels <- as.list(labels)
     }
 
-    key <- data_frame(mapped, .name_repair = ~ aesthetic)
+    key <- data_frame(!!aesthetic := mapped)
     key$.value <- breaks
     key$.label <- labels
 

From c1568c2f81125c193623f45ed46e02a726539018 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Fri, 20 Sep 2024 12:25:31 +0200
Subject: [PATCH 4/4] add news bullet

---
 NEWS.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/NEWS.md b/NEWS.md
index 5df6059f0f..973a883514 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,6 @@
 # ggplot2 (development version)
 
+* More stability for vctrs-based palettes (@teunbrand, #6117).
 * Built-in `theme_*()` functions now have `ink` and `paper` arguments to control
   foreground and background colours respectively (@teunbrand)
 * The `summary()` method for ggplots is now more terse about facets