从0开始学习R语言--Day48--Calibration Curves 评估模型

在处理医疗数据集时，我们建立cox回归模型去分析危险因素的数据集往往都是直接用全部的，而不会留少许来帮助我们去验证模型的效果，因为很多时候这些数据都是经过多重筛选的，分割一小部分都有可能会错过很重要的数据（例如一些疾病的变体），但我们又不可能手动筛选好的数据作为测试集，这并不符合测试集的意义。

在这种情况下，我们会用Calibration Curves来评估模型的效果，原理是将预测概率分为若干个区间，计算每个区间内观察到的实际值的比例，当然在这之前可以先计算一下模型的C-index值，大于0.7了再做这个评估可以节省很多时间。

以下是一个例子：

复制代码

# 加载必要的包
library(ggplot2)
library(caret)
library(dplyr)

# 1. 生成模拟数据集
set.seed(123)
n <- 1000
x1 <- rnorm(n)
x2 <- rnorm(n)
# 真实概率(非线性关系)
true_prob <- plogis(0.5 + 0.8*x1 - 0.6*x2 + 0.5*x1*x2)
# 生成二元响应变量
y <- rbinom(n, 1, true_prob)
data <- data.frame(x1, x2, y)

# 2. 分割数据集
train_index <- createDataPartition(y, p = 0.7, list = FALSE)
train_data <- data[train_index, ]
test_data <- data[-train_index, ]

# 3. 训练逻辑回归模型
model <- glm(y ~ x1 + x2 + x1:x2, data = train_data, family = binomial)

# 4. 在测试集上预测概率
test_data$pred_prob <- predict(model, newdata = test_data, type = "response")

# 5. 创建校准曲线
calibration_data <- data.frame(
  predicted = test_data$pred_prob,
  actual = test_data$y
) %>%
  arrange(predicted) %>%
  mutate(bin = cut(predicted, breaks = seq(0, 1, by = 0.1), include.lowest = TRUE)) %>%
  group_by(bin) %>%
  summarise(
    mean_pred = mean(predicted),
    mean_actual = mean(actual),
    n = n()
  )

# 6. 绘制校准曲线
ggplot(calibration_data, aes(x = mean_pred, y = mean_actual)) +
  geom_point(aes(size = n), color = "blue") +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "red") +
  geom_smooth(method = "loess", se = FALSE, color = "darkgreen") +
  labs(x = "预测概率", y = "实际观察比例", 
       title = "模型校准曲线",
       subtitle = "理想情况应接近对角线") +
  xlim(0, 1) + ylim(0, 1) +
  theme_minimal()

# 使用caret包更简单的校准曲线
cal_plot_data <- calibration(factor(y) ~ pred_prob, data = test_data, cuts = 10)
xyplot(cal_plot_data, auto.key = list(columns = 2))

输出：

输出表明整体预测概率的趋势和实际的概率基本一致，左下角略低于实际，说明模型在低风险区域低估了实际风险，而分箱图展示的遇校准曲线不一致，这是为了说明用简单函数需要看清楚标签和事件需要仔细对应。