如何在R中为XGBoost模型绘制校准曲线并计算相关指标？

基于你已有的训练代码，我们可以用几个常用R包快速完成校准曲线绘制、Brier分数、校准截距和斜率的计算，无需复杂自定义函数：

1. 加载所需工具包 #

先确保安装并加载以下包：

library(yardstick)  # 计算Brier分数
library(ggplot2)    # 绘制校准曲线
library(dplyr)      # 数据分组统计
library(stats)      # 拟合校准回归模型

2. 计算Brier分数 #

Brier分数是预测概率与实际标签的均方误差，用yardstick包可以直接计算：

# 整理计算所需数据
brier_df <- tibble(
  truth = test_data$`Variable`,
  estimate = probs[,2]  # 取正类的预测概率
)

# 计算Brier分数
brier_result <- brier_score(brier_df, truth, estimate)
cat("Brier分数：", brier_result$.estimate, "\n")

3. 计算校准截距与斜率 #

通过拟合逻辑回归校准模型获取这两个指标：以实际标签为因变量、模型预测概率为自变量拟合逻辑回归，截距项就是校准截距，自变量系数就是校准斜率（理想状态为截距=0，斜率=1）：

# 将分类标签转为0/1数值，方便拟合模型
test_data$binary_label <- ifelse(test_data$`Variable` == levels(test_data$`Variable`)[2], 1, 0)

# 拟合校准回归
cal_model <- glm(binary_label ~ probs[,2], data = test_data, family = binomial())

# 提取结果
cal_intercept <- coef(cal_model)[1]
cal_slope <- coef(cal_model)[2]

cat("校准截距：", cal_intercept, "\n")
cat("校准斜率：", cal_slope, "\n")

4. 绘制校准曲线 #

采用分箱法（把预测概率分成10个区间，计算每个区间的实际事件发生率）绘制，同时添加理想校准线和拟合校准线：

# 给预测概率分箱
test_data$prob_bin <- cut(probs[,2], breaks = seq(0, 1, by = 0.1), include.lowest = TRUE)

# 统计每个分箱的平均预测概率、实际发生率
cal_stats <- test_data %>%
  group_by(prob_bin) %>%
  summarise(
    mean_pred = mean(probs[,2]),
    actual_rate = mean(binary_label),
    sample_count = n()
  )

# 绘制校准曲线
ggplot(cal_stats, aes(x = mean_pred, y = actual_rate)) +
  geom_point(aes(size = sample_count), alpha = 0.7)  # 点大小对应分箱样本量
  geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed")  # 理想校准线
  geom_smooth(method = "glm", method.args = list(family = binomial()), se = FALSE, color = "blue")  # 拟合校准线
  labs(
    x = "预测概率",
    y = "实际事件发生率",
    title = "XGBoost模型校准曲线",
    size = "分箱样本量"
  ) +
  theme_minimal()

补充说明 #

• 校准截距接近0、斜率接近1说明模型校准效果好：截距>0代表模型整体低估概率，截距<0则高估；斜率<1说明概率区分度被压缩，斜率>1则区分度被放大。
• 若不想用分箱法，可直接用geom_smooth对全量数据拟合逻辑回归曲线，不过分箱法更直观展示分组校准情况。

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