解决ggplot2中Facet Wrap最后分面过度拉伸问题

问题背景 #

我有一个按每年9月1日拆分的纵向分面图，每个分面对应一个年度周期（例如2022-2023代表2022年9月至2023年8月）。当最后一个分面仅包含数月数据而非完整年度时，该分面会被拉伸占据全部可用空间，希望让所有分面保持一致宽度，数据不全的分面显示截断效果而非拉伸。

解决思路 #

让每个分面的x轴范围固定为对应年度的完整周期（当年9月1日到次年8月1日），即使数据未覆盖完整周期，x轴仍保留该范围，从而避免分面被拉伸。以下提供两种可行实现方式：

方法一：使用ggh4x包实现自定义分面轴范围（推荐） #

ggh4x扩展包提供了更灵活的分面控制能力，可以为每个分面单独设置x轴区间：

1. 安装并加载依赖包：

install.packages("ggh4x")
library(ggh4x)

2. 为每个年度周期计算对应的x轴起止日期：

range_df <- results %>%
  distinct(year_range) %>%
  mutate(
    start_date = as.Date(paste(substr(year_range, 1, 4), "09-01", sep = "-")),
    end_date = as.Date(paste(substr(year_range, 6, 9), "08-01", sep = "-"))
  )

3. 定义分面x轴的缩放函数：

scale_fun <- function(x) {
  current_range <- range_df[range_df$year_range == x, ]
  scale_x_date(
    limits = c(current_range$start_date, current_range$end_date),
    breaks = scales::date_breaks("3 months"),
    labels = scales::date_format("%b %Y")
  )
}

4. 修改绘图代码，使用facet_wrap2替代facet_wrap：

faceted <- just_the_plot +
  facet_wrap2(
    ~ year_range, 
    ncol = 1, 
    scales = "free_x", 
    axes = "fixed", 
    scale_functions = list(x = scale_fun)
  ) +
  coord_cartesian(expand = FALSE) +
  bbc_style()
faceted

方法二：手动补充完整周期的空数据 #

如果不想额外加载扩展包，可以为每个年度周期补充完整12个月的日期记录（即使无对应数据），让ggplot自动识别完整的x轴范围：

1. 生成所有年度周期对应的完整日期序列：

full_dates <- expand.grid(
  year_range = unique(results$year_range),
  month_date = seq.Date(from = as.Date("2022-09-01"), by = "months", length.out = 12)
) %>%
  mutate(
    start_year = as.integer(substr(year_range, 1, 4)),
    # 调整日期到对应年度周期的正确月份
    month_date = as.Date(paste(
      start_year + (lubridate::month(month_date) >= 9),
      lubridate::month(month_date),
      "01",
      sep = "-"
    ))
  )

2. 合并原始数据与完整日期序列，填充必要字段：

full_results <- full_dates %>%
  left_join(results %>% select(-year_range), by = "month_date") %>%
  group_by(year_range) %>%
  fill(name, .direction = "downup") %>% # 填充name字段避免绘图报错
  ungroup()

3. 重新拆分正负数据并绘图：

# 重新拆分正负数据
pos_full <- full_results %>% filter(total > 0)
bos_full <- full_results %>% filter(total <= 0) %>% mutate(total = -total)

# 重新创建绘图对象
just_the_plot_full <- ggplot() +
  geom_area(data = pos_full, aes(x = month_date, y = total, fill=name, colour=name)) +
  geom_area(data = bos_full, aes(x = month_date, y = total, fill=name, colour=name)) +
  scale_fill_manual(values = half_transparent_fill_color_named_vector) +
  scale_color_manual(values = border_color_named_vector)

# 绘制分面图
faceted_full <- just_the_plot_full +
  facet_wrap(~ year_range, ncol= 1, scales = "free_x") +
  coord_cartesian(expand = FALSE) +
  bbc_style()
faceted_full

内容的提问来源于stack exchange，提问作者merof