From d497184c6465ba8d4bb48c52cf143f801e2acceb Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 20 Jun 2024 13:26:58 +0200 Subject: [PATCH 1/9] move panel assembly to coord --- R/coord-.R | 11 +++++++++++ R/layout.R | 15 ++------------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/R/coord-.R b/R/coord-.R index ced1257b42..116e0d8855 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -203,6 +203,17 @@ Coord <- ggproto("Coord", # used as a fudge for CoordFlip and CoordPolar modify_scales = function(scales_x, scales_y) { invisible() + }, + + draw_panel = function(self, panel, params, theme) { + fg <- self$render_fg(params, theme) + bg <- self$render_bg(params, theme) + if (isTRUE(theme$panel.ontop)) { + panel <- c(panel, list(bg), list(fg)) + } else { + panel <- c(list(bg), panel, list(fg)) + } + gTree(children = inject(gList(!!!panel))) } ) diff --git a/R/layout.R b/R/layout.R index 41efa7e828..a25f8a08e4 100644 --- a/R/layout.R +++ b/R/layout.R @@ -80,19 +80,8 @@ Layout <- ggproto("Layout", NULL, panels <- lapply(seq_along(panels[[1]]), function(i) { panel <- lapply(panels, `[[`, i) panel <- c(facet_bg[i], panel, facet_fg[i]) - - coord_fg <- self$coord$render_fg(self$panel_params[[i]], theme) - coord_bg <- self$coord$render_bg(self$panel_params[[i]], theme) - if (isTRUE(theme$panel.ontop)) { - panel <- c(panel, list(coord_bg), list(coord_fg)) - } else { - panel <- c(list(coord_bg), panel, list(coord_fg)) - } - - ggname( - paste("panel", i, sep = "-"), - gTree(children = inject(gList(!!!panel))) - ) + panel <- self$coord$draw_panel(panel, self$panel_params[[i]], theme) + ggname(paste("panel", i, sep = "-"), panel) }) plot_table <- self$facet$draw_panels( panels, From 7398fc9dff469204f1790cbcb0928615f120e817 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 20 Jun 2024 13:46:42 +0200 Subject: [PATCH 2/9] move panel clipping responsibility from facets to coords --- R/coord-.R | 9 ++++++--- R/facet-grid-.R | 2 +- R/facet-null.R | 3 +-- R/facet-wrap.R | 2 +- 4 files changed, 9 insertions(+), 7 deletions(-) diff --git a/R/coord-.R b/R/coord-.R index 116e0d8855..bce7365962 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -209,11 +209,14 @@ Coord <- ggproto("Coord", fg <- self$render_fg(params, theme) bg <- self$render_bg(params, theme) if (isTRUE(theme$panel.ontop)) { - panel <- c(panel, list(bg), list(fg)) + panel <- list2(!!!panel, bg, fg) } else { - panel <- c(list(bg), panel, list(fg)) + panel <- list2(bg, !!!panel, fg) } - gTree(children = inject(gList(!!!panel))) + gTree( + children = inject(gList(!!!panel)), + vp = viewport(clip = self$clip) + ) } ) diff --git a/R/facet-grid-.R b/R/facet-grid-.R index 0854b5299b..f4eb416405 100644 --- a/R/facet-grid-.R +++ b/R/facet-grid-.R @@ -409,7 +409,7 @@ FacetGrid <- ggproto("FacetGrid", Facet, } panel_table <- gtable_matrix("layout", panel_table, - panel_widths, panel_heights, respect = respect, clip = coord$clip, z = mtx(1)) + panel_widths, panel_heights, respect = respect, z = mtx(1)) panel_table$layout$name <- paste0('panel-', rep(seq_len(nrow), ncol), '-', rep(seq_len(ncol), each = nrow)) spacing_x <- calc_element("panel.spacing.x", theme) diff --git a/R/facet-null.R b/R/facet-null.R index bc95141fde..c66f39fa03 100644 --- a/R/facet-null.R +++ b/R/facet-null.R @@ -63,11 +63,10 @@ FacetNull <- ggproto("FacetNull", Facet, grob_widths <- unit.c(grobWidth(axis_v$left), unit(1, "null"), grobWidth(axis_v$right)) grob_heights <- unit.c(grobHeight(axis_h$top), unit(abs(aspect_ratio), "null"), grobHeight(axis_h$bottom)) grob_names <- c("spacer", "axis-l", "spacer", "axis-t", "panel", "axis-b", "spacer", "axis-r", "spacer") - grob_clip <- c("off", "off", "off", "off", coord$clip, "off", "off", "off", "off") layout <- gtable_matrix("layout", all, widths = grob_widths, heights = grob_heights, - respect = respect, clip = grob_clip, + respect = respect, clip = "off", z = z_matrix ) layout$layout$name <- grob_names diff --git a/R/facet-wrap.R b/R/facet-wrap.R index dfe487a3f8..6f994c8ed8 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -322,7 +322,7 @@ FacetWrap <- ggproto("FacetWrap", Facet, empties <- apply(panel_table, c(1,2), function(x) is.zero(x[[1]])) panel_table <- gtable_matrix("layout", panel_table, widths = unit(rep(1, ncol), "null"), - heights = unit(rep(abs(aspect_ratio), nrow), "null"), respect = respect, clip = coord$clip, z = matrix(1, ncol = ncol, nrow = nrow)) + heights = unit(rep(abs(aspect_ratio), nrow), "null"), respect = respect, z = matrix(1, ncol = ncol, nrow = nrow)) panel_table$layout$name <- paste0('panel-', rep(seq_len(ncol), nrow), '-', rep(seq_len(nrow), each = ncol)) From a4f77011da6ca69bcfe896546299f051274b01cc Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 20 Jun 2024 14:25:31 +0200 Subject: [PATCH 3/9] coord_radial uses clipping path --- R/coord-radial.R | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/R/coord-radial.R b/R/coord-radial.R index b426bc27a8..fc37352f30 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -387,6 +387,26 @@ CoordRadial <- ggproto("CoordRadial", Coord, ) }, + + draw_panel = function(self, panel, params, theme) { + if (self$clip == "on") { + clip_path <- data_frame0( + x = c(Inf, Inf, -Inf, -Inf), + y = c(Inf, -Inf, -Inf, Inf) + ) + clip_path <- coord_munch(self, clip_path, params, is_closed = TRUE) + clip_path <- polygonGrob(clip_path$x, clip_path$y) + # 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) + )) + } + ggproto_parent(Coord, self)$draw_panel(panel, params, theme) + }, + labels = function(self, labels, panel_params) { # `Layout$resolve_label()` doesn't know to look for theta/r/r.sec guides, # so we'll handle title propagation here. From e2acd9a1a2a214dab55b1c7f94349de12814340a Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 20 Jun 2024 14:55:49 +0200 Subject: [PATCH 4/9] only apply clipping mask when possibly supported --- R/coord-radial.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/coord-radial.R b/R/coord-radial.R index fc37352f30..9095c47474 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -389,7 +389,8 @@ CoordRadial <- ggproto("CoordRadial", Coord, draw_panel = function(self, panel, params, theme) { - if (self$clip == "on") { + clip_support <- check_device("clippingPaths", "test", maybe = TRUE) + if (self$clip == "on" && !isFALSE(clip_support)) { clip_path <- data_frame0( x = c(Inf, Inf, -Inf, -Inf), y = c(Inf, -Inf, -Inf, Inf) From f0eecb4e56836feb864cf7ce3c30e372c53c33ed Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 20 Jun 2024 14:58:53 +0200 Subject: [PATCH 5/9] add news bullet --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 67c07b0b05..e737b033b5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # ggplot2 (development version) +* `coord_radial(clip = "on")` clips to the panel area when the graphics device + supports clipping paths (@teunbrand, #5952). +* (internal) Panel clipping responsibility moved from Facet class to Coord + class through new `Coord$draw_panel()` method. * `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). From aec5b40417c23951c9140bcadc27663cf55bc6cd Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 24 Jun 2024 11:23:02 +0200 Subject: [PATCH 6/9] turn on strip clipping by default --- R/theme-defaults.R | 6 +- ...et-wrap-with-omitted-inner-axis-labels.svg | 76 ++++++++++++++----- ...sitioned-correctly-in-non-table-layout.svg | 18 ----- 3 files changed, 59 insertions(+), 41 deletions(-) diff --git a/R/theme-defaults.R b/R/theme-defaults.R index 6ecd6d68c0..edde1f7fe0 100644 --- a/R/theme-defaults.R +++ b/R/theme-defaults.R @@ -205,7 +205,7 @@ theme_grey <- function(base_size = 11, base_family = "", panel.ontop = FALSE, strip.background = element_rect(fill = "grey85", colour = NA), - strip.clip = "inherit", + strip.clip = "on", strip.text = element_text( colour = "grey10", size = rel(0.8), @@ -490,7 +490,7 @@ theme_void <- function(base_size = 11, base_family = "", legend.box.margin = rel(0), legend.box.spacing = unit(0.2, "cm"), legend.ticks.length = rel(0.2), - strip.clip = "inherit", + strip.clip = "on", strip.text = element_text(size = rel(0.8)), strip.switch.pad.grid = rel(0.5), strip.switch.pad.wrap = rel(0.5), @@ -621,7 +621,7 @@ theme_test <- function(base_size = 11, base_family = "", panel.ontop = FALSE, strip.background = element_rect(fill = "grey85", colour = "grey20"), - strip.clip = "inherit", + strip.clip = "on", strip.text = element_text( colour = "grey10", size = rel(0.8), diff --git a/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg index 66caee5c07..819e6cd9bd 100644 --- a/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg +++ b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg @@ -117,74 +117,110 @@ - - + + - + 6 + + + + + + + + + 1 - - + + - + 8 - -0 - - + + - + + +0 - - + + - + 4 + + + + + + + + + 0 - - + + - + 4 + + + + + + + + + 1 - - + + - + 6 + + + + + + + + + 0 diff --git a/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg b/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg index c3f247ebe5..0aa45cb61c 100644 --- a/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg +++ b/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg @@ -349,15 +349,6 @@ - - - - - - - - - @@ -380,15 +371,6 @@ - - - - - - - - - From 2a7cdf956a896bbdc5ab96cd48cf1e9e749c6241 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 24 Jun 2024 11:30:55 +0200 Subject: [PATCH 7/9] remove superfluous `clip` argument --- R/facet-.R | 7 +++---- ...cet-wrap-with-omitted-inner-axis-labels.svg | 9 --------- ...ositioned-correctly-in-non-table-layout.svg | 18 ------------------ 3 files changed, 3 insertions(+), 31 deletions(-) diff --git a/R/facet-.R b/R/facet-.R index f985d84afc..23d3db6982 100644 --- a/R/facet-.R +++ b/R/facet-.R @@ -153,8 +153,7 @@ Facet <- ggproto("Facet", NULL, table <- self$init_gtable( panels, layout, theme, ranges, params, - aspect_ratio = aspect_ratio %||% coord$aspect(ranges[[1]]), - clip = coord$clip + aspect_ratio = aspect_ratio %||% coord$aspect(ranges[[1]]) ) table <- self$attach_axes(table, layout, ranges, coord, theme, params) @@ -198,7 +197,7 @@ Facet <- ggproto("Facet", NULL, data }, init_gtable = function(panels, layout, theme, ranges, params, - aspect_ratio = NULL, clip = "on") { + aspect_ratio = NULL) { # Initialise matrix of panels dim <- c(max(layout$ROW), max(layout$COL)) @@ -228,7 +227,7 @@ Facet <- ggproto("Facet", NULL, "layout", table, widths = widths, heights = heights, respect = !is.null(aspect_ratio), - clip = clip, z = matrix(1, dim[1], dim[2]) + clip = "off", z = matrix(1, dim[1], dim[2]) ) # Set panel names diff --git a/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg index 819e6cd9bd..7c936b4768 100644 --- a/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg +++ b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg @@ -107,15 +107,6 @@ - - - - - - - - - diff --git a/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg b/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg index 0aa45cb61c..7d546bcc7e 100644 --- a/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg +++ b/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg @@ -93,24 +93,6 @@ - - - - - - - - - - - - - - - - - - From 23f16e099bf05b57324fdbd37cac6792e5f05ff0 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 24 Jun 2024 11:32:53 +0200 Subject: [PATCH 8/9] add another bullet --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index fbbfb3b0d9..05b339aeef 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,8 @@ supports clipping paths (@teunbrand, #5952). * (internal) Panel clipping responsibility moved from Facet class to Coord class through new `Coord$draw_panel()` method. +* `theme(strip.clip)` now defaults to `"on"` and is independent of Coord + clipping (@teunbrand, 5952). * (internal) rearranged the code of `Facet$draw_paensl()` method (@teunbrand). * `geom_rug()` prints a warning when `na.rm = FALSE`, as per documentation (@pn317, #5905) * `position_dodge(preserve = "single")` now handles multi-row geoms better, From e52e6d6e926b1416b33dd03a98f40ae54903fa7e Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 20 Aug 2024 10:36:00 +0200 Subject: [PATCH 9/9] reminder for the future --- tests/testthat/test-coord-polar.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/testthat/test-coord-polar.R b/tests/testthat/test-coord-polar.R index 6e5f435d60..a594835740 100644 --- a/tests/testthat/test-coord-polar.R +++ b/tests/testthat/test-coord-polar.R @@ -158,6 +158,9 @@ test_that("bounding box calculations are sensible", { # Visual tests ------------------------------------------------------------ +#TODO: Once {vdiffr} supports non-rectangular clipping paths, we should add a +# test for `coord_radial(clip = "on")`'s ability to clip to the sector + test_that("polar coordinates draw correctly", { theme <- theme_test() + theme(