geom_col底部对齐失效求助（附可复现代码与图表）

问题现状 #

使用geom_col绘制堆叠柱状图并结合facet_grid2分面时，不同分面下的WEAPON对应的柱子无法底部对齐，存在多余空白区域；将缺失值转为NA无效，且单一YEAR/ROOM分面时无此问题。

原因分析 #

当前数据中部分(YEAR, ROOM, WEAPON_ID, GENDER)组合缺失，加上facet_grid2的scales="free"和space="free"参数，导致每个分面的y轴仅包含当前分面存在的WEAPON类别，不同分面的WEAPON位置无法一一对应，从而出现空白和对齐偏差。

解决方案 #

补全所有(YEAR, ROOM, WEAPON_ID, GENDER)的组合，将缺失数据的TOTAL设为0，确保每个分面的y轴包含全部WEAPON类别，同时调整文本位置过滤无效值。

修改后的完整代码 #

library(dplyr)
library(ggplot2)
library(ggiraph)
library(ggh4x)

# Data with Cluedo theme
set.seed(123)
cluedo_data <- data.frame(
  SUSPECT_ID = 1:100,
  YEAR = sample(2018:2020, 100, replace = TRUE),
  ROOM = sample(c("Library", "Kitchen", "Conservatory"), 100, replace = TRUE),
  GENDER = sample(c("M", "F"), 100, replace = TRUE),
  CLUEDO_PATH = sample(c("New", "Old"), 100, replace = TRUE),
  WEAPON_ID = paste0("weapon_", sample(1:10, 100, replace = TRUE)),
  CLUE_TYPE = sample(c("OPEN", "MCQ"), 100, replace = TRUE),
  EVIDENCE = sample(c(-1, 0, 1), 100, replace = TRUE),
  SCORE = sample(0:10, 100, replace = TRUE)
)

# Filter and transform data
open_scores <- cluedo_data %>%
  filter(CLUE_TYPE == "OPEN", CLUEDO_PATH == "New") %>%
  group_by(YEAR, SUSPECT_ID, ROOM, WEAPON_ID) %>%
  filter(sum(abs(EVIDENCE)) != 0) %>%
  distinct(SUSPECT_ID, .keep_all = TRUE) %>% 
  mutate(TOTAL = max(sum(SCORE), 0)) %>%
  ungroup() %>%
  group_by(YEAR, ROOM, WEAPON_ID) %>%
  top_n(1, TOTAL) %>%
  distinct(YEAR, WEAPON_ID, ROOM, GENDER, TOTAL) %>%
  ungroup()

open_scores$WEAPON_ID <- gsub('weapon_', 'w', open_scores$WEAPON_ID)

color_table <- tibble(gender = c("M", "F"), Color = c("#795695", "#00868b"))
open_scores$GENDER <- factor(open_scores$GENDER, levels = color_table$gender)

# 补全所有YEAR、ROOM、WEAPON_ID、GENDER的组合，缺失TOTAL设为0
all_combinations <- expand.grid(
  YEAR = unique(open_scores$YEAR),
  ROOM = unique(open_scores$ROOM),
  WEAPON_ID = unique(open_scores$WEAPON_ID),
  GENDER = levels(open_scores$GENDER)
)

open_scores_full <- all_combinations %>%
  left_join(open_scores, by = c("YEAR", "ROOM", "WEAPON_ID", "GENDER")) %>%
  mutate(TOTAL = ifelse(is.na(TOTAL), 0, TOTAL))

plt <- ggplot(open_scores_full) +
  geom_col(aes(TOTAL, WEAPON_ID, fill = GENDER), width = 0.6, position = position_stack(vjust = 0)) +
  # 仅在有非0数据的行显示WEAPON_ID文本
  geom_text(data = open_scores_full %>% filter(TOTAL > 0), 
            aes(x = 1, y = WEAPON_ID, label = WEAPON_ID), 
            hjust = "inward", nudge_x = -0.5, colour = "white", size = 4) +
  # 仅显示非0的TOTAL文本
  geom_text(data = open_scores_full %>% filter(TOTAL > 0), 
            aes(x = TOTAL, y = WEAPON_ID, label = TOTAL, fill = GENDER), 
            position = position_stack(vjust = 0.6), colour = "white", size = 4) + 
  facet_grid2(vars(ROOM), vars(YEAR), render_empty = FALSE, axes = "all", scales = "free", space = "free") +
  scale_fill_manual(values = color_table$Color) +
  theme(axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks.x = element_blank(), axis.ticks.y = element_blank()) +
  scale_x_continuous(breaks = NULL) +
  scale_y_discrete(breaks = NULL) +
  theme(axis.title.x = element_text(size = 15), axis.title.y = element_text(size = 15), strip.text.x = element_text(size = 13), strip.text.y = element_text(size = 13), legend.text = element_text(size = 20), legend.title = element_text(size = 20)) + 
  theme(legend.position = "top", plot.title = element_text(hjust = 0.5)) +
  xlab("Mean SCORE of Clues per WEAPON through YEAR") +
  ylab("WEAPON") +
  theme(text = element_text(family = "mono"))

plt <- girafe(ggobj = plt, width_svg = 18, height_svg = 11,
              options = list(
                opts_hover_inv(css = "opacity:0.7;"),
                opts_hover(css = "stroke-width:2;")
              ))

# Print plot
print(plt)

效果说明 #

修改后，所有分面的WEAPON类别保持一致，柱状图底部完全对齐，空白区域被消除；同时通过过滤TOTAL>0的行，避免显示无效的0值文本，保证图表简洁性。

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