9

我已经开始使用 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）在所有折叠中大致相同？

4

4 回答 4

23

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

...当 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
于 2014-05-15T09:36:05.767 回答
11

我确信 (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
于 2012-05-01T15:47:53.173 回答
8

@joran 是对的（关于他的假设（b））。 dismo::kfold()是您正在寻找的。

所以data从最初的问题开始使用：

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

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

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

于 2014-01-31T08:33:42.730 回答
2

我发现 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
于 2021-09-03T08:24:56.603 回答