allow fewer elements in named values vector in manual scales (#4471)

Author: thomasp85

NEWS.md

@@ -1,5 +1,9 @@
 # ggplot2 (development version)
 
+* Manual scales now allow named vectors passed to `values` to contain fewer 
+  elements than existing in the data. Elements not present in values will be set
+  to `NA` (@thomasp85, #3451)
+  
 * Remove cross-inheritance of default discrete colour/fill scales and check the
   type and aesthetic of function output if `type` is a function 
   (@thomasp85, #4149)

R/scale-manual.r

@@ -28,6 +28,8 @@
 #'   - A character vector of breaks
 #'   - A function that takes the limits as input and returns breaks
 #'     as output
+#' @param na.value The aesthetic value to use for missing (`NA`) values
+#'
 #' @section Color Blindness:
 #' Many color palettes derived from RGB combinations (like the "rainbow" color
 #' palette) are not suitable to support all viewers, especially those with
@@ -80,38 +82,38 @@ NULL
 
 #' @rdname scale_manual
 #' @export
-scale_colour_manual <- function(..., values, aesthetics = "colour", breaks = waiver()) {
-  manual_scale(aesthetics, values, breaks, ...)
+scale_colour_manual <- function(..., values, aesthetics = "colour", breaks = waiver(), na.value = "grey50") {
+  manual_scale(aesthetics, values, breaks, ..., na.value = na.value)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_fill_manual <- function(..., values, aesthetics = "fill", breaks = waiver()) {
-  manual_scale(aesthetics, values, breaks, ...)
+scale_fill_manual <- function(..., values, aesthetics = "fill", breaks = waiver(), na.value = "grey50") {
+  manual_scale(aesthetics, values, breaks, ..., na.value = na.value)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_size_manual <- function(..., values, breaks = waiver()) {
-  manual_scale("size", values, breaks, ...)
+scale_size_manual <- function(..., values, breaks = waiver(), na.value = NA) {
+  manual_scale("size", values, breaks, ..., na.value = na.value)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_shape_manual <- function(..., values, breaks = waiver()) {
-  manual_scale("shape", values, breaks, ...)
+scale_shape_manual <- function(..., values, breaks = waiver(), na.value = NA) {
+  manual_scale("shape", values, breaks, ..., na.value = na.value)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_linetype_manual <- function(..., values, breaks = waiver()) {
-  manual_scale("linetype", values, breaks, ...)
+scale_linetype_manual <- function(..., values, breaks = waiver(), na.value = "blank") {
+  manual_scale("linetype", values, breaks, ..., na.value = na.value)
 }
 
 #' @rdname scale_manual
 #' @export
-scale_alpha_manual <- function(..., values, breaks = waiver()) {
-  manual_scale("alpha", values, breaks, ...)
+scale_alpha_manual <- function(..., values, breaks = waiver(), na.value = NA) {
+  manual_scale("alpha", values, breaks, ..., na.value = na.value)
 }
 
 #' @rdname scale_manual
@@ -121,7 +123,7 @@ scale_discrete_manual <- function(aesthetics, ..., values, breaks = waiver()) {
 }
 
 
-manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), ...) {
+manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), limits = NULL, ...) {
   # check for missing `values` parameter, in lieu of providing
   # a default to all the different scale_*_manual() functions
   if (is_missing(values)) {
@@ -130,6 +132,10 @@ manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), ...) {
     force(values)
   }
 
+  if (is.null(limits)) {
+    limits <- names(values)
+  }
+
   # order values according to breaks
   if (is.vector(values) && is.null(names(values)) && !is.waive(breaks) &&
       !is.null(breaks) && !is.function(breaks)) {
@@ -146,5 +152,5 @@ manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), ...) {
     }
     values
   }
-  discrete_scale(aesthetic, "manual", pal, breaks = breaks, ...)
+  discrete_scale(aesthetic, "manual", pal, breaks = breaks, limits = limits, ...)
 }

man/scale_manual.Rd

@@ -88,12 +88,12 @@ test_that("unnamed values match breaks in manual scales", {
 
 test_that("limits works (#3262)", {
   # named charachter vector
-  s1 <- scale_colour_manual(values = c("8" = "c", "4" = "a", "6" = "b"), limits = c("4", "8"))
+  s1 <- scale_colour_manual(values = c("8" = "c", "4" = "a", "6" = "b"), limits = c("4", "8"), na.value = NA)
   s1$train(c("4", "6", "8"))
   expect_equal(s1$map(c("4", "6", "8")), c("a", NA, "c"))
 
   # named charachter vector
-  s2 <- scale_colour_manual(values = c("c", "a", "b"), limits = c("4", "8"))
+  s2 <- scale_colour_manual(values = c("c", "a", "b"), limits = c("4", "8"), na.value = NA)
   s2$train(c("4", "6", "8"))
   expect_equal(s2$map(c("4", "6", "8")), c("c", NA, "a"))
 })