sprinkle vctrs over ScaleDiscrete$map()

Author: teunbrand

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