Preserve NAs in discrete palettes (#5949)

* choose `na.value` when unmatched

* add test

* add news bullet

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))
+})