ggplot分面堆叠条形图出现额外条形，如何移除？

我尝试创建按国家收入组分面的堆叠条形图，每个条形对应一个国家。但用以下代码生成的图表中，四个收入组里有三个出现了额外条形，请问如何移除这些额外条形？

plot<- ggplot(data, aes(x = as.factor(country), y = rank_mean, fill = theme)) +
    geom_bar(stat = "identity") +
    geom_text(aes(label = country), y = (data$tot+20), size = 1.5, color = "black", angle = 90) +
    facet_wrap(incgrp ~ ., scales = "free_x") +
    labs(title="", x="", y="") + 
    scale_fill_manual(values = Blues) +
    theme(legend.position = 'bottom', 
      axis.text.x=element_blank(),
      axis.ticks.x=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks.y=element_blank(),
      axis.title=element_text(size=10),
      legend.text=element_text(size=10),
      legend.title = element_blank()) +
    guides(fill = guide_legend(nrow = 2)) 

生成的图表显示：四个收入组中有三个出现了无数据的额外条形。

解决方案 #

出现额外条形的核心原因是：country被转为因子后保留了全数据集的所有水平，分面时即使某组没有对应国家的数据，该因子水平仍会被保留，从而生成空条形。可通过以下两种方式解决：

方法1：预处理数据，按收入组生成组内因子 #

使用dplyr按收入组分组，将country转换为仅包含当前组内国家的因子，这样每个分面只会显示有数据的国家：

library(dplyr)
# 预处理数据
data <- data %>%
  group_by(incgrp) %>%
  mutate(country = factor(country)) %>%
  ungroup()

# 原绘图代码调整后重新运行
plot<- ggplot(data, aes(x = country, y = rank_mean, fill = theme)) +
    geom_bar(stat = "identity") +
    geom_text(aes(label = country), y = (tot + 20), size = 1.5, color = "black", angle = 90) +
    facet_wrap(incgrp ~ ., scales = "free_x") +
    labs(title="", x="", y="") + 
    scale_fill_manual(values = Blues) +
    theme(legend.position = 'bottom', 
      axis.text.x=element_blank(),
      axis.ticks.x=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks.y=element_blank(),
      axis.title=element_text(size=10),
      legend.text=element_text(size=10),
      legend.title = element_blank()) +
    guides(fill = guide_legend(nrow = 2)) 

方法2：在绘图时直接去除无效因子水平 #

使用forcats包的fct_drop()函数，在x轴映射中直接移除没有数据的国家因子水平，无需预处理数据：

# 修改x轴映射，替换as.factor为fct_drop
plot<- ggplot(data, aes(x = forcats::fct_drop(country), y = rank_mean, fill = theme)) +
    geom_bar(stat = "identity") +
    geom_text(aes(label = country), y = (tot + 20), size = 1.5, color = "black", angle = 90) +
    facet_wrap(incgrp ~ ., scales = "free_x") +
    labs(title="", x="", y="") + 
    scale_fill_manual(values = Blues) +
    theme(legend.position = 'bottom', 
      axis.text.x=element_blank(),
      axis.ticks.x=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks.y=element_blank(),
      axis.title=element_text(size=10),
      legend.text=element_text(size=10),
      legend.title = element_blank()) +
    guides(fill = guide_legend(nrow = 2)) 

额外优化 #

原代码中geom_text的y = (data$tot+20)存在风险，直接引用整个数据框的列可能导致分面时文本位置错位，建议改为y = (tot + 20)（直接使用列名，ggplot会自动按行匹配对应数据）。

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