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

* add space argument

* add test

* document

* add news bullet

* accept new snapshot

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,

tests/testthat/_snaps/facet-layout.md

@@ -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/test-facet-layout.R

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