如何将ggplot2柱状图中空缺条形替换为NA标识

现有代码生成的柱状图中，age=36的"activity"和"emotionality"分组因数据为NA无条形，以下是修改后的代码，可在空缺区域显示NA标识：

# example data
Correlation_task_persistence <-  c("0.29", "0.29","0.24", "0.20", "0.24", "0.04", "0.00", "0.04")
Biv_A_task_persistence <- c("80%", "80%","44%", "44%", "47%", "72%", "49%", "55%")
Biv_E_task_persistence  <- c("20%", "20%", "57%", "56%", "54%", "29%", "52%", "45%")
Correlation_activity <- c("0.29", "0.29", NA, "0.29", "0.08", "0.08", "0.07", "0.00")
Biv_A_activity <- c("80%", "80%", NA, "80%", "45%", "70%", "20%", "50%")
Biv_E_activity <- c("20%", "20%", NA, "20%", "55%", "40%", "90%", "50%")
age <- c("intercept", "slope", "36", "30", "24", "18", "12", "6")
Correlation_emotionality <-  c("0.19", "0.19","0.34", "0.10", "0.13", "0.04", "0.00", "0.04")
Biv_A_emotionality <- c("80%", "80%","43%", "44%", "47%", "71%", "49%", "55%")
Biv_E_emotionality  <- c("20%", "20%", "57%", "56%", "53%", "29%", "51%", "45%")
df.new <- data.frame(Correlation_task_persistence, Biv_A_task_persistence,Biv_E_task_persistence, Correlation_activity, Biv_A_activity, Biv_E_activity, Correlation_emotionality, Biv_A_emotionality, Biv_E_emotionality, age)

# 修改后的绘图代码
library(tidyverse)

# 先创建包含所有age和group组合的完整网格，确保NA位置不丢失
full_grid <- expand.grid(
  age = factor(c("0", "6", "12", "18", "24", "30", "36", "intercept", "slope"), ordered = TRUE),
  group = c("task_persistence", "activity", "emotionality")
)

df.new %>%
  mutate(across(
    Correlation_task_persistence:Biv_E_emotionality,
    ~ if_else(as.numeric(gsub("%", "", .x)) > 1,
              as.numeric(gsub("%", "", .x, fixed = TRUE)) / 100,
              as.numeric(.x)
    )
  )) %>%
  pivot_longer(-c(age, contains("Correlation"))) %>%
  mutate(
    # 修复原代码中if_else的逻辑错误，正确匹配三个分组的Correlation值
    Correlation = case_when(
      grepl("task", name) ~ Correlation_task_persistence,
      grepl("activity", name) ~ Correlation_activity,
      grepl("emotionality", name) ~ Correlation_emotionality
    ),
    final_value = Correlation * value,
    name = gsub("_task", "", name)
  ) %>%
  tidyr::extract("name", c("var", "group"), regex = "(.*)_([^_]+)$") %>%
  group_by(age, group) %>%
  mutate(label = scales::percent(final_value / sum(final_value, na.rm = TRUE))) %>%
  ungroup() %>%
  mutate(age = factor(age,
                      levels = c("0", "6", "12", "18", "24", "30", "36", "intercept", "slope"),
                      ordered = TRUE
  )) %>%
  # 合并完整网格，补全缺失的NA组合
  right_join(full_grid, by = c("age", "group")) %>%
  ggplot(aes(x = age, y = final_value, fill = var)) +
  geom_col(aes(linewidth = final_value > 0), color = "black", na.rm = TRUE) +
  theme_classic() +
  # 处理Correlation文本的显示，NA位置不显示数值
  geom_text(aes(label = ifelse(is.na(final_value), NA, Correlation), group = age),
            stat = "summary", fun = function(x) sum(x, na.rm = TRUE) + 0.01 * sign(sum(x, na.rm = TRUE)), 
            size = 3, na.rm = TRUE) +
  # 堆叠文本，NA位置不显示百分比
  geom_text(aes(label = label), size = 3, position = position_stack(vjust = 0.5), na.rm = TRUE) +
  # 在NA位置添加"NA"标识
  geom_text(data = . %>% filter(is.na(final_value)), 
            aes(x = age, y = 0.1, label = "NA"), 
            size = 4, color = "red") +
  scale_fill_grey(start = 0.475, end = 0.8, na.value = "red") +
  scale_linewidth_manual(values = c("TRUE" = .5, "FALSE" = 0), guide = "none") +
  labs(y = "Correlation") +
  labs(x = "") +
  theme(
    legend.position = "bottom",
    legend.title = element_blank()
  ) +
  facet_wrap(~group)

关键修改说明 #

• 补全数据网格：创建full_grid确保所有age和group的组合都存在，避免NA的分组被自动过滤
• 修复Correlation匹配逻辑：原代码的if_else只能处理两个分支，改用case_when正确匹配三个分组的Correlation值
• 添加NA标识文本：用geom_text专门针对final_value为NA的位置，在y轴0.1处显示红色"NA"
• 处理NA值计算：在sum中加入na.rm = TRUE避免计算出错，同时在文本层设置na.rm = TRUE跳过NA位置的数值显示

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