如何在R的Caret包交叉验证各折内为患者随机采样构建迷你训练集？

核心需求 #

你有含重复患者测量数据的临床数据集（600患者×10条记录=6000行），已拆分好独立的训练/测试集（同患者数据不跨集）。需要在Caret的交叉验证（CV）每一轮迭代中，先为每个患者随机采样1条记录生成迷你训练集，再基于该迷你集做CV与超参数调优，避免提前单次采样造成的数据浪费。

可行实现方案 #

通过自定义Caret的重采样索引，将患者级随机采样嵌套到CV流程中，具体代码如下：

步骤1：自定义重采样索引生成函数 #

该函数会完成「重复采样患者记录+生成CV折索引」的逻辑：

library(caret)
library(dplyr)

generate_custom_cv <- function(train_data, n_repeats = 10, n_folds = 10) {
  cv_indexes <- list()
  patient_ids <- unique(train_data$patient_ID)
  
  for (rep in 1:n_repeats) {
    # 1. 为每个患者随机抽取1条记录
    sampled_df <- train_data %>%
      group_by(patient_ID) %>%
      slice_sample(n = 1) %>%
      ungroup()
    
    # 2. 为采样后的迷你集生成n_folds折的划分索引
    fold_ids <- createFolds(y = sampled_df$continuous_variable, k = n_folds)
    
    # 3. 将迷你集的行号映射回原始训练集的行号
    train_data_with_row <- train_data %>% mutate(row_idx = row_number())
    sampled_rows <- train_data_with_row %>%
      semi_join(sampled_df, by = c("patient_ID", setdiff(names(train_data), "patient_ID"))) %>%
      pull(row_idx)
    
    # 4. 存储每折对应的原始数据行号
    for (fold in 1:n_folds) {
      cv_indexes[[paste0("Rep", rep, "_Fold", fold)]] <- sampled_rows[fold_ids[[fold]]]
    }
  }
  
  # 生成每折对应的测试集索引（训练集的补集）
  cv_indexes_test <- lapply(cv_indexes, function(idx) setdiff(1:nrow(train_data), idx))
  
  return(list(index = cv_indexes, indexOut = cv_indexes_test))
}

步骤2：配置训练控制参数并训练模型 #

# 生成自定义CV索引（10次重复，每次重复做10折CV）
cv_indices <- generate_custom_cv(train_data = train, n_repeats = 10, n_folds = 10)

# 配置trainControl，使用自定义重采样规则
trControl <- trainControl(
  method = "custom",
  index = cv_indices$index,
  indexOut = cv_indices$indexOut,
  allowParallel = TRUE,
  verboseIter = TRUE
)

# 训练模型（训练时移除patient_ID列）
model <- train(
  continuous_variable ~ ., 
  data = train %>% select(-patient_ID),
  method = "ranger", 
  tuneLength = 60, 
  trControl = trControl
)

方案优势 #

• 充分利用数据：每一轮CV重复都会重新采样患者的不同记录，避免了仅用10%数据的浪费
• 结果更稳健：超参数性能评估基于多次采样后的CV平均结果，降低单次采样的随机性影响
• 符合数据结构：严格保证同患者的记录不会同时出现在同一折的训练/测试集中（因为采样后每个患者仅一条记录，常规CV自然满足分组独立性）

测试集评估 #

训练完成后，仍可按需求对测试集做患者级采样（或直接用所有测试记录），然后评估模型：

# 可选：对测试集做患者级采样（与训练时采样逻辑一致）
test_sampled <- test %>%
  group_by(patient_ID) %>%
  slice_sample(n = 1) %>%
  ungroup() %>%
  select(-patient_ID)

# 预测并计算RMSE
predictions <- predict(model, newdata = test_sampled)
RMSE(predictions, test_sampled$continuous_variable)

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