优化重复交叉验证：R语言中10次5折交叉验证代码的双重循环能否避免？

问题描述 #

我需要执行10次5折交叉验证来计算二分类模型的准确率，目前用caret包写了一个带双重循环的R函数，能正常运行但效率较低，感觉是最直观但最慢的实现方式。想请教下这个双重循环是否可以避免？

原函数代码：

library(caret)
cross_validation <- function(y, x) {
  acc <- c()
  idx <- 1:length(y)
  for (j in 1:10) {
    folds <- createFolds(y, k = 5, list = TRUE, returnTrain = FALSE)
    for (i in 1:5) {
      training <- idx[-unlist(folds[i])]
      model <- glm(y[training] ~ ., data = x[training, ], family = binomial())
      preds <- predict(model, newdata = x[unlist(folds[i]), ], type = "response")
      preds[preds>0.5] <- 1
      preds[preds <=0.5] <- 0
      acc[i] <- confusionMatrix(as.factor(y[unlist(folds[i])]), as.factor(preds))$overall[1]
    }
  }
  mean(acc, na.rm = T)
}

示例运行：

set.seed(42)
y <- sample(0:1,100,T)
df <- data.frame("Norm" = rnorm(100), "Exp" = rexp(100))
> cross_validation(y, df)
[1] 0.45

回答 #

当然可以避免双重循环！而且你完全可以利用caret包本身的内置功能来更高效地完成这个任务，不用手动写嵌套循环。下面给你两种方案：

方案1：用caret的train()函数（最推荐）

caret的train()函数原生支持重复交叉验证，内部已经做了优化，代码简洁且效率更高，还能自动处理结果汇总。

library(caret)

# 准备数据：注意把响应变量转成因子（二分类任务caret要求）
set.seed(42)
y <- sample(0:1, 100, TRUE)
df <- data.frame(y = as.factor(y), Norm = rnorm(100), Exp = rexp(100))

# 配置重复5折交叉验证的控制参数
train_control <- trainControl(
  method = "repeatedcv",  # 指定重复交叉验证
  number = 5,             # 5折
  repeats = 10,           # 重复10次
  classProbs = TRUE,      # 因为是二分类，需要计算概率（对应glm的binomial家族）
  summaryFunction = defaultSummary  # 使用默认的评估指标（包含准确率）
)

# 训练模型并执行交叉验证
model <- train(
  y ~ .,
  data = df,
  method = "glm",
  family = binomial(),
  trControl = train_control,
  metric = "Accuracy"  # 指定我们关注的评估指标是准确率
)

# 查看最终的平均准确率
cat("平均准确率：", model$results$Accuracy, "\n")

这个方法的优势：

• 不用手动维护循环、索引和准确率向量，代码更简洁易读
• caret内部的实现经过优化，比手动循环效率更高
• 可以轻松切换模型（比如换随机森林只需要改method = "rf"），还能添加参数调优逻辑

方案2：手动实现但用迭代函数替代双重循环

如果因为某些原因需要自定义交叉验证逻辑，可以用purrr包的map系列函数（或者base R的lapply）替代显式的双重循环，提升代码可读性和效率。

library(caret)
library(purrr)  # 提供更友好的迭代函数，base R的lapply也可以替代

cross_validation_optimized <- function(y, x) {
  # 把响应变量转成因子，确保分类一致
  y <- as.factor(y)
  
  # 一次性生成10次重复的5折折叠集合
  repeated_folds <- replicate(10, createFolds(y, k = 5, list = TRUE), simplify = FALSE)
  
  # 遍历每一次重复的折叠，计算该次5折的准确率均值
  acc_per_repeat <- map_dbl(repeated_folds, function(folds) {
    # 遍历当前重复的每个折叠，计算单折准确率
    fold_acc <- map_dbl(folds, function(fold_idx) {
      train_idx <- seq_along(y)[-fold_idx]
      model <- glm(y[train_idx] ~ ., data = x[train_idx, ], family = binomial())
      
      preds <- predict(model, newdata = x[fold_idx, ], type = "response")
      preds <- as.factor(ifelse(preds > 0.5, 1, 0))
      # 确保预测结果的水平和原响应变量一致，避免confusionMatrix报错
      levels(preds) <- levels(y)
      
      confusionMatrix(preds, y[fold_idx])$overall["Accuracy"]
    })
    mean(fold_acc, na.rm = TRUE)
  })
  
  # 返回所有重复的平均准确率
  mean(acc_per_repeat, na.rm = TRUE)
}

# 测试优化后的函数
set.seed(42)
y <- sample(0:1,100,TRUE)
df <- data.frame("Norm" = rnorm(100), "Exp" = rexp(100))
cat("平均准确率：", cross_validation_optimized(y, df), "\n")

这个方法的优势：

• 用函数式迭代替代显式的for循环，代码更简洁，减少了手动维护向量索引的错误
• purrr的map系列函数在处理大量迭代时，效率比原生for循环略高

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