R使用插入符号训练函数的随机林交叉验证不会产生与手工执行相同的准确性

Question

我正在工作中的一些数据上建立一个随机森林（这意味着我不能分享那个数据，有15K个观测），使用插入符号训练函数进行交叉验证，模型的准确率很低：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)

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

--edit2
以下是有关我的数据的一些详细信息:
15493 OBS。17个变量中:
ICNUmber是一个包含1531个不同值的字符串，这些是类
其他16个变量是具有33个级别的因子
--edit2

--edit3
我的最后一个实验是删除所有出现次数少于10次的类的观察，剩下396个类的12k个观察。对于此数据集，手动和自动交叉验证精度匹配...
--edit3

Answer 1

这是一个棘手的问题！；-)
错误是由于误用了traincontrol中的index选项。

根据帮助页，index应为：

包含每个重采样迭代的元素的列表。每个列表元素都是一个整数向量，对应于在该迭代中用于训练的行。

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))

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

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包(v0.2.0)于2018-03-09创建。