分层 10 折交叉验证

Question

我已经开始使用 10 折交叉验证为人工数据集创建一些训练和测试集：

rows <- 1000

X1<- sort(runif(n = rows, min = -1, max =1))
occ.prob <- 1/(1+exp(-(0.0 + 3.0*X1)))
true.presence <- rbinom(n = rows, size = 1, prob = occ.prob)

# combine data as data frame and save
data <- data.frame(X1, true.presence)

id <- sample(1:10,nrow(data),replace=TRUE)
ListX <- split(data,id) 
fold1 <- data[id==1,] 
fold2 <- data[id==2,] 
fold3 <- data[id==3,] 
fold4 <- data[id==4,] 
fold5 <- data[id==5,] 
fold6 <- data[id==6,] 
fold7 <- data[id==7,] 
fold8 <- data[id==8,] 
fold9 <- data[id==9,] 
fold10 <- data[id==10,] 

trainingset <- subset(data, id %in% c(2,3,4,5,6,7,8,9,10))
testset <- subset(data, id %in% c(1))

我只是想知道是否有更简单的方法来实现这一点，以及如何执行分层交叉验证以确保类先验 (true.presence) 在所有折叠中大致相同？

Answer 1

我发现 splitTools 非常有用，希望小插图 https://cran.r-project.org/web/packages/splitTools/vignettes/splitTools.html 可以帮助任何对此主题感兴趣的人。

> y <- rep(c(letters[1:4]), each = 5)
> y
 [1] "a" "a" "a" "a" "a" "b" "b" "b" "b" "b" "c" "c" "c" "c" "c" "d" "d" "d" "d" "d"
> create_folds(y)
$Fold1
 [1]  1  2  3  5  6  7  8 10 12 13 14 15 17 18 19 20

$Fold2
 [1]  1  2  4  5  6  8  9 10 11 12 13 14 16 17 19 20

$Fold3
 [1]  2  3  4  5  6  7  9 10 11 12 13 15 16 17 18 20

$Fold4
 [1]  1  2  3  4  7  8  9 10 11 13 14 15 16 18 19 20

$Fold5
 [1]  1  3  4  5  6  7  8  9 11 12 14 15 16 17 18 19

> create_folds(y, m_rep = 3)
$Fold1.Rep1
 [1]  1  2  4  5  6  7  8 10 11 12 13 15 16 17 19 20

$Fold2.Rep1
 [1]  2  3  4  5  6  8  9 10 11 12 13 14 16 17 18 20

$Fold3.Rep1
 [1]  1  2  3  5  7  8  9 10 11 12 14 15 17 18 19 20

$Fold4.Rep1
 [1]  1  2  3  4  6  7  9 10 11 13 14 15 16 18 19 20

$Fold5.Rep1
 [1]  1  3  4  5  6  7  8  9 12 13 14 15 16 17 18 19

$Fold1.Rep2
 [1]  1  2  3  5  6  8  9 10 11 12 13 14 16 17 18 19

$Fold2.Rep2
 [1]  1  2  3  4  6  7  8 10 11 12 14 15 17 18 19 20

$Fold3.Rep2
 [1]  2  3  4  5  6  7  8  9 12 13 14 15 16 17 19 20

$Fold4.Rep2
 [1]  1  3  4  5  7  8  9 10 11 13 14 15 16 17 18 20

$Fold5.Rep2
 [1]  1  2  4  5  6  7  9 10 11 12 13 15 16 18 19 20

$Fold1.Rep3
 [1]  1  2  3  4  6  7  9 10 11 12 13 15 16 18 19 20

$Fold2.Rep3
 [1]  2  3  4  5  6  8  9 10 11 12 13 14 16 17 18 19

$Fold3.Rep3
 [1]  1  2  4  5  6  7  8  9 11 12 14 15 16 17 19 20

$Fold4.Rep3
 [1]  1  2  3  5  7  8  9 10 12 13 14 15 17 18 19 20

$Fold5.Rep3
 [1]  1  3  4  5  6  7  8 10 11 13 14 15 16 17 18 20

Answer 2

@joran 是对的（关于他的假设 (b)）。 dismo::kfold() 就是你要找的。​​p>

所以使用最初问题中的data：

require(dismo)
folds <- kfold(data, k=10, by=data$true.presence)

给出一个长度为nrow(data) 的向量，其中包含每行数据的折叠关联。 因此，data[fold==1,] 返回第一个折叠，data[fold!=1,] 可用于验证。

编辑 6/2018：我强烈支持使用 @gkcn 推荐的 caret 包。它更好地集成在 tidyverse 工作流程中，并且更积极地开发。去吧！

Answer 3

caret 包的createFolds 方法执行分层分区。这是帮助页面中的一段：

...当 y 是试图平衡拆分内的类分布的一个因素时，随机抽样是在 y 的水平（=结果）内完成的。

这是您问题的答案：

library(caret)
folds <- createFolds(factor(data$true.presence), k = 10, list = FALSE)

和比例：

> library(plyr)
> data$fold <- folds
> ddply(data, 'fold', summarise, prop=mean(true.presence))
     fold      prop
1       1 0.5000000
2       2 0.5050505
3       3 0.5000000
4       4 0.5000000
5       5 0.5000000
6       6 0.5049505
7       7 0.5000000
8       8 0.5049505
9       9 0.5000000
10     10 0.5050505

Answer 4

我确信 (a) 有一种更有效的编码方式，并且 (b) 几乎可以肯定在包中的某处有一个函数会返回折叠，但这里有一些简单的代码可以让您了解如何做到这一点：

rows <- 1000

X1<- sort(runif(n = rows, min = -1, max =1))
occ.prob <- 1/(1+exp(-(0.0 + 3.0*X1)))
true.presence <- rbinom(n = rows, size = 1, prob = occ.prob)

# combine data as data frame and save
dat <- data.frame(X1, true.presence)

require(plyr)
createFolds <- function(x,k){
    n <- nrow(x)
    x$folds <- rep(1:k,length.out = n)[sample(n,n)]
    x
}

folds <- ddply(dat,.(true.presence),createFolds,k = 10)

#Proportion of true.presence in each fold:
ddply(folds,.(folds),summarise,prop = sum(true.presence)/length(true.presence))

   folds      prop
1      1 0.5049505
2      2 0.5049505
3      3 0.5100000
4      4 0.5100000
5      5 0.5100000
6      6 0.5100000
7      7 0.5100000
8      8 0.5100000
9      9 0.5050505
10    10 0.5050505