Variable panel size (space) for facet_wrap() (#5956)

* add space argument

* add test

* document

* add news bullet

* accept new snapshot

Author: teunbrand

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* `facet_wrap()` can have `space = "free_x"` with 1-row layouts and 
+  `space = "free_y"` with 1-column layouts (@teunbrand)
 * Secondary axes respect `n.breaks` setting in continuous scales (@teunbrand, #4483).
 * Layers can have names (@teunbrand, #4066).
 * (internal) improvements to `pal_qualitative()` (@teunbrand, #5013)

R/facet-wrap.R

@@ -18,6 +18,12 @@ NULL
 #' @param scales Should scales be fixed (`"fixed"`, the default),
 #'   free (`"free"`), or free in one dimension (`"free_x"`,
 #'   `"free_y"`)?
+#' @param space If `"fixed"` (default), all panels have the same size and
+#'   the number of rows and columns in the layout can be arbitrary. If
+#'   `"free_x"`, panels have widths proportional to the length of the x-scale,
+#'   but the layout is constrained to one row. If `"free_y"`, panels have
+#'   heights proportional to the length of the y-scale, but the layout is
+#'   constrained to one column.
 #' @param strip.position By default, the labels are displayed on the top of
 #'   the plot. Using `strip.position` it is possible to place the labels on
 #'   either of the four sides by setting \code{strip.position = c("top",
@@ -109,9 +115,9 @@ NULL
 #'   geom_point() +
 #'   facet_wrap(vars(class), dir = "tr")
 facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
-                       shrink = TRUE, labeller = "label_value", as.table = TRUE,
-                       switch = deprecated(), drop = TRUE, dir = "h",
-                       strip.position = 'top', axes = "margins",
+                       space = "fixed", shrink = TRUE, labeller = "label_value",
+                       as.table = TRUE, switch = deprecated(), drop = TRUE,
+                       dir = "h", strip.position = 'top', axes = "margins",
                        axis.labels = "all") {
   scales <- arg_match0(scales %||% "fixed", c("fixed", "free_x", "free_y", "free"))
   dir <- arg_match0(dir, c("h", "v", "lt", "tl", "lb", "bl", "rt", "tr", "rb", "br"))
@@ -128,6 +134,30 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
     y = any(scales %in% c("free_y", "free"))
   )
 
+  # We cannot have free space in both directions
+  space <- arg_match0(space, c("free_x", "free_y", "fixed"))
+  space_free <- list(x = space == "free_x", y = space == "free_y")
+  if (space_free$x) {
+    if ((nrow %||% 1) != 1 || !is.null(ncol)) {
+      cli::cli_warn(
+        "Cannot use {.code space = \"free_x\"} with custom \\
+        {.arg nrow} or {.arg ncol}."
+      )
+    }
+    ncol <- NULL
+    nrow <- 1L
+  }
+  if (space_free$y) {
+    if ((ncol %||% 1) != 1 || !is.null(nrow)) {
+      cli::cli_warn(
+        "Cannot use {.code space= \"free_y\"} with custom \\
+        {.arg nrow} or {.arg ncol}."
+      )
+    }
+    ncol <- 1L
+    nrow <- NULL
+  }
+
   # If scales are free, always draw the axes
   draw_axes <- arg_match0(axes, c("margins", "all_x", "all_y", "all"))
   draw_axes <- list(
@@ -174,6 +204,7 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
       drop = drop,
       ncol = ncol,
       nrow = nrow,
+      space_free = space_free,
       labeller = labeller,
       dir = dir,
       draw_axes = draw_axes,

man/facet_wrap.Rd

@@ -22,6 +22,10 @@
 
     `nrow` must be a whole number or `NULL`, not the number 1.5.
 
+---
+
+    Cannot use `space = "free_x"` with custom `nrow` or `ncol`.
+
 ---
 
     Need 3 panels, but together `nrow` and `ncol` only provide 1.

tests/testthat/_snaps/facet-layout.md

@@ -172,6 +172,25 @@ test_that("grid: drop = FALSE preserves unused levels", {
   expect_equal(as.character(grid_ab$b), as.character(rep(4:1, 4)))
 })
 
+test_that("wrap: space = 'free_x/y' sets panel sizes", {
+
+  df <- data.frame(x = 1:3)
+  p <- ggplot(df, aes(x, x)) +
+    geom_point() +
+    scale_x_continuous(limits = c(0, NA), expand = c(0, 0)) +
+    scale_y_continuous(limits = c(0, NA), expand = c(0, 0))
+
+  # Test free_x
+  gt <- ggplotGrob(p + facet_wrap(~x, scales = "free_x", space = "free_x"))
+  test <- gt$widths[panel_cols(gt)$l]
+  expect_equal(as.numeric(test), 1:3)
+
+  # Test free_y
+  gt <- ggplotGrob(p + facet_wrap(~x, scales = "free_y", space = "free_y"))
+  test <- gt$heights[panel_rows(gt)$t]
+  expect_equal(as.numeric(test), 1:3)
+})
+
 # Missing behaviour ----------------------------------------------------------
 
 a3 <- data_frame(
@@ -207,6 +226,8 @@ test_that("facet_wrap throws errors at bad layout specs", {
   expect_snapshot_error(facet_wrap(~test, nrow = -1))
   expect_snapshot_error(facet_wrap(~test, nrow = 1.5))
 
+  expect_snapshot_warning(facet_wrap(~test, nrow = 2, space = "free_x"))
+
   p <- ggplot(mtcars) +
     geom_point(aes(mpg, disp)) +
     facet_wrap(~gear, ncol = 1, nrow = 1)