如何给ggplot柱状图添加双轴、散点与折线（搁浅率数据）

问题背景 #

现有12个分区的搁浅数据，已绘制各分区搁浅总数的柱状图，需叠加每个75km分区的搁浅率（kmrate）散点与折线。当前代码存在两个核心问题：

• 散点和折线显示位置异常，未与对应分区对齐
• 双轴刻度逻辑错误，右侧搁浅率刻度与实际数据不匹配

数据集如下：

dfo_sba2_noNA <- structure(list(
  Subarea = factor(1:12),
  Quantity = c(96, 431, 118, 469, 1, 20, 313, 252, 14, 118, 7, 21),
  kmrate = c(1.28, 5.75, 1.57, 6.25, 0.0133, 0.267, 4.17, 3.36, 0.187, 1.57, 0.0933, 0.28)
), class = "data.frame")

修正后的代码 #

library(ggplot2)

p_sba2 <- ggplot(dfo_sba2_noNA, aes(x = Subarea)) +
  # 绘制柱状图（搁浅总数）
  geom_bar(aes(y = Quantity), stat = "identity", fill = "steelblue") +
  # 绘制搁浅率散点：将kmrate转换为对应左边y轴的数值（kmrate*75）
  geom_point(aes(y = kmrate * 75), color = "red", size = 3) +
  # 绘制搁浅率折线：统一分组为1，确保连续连接所有分区
  geom_line(aes(y = kmrate * 75, group = 1), color = "red", linewidth = 1) +
  # 设置双轴刻度：左边为总数，右边为总数/75得到搁浅率
  scale_y_continuous(
    name = "Number of observations",
    breaks = seq(0, 500, 100),  # 根据数据最大值调整刻度
    sec.axis = sec_axis(~./75, name = "Stranding rate (per km)")
  ) +
  labs(x = "Subarea") +
  theme(
    panel.grid.major.y = element_line(colour = "white"),
    panel.border = element_rect(colour = "black", fill = NA),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "white"),
    axis.title = element_text(size = 10),
    axis.text = element_text(size = 10),
    legend.position = "none"  # 去掉冗余图例
  )

p_sba2

关键修改说明 #

• 双轴映射修正：ggplot不支持直接使用两个独立y轴数据，必须将右侧轴数据（kmrate）转换为左侧轴的数值范围（kmrate*75），再通过sec_axis(~./75)将左侧刻度转换为右侧的搁浅率刻度，确保数据与刻度匹配
• x轴与分组统一：散点使用与柱状图相同的Subarea作为x轴，折线设置group=1确保所有分区的点被连续连接，避免原代码中按分区分组导致的折线断裂
• 刻度范围优化：根据数据中Quantity的最大值（469）调整左侧y轴刻度为0-500，避免原代码中1600的无效范围，让图表更紧凑直观
• 美学简化：去掉不必要的图例，统一散点和折线的颜色与大小，提升图表可读性

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