diff --git a/NEWS.md b/NEWS.md index dd574ac1aa..e19471d2e2 100644 --- a/NEWS.md +++ b/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 diff --git a/R/geom-ribbon.R b/R/geom-ribbon.R index a8f6b1be42..f1d339a2eb 100644 --- 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/tests/testthat/_snaps/geom-ribbon.md b/tests/testthat/_snaps/geom-ribbon.md index a2db3d427d..4c1fbb5ecc 100644 --- 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 index c923942dde..6bd08875f1 100644 --- 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", {