Add strip.spacing theme element

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).

R/facet-grid-.R

@@ -390,23 +390,24 @@ 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")
     inside_x <- (calc_element("strip.placement.x", theme) %||% "inside") == "inside"
     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

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
   },

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(

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"),
 

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)

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", {