From 170a8e8255a94b55ea2a6d1dd2874282bf1b2379 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 26 Aug 2024 11:08:14 +0200 Subject: [PATCH] Fix #375 ignore empty areas when collecting titles --- NEWS.md | 39 +- R/collect_axes.R | 60 ++- ...oesn-t-interfere-with-title-collection.svg | 439 ++++++++++++++++++ .../multi-cell-title-and-axis-collection.svg | 4 +- tests/testthat/test-collect_axes.R | 13 + 5 files changed, 509 insertions(+), 46 deletions(-) create mode 100644 tests/testthat/_snaps/collect_axes/empty-areas-doesn-t-interfere-with-title-collection.svg diff --git a/NEWS.md b/NEWS.md index 1121c6c..466851e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,39 +1,40 @@ # patchwork (development version) * `free()` now better aligns plots in horizontal direction -* Plot backgrounds are now always placed beneath all other elements in the +* Plot backgrounds are now always placed beneath all other elements in the patchwork (#370) -* Axis titles can now reliably be collected even with faceted plots (#367 and +* Axis titles can now reliably be collected even with faceted plots (#367 and #369) * Native support for gt objects +* Empty patches no longer breaks up axis title collection (#375) # patchwork 1.2.0 * Axes and axis titles can now be collected using the `plot_layout()` function. - Collecting axes will remove duplicated axes in the x- or y-direction. - Collecting axis titles will also remove duplicated titles in the x- or + Collecting axes will remove duplicated axes in the x- or y-direction. + Collecting axis titles will also remove duplicated titles in the x- or y-direction, but also merge duplicated titles in the other direction (#150). * Fix a bug that prevented faceted plots with axes on the right from being used (#340) * Added `free()` function to mark a plot to not be aligned with the rest. The - margin of the plot will still be aligned with the margins of the other plots - but everything inside of that will by unaligned. + margin of the plot will still be aligned with the margins of the other plots + but everything inside of that will by unaligned. # patchwork 1.1.3 * `NULL` can now be used with the different arithmetic operators and will result in a non-operation (i.e. the non-null part will be returned unmodified) (#290) -* Fix a bug that prevented plots with multi-level strips from being merged +* Fix a bug that prevented plots with multi-level strips from being merged together (#277) -* Patchworks will now render correctly when unserialised in a fresh session, +* Patchworks will now render correctly when unserialised in a fresh session, providing the patchwork package is available (#242) -* Fixed a bug preventing faceted plots with strip placement outside the axis +* Fixed a bug preventing faceted plots with strip placement outside the axis from being aligned (#325) * Fixed a bug that let to inconsistent results when combining fixed aspect plots in different order (#274) -* Fixed a bug that prevented nested patchworks with empty columns or rows at the +* Fixed a bug that prevented nested patchworks with empty columns or rows at the bottom or to the right to be inserted into a layout (#273) -* Patchwork objects now behaves more correctly like an unnamed list of ggplots. +* Patchwork objects now behaves more correctly like an unnamed list of ggplots. This makes `View()` work on them (#317), and allow one to use `length()` to determine the number of patches in a patchwork (#293) * Expressions and calls can now be used as plot annotations in the same way as @@ -47,7 +48,7 @@ * Use vdiffr conditionally to pass test on M1 mac * Add `str()` method to patchwork objects (#217) -* Fix a bug in `inset_element()` when insetting plots with fixed dimensions +* Fix a bug in `inset_element()` when insetting plots with fixed dimensions (#214) * Make sure that `-`, `/`, and `|` works with all supported object types (#221) @@ -55,20 +56,20 @@ * Add `inset_element()` to allow adding plots as insets * patchwork now supports `raster` and `nativeRaster` objects -* Avoid incrementing tag counter when recursing into a nested plot without +* Avoid incrementing tag counter when recursing into a nested plot without additional tags to use (#147) -* Fix bug that prevented strips turned off with `element_blank()` from working +* Fix bug that prevented strips turned off with `element_blank()` from working (#200) -* Add option to supply a custom sequence of tags to use for auto-tagging (#211, +* Add option to supply a custom sequence of tags to use for auto-tagging (#211, #63) # patchwork 1.0.1 * Renaming of `align_plots()` to `align_patches()` to avoid namespace clash with cowplot (#130) -* Renaming of `as_grob()` (unexported) to `as_patch()` to avoid potential +* Renaming of `as_grob()` (unexported) to `as_patch()` to avoid potential future namespace clash with cowplot (#131) -* Fix bug in plot simplification with `theme(strip.placement = 'outside')` +* Fix bug in plot simplification with `theme(strip.placement = 'outside')` (#132) * Fix a bug in guide collection in R >= 4.0 due to the new unit implementation in grid (#170) @@ -76,7 +77,7 @@ (#137) * Fix a bug in base graphic support where the environment of the plot was not captured (#138) -* Fix a bug when combining plots having guides placed manually in combination +* Fix a bug when combining plots having guides placed manually in combination with faceting (#144) * Fix a bug where having negative margins around the legend would result in an unintelligeble error (#148) @@ -84,7 +85,7 @@ * Fix alignments of strips when only a single strip is present (#163) * Fix a bug that caused theme void to result in errors (#180) * Make aligning multiple fixed aspect plots more consistent (#175) -* Correct alignment of guides when ssembling fixed aspect plots (#140, +* Correct alignment of guides when ssembling fixed aspect plots (#140, @ilia-kats) # patchwork 1.0.0 diff --git a/R/collect_axes.R b/R/collect_axes.R index 1bdba58..2d9c2fc 100644 --- a/R/collect_axes.R +++ b/R/collect_axes.R @@ -24,7 +24,8 @@ collect_axis_titles <- function(gt, dir = "x", merge = TRUE) { # Simplify layout of grobs to matrix layout <- grob_layout(gt, c(idx, patch_index)) - layout[layout %in% patch_index] <- NA # Remove patches + nested <- layout %in% patch_index + layout[nested] <- NA # Remove patches # Mark duplicated grobs structure <- grob_id(gt$grobs, layout, byrow = dir == "x", merge = merge, unpack = TRUE) @@ -34,36 +35,47 @@ collect_axis_titles <- function(gt, dir = "x", merge = TRUE) { next } - # Identify 'run'-rectangles in the structure - runs <- rle_2d(structure, byrow = dir == "y") - runs <- runs[!is.na(runs$value), , drop = FALSE] - - # Find first grob in run - start_runs <- c("row_start", "col_start") - if (name == "xlab-b") start_runs[1] <- "row_end" - if (name == "ylab-r") start_runs[2] <- "col_end" - start_idx <- layout[as.matrix(runs[, start_runs])] + structure[nested] <- 0 - # Find last grob in run - end_runs <- c("row_end", "col_end") - if (name == "xlab-t") end_runs[1] <- "row_start" - if (name == "ylab-l") end_runs[2] <- "col_start" - end_idx <- layout[as.matrix(runs[, end_runs])] + # Identify 'run'-rectangles in the structure + runs <- rle_2d(structure, byrow = dir == "y", ignore.na = TRUE) + runs <- runs[!is.na(runs$value) & runs$value != 0, , drop = FALSE] + + # Get all panels in each run and put the keeper first + panels <- lapply(seq_len(nrow(runs)), function(i) { + rows <- runs$row_start[i]:runs$row_end[i] + cols <- runs$col_start[i]:runs$col_end[i] + first <- switch(name, + "xlab-t" = layout[runs$row_start[i], cols], + "xlab-b" = layout[runs$row_end[i]], + "ylab-l" = layout[rows, runs$col_start[i]], + "ylab-r" = layout[rows, runs$col_end[i]] + ) + first <- first[!is.na(first)][1] + panels <- as.vector(layout[rows , cols]) + panels <- panels[!is.na(panels)] + unique(c(first, panels)) + }) + + title_grob <- vapply(panels, `[[`, numeric(1), 1) # Mark every non-start grob for deletion - delete <- c(delete, setdiff(idx, start_idx)) + delete <- c(delete, setdiff(idx, title_grob)) - if (all(start_idx == end_idx)) { + if ((dir == "x" && all(runs$col_start == runs$col_end)) || + (dir == "y" && all(runs$row_start == runs$row_end))) { next } # Stretch titles over span if (dir == "y") { - gt$layout$b[start_idx] <- gt$layout$b[end_idx] - gt$layout$z[start_idx] <- max(gt$layout$z[idx]) + gt$layout$t[title_grob] <- vapply(panels, function(i) min(gt$layout$t[i]), numeric(1)) + gt$layout$b[title_grob] <- vapply(panels, function(i) max(gt$layout$b[i]), numeric(1)) + gt$layout$z[title_grob] <- max(gt$layout$z[idx]) } else { - gt$layout$r[start_idx] <- gt$layout$r[end_idx] - gt$layout$z[start_idx] <- max(gt$layout$z[idx]) + gt$layout$l[title_grob] <- vapply(panels, function(i) min(gt$layout$l[i]), numeric(1)) + gt$layout$r[title_grob] <- vapply(panels, function(i) max(gt$layout$r[i]), numeric(1)) + gt$layout$z[title_grob] <- max(gt$layout$z[idx]) } } delete_grobs(gt, delete) @@ -336,7 +348,7 @@ on_load({ # #> 2 1 2 3 3 2 # #> 5 3 3 1 2 3 # #> 6 3 3 3 3 1 -rle_2d <- function(m, byrow = FALSE) { +rle_2d <- function(m, byrow = FALSE, ignore.na = FALSE) { n <- length(m) @@ -370,13 +382,13 @@ rle_2d <- function(m, byrow = FALSE) { levels <- unique(as.vector(m)) # Simplified case when there is just a single level - if (length(levels) == 1L) { + if ((ignore.na && sum(!is.na(levels)) == 1) || length(levels) == 1L) { ans <- data.frame( col_start = 1L, col_end = dim[2], row_start = 1L, row_end = dim[1], - value = m[1] + value = sort(levels, na.last = TRUE)[1] ) return(rename(ans)) } diff --git a/tests/testthat/_snaps/collect_axes/empty-areas-doesn-t-interfere-with-title-collection.svg b/tests/testthat/_snaps/collect_axes/empty-areas-doesn-t-interfere-with-title-collection.svg new file mode 100644 index 0000000..a14e805 --- /dev/null +++ b/tests/testthat/_snaps/collect_axes/empty-areas-doesn-t-interfere-with-title-collection.svg @@ -0,0 +1,439 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 +400 + + + + + + + + + + +10 +15 +20 +25 +30 +35 +Plot 1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Plot 1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 +400 + + + + +Plot 1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 +400 + + + + + + + + + + +10 +15 +20 +25 +30 +35 +Plot 1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 +400 + + + + + + + + + + +10 +15 +20 +25 +30 +35 +Plot 1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +10 +15 +20 +25 +30 +35 +mpg +disp +Plot 1 +Empty areas doesn't interfere with title collection + + diff --git a/tests/testthat/_snaps/collect_axes/multi-cell-title-and-axis-collection.svg b/tests/testthat/_snaps/collect_axes/multi-cell-title-and-axis-collection.svg index d44528b..b711c57 100644 --- a/tests/testthat/_snaps/collect_axes/multi-cell-title-and-axis-collection.svg +++ b/tests/testthat/_snaps/collect_axes/multi-cell-title-and-axis-collection.svg @@ -559,9 +559,7 @@ 25 30 35 -mpg -mpg -mpg +mpg disp Plot 1 multi-cell title and axis collection diff --git a/tests/testthat/test-collect_axes.R b/tests/testthat/test-collect_axes.R index 7ebf3b0..efc93af 100644 --- a/tests/testthat/test-collect_axes.R +++ b/tests/testthat/test-collect_axes.R @@ -32,3 +32,16 @@ test_that("axis columns are properly resized", { p5 + p5 + p5 + p6 + layout ) }) + +test_that("axis titles are collected across empty areas", { + plots <- wrap_plots(rep(list(p1), 6)) + + plot_layout( + axes = "collect", + axis_titles = "collect", + design = "#AB\nC#D\nEF#" + ) + expect_doppelganger( + "Empty areas doesn't interfere with title collection", + plots + ) +})