Fix geom_ribbon(na.rm) (#6244)

* custom `GeomRibbon$handle_na` method

* modify test

* add news bullet

Author: teunbrand

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* `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

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

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()`).
+

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", {