diff --git a/NEWS.md b/NEWS.md index d0f10aadc4..4c0ea1e891 100644 --- a/NEWS.md +++ b/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). diff --git a/R/scale-.R b/R/scale-.R index 432bd6c7d5..1773f15142 100644 --- a/R/scale-.R +++ b/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))) { diff --git a/tests/testthat/test-scale-manual.R b/tests/testthat/test-scale-manual.R index 4e45b65557..3d87268c41 100644 --- a/tests/testthat/test-scale-manual.R +++ b/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)) +})