我的问题与caret: 结合createResample和groupKFold中提出的问题非常相似

唯一的区别是：我需要在分组后创建分层的折叠（重复10次），而不是使用引导重采样（据我所知，这些不是分层的），以便与caret的trainControl一起使用。以下代码可以用于10折重复交叉验证，但我无法根据“ID”（df$ID）对数据进行分组。

# 创建索引
cv.10.folds <- createMultiFolds(rf_label, k = 10, times = 10)
# 创建折叠
ctrl.10fold <- trainControl(method = "repeatedcv", number = 10, repeats = 10, index = cv.10.folds)
# 训练
rf.ctrl10 <- train(rf_train, y = rf_label, method = "rf", tuneLength = 6, 
                   ntree = 1000, trControl = ctrl.10fold, importance = TRUE)

这是我的实际问题：我的数据包含许多由20个实例组成的组，每组具有相同的“ID”。因此，当使用10折重复10次的交叉验证时，某个组的一些实例会在训练集中，而另一些会在验证集中。我希望避免这种情况，但总体上我需要对预测值（df$Label）进行分层划分。（所有具有相同“ID”的实例也具有相同的预测/标签值。）

在上面链接中提供并接受的答案中（见下面的部分），我猜我需要修改folds2行以包含分层的10折交叉验证，而不是引导重采样

folds <- groupKFold(x)
folds2 <- lapply(folds, function(x) lapply(1:10, function(i) sample(x, size = length(x), replace = TRUE)))

但遗憾的是我无法准确弄清楚该如何做。你能帮我吗？

回答：

这里提供了一种执行带阻塞的分层重复K折交叉验证的方法。

library(caret)
library(tidyverse)

一些虚假数据，其中id将作为阻塞因子：

id <- sample(1:55, size = 1000, replace = T)
y <- rnorm(1000)
x <- matrix(rnorm(10000), ncol = 10)
df <- data.frame(id, y, x)

按阻塞因子汇总观察值：

df %>%  
  group_by(id) %>%  
  summarise(mean = mean(y)) %>%  
  ungroup() -> groups1 

基于分组数据创建分层折叠：

folds <- createMultiFolds(groups1$mean, 10, 3)

将原始df重新连接到组数据，并获取df的行id

folds <- lapply(folds, function(i){  
  data.frame(id = i) %>%    
    left_join(df %>%                
                rowid_to_column()) %>%    
    pull(rowid) })

检查测试集中的数据id是否不在训练集中：

lapply(folds, function(i){  
  sum(df[i,1] %in% df[-i,1])})

输出是一堆零，这意味着测试折叠中的id不在训练折叠中。

如果你的组id不是数字，有两种方法可以使其工作：
1 将它们转换为数字：

首先是一些数据

id <- sample(1:55, size = 1000, replace = T)
y <- rnorm(1000)
x <- matrix(rnorm(10000), ncol = 10)
df <- data.frame(id = paste0("id_", id), y, x) #因子id's
df %>%  
  mutate(id = as.numeric(id)) %>% #转换为数字  
  group_by(id) %>%  
  summarise(mean = mean(y)) %>%  
  ungroup() -> groups1 
folds <- createMultiFolds(groups1$mean, 10, 3)
folds <- lapply(folds, function(i){  
  data.frame(id = i) %>%    
    left_join(df %>%                
                mutate(id = as.numeric(id)) %>% #同样需要在原始数据框中转换为数字                
                rowid_to_column()) %>%    
    pull(rowid) })  

2 在分组数据中根据折叠索引过滤id，然后按id连接

df %>%  
  group_by(id) %>%  
  summarise(mean = mean(y)) %>%  
  ungroup() -> groups1 
folds <- createMultiFolds(groups1$mean, 10, 3)
folds <- lapply(folds, function(i){  
  groups1 %>% #从分组数据开始    
    select(id) %>% #选择id's    
    slice(i) %>% #根据折叠索引过滤id's    
    left_join(df %>% #按id连接                
                rowid_to_column()) %>%    
    pull(rowid) })

这对caret有效吗？

ctrl.10fold <- trainControl(method = "repeatedcv", number = 10, repeats = 3, index = folds)
rf.ctrl10 <- train(x = df[,-c(1:2)], y = df$y, data = df, method = "rf", tuneLength = 1, 
                   ntree = 20, trControl = ctrl.10fold, importance = TRUE)
rf.ctrl10$results
#output  
  mtry     RMSE    Rsquared       MAE     RMSESD  RsquaredSD      MAESD
1    3 1.041641 0.007534611 0.8246514 0.06953668 0.009488169 0.05934975

我还建议你查看库mlr，它有许多不错的功能，包括阻塞 – 这里是Stack Overflow上的一个答案。它有许多非常好的教程，关于许多事情。很长一段时间我以为你要么使用caret，要么使用mlr，但它们彼此非常好的互补。