From 9aa186cc54c56a8b753f0457cf4a3221f88d36e3 Mon Sep 17 00:00:00 2001 From: Yunuuuu Date: Wed, 9 Apr 2025 11:51:01 +0800 Subject: [PATCH 1/2] Make the input panels for `Facet$draw_panesl` predicatable --- R/coord-.R | 13 +++++-------- R/coord-radial.R | 5 +---- R/layer.R | 6 +++++- R/layout.R | 8 ++++++-- R/utilities-grid.R | 7 +++++++ 5 files changed, 24 insertions(+), 15 deletions(-) diff --git a/R/coord-.R b/R/coord-.R index 6b0470e39e..e2288e9c52 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -211,17 +211,14 @@ Coord <- ggproto("Coord", }, draw_panel = function(self, panel, params, theme) { - fg <- self$render_fg(params, theme) - bg <- self$render_bg(params, theme) + fg <- ensure_grob(self$render_fg(params, theme)) + bg <- ensure_grob(self$render_bg(params, theme)) if (isTRUE(theme$panel.ontop)) { - panel <- list2(!!!panel, bg, fg) + panel <- gList(panel, bg, fg) } else { - panel <- list2(bg, !!!panel, fg) + panel <- gList(bg, panel, fg) } - gTree( - children = inject(gList(!!!panel)), - vp = viewport(clip = self$clip) - ) + gTree(children = panel, vp = viewport(clip = self$clip)) } ) diff --git a/R/coord-radial.R b/R/coord-radial.R index 8df50bcb1e..45433fc59b 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -405,10 +405,7 @@ CoordRadial <- ggproto("CoordRadial", Coord, # Note that clipping path is applied to panel without coord # foreground/background (added in parent method). # These may contain decorations that needn't be clipped - panel <- list(gTree( - children = inject(gList(!!!panel)), - vp = viewport(clip = clip_path) - )) + panel <- editGrob(panel, vp = viewport(clip = clip_path)) } ggproto_parent(Coord, self)$draw_panel(panel, params, theme) }, diff --git a/R/layer.R b/R/layer.R index cb81e84b58..d6262e9ee8 100644 --- a/R/layer.R +++ b/R/layer.R @@ -452,7 +452,11 @@ Layer <- ggproto("Layer", NULL, } data <- self$geom$handle_na(data, self$computed_geom_params) - self$geom$draw_layer(data, self$computed_geom_params, layout, layout$coord) + grobs <- self$geom$draw_layer(data, + self$computed_geom_params, + layout, layout$coord + ) + lapply(grobs, ensure_grob) } ) diff --git a/R/layout.R b/R/layout.R index 92a28216d7..a0a1ba91ef 100644 --- a/R/layout.R +++ b/R/layout.R @@ -78,8 +78,12 @@ Layout <- ggproto("Layout", NULL, # Draw individual panels, then assemble into gtable panels <- lapply(seq_along(panels[[1]]), function(i) { - panel <- lapply(panels, `[[`, i) - panel <- c(facet_bg[i], panel, facet_fg[i]) + panel <- gTree(children = inject(gList(!!!lapply(panels, `[[`, i)))) + panel <- gTree(children = gList( + ensure_grob(facet_bg[[i]]), + panel, + ensure_grob(facet_fg[[i]]) + )) panel <- self$coord$draw_panel(panel, self$panel_params[[i]], theme) ggname(paste("panel", i, sep = "-"), panel) }) diff --git a/R/utilities-grid.R b/R/utilities-grid.R index a935d5b38f..5a69fe6612 100644 --- a/R/utilities-grid.R +++ b/R/utilities-grid.R @@ -4,6 +4,13 @@ grid::unit #' @export grid::arrow +# helper function to ensure the object is a grob +# This will simply return a `zeroGrob()` for non-grob object +ensure_grob <- function(x) { + if (inherits(x, "gList")) x <- gTree(children = x) + if (is.grob(x)) x else zeroGrob() +} + # Name ggplot grid object # Convenience function to name grid objects # From 27e655ae3a2bcfb6ac05b2d80f1d5b98e73382a1 Mon Sep 17 00:00:00 2001 From: Yunuuuu Date: Wed, 9 Apr 2025 12:19:05 +0800 Subject: [PATCH 2/2] fix R CMD check error --- tests/testthat/test-geom-sf.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-geom-sf.R b/tests/testthat/test-geom-sf.R index 29f5da8323..b06138d451 100644 --- a/tests/testthat/test-geom-sf.R +++ b/tests/testthat/test-geom-sf.R @@ -120,11 +120,13 @@ test_that("geom_sf() handles alpha properly", { g <- get_layer_grob(p)[[1]] # alpha affects the colour of points and lines - expect_equal(g[[1]]$gp$col, alpha(red, 0.5)) - expect_equal(g[[2]]$gp$col, alpha(red, 0.5)) + # geom_sf() will use `gList()` which is not a grob + # and will be wrapped into a `gTree()`. + expect_equal(g$children[[1]]$gp$col, alpha(red, 0.5)) + expect_equal(g$children[[2]]$gp$col, alpha(red, 0.5)) # alpha doesn't affect the colour of polygons, but the fill - expect_equal(g[[3]]$gp$col, alpha(red, 1.0)) - expect_equal(g[[3]]$gp$fill, alpha(red, 0.5)) + expect_equal(g$children[[3]]$gp$col, alpha(red, 1.0)) + expect_equal(g$children[[3]]$gp$fill, alpha(red, 0.5)) }) test_that("errors are correctly triggered", {