add option align_axis_title

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)

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.

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

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,

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
   )
 }