From a0ce9b8a141416c7b45f49b93a25af48fb9bbeb6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 9 Sep 2024 19:32:40 +0200 Subject: [PATCH 1/7] add panel.widths/panel.heights theme elements --- R/theme-elements.R | 2 ++ R/theme.R | 2 ++ 2 files changed, 4 insertions(+) diff --git a/R/theme-elements.R b/R/theme-elements.R index 747bb0cf78..f776204fcc 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -634,6 +634,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 43c379f9b6..d2da1f82af 100644 --- a/R/theme.R +++ b/R/theme.R @@ -427,6 +427,8 @@ theme <- function(..., panel.grid.minor.x, panel.grid.minor.y, panel.ontop, + panel.widths, + panel.heights, plot.background, plot.title, plot.title.position, From c03f1980649d232c95dfe4773b0631592eb59e4d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 9 Sep 2024 19:33:00 +0200 Subject: [PATCH 2/7] add `set_panel_size()` method to layout --- R/layout.R | 41 ++++++++++++++++++++++++++++++++++++++++- 1 file changed, 40 insertions(+), 1 deletion(-) diff --git a/R/layout.R b/R/layout.R index 1b578111b2..ea742ccb6c 100644 --- a/R/layout.R +++ b/R/layout.R @@ -94,6 +94,7 @@ Layout <- ggproto("Layout", NULL, theme, self$facet_params ) + plot_table <- self$set_panel_size(plot_table, theme) # Draw individual labels, then add to gtable labels <- self$coord$labels( @@ -297,10 +298,48 @@ Layout <- ggproto("Layout", NULL, }) names(label_grobs) <- names(labels) label_grobs + }, + + 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) + } + + 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 } ) - # Helpers ----------------------------------------------------------------- # Function for applying scale method to multiple variables in a given From aaf3b4e5ea721aba56358abcb6b0fcb23d9ae68d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 9 Sep 2024 19:33:35 +0200 Subject: [PATCH 3/7] add test --- tests/testthat/test-theme.R | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 9c10202504..19eebcc18d 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -616,6 +616,40 @@ 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)) + +}) + # Visual tests ------------------------------------------------------------ test_that("aspect ratio is honored", { From ea8d2bff0169f78dc0d9b029c05d53be278de179 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 9 Sep 2024 19:37:45 +0200 Subject: [PATCH 4/7] document --- NEWS.md | 1 + R/theme.R | 3 +++ man/theme.Rd | 6 ++++++ 3 files changed, 10 insertions(+) diff --git a/NEWS.md b/NEWS.md index 40bdb3d156..2a335faff4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* Added `panel.widths` and `panel.heights` to `theme()` (#5338, @teunbrand). * `guide_bins()`, `guide_colourbar()` and `guide_coloursteps()` gain an `angle` argument to overrule theme settings, similar to `guide_axis(angle)` (@teunbrand, #4594). diff --git a/R/theme.R b/R/theme.R index d2da1f82af..d1f3082635 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`. diff --git a/man/theme.Rd b/man/theme.Rd index 829254ecdf..e560a465ab 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})} From 66e37cb92d44a0be4b55aceaf26199b461371a90 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 10 Sep 2024 13:21:51 +0200 Subject: [PATCH 5/7] add aspect ratio warning --- R/layout.R | 8 ++++++++ tests/testthat/test-theme.R | 7 +++++++ 2 files changed, 15 insertions(+) diff --git a/R/layout.R b/R/layout.R index ea742ccb6c..15a34509dd 100644 --- a/R/layout.R +++ b/R/layout.R @@ -309,6 +309,14 @@ Layout <- ggproto("Layout", NULL, 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}." + ) + } + rows <- panel_rows(table) cols <- panel_cols(table) diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 19eebcc18d..0055e66ef1 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -650,6 +650,13 @@ test_that("panel.widths and panel.heights works with free-space panels", { }) +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") +}) + # Visual tests ------------------------------------------------------------ test_that("aspect ratio is honored", { From ac14e3b1a60af3c8603cadb1e381191fde8d3969 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 10 Sep 2024 15:04:03 +0200 Subject: [PATCH 6/7] turn off respect --- R/layout.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/layout.R b/R/layout.R index 15a34509dd..f8e4820502 100644 --- a/R/layout.R +++ b/R/layout.R @@ -315,6 +315,7 @@ Layout <- ggproto("Layout", NULL, cli::cli_warn( "Aspect ratios are overruled by {.arg {args}} theme element{?s}." ) + table$respect <- FALSE } rows <- panel_rows(table) From fd75e538ed6f63615dd3b848372534778353313d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Dec 2024 11:10:01 +0100 Subject: [PATCH 7/7] `set_panel_size()` is a Facet method --- R/facet-.R | 47 +++++++++++++++++++++++++++++++++++++++++++++++ R/layout.R | 50 +------------------------------------------------- 2 files changed, 48 insertions(+), 49 deletions(-) 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 0dd99526f0..3ed27e9ca4 100644 --- a/R/layout.R +++ b/R/layout.R @@ -94,7 +94,7 @@ Layout <- ggproto("Layout", NULL, theme, self$facet_params ) - plot_table <- self$set_panel_size(plot_table, theme) + plot_table <- self$facet$set_panel_size(plot_table, theme) # Draw individual labels, then add to gtable labels <- self$coord$labels( @@ -298,54 +298,6 @@ Layout <- ggproto("Layout", NULL, }) names(label_grobs) <- names(labels) label_grobs - }, - - 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 } )