diff --git a/NEWS.md b/NEWS.md index 8214635e8c..ad0681b632 100644 --- a/NEWS.md +++ b/NEWS.md @@ -237,6 +237,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 diff --git a/R/facet-.R b/R/facet-.R index def19f221a..b124b54872 100644 --- a/R/facet-.R +++ b/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 } ) diff --git a/R/layout.R b/R/layout.R index 5954031d20..d3cad0ffeb 100644 --- a/R/layout.R +++ b/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 diff --git a/R/theme-elements.R b/R/theme-elements.R index b1cb67b046..947e4e0af3 100644 --- a/R/theme-elements.R +++ b/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"), diff --git a/R/theme.R b/R/theme.R index 04ab2edf98..2ebd892f62 100644 --- a/R/theme.R +++ b/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, diff --git a/man/theme.Rd b/man/theme.Rd index 869e45ea71..d28c10b149 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -121,6 +121,8 @@ theme( panel.grid.minor.x, panel.grid.minor.y, panel.ontop, + panel.widths, + panel.heights, plot.background, plot.title, plot.title.position, @@ -311,6 +313,10 @@ from \code{line}} the data layers (\code{logical}). Usually used with a transparent or blank \code{panel.background}.} +\item{panel.widths, panel.heights}{Sizes for panels (\code{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.} + \item{plot.background}{background of the entire plot (\code{\link[=element_rect]{element_rect()}}; inherits from \code{rect})} diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index a1b656dbab..ef358b10b6 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -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 ------------------------------------------------------------