diff --git a/NAMESPACE b/NAMESPACE index 41f3d3c..a6556cc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -124,6 +124,7 @@ importFrom(grid,gTree) importFrom(grid,grid.draw) importFrom(grid,grid.newpage) importFrom(grid,grobHeight) +importFrom(grid,grobWidth) importFrom(grid,heightDetails) importFrom(grid,is.grob) importFrom(grid,is.unit) @@ -141,6 +142,7 @@ importFrom(gtable,gtable) importFrom(gtable,gtable_add_cols) importFrom(gtable,gtable_add_grob) importFrom(gtable,gtable_add_rows) +importFrom(gtable,gtable_filter) importFrom(gtable,gtable_height) importFrom(gtable,gtable_width) importFrom(gtable,is.gtable) diff --git a/R/collect_axes.R b/R/collect_axes.R index 1bdba58..010b609 100644 --- a/R/collect_axes.R +++ b/R/collect_axes.R @@ -133,6 +133,110 @@ collect_axes <- function(gt, dir = "x") { new } +#' @importFrom ggplot2 zeroGrob +#' @importFrom gtable is.gtable gtable_height gtable_width gtable_filter gtable_add_grob +#' @importFrom grid grobHeight grobWidth +collapse_axes_and_titles <- function(gt, n, collapsed_positions) { + for (i in seq_len(n)) { + for (position in collapsed_positions) { + lab_pattern <- switch(position, + t = , + b = paste("xlab", position, i, sep = "-"), + l = , + r = paste("ylab", position, i, sep = "-") + ) + lab_pattern <- paste0("^", lab_pattern, "$") + axis_pattern <- paste0( + "^axis-", position, "(-\\d+){0,2}", + "(, axis-", position, "(-\\d+){0,2})*", # recycle multiple panels + "-", i, "$" + ) + + # this grob contain both axis labels and axis title + axis_and_title <- gtable_filter( + gt, paste(lab_pattern, axis_pattern, sep = "|") + ) + + # both axis labels and title must exist + if (length(axis_and_title) != 2L) next + + # integrate axis and lab grobs ------------------------------ + grobs <- .subset2(axis_and_title, "grobs") + layout <- .subset2(gt, "layout") + lab_index <- which(grepl(lab_pattern, .subset2(layout, "name"))) + axis_index <- which(grepl(axis_pattern, .subset2(layout, "name"))) + + ## we reset the axis labels grob size ----------------------- + if (position == "t") { + axis_and_title$heights <- do.call( + unit.c, lapply(grobs, function(grob) { + if (is.gtable(grob)) gtable_height(grob) else grobHeight(grob) + }) + ) + axis_and_title$vp <- viewport( + y = unit(0, "npc"), just = "bottom", + height = sum(axis_and_title$heights) + ) + } + if (position == "b") { + axis_and_title$heights <- do.call( + unit.c, lapply(grobs, function(grob) { + if (is.gtable(grob)) gtable_height(grob) else grobHeight(grob) + }) + ) + axis_and_title$vp <- viewport( + y = unit(1, "npc"), just = "top", + height = sum(axis_and_title$heights) + ) + } + if (position == "l") { + axis_and_title$widths <- do.call( + unit.c, lapply(grobs, function(grob) { + if (is.gtable(grob)) gtable_width(grob) else grobWidth(grob) + }) + ) + axis_and_title$vp <- viewport( + x = unit(1, "npc"), just = "right", + width = sum(axis_and_title$widths) + ) + } + if (position == "r") { + axis_and_title$widths <- do.call( + unit.c, lapply(grobs, function(grob) { + if (is.gtable(grob)) gtable_width(grob) else grobWidth(grob) + }) + ) + axis_and_title$vp <- viewport( + x = unit(0, "npc"), just = "left", + width = sum(axis_and_title$widths) + ) + } + # remove the original grobs ----------------------------- + gt$grobs[[axis_index]] <- zeroGrob() + gt$grobs[[lab_index]] <- zeroGrob() + + # insert the collapsed axis title and labs -------------- + new_area <- layout[axis_index, , drop = FALSE] + gt <- gtable_add_grob( + gt, + grobs = axis_and_title, + .subset2(new_area, "t"), + .subset2(new_area, "l"), + .subset2(new_area, "b"), + .subset2(new_area, "r"), + name = switch(position, + t = , + b = paste("xlab", "axis", position, i, sep = "-"), + l = , + r = paste("ylab", "axis", position, i, sep = "-") + ), + clip = "off" + ) + } + } + gt +} + # For every given row, check if all non-zero grobs occupying that row have a # name that has a pattern. If all these grobs in that row do, measure the # grob heights and put that into the gtable's heights. diff --git a/R/plot_layout.R b/R/plot_layout.R index 02cc56b..07b842a 100644 --- a/R/plot_layout.R +++ b/R/plot_layout.R @@ -27,6 +27,9 @@ #' @param design Specification of the location of areas in the layout. Can either #' be specified as a text string or by concatenating calls to [area()] together. #' See the examples for further information on use. +#' @param align_axis_title A boolean value or a character of the axis position +#' ("t", "l", "b", "r") indicates how to align the axis title. By default, all +#' axis title will be aligned. #' @param axes A string specifying how axes should be treated. `'keep'` will #' retain all axes in individual plots. `'collect'` will remove duplicated #' axes when placed in the same run of rows or columns of the layout. @@ -109,7 +112,8 @@ plot_layout <- function(ncol = NULL, nrow = NULL, byrow = NULL, widths = NULL, heights = NULL, guides = NULL, tag_level = NULL, - design = NULL, axes = NULL, axis_titles = axes) { + design = NULL, align_axis_title = NULL, + axes = NULL, axis_titles = axes) { if (!is.null(guides)) guides <- match.arg(guides, c('auto', 'collect', 'keep')) if (!is.null(tag_level)) tag_level <- match.arg(tag_level, c('keep', 'new')) if (!is.null(axes)) axes <- match.arg( @@ -118,6 +122,16 @@ plot_layout <- function(ncol = NULL, nrow = NULL, byrow = NULL, widths = NULL, if (!is.null(axis_titles)) collect_titles <- match.arg( axis_titles, c('keep', 'collect', 'collect_x', 'collect_y') ) + # By default, we always align the axis titles + if (isTRUE(align_axis_title) || is.null(align_axis_title)) { + align_axis_title <- NULL + } else if (isFALSE(align_axis_title)) { + align_axis_title <- character() + } else if (!all(align_axis_title %in% c("t", "l", "b", "r"))) { + cli_abort( + "only 't', 'l', 'b', and 'r' are allowed in {.arg align_axis_title}" + ) + } structure(list( ncol = ncol, nrow = nrow, @@ -126,6 +140,7 @@ plot_layout <- function(ncol = NULL, nrow = NULL, byrow = NULL, widths = NULL, heights = heights, guides = guides, tag_level = tag_level, + align_axis_title = align_axis_title, axes = axes, axis_titles = axis_titles, design = as_areas(design) @@ -305,7 +320,7 @@ c.patch_area <- function(..., recursive = FALSE) { } default_layout <- plot_layout( byrow = TRUE, widths = NA, heights = NA, guides = 'auto', tag_level = 'keep', - axes = 'keep', axis_titles = 'keep' + align_axis_title = c("t", "l", "b", "r"), axes = 'keep', axis_titles = 'keep' ) #' @importFrom utils modifyList #' @export diff --git a/R/plot_patchwork.R b/R/plot_patchwork.R index 87ede53..6fe6259 100644 --- a/R/plot_patchwork.R +++ b/R/plot_patchwork.R @@ -241,6 +241,15 @@ build_patchwork <- function(x, guides = 'auto') { gt_new <- collect_axis_titles(gt_new, "y", merge = TRUE) } + # the default behaviour is aligning all axis, if we don't want to align an + # axis we collapsed it + collapsed_positions <- setdiff( + c("t", "l", "b", "r"), + x$layout$align_axis_title + ) + if (length(collapsed_positions)) { + gt_new <- collapse_axes_and_titles(gt_new, length(gt), collapsed_positions) + } gt_new <- gtable_add_grob( gt_new, zeroGrob(), t = PANEL_ROW, diff --git a/R/wrap_plots.R b/R/wrap_plots.R index 8401e20..d143277 100644 --- a/R/wrap_plots.R +++ b/R/wrap_plots.R @@ -46,7 +46,8 @@ #' wrap_plots <- function(..., ncol = NULL, nrow = NULL, byrow = NULL, widths = NULL, heights = NULL, guides = NULL, - tag_level = NULL, design = NULL, axes = NULL, + tag_level = NULL, design = NULL, + align_axis_title = NULL, axes = NULL, axis_titles = axes) { if (is_valid_plot(..1)) { plots <- list(...) @@ -69,8 +70,8 @@ wrap_plots <- function(..., ncol = NULL, nrow = NULL, byrow = NULL, } Reduce(`+`, plots, init = plot_filler()) + plot_layout( ncol = ncol, nrow = nrow, byrow = byrow, widths = widths, heights = heights, - guides = guides, tag_level = tag_level, design = design, axes = axes, - axis_titles = axis_titles + guides = guides, tag_level = tag_level, design = design, + align_axis_title = align_axis_title, axes = axes, axis_titles = axis_titles ) } diff --git a/man/plot_layout.Rd b/man/plot_layout.Rd index 894e479..e278f80 100644 --- a/man/plot_layout.Rd +++ b/man/plot_layout.Rd @@ -13,6 +13,7 @@ plot_layout( guides = NULL, tag_level = NULL, design = NULL, + align_axis_title = NULL, axes = NULL, axis_titles = axes ) @@ -47,6 +48,10 @@ auto-tagging should behave. See \code{\link[=plot_annotation]{plot_annotation()} be specified as a text string or by concatenating calls to \code{\link[=area]{area()}} together. See the examples for further information on use.} +\item{align_axis_title}{A boolean value or a character of the axis position +("t", "l", "b", "r") indicates how to align the axis title. By default, all +axis title will be aligned.} + \item{axes}{A string specifying how axes should be treated. \code{'keep'} will retain all axes in individual plots. \code{'collect'} will remove duplicated axes when placed in the same run of rows or columns of the layout. diff --git a/man/wrap_plots.Rd b/man/wrap_plots.Rd index 3b011e3..05eaa47 100644 --- a/man/wrap_plots.Rd +++ b/man/wrap_plots.Rd @@ -14,6 +14,7 @@ wrap_plots( guides = NULL, tag_level = NULL, design = NULL, + align_axis_title = NULL, axes = NULL, axis_titles = axes ) @@ -50,6 +51,10 @@ auto-tagging should behave. See \code{\link[=plot_annotation]{plot_annotation()} be specified as a text string or by concatenating calls to \code{\link[=area]{area()}} together. See the examples for further information on use.} +\item{align_axis_title}{A boolean value or a character of the axis position +("t", "l", "b", "r") indicates how to align the axis title. By default, all +axis title will be aligned.} + \item{axes}{A string specifying how axes should be treated. \code{'keep'} will retain all axes in individual plots. \code{'collect'} will remove duplicated axes when placed in the same run of rows or columns of the layout.