R语言 插入符号:组合分层创建MultiFolds(repeatedCV)和groupKFold

Question

我的问题与 插入符号：组合创建重新采样和分组KFold

唯一的区别：我需要在分组后创建分层折叠(也重复 10 次)，而不是自举重新采样(据我所知没有分层)以将其与插入符号的 trainControl 一起使用。 以下代码适用于 10 倍重复的 CV，但我无法包含基于"ID"(df$ID)的数据分组。

# creating indices
cv.10.folds <- createMultiFolds(rf_label, k = 10, times = 10)
# creating folds    
ctrl.10fold <- trainControl(method = "repeatedcv", number = 10, repeats = 10, index = cv.10.folds)
# train
rf.ctrl10 <- train(rf_train, y = rf_label, method = "rf", tuneLength = 6,
ntree = 1000, trControl = ctrl.10fold, importance = TRUE)

这是我的实际问题：我的数据包含许多组，每个组由 20 个实例组成，具有相同的"ID"。因此，当使用重复 10 次的 10 倍 CV 时，我会在训练中获得一组的一些实例，在验证集中得到一些实例。我想避免这种情况，但总的来说，我需要对预测值进行分层分区 (df$Label)。(具有相同"ID"的所有实例也具有相同的预测/标签值。

在上面链接提供和接受的答案中(见下面的部分)，我想我必须修改folds2行以包含分层的 10 倍 CV 而不是自举

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

但不幸的是，我无法弄清楚究竟如何。你能帮我吗？

Answer 1

这是一种使用阻塞执行分层重复 K 折叠 CV 的方法。

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) #factor id's
df %>%
mutate(id = as.numeric(id)) %>% #convert to numeric
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)) %>% #also need to convert to numeric in the original data frame
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 %>% #start from grouped data
select(id) %>% #select id's
slice(i) %>% #filter id's according to fold index
left_join(df %>% #join by id 
rowid_to_column()) %>%
pull(rowid) 
})

它适用于插入符号吗？

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，它具有许多不错的功能，包括阻塞 - 这是SO的一个答案。它有很多关于很多事情的非常好的教程。很长一段时间以来，我认为你要么使用caret要么使用mlr但它们很好地互补在一起。