R语言ggplot2发散条形图：适配李克特量表调整X轴

问题核心 #

需要创建符合5点李克特量表的发散条形图：

• 量表定义：1=显著增加，2=增加，3=不变，4=减少，5=显著减少
• 图表要求：X轴中心为3（不变），均值<3时条形向左延伸（值越小条形越长），均值>3时条形向右延伸（值越大条形越长）
• 需将提供的棒棒糖图代码修改为同风格的发散条形图（非堆叠）

修正后的基础发散条形图代码 #

library(tidyverse)
library(ggplot2)

# 数据预处理
str <- df %>%
  dplyr::select(starts_with("f_22")) %>%
  na.omit()

variable_names <- c(
  "f_22a" = "M",
  "f_22b" = "S",
  "f_22c" = "H",
  "f_22d" = "V",
  "f_22e" = "F",
  "f_22f" = "J",
  "f_22g" = "R",
  "f_22h" = "F",
  "f_22i" = "M",
  "f_22j" = "p",
  "f_22k" = "a",
  "f_22l" = "Z"
)

mean_data <- str %>%
  summarize(across(starts_with("f_22"), ~ mean(., na.rm = TRUE))) %>%
  pivot_longer(cols = everything(), names_to = "variable", values_to = "mean_value") %>%
  mutate(
    label = factor(variable_names[variable], levels = variable_names[order(mean_value)]),
    # 关键修正：计算与中心值3的偏移量，替代原错误的取负逻辑
    diff = mean_value - 3,
    direction = ifelse(diff < 0, "增加方向", "减少方向")
  )

# 绘制发散条形图
ggplot(mean_data, aes(y = label, x = diff)) +
  geom_bar(stat = "identity", aes(fill = direction), show.legend = FALSE) +
  scale_fill_manual(values = c("增加方向" = "pink", "减少方向" = "lightblue")) +
  # 对齐李克特量表的X轴刻度
  scale_x_continuous(
    breaks = seq(-2, 2, 1),
    limits = c(min(mean_data$diff) - 0.3, max(mean_data$diff) + 0.3),
    labels = c("显著增加", "增加", "不变", "减少", "显著减少")
  ) +
  # 添加中心参考线
  geom_vline(xintercept = 0, linetype = "dashed", color = "black", size = 1) +
  # 在条形末端添加均值标签
  geom_text(aes(x = diff, label = round(mean_value, 1)), 
            hjust = ifelse(mean_data$diff < 0, 1.1, -0.1),
            color = "black", size = 3) +
  theme_minimal() +
  labs(x = "", y = "")

棒棒糖图转发散条形图的代码 #

# 数据预处理
mean_data_test <- str %>%
  summarize(across(starts_with("f_22"), ~ mean(., na.rm = TRUE))) %>%
  pivot_longer(cols = everything(), names_to = "variable", values_to = "mean_value") %>%
  mutate(
    label = factor(variable_names[variable], levels = variable_names[order(mean_value)]),
    diff = mean_value - 3,
    direction = ifelse(diff < 0, "增加方向", "减少方向")
  )

variable_names <- c(
  "f_22a" = "wetgqwfsa",
  "f_22b" = "sdgsvyx",
  "f_22c" = "sdfg",
  "f_22d" = "adhf",
  "f_22e" = "yxc",
  "f_22f" = "asfd",
  "f_22g" = "ag",
  "f_22h" = "wetggasg",
  "f_22i" = "zöotukt",
  "f_22j" = "qwerqwr",
  "f_22k" = "ybcv",
  "f_22l" = "afdaf"
)

# 转换为发散条形图
ggplot(mean_data_test, aes(x = label, y = diff)) +
  # 替换棒棒糖图的线段和点为条形
  geom_bar(stat = "identity", aes(fill = direction), show.legend = FALSE) +
  scale_fill_manual(values = c("增加方向" = "pink", "减少方向" = "lightblue")) +
  # 添加中心参考线
  geom_hline(yintercept = 0, linetype = "dashed", color = "black", size = 1) +
  # 添加均值标签
  geom_text(aes(y = diff, label = round(mean_value, 1)), 
            vjust = ifelse(mean_data_test$diff < 0, -0.5, 1.5),
            color = "black", size = 3) +
  # 对齐李克特量表的Y轴刻度
  scale_y_continuous(
    breaks = seq(-2, 2, 1),
    limits = c(min(mean_data_test$diff) - 0.3, max(mean_data_test$diff) + 0.3),
    labels = c("显著增加", "增加", "不变", "减少", "显著减少")
  ) +
  theme_light() +
  theme(
    panel.grid.major.x = element_blank(),
    panel.border = element_blank(),
    axis.ticks.x = element_blank(),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    axis.text.y = element_text(size = 12), 
    text = element_text(size = 14, family = "sans")
  ) +
  theme(aspect.ratio = 0.9) + 
  coord_flip()

关键修改说明 #

1. 数据转换逻辑修正：用diff = mean_value - 3计算与中心值的偏移量，替代原错误的直接取负逻辑，确保条形长度与量表真实差异成正比。
2. 刻度对齐量表：将轴刻度设置为seq(-2,2,1)，对应李克特量表的1到5（3+(-2)=1，3+2=5），标签直接匹配量表定义，可读性更强。
3. 颜色映射规范化：将颜色映射放入aes()中配合scale_fill_manual统一管理，避免单独赋值的不规范问题。
4. 标签优化：在条形末端添加均值标签，通过hjust/vjust调整位置，确保标签不被条形遮挡。
5. 棒棒糖图转条形：替换原geom_segment和geom_point为geom_bar，保留原主题风格，适配条形图的布局。

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