Misaligned patchwork of facets when using free scaling and mixed-format labels

Question

library(tidyverse)
library(scales)
library(patchwork)

df <- tibble(
  date = rep(seq(ymd("2024-01-01"), ymd("2024-12-01"), by = "month"), 2),
  var1 = c(seq(1e6, 2.1e6, 1e5), seq(2e6, 3.1e6, 1e5)),
  var2 = c(10:21, 30:41),
  group = c(rep("Group A", 12), rep("Group B", 12))
)

p1 <- df |>
  ggplot(aes(date, var1)) +
  geom_line() +
  facet_wrap(~group, scales = "free_y") +
  scale_y_continuous(label = label_currency(scale_cut = cut_short_scale(), prefix = "£"))

p2 <- df |>
  ggplot(aes(date, var2)) +
  geom_line() +
  facet_wrap(~group, scales = "free_y") +
  theme(
    strip.background = element_blank(),
    strip.text = element_blank(),
  )

# Misaligned with differing label widths. Fails to collect the axes and titles
p1 / p2 + plot_layout(heights = c(2, 1), axes = "collect_x", axis_titles = "collect_x") +
  plot_annotation(
    "Misaligned & Axes/Titles Not Collected", 
    subtitle = "Mixed Label Formats & Free (y) Scaling")

# Aligned if label widths are the same (plotting p2 twice!) and collects axes/titles
# The desired outcome is to have `p1 / p2` align similarly
p2 / p2 + plot_layout(heights = c(2, 1), axes = "collect_x", axis_titles = "collect_x") +
  plot_annotation(
    "Aligned & Axes/Titles Collected", 
    subtitle = "Common Label Formats")

# Adding a fixed width has the side-effect of an AWOL currency prefix
p3 <- p1 +
  scale_y_continuous(
    label = label_currency(scale_cut = cut_short_scale(), prefix = "£", width = 10)
  )

p4 <- p2 +
  scale_y_continuous(label = label_number(width = 10))

p3 / p4 + plot_layout(heights = c(2, 1), axes = "collect_x", axis_titles = "collect_x") +
  plot_annotation(
    "Misaligned, Stray £ & Axes/Titles Not Collected", 
    subtitle = "Fixed Label Widths")

^{Created on 2024-03-25 with reprex v2.1.0}

Answer 1

patchwork will align the plots not the facets from each plot. Instead, one option to achieve your desired result would be to create each "facet" panel as a separate plot:

library(tidyverse)
library(scales)
library(patchwork)

df <- tibble(
  date = rep(seq(ymd("2024-01-01"), ymd("2024-12-01"), by = "month"), 2),
  var1 = c(seq(1e6, 2.1e6, 1e5), seq(2e6, 3.1e6, 1e5)),
  var2 = c(10:21, 30:41),
  group = c(rep("Group A", 12), rep("Group B", 12))
)

df |>
  pivot_longer(c(var1, var2), names_to = "var") |>
  split(~ group + var) |>
  purrr::imap(
    \(x, y) {
      scale_y <- if (grepl("var1$", y)) {
        scale_y_continuous(
          name = "var1",
          label = label_currency(scale_cut = cut_short_scale(), prefix = "£")
        )
      } else {
        scale_y_continuous(name = "var2")
      }
      remove_strip <- if (!grepl("var1$", y)) theme(strip.text = element_blank())

      x |>
        ggplot(aes(date, value)) +
        geom_line() +
        scale_y +
        facet_wrap(~group, scales = "free_y") +
        remove_strip
    }
  ) |>
  wrap_plots(
    ncol = 2
  ) + plot_layout(
    heights = c(2, 1),
    axis_titles = "collect"
  ) +
  plot_annotation(
    "Misaligned & Axes/Titles Not Collected",
    subtitle = "Mixed Label Formats & Free (y) Scaling"
  )