From 892987bea2583a2af0d7124f2d98e1e32c2c20be Mon Sep 17 00:00:00 2001 From: Paul Newell Date: Thu, 23 May 2024 14:25:47 +0100 Subject: [PATCH 1/7] 'geom_rug()' prints a warning when 'na.rm = FALSE' Fixes issue #5905. When presented with missing values, 'geom_rug()' was not printing a warning message, contrary to the documentation. A warning message is now printed when 'na.rm = FALSE' ad suppressed when 'na.rm = TRUE', as expected. --- NEWS.md | 1 + R/geom-rug.R | 14 ++++++++++++++ 2 files changed, 15 insertions(+) diff --git a/NEWS.md b/NEWS.md index c469b5255c..3771ac3b08 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* `geom_rug()` prints a warning when `na.rm = FALSE`, as per documentation (#) * The `arrow.fill` parameter is now applied to more line-based functions: `geom_path()`, `geom_line()`, `geom_step()` `geom_function()`, line geometries in `geom_sf()` and `element_line()`. diff --git a/R/geom-rug.R b/R/geom-rug.R index cda6a01bc4..79360314b2 100644 --- a/R/geom-rug.R +++ b/R/geom-rug.R @@ -88,6 +88,20 @@ geom_rug <- function(mapping = NULL, data = NULL, GeomRug <- ggproto("GeomRug", Geom, optional_aes = c("x", "y"), + setup_params = function(self, data, params) { + self$required_aes <- character() + + if (grepl("b|t", params$sides)) { + self$required_aes <- c(self$required_aes, "x") + } + + if (grepl("l|r", params$sides)) { + self$required_aes <- c(self$required_aes, "y") + } + + params + }, + draw_panel = function(self, data, panel_params, coord, lineend = "butt", sides = "bl", outside = FALSE, length = unit(0.03, "npc")) { data <- check_linewidth(data, snake_class(self)) From c7ab780b753f7d2ac8101cb7719c9ef48ff40f26 Mon Sep 17 00:00:00 2001 From: Paul Newell Date: Thu, 23 May 2024 15:16:35 +0100 Subject: [PATCH 2/7] Impement local changes in 'handle_na()' Make local changes in 'handle_na() instead of global changes to 'GeomRug' --- R/geom-rug.R | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/R/geom-rug.R b/R/geom-rug.R index 79360314b2..0c000f3d41 100644 --- a/R/geom-rug.R +++ b/R/geom-rug.R @@ -88,20 +88,6 @@ geom_rug <- function(mapping = NULL, data = NULL, GeomRug <- ggproto("GeomRug", Geom, optional_aes = c("x", "y"), - setup_params = function(self, data, params) { - self$required_aes <- character() - - if (grepl("b|t", params$sides)) { - self$required_aes <- c(self$required_aes, "x") - } - - if (grepl("l|r", params$sides)) { - self$required_aes <- c(self$required_aes, "y") - } - - params - }, - draw_panel = function(self, data, panel_params, coord, lineend = "butt", sides = "bl", outside = FALSE, length = unit(0.03, "npc")) { data <- check_linewidth(data, snake_class(self)) @@ -171,5 +157,23 @@ GeomRug <- ggproto("GeomRug", Geom, draw_key = draw_key_path, - rename_size = TRUE + rename_size = TRUE, + + handle_na = function(self, data, params) { + sides_aes <- character() + + if (grepl("b|t", params$sides)) { + sides_aes <- c(sides_aes, "x") + } + + if (grepl("l|r", params$sides)) { + sides_aes <- c(sides_aes, "y") + } + + remove_missing( + data, params$na.rm, + c(sides_aes, self$required_aes, self$non_missing_aes), + snake_class(self) + ) + } ) From f56bfe1b6d5a09cfe5cdba464ae9607650f145e7 Mon Sep 17 00:00:00 2001 From: Paul Newell Date: Thu, 23 May 2024 17:06:21 +0100 Subject: [PATCH 3/7] Test for 'geom_rug()' warning about missing values Also added the issue number to NEWS --- NEWS.md | 2 +- tests/testthat/test-geom-rug.R | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 3771ac3b08..a9e158dccc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # ggplot2 (development version) -* `geom_rug()` prints a warning when `na.rm = FALSE`, as per documentation (#) +* `geom_rug()` prints a warning when `na.rm = FALSE`, as per documentation (#5905) * The `arrow.fill` parameter is now applied to more line-based functions: `geom_path()`, `geom_line()`, `geom_step()` `geom_function()`, line geometries in `geom_sf()` and `element_line()`. diff --git a/tests/testthat/test-geom-rug.R b/tests/testthat/test-geom-rug.R index a613e58f0d..28aa17efcb 100644 --- a/tests/testthat/test-geom-rug.R +++ b/tests/testthat/test-geom-rug.R @@ -40,3 +40,21 @@ test_that("Rug lengths are correct", { }) +test_that( + "geom_rug() warns about missing values when na.rm = FALSE", + { + df2 <- df + n_missing <- 2 + df2$x[sample(nrow(df2), size = n_missing)] <- NA + + p1 <- ggplot(df2, aes(x = x)) + geom_rug() + p2 <- ggplot(df2, aes(x = x)) + geom_rug(na.rm = TRUE) + + expect_warning( + ggplotGrob(p1), + paste0("Removed ", n_missing, " rows containing missing values or values outside the scale range") + ) + + expect_no_warning(ggplotGrob(p2)) + } +) From afdf2fc36fd3e9041d03a1e4228f71add4935883 Mon Sep 17 00:00:00 2001 From: Paul Newell Date: Tue, 4 Jun 2024 15:15:06 +0100 Subject: [PATCH 4/7] Handle rugs in orthogonal directions better When plotting rugs in both the 'x' and 'y' direction simultaneously, values of 'x' were being dropped when 'y' was missing, and vice versa. A warning will be given for each axis ('x' or 'y') that contains missing values, if 'na.rm = FALSE'. --- R/geom-rug.R | 31 ++++++++++++++++++++++++++----- 1 file changed, 26 insertions(+), 5 deletions(-) diff --git a/R/geom-rug.R b/R/geom-rug.R index 0c000f3d41..019f8e4c4f 100644 --- a/R/geom-rug.R +++ b/R/geom-rug.R @@ -170,10 +170,31 @@ GeomRug <- ggproto("GeomRug", Geom, sides_aes <- c(sides_aes, "y") } - remove_missing( - data, params$na.rm, - c(sides_aes, self$required_aes, self$non_missing_aes), - snake_class(self) - ) + if (length(sides_aes) > 0) { + df_list <- lapply( + sides_aes, + function(axis) { + remove_missing( + data, params$na.rm, + c(axis, self$required_aes, self$non_missing_aes), + snake_class(self) + ) + } + ) + data <- switch( + paste0(sides_aes, collapse = ""), + "x" = , + "y" = df_list[[1]], + "xy" = dplyr::union(df_list[[1]], df_list[[2]]) + ) + } else { + data <- remove_missing( + data, params$na.rm, + c(self$required_aes, self$non_missing_aes), + snake_class(self) + ) + } + + data } ) From 3a686cc41ce9f4ab2ebde7cb56bfcd91301c0833 Mon Sep 17 00:00:00 2001 From: Paul Newell Date: Thu, 6 Jun 2024 13:46:36 +0100 Subject: [PATCH 5/7] Remove dependence on 'dplyr' Use 'vctrs::vec_set_union()' instead of 'dplyr::union()' --- R/geom-rug.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/geom-rug.R b/R/geom-rug.R index 019f8e4c4f..5204c610aa 100644 --- a/R/geom-rug.R +++ b/R/geom-rug.R @@ -185,7 +185,7 @@ GeomRug <- ggproto("GeomRug", Geom, paste0(sides_aes, collapse = ""), "x" = , "y" = df_list[[1]], - "xy" = dplyr::union(df_list[[1]], df_list[[2]]) + "xy" = vctrs::vec_set_union(df_list[[1]], df_list[[2]]) ) } else { data <- remove_missing( From 7f88f49cef2fb986d03554436c61ec656e0f0a32 Mon Sep 17 00:00:00 2001 From: Paul Newell Date: Thu, 6 Jun 2024 13:56:53 +0100 Subject: [PATCH 6/7] Update 'testthat' version to 3.1.5 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index f3b9ee7208..dcaf992c7f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -67,7 +67,7 @@ Suggests: rpart, sf (>= 0.7-3), svglite (>= 2.1.2), - testthat (>= 3.1.2), + testthat (>= 3.1.5), vdiffr (>= 1.0.6), xml2 Enhances: From 9862cf9dbf044e7065c83d9df5875d3cc780a715 Mon Sep 17 00:00:00 2001 From: Paul Newell Date: Thu, 6 Jun 2024 14:42:15 +0100 Subject: [PATCH 7/7] Add github handle to NEWS bullet --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index c20ad9bac8..67c07b0b05 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # ggplot2 (development version) -* `geom_rug()` prints a warning when `na.rm = FALSE`, as per documentation (#5905) +* `geom_rug()` prints a warning when `na.rm = FALSE`, as per documentation (@pn317, #5905) * `position_dodge(preserve = "single")` now handles multi-row geoms better, such as `geom_violin()` (@teunbrand based on @clauswilke's work, #2801). * `position_jitterdodge()` now dodges by `group` (@teunbrand, #3656)