Setting panel sizes in theme() (#6094)

* add panel.widths/panel.heights theme elements

* add `set_panel_size()` method to layout

* add test

* document

* add aspect ratio warning

* turn off respect

* `set_panel_size()` is a Facet method

Author: teunbrand

NEWS.md

@@ -238,6 +238,7 @@
   (@teunbrand, #4722, #6069).
 * `geom_abline()` clips to the panel range in the vertical direction too
   (@teunbrand, #6086).
+* Added `panel.widths` and `panel.heights` to `theme()` (#5338, @teunbrand).
 
 # ggplot2 3.5.1
 

R/facet-.R

@@ -263,6 +263,53 @@ Facet <- ggproto("Facet", NULL,
   },
   format_strip_labels = function(layout, params) {
     return()
+  },
+  set_panel_size = function(table, theme) {
+
+    new_widths  <- calc_element("panel.widths",  theme)
+    new_heights <- calc_element("panel.heights", theme)
+
+    if (is.null(new_widths) && is.null(new_heights)) {
+      return(table)
+    }
+
+    if (isTRUE(table$respect)) {
+      args <- !c(is.null(new_widths), is.null(new_heights))
+      args <- c("panel.widths", "panel.heights")[args]
+      cli::cli_warn(
+        "Aspect ratios are overruled by {.arg {args}} theme element{?s}."
+      )
+      table$respect <- FALSE
+    }
+
+    rows <- panel_rows(table)
+    cols <- panel_cols(table)
+
+    if (length(new_widths) == 1L && nrow(cols) > 1L) {
+      # Get total size of non-panel widths in between panels
+      extra <- setdiff(seq(min(cols$l), max(cols$r)), union(cols$l, cols$r))
+      extra <- unit(sum(width_cm(table$widths[extra])), "cm")
+      # Distribute width proportionally
+      relative   <- as.numeric(table$widths[cols$l]) # assumed to be simple units
+      new_widths <- (new_widths - extra) * (relative / sum(relative))
+    }
+    if (!is.null(new_widths)) {
+      table$widths[cols$l] <- rep(new_widths, length.out = nrow(cols))
+    }
+
+    if (length(new_heights) == 1L && nrow(rows) > 1L) {
+      # Get total size of non-panel heights in between panels
+      extra <- setdiff(seq(min(rows$t), max(rows$t)), union(rows$t, rows$b))
+      extra <- unit(sum(height_cm(table$heights[extra])), "cm")
+      # Distribute height proportionally
+      relative    <- as.numeric(table$heights[rows$t]) # assumed to be simple units
+      new_heights <- (new_heights - extra) * (relative / sum(relative))
+    }
+    if (!is.null(new_heights)) {
+      table$heights[rows$t] <- rep(new_heights, length.out = nrow(rows))
+    }
+
+    table
   }
 )
 

R/layout.R

@@ -94,6 +94,7 @@ Layout <- ggproto("Layout", NULL,
       theme,
       self$facet_params
     )
+    plot_table <- self$facet$set_panel_size(plot_table, theme)
 
     # Draw individual labels, then add to gtable
     labels <- self$coord$labels(
@@ -300,7 +301,6 @@ Layout <- ggproto("Layout", NULL,
   }
 )
 
-
 # Helpers -----------------------------------------------------------------
 
 # Function for applying scale method to multiple variables in a given

R/theme-elements.R

@@ -639,6 +639,8 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
   panel.grid.minor.x  = el_def("element_line", "panel.grid.minor"),
   panel.grid.minor.y  = el_def("element_line", "panel.grid.minor"),
   panel.ontop         = el_def("logical"),
+  panel.widths        = el_def("unit"),
+  panel.heights       = el_def("unit"),
 
   strip.background    = el_def("element_rect", "rect"),
   strip.background.x  = el_def("element_rect", "strip.background"),

R/theme.R

@@ -143,6 +143,9 @@
 #'   and x axis grid lines are vertical. `panel.grid.*.*` inherits from
 #'   `panel.grid.*` which inherits from `panel.grid`, which in turn inherits
 #'   from `line`
+#' @param panel.widths,panel.heights Sizes for panels (`units`). Can be a
+#'   single unit to set the total size for the panel area, or a unit vector to
+#'   set the size of individual panels.
 #' @param panel.ontop option to place the panel (background, gridlines) over
 #'   the data layers (`logical`). Usually used with a transparent or blank
 #'   `panel.background`.
@@ -427,6 +430,8 @@ theme <- function(...,
                   panel.grid.minor.x,
                   panel.grid.minor.y,
                   panel.ontop,
+                  panel.widths,
+                  panel.heights,
                   plot.background,
                   plot.title,
                   plot.title.position,

man/theme.Rd

@@ -617,6 +617,47 @@ test_that("complete_theme completes a theme", {
   reset_theme_settings()
 })
 
+test_that("panel.widths and panel.heights works with free-space panels", {
+
+  df <- data.frame(x = c(1, 1, 2, 1, 3), g = c("A", "B", "B", "C", "C"))
+
+  p <- ggplotGrob(
+    ggplot(df, aes(x, x)) +
+      geom_point() +
+      scale_x_continuous(expand = expansion(add = 1)) +
+      facet_grid(~ g, scales = "free_x", space = "free_x") +
+      theme(
+        panel.widths = unit(11, "cm"),
+        panel.spacing.x = unit(1, "cm")
+      )
+  )
+
+  idx <- range(panel_cols(p)$l)
+  expect_equal(as.numeric(p$widths[seq(idx[1], idx[2])]), c(2, 1, 3, 1, 4))
+
+  p <- ggplotGrob(
+    ggplot(df, aes(x, x)) +
+      geom_point() +
+      scale_y_continuous(expand = expansion(add = 1)) +
+      facet_grid(g ~ ., scales = "free_y", space = "free_y") +
+      theme(
+        panel.heights = unit(11, "cm"),
+        panel.spacing.y = unit(1, "cm")
+      )
+  )
+
+  idx <- range(panel_rows(p)$t)
+  expect_equal(as.numeric(p$heights[seq(idx[1], idx[2])]), c(2, 1, 3, 1, 4))
+
+})
+
+test_that("panel.widths and panel.heights appropriately warn about aspect override", {
+  p <- ggplot(mpg, aes(displ, hwy)) +
+    geom_point() +
+    theme(aspect.ratio = 1, panel.widths = unit(4, "cm"))
+  expect_warning(ggplotGrob(p), "Aspect ratios are overruled")
+})
+
 test_that("margin_part() mechanics work as expected", {
 
   t <- theme_gray() +
@@ -630,7 +671,6 @@ test_that("margin_part() mechanics work as expected", {
 
   test <- calc_element("plot.margin", t)
   expect_equal(as.numeric(test), c(5.5, 5.5, 11, 5.5))
-
 })
 
 # Visual tests ------------------------------------------------------------