Preserve NAs in discrete palettes (#5949)

* choose `na.value` when unmatched

* add test

* add news bullet

Author: teunbrand

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* Missing values from discrete palettes are no longer translated 
+  (@teunbrand, #5929).
 * Fixed bug in `facet_grid(margins = TRUE)` when using expresssions 
   (@teunbrand, #1864).
 * `geom_step()` now supports the `orientation` argument (@teunbrand, #5936).

R/scale-.R

@@ -973,23 +973,23 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
       self$n.breaks.cache <- n
     }
 
-    if (!is_null(names(pal))) {
+    na_value <- if (self$na.translate) self$na.value else NA
+    pal_names <- 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
-      idx_nomatch <- is.na(match(names(pal), limits))
-      pal[idx_nomatch] <- NA
-      pal_match <- pal[match(as.character(x), names(pal))]
-      pal_match <- unname(pal_match)
-    } else {
-      # if pal is not named, limit the values directly
-      pal_match <- pal[match(as.character(x), limits)]
+      pal[is.na(match(pal_names, limits))] <- na_value
+      pal <- unname(pal)
+      limits <- pal_names
     }
+    pal <- c(pal, na_value)
+    pal_match <- pal[match(as.character(x), limits, nomatch = length(pal))]
 
-    if (self$na.translate) {
-      ifelse(is.na(x) | is.na(pal_match), self$na.value, pal_match)
-    } else {
-      pal_match
+    if (!is.na(na_value)) {
+      pal_match[is.na(x)] <- na_value
     }
+    pal_match
   },
 
   rescale = function(self, x, limits = self$get_limits(), range = c(1, length(limits))) {

tests/testthat/test-scale-manual.R

@@ -152,3 +152,27 @@ test_that("limits and breaks (#4619)", {
   expect_equal(s3$map(c("4", "6", "8")), c("a", "b", "c"))
   expect_equal(s3$break_positions(), c("a", "c"))
 })
+
+test_that("NAs from palette are not translated (#5929)", {
+
+  s1 <- scale_colour_manual(
+    values = c("4" = "a", "6" = NA, "8" = "c"),
+    na.translate = TRUE, na.value = "x"
+  )
+  s1$train(c("8", "6", "4"))
+  expect_equal(s1$map(c("4", "6", "8", "10")), c("a", NA, "c", "x"))
+
+  s2 <- scale_colour_manual(
+    values = c("4" = "a", "6" = NA, "8" = "c"),
+    na.translate = TRUE, na.value = NA
+  )
+  s2$train(c("8", "6", "4"))
+  expect_equal(s2$map(c("4", "6", "8", "10")), c("a", NA, "c", NA))
+
+  s3 <- scale_colour_manual(
+    values = c("4" = "a", "6" = NA, "8" = "c"),
+    na.translate = FALSE, na.value = "x"
+  )
+  s3$train(c("8", "6", "4"))
+  expect_equal(s3$map(c("4", "6", "8", "10")), c("a", NA, "c", NA))
+})