Merge branch 'main' into flexible_palettes

teunbrand · teunbrand · commit 0e465b048921 · 2025-01-22T15:21:51.000+01:00
diff --git a/NEWS.md b/NEWS.md
@@ -2,6 +2,10 @@
 
 * The default colour and fill scales have a new `palette` argument 
   (@teunbrand, #6064).
+* `scale_{x/y}_discrete(continuous.limits)` is a new argument to control the
+  display range of discrete scales (@teunbrand, #4174, #6259).
+* `geom_ribbon()` now appropriately warns about, and removes, missing values 
+  (@teunbrand, #6243).
 * `guide_*()` can now accept two inside legend theme elements:
   `legend.position.inside` and `legend.justification.inside`, allowing inside
   legends to be placed at different positions. Only inside legends with the same
diff --git a/R/coord-radial.R b/R/coord-radial.R
@@ -4,7 +4,7 @@
 #' @param end Position from 12 o'clock in radians where plot ends, to allow
 #'   for partial polar coordinates. The default, `NULL`, is set to
 #'   `start + 2 * pi`.
-#' @param expand If `TRUE`, the default, adds a small expansion factor the
+#' @param expand If `TRUE`, the default, adds a small expansion factor to
 #'   the limits to prevent overlap between data and axes. If `FALSE`, limits
 #'   are taken directly from the scale.
 #' @param r.axis.inside One of the following:
diff --git a/R/geom-point.R b/R/geom-point.R
@@ -85,6 +85,13 @@
 #' ggplot(mtcars, aes(wt, mpg)) +
 #'   geom_point(shape = 21, colour = "black", fill = "white", size = 5, stroke = 5)
 #'
+#' # The default shape in legends is not filled, but you can override the shape
+#' # in the guide to reflect the fill in the legend
+#' ggplot(mtcars, aes(wt, mpg, fill = factor(carb), shape = factor(cyl))) +
+#'   geom_point(size = 5, stroke = 1) +
+#'   scale_shape_manual(values = 21:25) +
+#'   scale_fill_ordinal(guide = guide_legend(override.aes = list(shape = 21)))
+#'
 #' \donttest{
 #' # You can create interesting shapes by layering multiple points of
 #' # different sizes
diff --git a/R/geom-ribbon.R b/R/geom-ribbon.R
@@ -126,7 +126,31 @@ GeomRibbon <- ggproto("GeomRibbon", Geom,
 
   draw_key = draw_key_polygon,
 
-  handle_na = function(data, params) {
+  handle_na = function(self, data, params) {
+
+    vars <- vapply(
+      strsplit(self$required_aes, "|", fixed = TRUE),
+      `[[`, i = 1, character(1)
+    )
+    if (params$flipped_aes || any(data$flipped_aes) %||% FALSE) {
+      vars <- switch_orientation(vars)
+    }
+    vars <- c(vars, self$non_missing_aes)
+
+    missing <- detect_missing(data, vars, finite = FALSE)
+    if (!any(missing)) {
+      return(data)
+    }
+    # We're rearranging groups to account for missing values
+    data$group <- vec_identify_runs(data_frame0(missing, data$group))
+    data <- vec_slice(data, !missing)
+
+    if (!params$na.rm) {
+      cli::cli_warn(
+        "Removed {sum(missing)} row{?s} containing missing values or values \\
+          outside the scale range ({.fn {snake_class(self)}})."
+      )
+    }
     data
   },
 
@@ -135,7 +159,6 @@ GeomRibbon <- ggproto("GeomRibbon", Geom,
                         flipped_aes = FALSE, outline.type = "both") {
     data <- check_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
-    if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ]
     data <- data[order(data$group), ]
 
     # Check that aesthetics are constant
diff --git a/R/guides-.R b/R/guides-.R
@@ -68,11 +68,14 @@ NULL
 #' }
 guides <- function(...) {
   args <- list2(...)
-  if (length(args) > 0) {
-    if (is.list(args[[1]]) && !is.guide(args[[1]])) args <- args[[1]]
-    args <- rename_aes(args)
+  # If there are no guides do nothing
+  if (length(args) == 0) {
+    return(NULL)
   }
 
+  if (is.list(args[[1]]) && !inherits(args[[1]], "guide")) args <- args[[1]]
+  args <- rename_aes(args)
+
   idx_false <- vapply(args, isFALSE, FUN.VALUE = logical(1L))
   if (isTRUE(any(idx_false))) {
     deprecate_warn0("3.3.4", "guides(`<scale>` = 'cannot be `FALSE`. Use \"none\" instead')")
@@ -84,11 +87,6 @@ guides <- function(...) {
     return(guides_list(guides = args))
   }
 
-  # If there are no guides, do nothing
-  if (length(args) == 0) {
-    return(NULL)
-  }
-
   # Raise warning about unnamed guides
   nms <- names(args)
   if (is.null(nms)) {
diff --git a/R/limits.R b/R/limits.R
@@ -4,7 +4,9 @@
 #' scales. By default, any values outside the limits specified are replaced with
 #' `NA`. Be warned that this will remove data outside the limits and this can
 #' produce unintended results. For changing x or y axis limits \strong{without}
-#' dropping data observations, see [coord_cartesian()].
+#' dropping data observations, see
+#' [`coord_cartesian(xlim, ylim)`][coord_cartesian], or use a full scale with
+#' [`oob = scales::oob_keep`][scales::oob_keep].
 #'
 #' @param ... For `xlim()` and `ylim()`: Two numeric values, specifying the left/lower
 #'  limit and the right/upper limit of the scale. If the larger value is given first,
diff --git a/R/scale-discrete-.R b/R/scale-discrete-.R
@@ -16,6 +16,12 @@
 #'   argument (the number of levels in the scale) returns the numerical values
 #'   that they should take.
 #' @param sec.axis [dup_axis()] is used to specify a secondary axis.
+#' @param continuous.limits One of:
+#'   * `NULL` to use the default scale range
+#'   * A numeric vector of length two providing a display range for the scale.
+#'   Use `NA` to refer to the existing minimum or maximum.
+#'   * A function that accepts the limits and returns a numeric vector of
+#'   length two.
 #' @rdname scale_discrete
 #' @family position scales
 #' @seealso
@@ -69,7 +75,8 @@
 #' }
 scale_x_discrete <- function(name = waiver(), ..., palette = seq_len,
                              expand = waiver(), guide = waiver(),
-                             position = "bottom", sec.axis = waiver()) {
+                             position = "bottom", sec.axis = waiver(),
+                             continuous.limits = NULL) {
   sc <- discrete_scale(
     aesthetics = ggplot_global$x_aes, name = name,
     palette = palette, ...,
@@ -78,13 +85,15 @@ scale_x_discrete <- function(name = waiver(), ..., palette = seq_len,
   )
 
   sc$range_c <- ContinuousRange$new()
+  sc$continuous_limits <- continuous.limits
   set_sec_axis(sec.axis, sc)
 }
 #' @rdname scale_discrete
 #' @export
 scale_y_discrete <- function(name = waiver(), ..., palette = seq_len,
                              expand = waiver(), guide = waiver(),
-                             position = "left", sec.axis = waiver()) {
+                             position = "left", sec.axis = waiver(),
+                             continuous.limits = NULL) {
   sc <- discrete_scale(
     aesthetics = ggplot_global$y_aes, name = name,
     palette = palette, ...,
@@ -93,6 +102,7 @@ scale_y_discrete <- function(name = waiver(), ..., palette = seq_len,
   )
 
   sc$range_c <- ContinuousRange$new()
+  sc$continuous_limits <- continuous.limits
   set_sec_axis(sec.axis, sc)
 }
 
@@ -106,6 +116,8 @@ scale_y_discrete <- function(name = waiver(), ..., palette = seq_len,
 #' @usage NULL
 #' @export
 ScaleDiscretePosition <- ggproto("ScaleDiscretePosition", ScaleDiscrete,
+  continuous_limits = NULL,
+
   train = function(self, x) {
     if (is.discrete(x)) {
       self$range$train(x, drop = self$drop, na.rm = !self$na.translate)
diff --git a/R/scale-expansion.R b/R/scale-expansion.R
@@ -81,9 +81,7 @@ expand_range4 <- function(limits, expand) {
 
   # Calculate separate range expansion for the lower and
   # upper range limits, and then combine them into one vector
-  lower <- expand_range(limits, expand[1], expand[2])[1]
-  upper <- expand_range(limits, expand[3], expand[4])[2]
-  c(lower, upper)
+  expand_range(limits, expand[c(1, 3)], expand[c(2, 4)])
 }
 
 #' Calculate the default expansion for a scale
@@ -153,7 +151,8 @@ expand_limits_scale <- function(scale, expand = expansion(0, 0), limits = waiver
       scale$map(limits),
       expand,
       coord_limits,
-      range_continuous = scale$range_c$range
+      range_continuous = scale$range_c$range,
+      continuous_limits = scale$continuous_limits
     )
   } else {
     # using the inverse transform to resolve the NA value is needed for date/datetime/time
@@ -170,7 +169,20 @@ expand_limits_continuous <- function(limits, expand = expansion(0, 0), coord_lim
 }
 
 expand_limits_discrete <- function(limits, expand = expansion(0, 0), coord_limits = c(NA, NA),
-                                   range_continuous = NULL) {
+                                   range_continuous = NULL, continuous_limits = NULL) {
+  if (is.function(continuous_limits)) {
+    continuous_limits <- continuous_limits(limits)
+  }
+  if (!is.null(continuous_limits)) {
+    if (!anyNA(continuous_limits)) {
+      continuous_limits <- range(continuous_limits)
+    }
+    check_numeric(continuous_limits, arg = "continuous.limits")
+    check_length(continuous_limits, 2L, arg = "continuous.limits")
+    missing <- is.na(continuous_limits)
+    limits  <- ifelse(missing, range(limits), continuous_limits)
+  }
+
   limit_info <- expand_limits_discrete_trans(
     limits,
     expand,
diff --git a/man/coord_polar.Rd b/man/coord_polar.Rd
diff --git a/man/geom_point.Rd b/man/geom_point.Rd
diff --git a/man/lims.Rd b/man/lims.Rd
diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd
diff --git a/tests/testthat/_snaps/geom-ribbon.md b/tests/testthat/_snaps/geom-ribbon.md
@@ -23,3 +23,7 @@
 
     `outline.type` must be one of "both", "upper", "lower", or "full", not "test".
 
+# NAs are dropped from the data
+
+    Removed 1 row containing missing values or values outside the scale range (`geom_ribbon()`).
+
diff --git a/tests/testthat/test-geom-ribbon.R b/tests/testthat/test-geom-ribbon.R
@@ -13,13 +13,19 @@ test_that("geom_ribbon() checks the aesthetics", {
   expect_snapshot_error(geom_ribbon(aes(year, ymin = level - 5, ymax = level + 5), outline.type = "test"))
 })
 
-test_that("NAs are not dropped from the data", {
+test_that("NAs are dropped from the data", {
   df <- data_frame(x = 1:5, y = c(1, 1, NA, 1, 1))
 
   p <- ggplot(df, aes(x))+
     geom_ribbon(aes(ymin = y - 1, ymax = y + 1))
+  p <- ggplot_build(p)
 
   expect_equal(get_layer_data(p)$ymin, c(0, 0, NA, 0, 0))
+  expect_snapshot_warning(
+    grob <- get_layer_grob(p)[[1]]
+  )
+  # We expect the ribbon to be broken up into 2 parts
+  expect_length(grob$children, 2)
 })
 
 test_that("geom_ribbon works in both directions", {
diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R
@@ -577,12 +577,16 @@ test_that("old S3 guides can be implemented", {
 
   withr::local_environment(my_env)
 
+  my_guides <- guides(x = guide_circle())
+  expect_length(my_guides$guides, 1)
+  expect_s3_class(my_guides$guides[[1]], "guide")
+
   expect_snapshot_warning(
     expect_doppelganger(
       "old S3 guide drawing a circle",
       ggplot(mtcars, aes(disp, mpg)) +
         geom_point() +
-        guides(x = "circle")
+        my_guides
     )
   )
 })
diff --git a/tests/testthat/test-scale-expansion.R b/tests/testthat/test-scale-expansion.R
@@ -96,6 +96,27 @@ test_that("expand_limits_discrete() can override limits with a both discrete and
     expand_limits_discrete(c("one", "two"), coord_limits = c(0, NA), range_continuous = c(1, 2)),
     c(0, 2)
   )
+  expect_identical(
+    expand_limits_discrete(1:2, range_continuous = c(1, 2), continuous_limits = c(0, 3)),
+    c(0, 3)
+  )
+  expect_identical(
+    expand_limits_discrete(1:2, range_continuous = c(1, 2), continuous_limits = c(NA, 4)),
+    c(1, 4)
+  )
+  expect_identical(
+    expand_limits_discrete(1:2, range_continuous = c(1, 2), continuous_limits = c(0, NA)),
+    c(0, 2)
+  )
+  expect_identical(
+    expand_limits_discrete(1:2, range_continuous = c(1, 2), continuous_limits = c(NA_real_, NA_real_)),
+    c(1, 2)
+  )
+  expect_identical(
+    expand_limits_discrete(1:2, range_continuous = 1:2,
+                           continuous_limits = function(x) x + c(-1, 1)),
+    c(0, 3)
+  )
 })
 
 test_that("expand_limits_continuous_trans() works with inverted transformations", {
diff --git a/vignettes/ggplot2-specs.Rmd b/vignettes/ggplot2-specs.Rmd
@@ -251,6 +251,8 @@ ggplot(sizes, aes(size, stroke, size = size, stroke = stroke)) +
   scale_size_identity()
 ```
 
+Because points are not typically filled, you may need to change some default settings when using these shapes and mapping `fill`. In particular, discrete `fill` guides will be drawn with an unfilled shape unless overridden (refer to `geom_point()` for an example of this).
+
 ## Text
 
 ### Font family
