如何指定一个验证数据集作为caret的保留集合

Question

我非常喜欢使用caret进行建模的早期阶段，特别是它的易于使用的重抽样方法。然而，我正在处理一个训练集中加入了半监督自训练的案例，导致我的交叉验证结果非常偏斜的模型。我的解决方案是使用验证集来衡量模型性能，但我无法直接在caret中使用验证集 - 我是否漏掉了什么或者这不被支持？我知道我可以编写自己的包装器来完成caret通常会为m执行的操作，但如果有一种方法可以避免这样做，那就太好了。

以下是我所经历的微不足道的示例：

> library(caret)
> set.seed(1)
> 
> #training/validation sets
> i <- sample(150,50)
> train <- iris[-i,]
> valid <- iris[i,]
> 
> #make my model
> tc <- trainControl(method="cv")
> model.rf <- train(Species ~ ., data=train,method="rf",trControl=tc)
> 
> #model parameters are selected using CV results...
> model.rf
100 samples
  4 predictors
  3 classes: 'setosa', 'versicolor', 'virginica' 

No pre-processing
Resampling: Cross-Validation (10 fold) 

Summary of sample sizes: 90, 90, 90, 89, 90, 92, ... 

Resampling results across tuning parameters:

  mtry  Accuracy  Kappa  Accuracy SD  Kappa SD
  2     0.971     0.956  0.0469       0.0717  
  3     0.971     0.956  0.0469       0.0717  
  4     0.971     0.956  0.0469       0.0717  

Accuracy was used to select the optimal model using  the largest value.
The final value used for the model was mtry = 2. 
> 
> #have to manually check validation set
> valid.pred <- predict(model.rf,valid)
> table(valid.pred,valid$Species)

valid.pred   setosa versicolor virginica
  setosa         17          0         0
  versicolor      0         20         1
  virginica       0          2        10
> mean(valid.pred==valid$Species)
[1] 0.94

我最初认为可以通过为trainControl()对象创建自定义的summaryFunction()来完成此操作，但我无法看到如何引用我的模型对象以从验证集中获取预测结果（文档 - http://caret.r-forge.r-project.org/training.html - 仅列出"data"、"lev"和"model"作为可能的参数）。例如，以下内容显然行不通：

tc$summaryFunction <- function(data, lev = NULL, model = NULL){
  data.frame(Accuracy=mean(predict(<model object>,valid)==valid$Species))
}

编辑：为了寻找一个真正丑陋的解决方案，我一直在尝试从另一个函数的作用域访问模型对象，但是我甚至没有看到它们被存储在哪里。希望有一种优雅的解决方案，我根本没有接近...

> tc$summaryFunction <- function(data, lev = NULL, model = NULL){
+   browser()
+   data.frame(Accuracy=mean(predict(model,valid)==valid$Species))
+ }
> train(Species ~ ., data=train,method="rf",trControl=tc)
note: only 1 unique complexity parameters in default grid. Truncating the grid to 1 .

Called from: trControl$summaryFunction(testOutput, classLevels, method)
Browse[1]> lapply(sys.frames(),function(x) ls(envi=x))
[[1]]
[1] "x"

[[2]]
 [1] "cons"      "contrasts" "data"      "form"      "m"         "na.action" "subset"   
 [8] "Terms"     "w"         "weights"   "x"         "xint"      "y"        

[[3]]
[1] "x"

[[4]]
 [1] "classLevels" "funcCall"    "maximize"    "method"      "metric"      "modelInfo"  
 [7] "modelType"   "paramCols"   "ppMethods"   "preProcess"  "startTime"   "testOutput" 
[13] "trainData"   "trainInfo"   "trControl"   "tuneGrid"    "tuneLength"  "weights"    
[19] "x"           "y"          

[[5]]
[1] "data"  "lev"   "model"

- David

Answer 1

请看trainControl。现在有直接指定用于建模数据的数据行（index参数）以及应用于计算保留估计值的行（称为indexOut）的选项。我认为这正是您要寻找的功能。

Max

- topepo

---

没错，这就是我最终采取的方法（正如我的解决方案所示）。顺便说一句，你的程序包做得很好。 - David

Answer 2

我认为我可能已经找到了一个解决方法，但我并不完全确定它是否达到了我想要的效果，我仍然希望有人能想出更加优雅的解决方案。无论如何，我意识到将验证集包含在训练集中并仅定义重新采样措施使用验证数据可能是最合理的。我认为这应该可以解决上述示例的问题：

> library(caret)
> set.seed(1)
> 
> #training/validation set indices
> i <- sample(150,50) #note - I no longer need to explictly create train/validation sets
> 
> #explicity define the cross-validation indices to be those from the validation set
> tc <- trainControl(method="cv",number=1,index=list(Fold1=(1:150)[-i]),savePredictions=T)
> (model.rf <- train(Species ~ ., data=iris,method="rf",trControl=tc))
150 samples
  4 predictors
  3 classes: 'setosa', 'versicolor', 'virginica' 

No pre-processing
Resampling: Cross-Validation (1 fold) 

Summary of sample sizes: 100 

Resampling results across tuning parameters:

  mtry  Accuracy  Kappa
  2     0.94      0.907
  3     0.94      0.907
  4     0.94      0.907

Accuracy was used to select the optimal model using  the largest value.
The final value used for the model was mtry = 2. 
> 
> #i think this worked because the resampling indices line up?
> all(sort(unique(model.rf$pred$rowIndex)) == sort(i))
[1] TRUE
> #exact contingency from above also indicate that this works
> table(model.rf$pred[model.rf$pred$.mtry==model.rf$bestTune[[1]],c("obs","pred")])
            pred
obs          setosa versicolor virginica
  setosa         17          0         0
  versicolor      0         20         2
  virginica       0          1        10

- David

---

这似乎可行，而且没有其他人提出异议，所以我现在会接受，但欢迎更优雅的解决方案。 - David