使用插入符号训练函数的 R 随机森林交叉验证不会产生与手动完成时相同的准确性

Question

我在工作中的一些数据上构建了一个随机森林(这意味着我无法共享该数据，有 15k 个观察值)，使用 caret train 函数进行交叉验证，模型的准确性非常低: 0.9%。

这是我使用的代码:

set.seed(512)
n <- nrow(my_data)

train_indices <- sample(1:n)
my_folds <- createFolds(train_indices, k=5)

model <- train(ICNumber ~ ., tuneGrid = data.frame(mtry = c(32), min.node.size = 1, splitrule = "gini"),
                 data = my_data, method = "ranger",
                 trControl = trainControl(verboseIter = TRUE, savePredictions = T, index=my_folds))

print(model$resample)

--编辑
正如 Gilles 所注意到的那样，折叠索引的构造有误，并且对 20% 的观察结果进行了训练，但即使我通过添加 returnTrain = T 来解决这个问题，我的准确度仍然接近于零
--编辑

model$resample 产生这个:

Accuracy ___ Kappa_____ Resample  
0.026823683_ 0.0260175246_ Fold1  
0.002615234_ 0.0019433907_ Fold2  
0.002301118_ 0.0017644472_ Fold3  
0.001637733_ 0.0007026352_ Fold4  
0.010187315_ 0.0094986595_ Fold5  

现在，如果我像这样手动进行交叉验证:

set.seed(512)
n <- nrow(my_data)

train_indices <- sample(1:n)
my_folds <- createFolds(train_indices, k=5)

for (fold in my_folds) {
  train_data <- my_data[-fold,]
  test_data <- my_data[fold,]

  model <- train(ICNumber ~ ., tuneGrid = data.frame(mtry = c(32), min.node.size = 1, splitrule = "gini"),
                 data = train_data, method = "ranger",
                 trControl = trainControl(method = "none"))

  p <- predict(model, test_data)
  e <- ifelse(p == test_data$ICNumber, T, F)
  print(sum(e) / nrow(test_data))
}

我得到以下准确度:

[1] 0.743871  
[1] 0.7566957  
[1] 0.7380645  
[1] 0.7390181  
[1] 0.7311168

我期望获得大致相同的准确度值，我在训练中做错了什么？还是人工预测代码有误？

--编辑
此外，这段代码在大 bean 数据上运行良好，我可以在下面重现 Gilles 的结果
--编辑

--编辑2
以下是有关我的数据的一些详细信息:
15493 观察。共 17 个变量:
ICNUber 是一个有 1531 个不同值的字符串，这些是类
其余16个变量为33个水平的因子
--编辑2

--编辑3
我的最后一个实验是删除所有发生次数少于 10 次的类的观察值，保留 396 个类的 12k 个观察值。对于这个数据集，手动和自动交叉验证的准确性匹配...
--编辑3

Answer 1

这是一个棘手的问题! ;-)
该错误来自于 trainControl 中的 index 选项的误用。

根据帮助页面，index 应该是:

a list with elements for each resampling iteration. Each list element is a vector of integers corresponding to the rows used for training at that iteration.

在您的代码中，您提供了与应删除的行对应的整数来自训练数据集，而不是提供对应于应该使用的行...

您可以使用 createFolds(train_indices, k=5, returnTrain = T) 来改变它的 createFolds(train_indices, k=5)。
另请注意，在内部，afaik，caret 正在创建相对平衡的折叠到您要预测的类。所以理想情况下代码应该更像:createFolds(my_data[train_indices, "Class"], k=5, returnTrain = T), 特别是如果类不平衡...

这是一个使用 Soybean 数据集的可重现示例

library(caret)
#> Le chargement a nécessité le package : lattice
#> Le chargement a nécessité le package : ggplot2
data(Soybean, package = "mlbench")
my_data <- droplevels(na.omit(Soybean))

您的代码(这里的训练数据比预期的要小得多，您只使用了 20% 的数据，因此准确性较低)。
由于训练数据集中缺少某些类(由于类不平衡和训练集减少)，您还会收到一些警告。

set.seed(512)
n <- nrow(my_data)

train_indices <- sample(1:n)
my_folds <- createFolds(train_indices, k=5)

model <- train(Class ~ ., tuneGrid = data.frame(mtry = c(32), min.node.size = 1, splitrule = "gini"),
               data = my_data, method = "ranger",
               trControl = trainControl(verboseIter = F, savePredictions = T, 
                                        index=my_folds))
#> Warning: Dropped unused factor level(s) in dependent variable: rhizoctonia-
#> root-rot.
#> Warning: Dropped unused factor level(s) in dependent variable: downy-
#> mildew.

print(model$resample)
#>    Accuracy     Kappa Resample
#> 1 0.7951002 0.7700909    Fold1
#> 2 0.5846868 0.5400131    Fold2
#> 3 0.8440980 0.8251373    Fold3
#> 4 0.8822222 0.8679453    Fold4
#> 5 0.8444444 0.8263563    Fold5

更正代码，仅使用 returnTrain = T(此处您实际上使用了 80% 的数据进行训练...)

set.seed(512)
n <- nrow(my_data)

train_indices <- sample(1:n)
my_folds <- createFolds(train_indices, k=5, returnTrain = T)

model <- train(Class ~ ., tuneGrid = data.frame(mtry = c(32), min.node.size = 1, splitrule = "gini"),
               data = my_data, method = "ranger",
               trControl = trainControl(verboseIter = F, savePredictions = T, 
                                        index=my_folds))

print(model$resample)
#>    Accuracy     Kappa Resample
#> 1 0.9380531 0.9293371    Fold1
#> 2 0.8750000 0.8583687    Fold2
#> 3 0.9115044 0.9009814    Fold3
#> 4 0.8660714 0.8505205    Fold4
#> 5 0.9107143 0.9003825    Fold5

与您的循环进行比较。仍然存在一些小差异，所以可能还有一些我不明白的地方。

set.seed(512)
n <- nrow(my_data)

train_indices <- sample(1:n)
my_folds <- createFolds(train_indices, k=5)

for (fold in my_folds) {
    train_data <- my_data[-fold,]
    test_data <- my_data[fold,]

    model <- train(Class ~ ., tuneGrid = data.frame(mtry = c(32), min.node.size = 1, splitrule = "gini"),
                   data = train_data, method = "ranger",
                   trControl = trainControl(method = "none"))

    p <- predict(model, test_data)
    e <- ifelse(p == test_data$Class, T, F)
    print(sum(e) / nrow(test_data))
}
#> [1] 0.9380531
#> [1] 0.875
#> [1] 0.9115044
#> [1] 0.875
#> [1] 0.9196429

由 reprex package 创建于 2018-03-09 (v0.2.0).