如何在GAM绘图中叠加构成样条的基函数？

问题说明 #

需要将GAM拟合的样条曲线与构成该样条的基函数绘制在同一窗口中，目前已实现分图绘制，但直接叠加时效果异常。

失效原因分析 #

1. 自变量尺度不匹配：basis(fit)返回的基函数数据使用的是标准化后的自变量，而非原始数据的dur尺度，直接映射原始dur会导致坐标轴错位。
2. 模型一致性问题：stat_smooth会重新拟合一个新的GAM，与之前训练好的fit模型参数不一致，无法保证结果对应。
3. 数值尺度差异：基函数的取值范围与二项式模型的响应概率（0-1）差异极大，直接叠加会导致其中一组数据无法正常显示。

正确实现代码 #

步骤1：数据准备与预处理 #

加载依赖、拟合模型，并将基函数数据转换为原始自变量尺度：

#### Load Libraries ####
library(mgcv)
library(tidyverse)
library(gratia)
library(gamair)

#### Set Theme ####
theme_set(theme_bw())

#### Add Data ####
data("wesdr")
wes <- as_tibble(wesdr)

#### Fit GAM ####
fit <- gam(
  ret ~ s(dur, bs = "cr"),
  method = "REML",
  family = binomial,
  data = wes
)

# 提取基函数数据并转换x到原始dur尺度
bf_data <- basis(fit)
x_center <- mean(wes$dur)
x_scale <- sd(wes$dur)
bf_data <- bf_data %>%
  mutate(dur = x * x_scale + x_center)

# 生成拟合曲线的预测数据（响应概率尺度）
new_x <- tibble(dur = seq(min(wes$dur), max(wes$dur), length.out = 200))
fit_pred <- predict(fit, newdata = new_x, type = "response", se.fit = TRUE)
pred_data <- new_x %>%
  mutate(
    fit = fit_pred$fit,
    lower = fit - 1.96 * fit_pred$se.fit,
    upper = fit + 1.96 * fit_pred$se.fit
  )

步骤2：绘制叠加可视化图 #

使用双y轴解决尺度差异问题，保证模型结果一致性：

#### 绘制叠加图 ####
ggplot() +
  # 绘制GAM拟合曲线与置信区间
  geom_ribbon(data = pred_data, aes(x = dur, ymin = lower, ymax = upper), fill = "steelblue", alpha = 0.2) +
  geom_line(data = pred_data, aes(x = dur, y = fit), color = "steelblue", linewidth = 1) +
  # 绘制基函数（缩放后适配左侧y轴，右侧显示原始基函数值）
  geom_line(data = bf_data, aes(x = dur, y = value * 0.2, color = bf), linewidth = 0.8) +
  # 设置双y轴
  scale_y_continuous(
    name = "视网膜病变概率",
    sec.axis = sec_axis(~ . / 0.2, name = "基函数值")
  ) +
  # 美化基函数颜色
  scale_color_viridis_d(name = "基函数") +
  labs(x = "患病时长（年）") +
  theme(legend.position = "bottom")

关键调整说明 #

• 基函数通过value * 0.2进行缩放，可根据实际显示效果调整缩放系数，右侧y轴通过反向缩放还原原始基函数值。
• 直接使用已拟合的fit模型提取预测值，避免重新拟合带来的参数不一致问题。
• 将基函数的标准化x轴转换为原始尺度，保证坐标轴对齐。

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