在RStudio中堆叠柱状图与折线图的实现问题

需求说明 #

• 底层柱状图：按AgeGroup（因子型）分组，展示Score的平均值，x轴为年龄组，y轴为测试得分
• 上层折线图：展示AgeSpecific（数值型）对应的测试得分，需与柱状图叠加展示

现有代码 #

library(ggplot2)

TestAgeGraph <- ggplot2::ggplot(df, aes(x = AgeGroup, y = Score, fill = AgeGroup)) +
  stat_summary(fun = "mean", geom = "bar") +
  labs (x = "Age Group", y = "Test Score", title = "Average Stage Group Across Age Group") +
  theme_light() + geom_point(position = position_jitter(width = 0.1), color = "black")

TestAgeGraph + theme (axis.text.x = element_text(size = 12),
                             axis.title.x = element_text(size = 16),
                             axis.title.y = element_text(size = 16),
                             plot.title = element_text(size = 20),
                             legend.text = element_text(size = 12))

遇到的问题 #

添加geom_line(aes(x = AgeSpecific, y = Score), color = "black")后，柱状图被挤到图像左侧，x轴标签显示混乱。

最小可复现数据（MRE） #

df <- structure(list(ID = 1:24, AgeSpecific = c(67, 5, 18, 14, 17, 
43, 14, 9, 11, 8, 19, 5, 25, 55, 45, 74, 12, 47, 48, 14, 18, 
15, 28, 28), AgeGroup = structure(c(9L, 1L, 5L, 4L, 5L, 7L, 4L, 
2L, 3L, 2L, 5L, 1L, 6L, 8L, 7L, 9L, 3L, 8L, 8L, 4L, 5L, 4L, 6L, 
6L), levels = c("KS1", "KS2", "KS3", "KS4", "KS5", "20-29", "30-45", 
"46-59", "60+"), class = "factor"), Score = c(74, 66, 75, 74, 
72, 81, 68, 56, 67, 78, 75, 92, 77, 78, 66, 51, 64, 73, 74, 73, 
75, 72, 73, 80)), row.names = c(NA, -24L), class = "data.frame")

原因分析 #

ggplot2中，因子型的AgeGroup会被自动转换为1到9的整数刻度，而AgeSpecific是5到74的数值，两者刻度范围差异极大，导致坐标轴被拉伸，柱状图被压缩到左侧，x轴显示混乱。

解决方案 #

通过双坐标轴映射，将具体年龄的数值范围转换为年龄组对应的刻度范围，实现双图层对齐：

library(ggplot2)

# 加载MRE数据（如果未加载）
df <- structure(list(ID = 1:24, AgeSpecific = c(67, 5, 18, 14, 17, 
43, 14, 9, 11, 8, 19, 5, 25, 55, 45, 74, 12, 47, 48, 14, 18, 
15, 28, 28), AgeGroup = structure(c(9L, 1L, 5L, 4L, 5L, 7L, 4L, 
2L, 3L, 2L, 5L, 1L, 6L, 8L, 7L, 9L, 3L, 8L, 8L, 4L, 5L, 4L, 6L, 
6L), levels = c("KS1", "KS2", "KS3", "KS4", "KS5", "20-29", "30-45", 
"46-59", "60+"), class = "factor"), Score = c(74, 66, 75, 74, 
72, 81, 68, 56, 67, 78, 75, 92, 77, 78, 66, 51, 64, 73, 74, 73, 
75, 72, 73, 80)), row.names = c(NA, -24L), class = "data.frame")

# 计算年龄组的数值映射（因子转整数）
df$age_group_num <- as.numeric(df$AgeGroup)

# 定义刻度转换函数：将具体年龄映射到年龄组的数值范围
min_age <- min(df$AgeSpecific)
max_age <- max(df$AgeSpecific)
min_group <- min(df$age_group_num)
max_group <- max(df$age_group_num)

age_to_group <- function(x) {
  (x - min_age) / (max_age - min_age) * (max_group - min_group) + min_group
}

# 反向转换函数：用于顶部x轴的标签显示
group_to_age <- function(x) {
  (x - min_group) / (max_group - min_group) * (max_age - min_age) + min_age
}

# 绘制最终图表
ggplot(df, aes(x = AgeGroup, y = Score)) +
  # 柱状图：年龄组平均得分
  stat_summary(fun = "mean", geom = "bar", aes(fill = AgeGroup)) +
  # 原始数据散点
  geom_point(position = position_jitter(width = 0.1), color = "black") +
  # 折线图：具体年龄得分，使用转换后的x轴位置
  geom_line(aes(x = age_to_group(AgeSpecific), group = 1), color = "black") +
  # 添加顶部x轴，显示具体年龄
  scale_x_discrete(sec.axis = sec_axis(trans = group_to_age, name = "Specific Age")) +
  labs(x = "Age Group", y = "Test Score", title = "Average Test Score Across Age Groups with Specific Age Trends") +
  theme_light() +
  theme(axis.text.x = element_text(size = 12),
        axis.title.x = element_text(size = 16),
        axis.title.y = element_text(size = 16),
        plot.title = element_text(size = 20),
        legend.text = element_text(size = 12))

关键说明 #

1. 通过age_to_group函数将具体年龄的数值范围压缩到年龄组因子对应的整数范围，确保折线图与柱状图的x轴对齐
2. 顶部次坐标轴通过group_to_age函数反向转换，显示原始具体年龄的刻度
3. group = 1确保折线图将所有点连接为一条线，若需按年龄组分段连线，可改为group = AgeGroup

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