使用facet_geo(scales='free_y')时如何移除空绘图区的Y轴文本？

问题复现 #

先构造模拟数据并运行原代码，会发现空面板仍显示Y轴文本：

library(tidyverse)
library(geofacet)

set.seed(123)
# 生成不含华盛顿特区的美国州缩写列表
state_list <- state.abb[-which(state.abb == "DC")]
# 随机选择30个州生成模拟数据
selected_states <- sample(state_list, 30)

# 构造模拟数据集
df <- expand_grid(
  state = selected_states,
  year = 2010:2020
) %>%
  mutate(value = rnorm(n(), mean = 50, sd = 10))

# 原代码：空面板会显示Y轴文本
ggplot(df, aes(x = year, y = value)) +
  geom_line() +
  facet_geo(~state, grid = "us_state_grid1", scales = "free_y", move_axes = TRUE) +
  theme_bw()

解决方案：通过修改gtable移除空面板Y轴元素 #

核心思路是提取ggplot的底层gtable对象，定位没有数据的面板，然后移除对应的Y轴文本和标题，同时保留scales='free_y'的功能：

# 1. 生成初始绘图对象
p <- ggplot(df, aes(x = year, y = value)) +
  geom_line() +
  facet_geo(~state, grid = "us_state_grid1", scales = "free_y", move_axes = TRUE) +
  theme_bw()

# 2. 构建绘图对象并识别空面板
pb <- ggplot_build(p)
# 筛选出没有数据的面板索引
empty_panels <- which(sapply(pb$data, function(x) nrow(x) == 0))

# 3. 提取gtable并修改空面板的Y轴元素
gt <- ggplot_gtable(pb)

# 遍历所有空面板，移除Y轴文本和标题
for (panel_idx in empty_panels) {
  # 定位Y轴文本的grob
  y_text_grob <- paste0("axis-l-", panel_idx)
  text_idx <- which(gt$layout$name == y_text_grob)
  if (length(text_idx) > 0) {
    gt$grobs[text_idx][[1]]$children[[2]] <- grid::zeroGrob()
  }
  
  # 定位Y轴标题的grob
  y_title_grob <- paste0("ylab-", panel_idx)
  title_idx <- which(gt$layout$name == y_title_grob)
  if (length(title_idx) > 0) {
    gt$grobs[title_idx] <- list(grid::zeroGrob())
  }
}

# 4. 绘制修改后的图形
grid::grid.draw(gt)

说明 #

• 该方法保留了scales='free_y'参数，有数据的面板仍能自由缩放Y轴
• 通过ggplot_build获取每个面板的数据状态，精准定位空面板
• 利用grid::zeroGrob()替换空面板的Y轴元素，彻底移除文本显示

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