多组数据下模型性能对分组折构成的敏感性分析及SuperLearner适配问题

一、6组情况下生成不同组占比的交叉验证折 #

针对6组数据，我们需要生成训练集组占比从完全均衡到极端不均衡的交叉验证折，核心是控制各组采样比例的偏离程度，同时保持训练集总大小稳定。

实现代码 #

library(tidyverse)
library(caret)
library(SuperLearner)

# 6组示例数据
df <- tibble(id = 1:3000,
             outcome = rnorm(3000),
             feature1 = rnorm(3000),
             feature2 = rnorm(3000),
             group = as.character(rep(1:6, each = 500)))

# 按组拆分数据索引
group_indices <- split(df$id, df$group)
n_groups <- length(group_indices)
# 均衡状态下每组的基准占比（1/6）
base_prop <- 1/n_groups
# 定义偏离均衡的程度序列：0=完全均衡，0.8=极端不均衡
deviation_seq <- seq(0, 0.8, by = 0.05)
# 每个偏离程度生成100个重复折
n_repeats <- 100

folds <- list()
fold_idx <- 1

for (dev in deviation_seq) {
  for (rep in 1:n_repeats) {
    # 随机选择一个主导组，分配更高占比
    dominant_group <- sample(n_groups, 1)
    # 初始化比例：非主导组按偏离程度降低占比
    props <- rep(base_prop * (1 - dev), n_groups)
    # 主导组占比 = 基准占比 + 其他组让渡的比例
    props[dominant_group] <- base_prop + dev * (n_groups - 1)
    
    # 修正比例总和为1（消除浮点误差）
    props <- props / sum(props)
    
    # 固定训练集总大小为2000，计算每组采样数量
    train_size_total <- 2000
    sample_sizes <- round(props * train_size_total)
    # 修正采样数量总和误差
    sample_sizes[dominant_group] <- sample_sizes[dominant_group] + (train_size_total - sum(sample_sizes))
    
    # 对每组进行无放回采样
    sampled_ids <- map2(group_indices, sample_sizes, ~sample(.x, size = .y, replace = FALSE)) %>% unlist()
    
    # 将采样结果存入折列表
    folds[[paste0("Fold_dev_", round(dev,2), "_rep_", rep)]] <- sampled_ids
    fold_idx <- fold_idx + 1
  }
}

关键说明 #

• 用deviation_seq控制偏离均衡的程度，数值越大，某一组占比越高，其余组占比越低
• 随机选择主导组，避免仅偏向单一组的偏差
• 固定训练集总大小，排除样本量对模型性能的干扰

二、提取SuperLearner的分折性能指标 #

SuperLearner默认输出整体性能，可通过两种方式获取分折性能：

方法1：利用CV.SuperLearner提取结果 #

CV.SuperLearner会返回每个观测的预测值，结合自定义折划分计算分折性能：

# 准备特征与结果变量
X <- df %>% select(feature1, feature2)
Y <- df$outcome

# 将训练集折转换为测试集折（CV.SuperLearner要求输入测试集索引）
cv_folds <- lapply(folds, function(train_ids) setdiff(df$id, train_ids))

# 运行交叉验证SuperLearner
cv_sl <- CV.SuperLearner(Y = Y, X = X,
                         SL.library = c("SL.lm", "SL.ranger"),
                         foldList = cv_folds,
                         verbose = FALSE)

# 计算每个折的R²与组占比偏离程度
perf_sl <- map_dfr(seq_along(cv_folds), function(idx) {
  test_ids <- cv_folds[[idx]]
  y_true <- Y[test_ids]
  y_pred <- cv_sl$pred[, idx]
  
  # 计算R²
  r2 <- 1 - sum((y_true - y_pred)^2) / sum((y_true - mean(y_true))^2)
  
  # 计算训练集组占比的偏离程度（偏差平方和）
  train_ids <- folds[[idx]]
  train_props <- df %>% filter(id %in% train_ids) %>% count(group) %>% mutate(prop = n/length(train_ids)) %>% pull(prop)
  deviation <- sum((train_props - base_prop)^2)
  
  tibble(fold_name = names(folds)[idx],
         deviation = deviation,
         r2 = r2)
})

# 可视化性能与偏离程度的关系
ggplot(perf_sl, aes(deviation, r2)) + 
  labs(y = "R²", x = "组占比偏离均衡程度（偏差平方和）") +
  geom_smooth(method = "lm") +
  geom_point(alpha = .75) + 
  ggpubr::stat_cor() +
  theme_minimal()

方法2：手动循环训练并计算性能 #

若需更灵活的控制，可手动遍历每个折训练模型并计算性能：

perf_sl_manual <- map_dfr(seq_along(folds), function(idx) {
  train_ids <- folds[[idx]]
  test_ids <- setdiff(df$id, train_ids)
  
  # 拆分训练/测试数据
  X_train <- X[train_ids, ]
  Y_train <- Y[train_ids]
  X_test <- X[test_ids, ]
  Y_test <- Y[test_ids]
  
  # 训练SuperLearner
  sl_fit <- SuperLearner(Y = Y_train, X = X_train,
                         SL.library = c("SL.lm", "SL.ranger"))
  
  # 预测并计算R²
  y_pred <- predict(sl_fit, newdata = X_test)$pred
  r2 <- 1 - sum((Y_test - y_pred)^2) / sum((Y_test - mean(Y_test))^2)
  
  # 计算组占比偏离程度
  train_props <- df %>% filter(id %in% train_ids) %>% count(group) %>% mutate(prop = n/length(train_ids)) %>% pull(prop)
  deviation <- sum((train_props - base_prop)^2)
  
  tibble(fold_name = names(folds)[idx],
         deviation = deviation,
         r2 = r2)
})

三、补充说明 #

• 组占比偏离程度的衡量可替换为基尼系数、最大组占比与基准占比的差值等，按需选择
• CV.SuperLearner效率更高，适合大样本；手动循环更灵活，便于添加自定义逻辑
• 始终保持训练集大小一致，确保组占比是影响模型性能的唯一变量

内容的提问来源于stack exchange，提问作者Dr. Fabian Habersack