diff --git a/NEWS.md b/NEWS.md index e99235a3a0..8e3be88e5a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* New `strip.spacing` theme element, determining the distance between panels + and strips (@teunbrand, #5935) * (internal) The plot's layout now has a coord parameter that is used to prevent setting up identical panel parameters (#5427) * (internal) rearranged the code of `Facet$draw_panels()` method (@teunbrand). diff --git a/R/facet-grid-.R b/R/facet-grid-.R index 4d4f12f345..4ac7222fc0 100644 --- a/R/facet-grid-.R +++ b/R/facet-grid-.R @@ -390,6 +390,7 @@ FacetGrid <- ggproto("FacetGrid", Facet, attr(row_vars, "facet") <- "grid" strips <- render_strips(col_vars, row_vars, params$labeller, theme) + spacing <- convertUnit(calc_element("strip.spacing", theme), "cm") padding <- convertUnit(calc_element("strip.switch.pad.grid", theme), "cm") switch_x <- !is.null(params$switch) && params$switch %in% c("both", "x") @@ -397,16 +398,16 @@ FacetGrid <- ggproto("FacetGrid", Facet, shift_x <- if (inside_x) 1 else 2 if (switch_x) { - space <- if (!inside_x & table_has_grob(table, "axis-b")) padding + pad <- as.numeric(!inside_x & table_has_grob(table, "axis-b")) * padding table <- seam_table( table, strips$x$bottom, side = "bottom", name = "strip-b", - shift = shift_x, z = 2, clip = "on", spacing = space + shift = shift_x, z = 2, clip = "on", spacing = spacing + pad ) } else { - space <- if (!inside_x & table_has_grob(table, "axis-t")) padding + pad <- as.numeric(!inside_x & table_has_grob(table, "axis-t")) * padding table <- seam_table( table, strips$x$top, side = "top", name = "strip-t", - shift = shift_x, z = 2, clip = "on", spacing = space + shift = shift_x, z = 2, clip = "on", spacing = spacing + pad ) } @@ -415,16 +416,16 @@ FacetGrid <- ggproto("FacetGrid", Facet, shift_y <- if (inside_y) 1 else 2 if (switch_y) { - space <- if (!inside_y & table_has_grob(table, "axis-l")) padding + pad <- as.numeric(!inside_y & table_has_grob(table, "axis-l")) * padding table <- seam_table( table, strips$y$left, side = "left", name = "strip-l", - shift = shift_y, z = 2, clip = "on", spacing = space + shift = shift_y, z = 2, clip = "on", spacing = spacing + pad ) } else { - space <- if (!inside_y & table_has_grob(table, "axis-r")) padding + pad <- as.numeric(!inside_y & table_has_grob(table, "axis-r")) * padding table <- seam_table( table, strips$y$right, side = "right", name = "strip-r", - shift = shift_y, z = 2, clip = "on", spacing = space + shift = shift_y, z = 2, clip = "on", spacing = spacing + pad ) } table diff --git a/R/facet-wrap.R b/R/facet-wrap.R index 4f07736f7d..1c0d49753b 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -390,6 +390,7 @@ FacetWrap <- ggproto("FacetWrap", Facet, # Set position invariant parameters padding <- convertUnit(calc_element("strip.switch.pad.wrap", theme), "cm") + spacing <- convertUnit(calc_element("strip.spacing", theme), "cm") position <- params$strip.position %||% "top" pos <- substr(position, 1, 1) prefix <- paste0("strip-", pos) @@ -418,15 +419,13 @@ FacetWrap <- ggproto("FacetWrap", Facet, table <- weave(table, mat, shift, size, name = prefix, z = 2, clip = "on") - if (!inside) { - axes <- grepl(paste0("axis-", pos), table$layout$name) - has_axes <- !vapply(table$grobs[axes], is.zero, logical(1)) - has_axes <- split(has_axes, table$layout[[pos]][axes]) - has_axes <- vapply(has_axes, sum, numeric(1)) > 0 - padding <- rep(padding, length(has_axes)) - padding[!has_axes] <- unit(0, "cm") - table <- weave(table, , shift, padding) - } + axes <- grepl(paste0("axis-", pos), table$layout$name) + has_axes <- !vapply(table$grobs[axes], is.zero, logical(1)) + has_axes <- split(has_axes, table$layout[[pos]][axes]) + has_axes <- vapply(has_axes, sum, numeric(1)) > 0 + padding <- rep(padding, length(has_axes)) + padding[inside | !has_axes] <- unit(0, "cm") + table <- weave(table, , shift, padding + spacing) table }, diff --git a/R/theme-defaults.R b/R/theme-defaults.R index 6ecd6d68c0..2a1a82a4b4 100644 --- a/R/theme-defaults.R +++ b/R/theme-defaults.R @@ -217,6 +217,7 @@ theme_grey <- function(base_size = 11, base_family = "", strip.placement = "inside", strip.placement.x = NULL, strip.placement.y = NULL, + strip.spacing = rel(0), strip.switch.pad.grid = unit(half_line / 2, "pt"), strip.switch.pad.wrap = unit(half_line / 2, "pt"), @@ -518,6 +519,7 @@ theme_void <- function(base_size = 11, base_family = "", hjust = 0.5, vjust = 0.5 ), plot.tag.position = 'topleft', + strip.spacing = rel(0), complete = TRUE ) @@ -635,6 +637,7 @@ theme_test <- function(base_size = 11, base_family = "", strip.placement.y = NULL, strip.switch.pad.grid = rel(0.5), strip.switch.pad.wrap = rel(0.5), + strip.spacing = rel(0), plot.background = element_rect(colour = "white"), plot.title = element_text( diff --git a/R/theme-elements.R b/R/theme-elements.R index bf3c693f3b..0d39b947fd 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -594,6 +594,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { strip.placement = el_def("character"), strip.placement.x = el_def("character", "strip.placement"), strip.placement.y = el_def("character", "strip.placement"), + strip.spacing = el_def(c("unit", "rel"), "spacing"), strip.switch.pad.grid = el_def(c("unit", "rel"), "spacing"), strip.switch.pad.wrap = el_def(c("unit", "rel"), "spacing"), diff --git a/R/theme.R b/R/theme.R index 7e8a794a11..7a7608f183 100644 --- a/R/theme.R +++ b/R/theme.R @@ -196,6 +196,8 @@ #' the position-dependent elements rather than to the parent elements #' @param strip.switch.pad.grid,strip.switch.pad.wrap space between strips and #' axes when strips are switched (`unit`); inherits from `spacing`. +#' @param strip.spacing Spacing in between panels and strips (`unit`); +#' inherits from `spacing`. #' #' @param ... additional element specifications not part of base ggplot2. In general, #' these should also be defined in the `element tree` argument. [Splicing][rlang::splice] a list is also supported. @@ -449,6 +451,7 @@ theme <- function(..., strip.text.y.right, strip.switch.pad.grid, strip.switch.pad.wrap, + strip.spacing, complete = FALSE, validate = TRUE) { elements <- find_args(..., complete = NULL, validate = NULL) diff --git a/man/theme.Rd b/man/theme.Rd index 1f12df3ba9..cdc5e650af 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -144,6 +144,7 @@ theme( strip.text.y.right, strip.switch.pad.grid, strip.switch.pad.wrap, + strip.spacing, complete = FALSE, validate = TRUE ) @@ -369,6 +370,9 @@ the position-dependent elements rather than to the parent elements} \item{strip.switch.pad.grid, strip.switch.pad.wrap}{space between strips and axes when strips are switched (\code{unit}); inherits from \code{spacing}.} +\item{strip.spacing}{Spacing in between panels and strips (\code{unit}); +inherits from \code{spacing}.} + \item{complete}{set this to \code{TRUE} if this is a complete theme, such as the one returned by \code{\link[=theme_grey]{theme_grey()}}. Complete themes behave differently when added to a ggplot object. Also, when setting diff --git a/tests/testthat/test-facet-strips.R b/tests/testthat/test-facet-strips.R index ece67935a4..1f820b974f 100644 --- a/tests/testthat/test-facet-strips.R +++ b/tests/testthat/test-facet-strips.R @@ -33,9 +33,9 @@ test_that("facet_wrap() switches to 'bottom'", { wrap_b <- p + facet_wrap(~cyl, strip.position = "bottom") wrap_b_expected <- list( - t = c(4, 4, 4), + t = c(5, 5, 5), l = c(3, 7, 11), - b = c(4, 4, 4), + b = c(5, 5, 5), r = c(3, 7, 11) ) @@ -47,9 +47,9 @@ test_that("facet_wrap() switches to 'left'", { wrap_l_expected <- list( t = c(3, 3, 3), - l = c(13, 8, 3), + l = c(15, 9, 3), b = c(3, 3, 3), - r = c(13, 8, 3) + r = c(15, 9, 3) ) expect_equal(strip_layout(wrap_l), wrap_l_expected) @@ -60,9 +60,9 @@ test_that("facet_wrap() switches to 'right'", { wrap_r_expected <- list( t = c(3, 3, 3), - l = c(14, 9, 4), + l = c(17, 11, 5), b = c(3, 3, 3), - r = c(14, 9, 4) + r = c(17, 11, 5) ) expect_equal(strip_layout(wrap_r), wrap_r_expected) @@ -85,10 +85,10 @@ test_that("facet_grid() switches to 'x'", { grid_x <- p + facet_grid(am ~ cyl, switch = "x") grid_x_expected <- list( - t = c(6, 6, 6, 3, 5), - l = c(3, 5, 7, 8, 8), - b = c(6, 6, 6, 3, 5), - r = c(3, 5, 7, 8, 8) + t = c(7, 7, 7, 3, 5), + l = c(3, 5, 7, 9, 9), + b = c(7, 7, 7, 3, 5), + r = c(3, 5, 7, 9, 9) ) expect_equal(strip_layout(grid_x), grid_x_expected) @@ -98,10 +98,10 @@ test_that("facet_grid() switches to 'y'", { grid_y <- p + facet_grid(am ~ cyl, switch = "y") grid_y_expected <- list( - t = c(3, 3, 3, 4, 6), - l = c(4, 6, 8, 3, 3), - b = c(3, 3, 3, 4, 6), - r = c(4, 6, 8, 3, 3) + t = c(3, 3, 3, 5, 7), + l = c(5, 7, 9, 3, 3), + b = c(3, 3, 3, 5, 7), + r = c(5, 7, 9, 3, 3) ) expect_equal(strip_layout(grid_y), grid_y_expected) @@ -111,10 +111,10 @@ test_that("facet_grid() switches to both 'x' and 'y'", { grid_xy <- p + facet_grid(am ~ cyl, switch = "both") grid_xy_expected <- list( - t = c(6, 6, 6, 3, 5), - l = c(4, 6, 8, 3, 3), - b = c(6, 6, 6, 3, 5), - r = c(4, 6, 8, 3, 3) + t = c(7, 7, 7, 3, 5), + l = c(5, 7, 9, 3, 3), + b = c(7, 7, 7, 3, 5), + r = c(5, 7, 9, 3, 3) ) expect_equal(strip_layout(grid_xy), grid_xy_expected) @@ -143,8 +143,8 @@ test_that("padding is only added if axis is present", { strip.switch.pad.grid = unit(10, "mm") ) pg <- ggplotGrob(p) - expect_equal(length(pg$heights), 19) - expect_equal(length(pg$widths), 18) + expect_equal(length(pg$heights), 20) + expect_equal(length(pg$widths), 19) pg <- ggplotGrob( p + scale_x_continuous(position = "top") + @@ -181,8 +181,8 @@ test_that("padding is only added if axis is present", { p + scale_x_continuous(position = "top") + scale_y_continuous(position = "right") ) - expect_equal(length(pg$heights), 19) - expect_equal(length(pg$widths), 18) + expect_equal(length(pg$heights), 20) + expect_equal(length(pg$widths), 19) }) test_that("y strip labels are rotated when strips are switched", {