feat: even more arguments available when using wrap_plot_list

This commit is contained in:
Andreas Gammelgaard Damsbo 2025-08-08 11:47:30 +02:00
parent d700658f5c
commit 46db0bd5e4
No known key found for this signature in database

View file

@ -738,7 +738,10 @@ line_break <- function(data, lineLength = 20, force = FALSE) {
#' @param data list of ggplot2 objects #' @param data list of ggplot2 objects
#' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL #' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL
#' @param title panel title #' @param title panel title
#' @param ... ignored for argument overflow #' @param guides passed to patchwork::wrap_plots()
#' @param axes passed to patchwork::wrap_plots()
#' @param axis_titles passed to patchwork::wrap_plots()
#' @param ... passed to patchwork::wrap_plots()
#' #'
#' @returns list of ggplot2 objects #' @returns list of ggplot2 objects
#' @export #' @export
@ -747,6 +750,9 @@ wrap_plot_list <- function(data,
tag_levels = NULL, tag_levels = NULL,
title = NULL, title = NULL,
axis.font.family = NULL, axis.font.family = NULL,
guides = "collect",
axes = "collect",
axis_titles = "collect",
...) { ...) {
if (ggplot2::is_ggplot(data[[1]])) { if (ggplot2::is_ggplot(data[[1]])) {
if (length(data) > 1) { if (length(data) > 1) {
@ -762,9 +768,9 @@ wrap_plot_list <- function(data,
})() |> })() |>
align_axes() |> align_axes() |>
patchwork::wrap_plots( patchwork::wrap_plots(
guides = "collect", guides = guides,
axes = "collect", axes = axes,
axis_titles = "collect", axis_titles = axis_titles,
... ...
) )
if (!is.null(tag_levels)) { if (!is.null(tag_levels)) {
@ -784,13 +790,17 @@ wrap_plot_list <- function(data,
cli::cli_abort("Can only wrap lists of {.cls ggplot} objects") cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
} }
if (inherits(x = out, what = "patchwork")) { if (!is.null(axis.font.family)) {
out & if (inherits(x = out, what = "patchwork")) {
ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family)) out <- out &
} else { ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
out + } else {
ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family)) out <- out +
ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
}
} }
out
} }
@ -801,7 +811,7 @@ wrap_plot_list <- function(data,
#' @returns list of ggplot2 objects #' @returns list of ggplot2 objects
#' @export #' @export
#' #'
align_axes <- function(...,x.axis=TRUE,y.axis=TRUE) { align_axes <- function(..., x.axis = TRUE, y.axis = TRUE) {
# https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object # https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
# https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150 # https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
if (ggplot2::is_ggplot(..1)) { if (ggplot2::is_ggplot(..1)) {
@ -819,13 +829,12 @@ align_axes <- function(...,x.axis=TRUE,y.axis=TRUE) {
xr <- clean_common_axis(p, "x") xr <- clean_common_axis(p, "x")
suppressWarnings({ suppressWarnings({
p |> purrr::map(p, \(.x){
purrr::map(p, \(.x){
out <- .x out <- .x
if (isTRUE(x.axis)){ if (isTRUE(x.axis)) {
out <- out + ggplot2::xlim(xr) out <- out + ggplot2::xlim(xr)
} }
if (isTRUE(y.axis)){ if (isTRUE(y.axis)) {
out <- out + ggplot2::ylim(yr) out <- out + ggplot2::ylim(yr)
} }
out out