如何在ggplot中实现平滑的置信区间与点估计曲线？

问题背景 #

现有如下数据集，需绘制RR值及其对应置信区间，但当前线条为折线，无法实现平滑效果，尝试geom_smooth/stat_smooth未生效，当前绘图代码如下：

原始数据集 #

data <- structure(list(RR = c(0.89, 0.9, 0.92, 0.93, 0.94, 0.95, 0.96, 
0.98, 0.99, 1, 1.01, 1.03, 1.04, 1.05, 1.06, 1.08, 1.09, 1.11, 
1.12, 1.13, 1.15), CI.upper = c(1, 1, 1.01, 1.01, 1.01, 1.01, 
1.02, 1.03, 1.04, 1.05, 1.06, 1.08, 1.1, 1.12, 1.13, 1.16, 1.18, 
1.21, 1.23, 1.25, 1.29), CI.lower = c(0.78, 0.8, 0.83, 0.85, 
0.87, 0.89, 0.9, 0.93, 0.94, 0.95, 0.96, 0.98, 0.98, 0.98, 0.99, 
1, 1, 1.01, 1.01, 1.01, 1.01), quan_demands = c(0, 5, 10, 15, 
20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80, 85, 90, 95, 
100)), class = "data.frame", row.names = c(NA, -21L))

当前绘图代码 #

ggplot(data = data, aes(x= quan_demands, y = RR)) + 
geom_point(size = 1, shape = 19, color = "darkblue") + 
geom_line(size = 0.5, colour = "darkblue") +
geom_ribbon(aes(ymin = CI.lower, ymax = CI.upper), linetype = 2, alpha = 0.4, fill = 
"deepskyblue3") +
theme_bw() + 
scale_x_continuous(limits = c(0, 100), 
                 breaks = seq(0, 100, 25)) +
scale_y_continuous(limits = c(0.75, 1.4), 
                 breaks = seq(0, 1.5, 0.2)) +
geom_vline(xintercept = 45, color = "black", linetype = "dashed") +
geom_hline(yintercept = 1, color = "black", linetype = "dashed") +
theme(plot.background = element_rect(fill = "white"),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_rect(color = "black", size = 1),
    axis.ticks = element_line(color = "black", size = 1),
    axis.text = element_text(color = "black", size = 12),
    plot.margin = unit(c(1, 1, 1, 1), "mm"),
    strip.background = element_rect(fill = "deepskyblue3", size = 1),
    strip.text.x = element_text(colour = "white", size = 13)) +
facet_grid(. ~ "title")

解决方法 #

方案1：样条插值生成平滑数据集 #

通过样条插值生成更密集的平滑点，再基于这些点绘制曲线和置信区间，步骤如下：

library(ggplot2)
library(splines)

# 生成密集的x轴取值
smooth_x <- seq(min(data$quan_demands), max(data$quan_demands), length.out = 100)

# 对RR、置信区间上下限分别做样条插值
smooth_RR <- spline(x = data$quan_demands, y = data$RR, xout = smooth_x)$y
smooth_CI_low <- spline(x = data$quan_demands, y = data$CI.lower, xout = smooth_x)$y
smooth_CI_high <- spline(x = data$quan_demands, y = data$CI.upper, xout = smooth_x)$y

# 组合成平滑数据集
smooth_data <- data.frame(
  quan_demands = smooth_x,
  RR = smooth_RR,
  CI.lower = smooth_CI_low,
  CI.upper = smooth_CI_high
)

# 绘制平滑曲线与置信区间
ggplot() +
  # 保留原始数据点
  geom_point(data = data, aes(x = quan_demands, y = RR), size = 1, shape = 19, color = "darkblue") +
  # 绘制平滑RR曲线
  geom_line(data = smooth_data, aes(x = quan_demands, y = RR), size = 0.5, colour = "darkblue") +
  # 绘制平滑置信区间
  geom_ribbon(data = smooth_data, aes(x = quan_demands, ymin = CI.lower, ymax = CI.upper), 
              linetype = 2, alpha = 0.4, fill = "deepskyblue3") +
  theme_bw() + 
  scale_x_continuous(limits = c(0, 100), breaks = seq(0, 100, 25)) +
  scale_y_continuous(limits = c(0.75, 1.4), breaks = seq(0, 1.5, 0.2)) +
  geom_vline(xintercept = 45, color = "black", linetype = "dashed") +
  geom_hline(yintercept = 1, color = "black", linetype = "dashed") +
  theme(plot.background = element_rect(fill = "white"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_rect(color = "black", size = 1),
        axis.ticks = element_line(color = "black", size = 1),
        axis.text = element_text(color = "black", size = 12),
        plot.margin = unit(c(1, 1, 1, 1), "mm"),
        strip.background = element_rect(fill = "deepskyblue3", size = 1),
        strip.text.x = element_text(colour = "white", size = 13)) +
  facet_grid(. ~ "title")

说明：length.out = 100控制插值点数量，数值越大曲线越平滑，可按需调整。

方案2：使用geom_xspline直接绘制平滑线 #

借助ggalt包的geom_xspline函数，无需提前处理数据，直接对原始点生成平滑曲线：

library(ggplot2)
library(ggalt)

ggplot(data = data, aes(x = quan_demands, y = RR)) +
  # 保留原始数据点
  geom_point(size = 1, shape = 19, color = "darkblue") +
  # 绘制平滑RR曲线，spline_shape控制平滑程度（0最平滑，1接近折线）
  geom_xspline(size = 0.5, colour = "darkblue", spline_shape = 0.5) +
  # 绘制置信区间填充
  geom_ribbon(aes(ymin = CI.lower, ymax = CI.upper), 
              linetype = 2, alpha = 0.4, fill = "deepskyblue3") +
  # 为置信区间边缘添加平滑线
  geom_xspline(aes(y = CI.lower), colour = "deepskyblue3", linetype = 2, spline_shape = 0.5) +
  geom_xspline(aes(y = CI.upper), colour = "deepskyblue3", linetype = 2, spline_shape = 0.5) +
  theme_bw() + 
  scale_x_continuous(limits = c(0, 100), breaks = seq(0, 100, 25)) +
  scale_y_continuous(limits = c(0.75, 1.4), breaks = seq(0, 1.5, 0.2)) +
  geom_vline(xintercept = 45, color = "black", linetype = "dashed") +
  geom_hline(yintercept = 1, color = "black", linetype = "dashed") +
  theme(plot.background = element_rect(fill = "white"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_rect(color = "black", size = 1),
        axis.ticks = element_line(color = "black", size = 1),
        axis.text = element_text(color = "black", size = 12),
        plot.margin = unit(c(1, 1, 1, 1), "mm"),
        strip.background = element_rect(fill = "deepskyblue3", size = 1),
        strip.text.x = element_text(colour = "white", size = 13)) +
  facet_grid(. ~ "title")

说明：若未安装ggalt包，需先执行install.packages("ggalt")安装。

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