Merge branch 'theme_geom_defaults' of https://github.com/teunbrand/ggplot2 into theme_geom_defaults

teunbrand · teunbrand · commit 43037b569f66 · 2024-08-20T10:12:53.000+02:00
diff --git a/NEWS.md b/NEWS.md
@@ -6,6 +6,10 @@
     * The `element_geom()` function can be used to populate that argument.
     * The `from_theme()` function allows access to the theme default fields from
       inside the `aes()` function.
+* 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).
 * `position_dodge()` and `position_jitterdodge()` now have a `reverse` argument 
   (@teunbrand, #3610)
@@ -133,6 +137,8 @@
 * New function `get_strip_labels()` to retrieve facet labels (@teunbrand, #4979)
 * Fixed bug in `position_dodge2()`'s identification of range overlaps 
   (@teunbrand, #5938, #4327).
+* Fixed bug where empty discrete scales weren't recognised as such 
+  (@teunbrand, #5945).
 
 # ggplot2 3.5.1
 
diff --git a/R/facet-grid-.R b/R/facet-grid-.R
@@ -297,12 +297,21 @@ FacetGrid <- ggproto("FacetGrid", Facet,
       return(data)
     }
 
-    # Compute faceting values and add margins
-    margin_vars <- list(intersect(names(rows), names(data)),
-      intersect(names(cols), names(data)))
-    data <- reshape_add_margins(data, margin_vars, params$margins)
-
+    # Compute faceting values
     facet_vals <- eval_facets(c(rows, cols), data, params$.possible_columns)
+    if (nrow(facet_vals) == nrow(data)) {
+      # Margins are computed on evaluated faceting values (#1864).
+      facet_vals <- reshape_add_margins(
+        # We add an index column to track data recycling
+        vec_cbind(facet_vals, .index = seq_len(nrow(facet_vals))),
+        list(intersect(names(rows), names(facet_vals)),
+             intersect(names(cols), names(facet_vals))),
+        params$margins
+      )
+      # Apply recycling on original data to fit margins
+      data <- vec_slice(data, facet_vals$.index)
+      facet_vals$.index <- NULL
+    }
 
     # If any faceting variables are missing, add them in by
     # duplicating the data
diff --git a/R/labels.R b/R/labels.R
@@ -24,9 +24,11 @@ setup_plot_labels <- function(plot, layers, data) {
   # Find labels from every layer
   for (i in seq_along(layers)) {
     layer <- layers[[i]]
+    exclude <- names(layer$aes_params)
     mapping <- layer$computed_mapping
     mapping <- strip_stage(mapping)
     mapping <- strip_dots(mapping, strip_pronoun = TRUE)
+    mapping <- mapping[setdiff(names(mapping), exclude)]
 
     # Acquire default labels
     mapping_default <- make_labels(mapping)
diff --git 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/R/scale-discrete-.R b/R/scale-discrete-.R
@@ -130,7 +130,9 @@ ScaleDiscretePosition <- ggproto("ScaleDiscretePosition", ScaleDiscrete,
   },
 
   is_empty = function(self) {
-    is.null(self$range$range) && is.null(self$limits) && is.null(self$range_c$range)
+    is.null(self$range$range) &&
+      (is.null(self$limits) || is.function(self$limits)) &&
+      is.null(self$range_c$range)
   },
 
   reset = function(self) {
diff --git a/R/scale-gradient.R b/R/scale-gradient.R
@@ -16,7 +16,7 @@
 #' @param low,high Colours for low and high ends of the gradient.
 #' @param guide Type of legend. Use `"colourbar"` for continuous
 #'   colour bar, or `"legend"` for discrete colour legend.
-#' @inheritDotParams continuous_scale -na.value -guide -aesthetics -expand -position
+#' @inheritDotParams continuous_scale -na.value -guide -aesthetics -expand -position -palette
 #' @seealso [scales::pal_seq_gradient()] for details on underlying
 #'   palette, [scale_colour_steps()] for binned variants of these scales.
 #'
diff --git a/R/scale-grey.R b/R/scale-grey.R
@@ -5,7 +5,7 @@
 #'
 #' @inheritParams scales::pal_grey
 #' @inheritParams scale_colour_hue
-#' @inheritDotParams discrete_scale -expand -position -scale_name
+#' @inheritDotParams discrete_scale -expand -position -scale_name -palette
 #' @family colour scales
 #' @seealso
 #' The documentation on [colour aesthetics][aes_colour_fill_alpha].
diff --git a/R/scale-hue.R b/R/scale-hue.R
@@ -4,7 +4,7 @@
 #' It does not generate colour-blind safe palettes.
 #'
 #' @param na.value Colour to use for missing values
-#' @inheritDotParams discrete_scale -aesthetics -expand -position -scale_name
+#' @inheritDotParams discrete_scale -aesthetics -expand -position -scale_name -palette
 #' @param aesthetics Character string or vector of character strings listing the
 #'   name(s) of the aesthetic(s) that this scale works with. This can be useful, for
 #'   example, to apply colour settings to the `colour` and `fill` aesthetics at the
diff --git a/R/scale-linetype.R b/R/scale-linetype.R
@@ -6,7 +6,7 @@
 #' no inherent order, this use is not advised.
 #'
 #' @inheritParams scale_x_discrete
-#' @inheritDotParams discrete_scale -expand -position -na.value -scale_name
+#' @inheritDotParams discrete_scale -expand -position -na.value -scale_name -palette
 #' @param na.value The linetype to use for `NA` values.
 #' @rdname scale_linetype
 #' @seealso
diff --git a/R/scale-shape.R b/R/scale-shape.R
@@ -10,7 +10,7 @@
 #' @param solid Should the shapes be solid, `TRUE`, or hollow,
 #'   `FALSE`?
 #' @inheritParams scale_x_discrete
-#' @inheritDotParams discrete_scale -expand -position -scale_name
+#' @inheritDotParams discrete_scale -expand -position -scale_name -palette
 #' @rdname scale_shape
 #' @seealso
 #' The documentation for [differentiation related aesthetics][aes_linetype_size_shape].
diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd
diff --git a/man/scale_grey.Rd b/man/scale_grey.Rd
diff --git a/man/scale_hue.Rd b/man/scale_hue.Rd
diff --git a/man/scale_linetype.Rd b/man/scale_linetype.Rd
diff --git a/man/scale_shape.Rd b/man/scale_shape.Rd
diff --git a/tests/testthat/test-facet-map.R b/tests/testthat/test-facet-map.R
@@ -22,6 +22,10 @@ test_that("margins add extra data", {
   loc <- panel_map_one(facet_grid(a~b, margins = "b"), df)
 
   expect_equal(nrow(loc), nrow(df) * 2)
+
+  # For variables including computation (#1864)
+  loc <- panel_map_one(facet_grid(a ~ I(b + 1), margins = TRUE), df)
+  expect_equal(nrow(loc), nrow(df) * 4)
 })
 
 test_that("grid: missing facet columns are duplicated", {
diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R
@@ -74,6 +74,21 @@ test_that("Labels can be extracted from attributes", {
   expect_equal(labels$y, "disp")
 })
 
+test_that("Labels from static aesthetics are ignored (#6003)", {
+
+  df <- data.frame(x = 1, y = 1, f = 1)
+
+  p <- ggplot(df, aes(x, y, colour = f)) + geom_point()
+  labels <- ggplot_build(p)$plot$labels
+
+  expect_equal(labels$colour, "f")
+
+  p <- ggplot(df, aes(x, y, colour = f)) + geom_point(colour = "blue")
+  labels <- ggplot_build(p)$plot$labels
+
+  expect_null(labels$colour)
+})
+
 test_that("alt text is returned", {
   p <- ggplot(mtcars, aes(mpg, disp)) +
     geom_point()
diff --git 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))
+})
