Блог

Я хотел бы рассчитать точность прогнозирования в выборке и вне выборки для определенных показателей, используя k-кратную перекрестную проверку каретки.

До сих пор я получил

 library(MASS)
library(leaps)
library(caret)
library(tidyverse)

full_df <- surgical

set.seed(123)
Performance_Summary <- function(data,
                                lev = NULL, 
                                model = NULL) {
                                c(RMSE = sqrt(mean((data$obs-data$pred)^2)),
                                  MAE = mean(data$obs - data$pred))
}

train.Control <- trainControl(method = "cv", number = 10, summaryFunction = Performance_Summary)
cv_linear_model <- train(y~., data = full_df, method = "lm", trControl = train.Control)

cv_linear_model
  

Что должно дать мне среднее значение RMSE и MAE для каждого из 10 наборов вне выборки (тестов).

Что я хотел бы сделать сейчас, так это вычислить средние значения RMSE и MAE для каждого из 10 наборов в выборке (обучающих).

Возможно ли это с использованием пакета каретки? Или мне нужно было бы реализовать k-кратную перекрестную проверку вручную, чтобы получить показатели в выборке.

Спасибо за вашу помощь!

Если вы не возражаете против подгонки модели дважды, сначала вы установите сгибы тестирования и обучения, используя пример набора BostonHousing данных, где medv зависимая переменная:

 library(mlbench)
data(BostonHousing)
full_df = BostonHousing[1:400,]

#create folds
set.seed(111)
testFolds = createFolds(full_df$medv,k=10)

trFolds =lapply(testFolds,function(i)setdiff(1:nrow(full_df),i))
  

В MAE ошибка, это должно быть среднее значение абсолютного:

 Performance_Summary <- function(data,
                                lev = NULL, 
                                model = NULL) {
                                c(RMSE = sqrt(mean((data$obs-data$pred)^2)),
                                  MAE = mean(abs(data$obs - data$pred)))
}
  

Запуск для тестовых данных, как обычно в каретке:

 test.Control <- trainControl(method = "cv", summaryFunction = Performance_Summary,index=trFolds,indexOut=testFolds)

results_test <- train(medv~., data = full_df, method = "lm", trControl = test.Control)

head(results_test$resample)
      RMSE  MAE Resample
1 4.07 3.02   Fold01
2 4.10 3.04   Fold02
3 5.76 4.48   Fold03
4 4.16 2.97   Fold04
5 4.10 3.01   Fold05
6 6.14 4.25   Fold06
  

Запуск с тем же обучением, но и тестирование с тем же индексом:

 train.Control <- trainControl(method = "cv", summaryFunction = Performance_Summary,index=trFolds,indexOut=trFolds)

results_train <- train(medv~., data = full_df, method = "lm", trControl = train.Control)

head(results_train$resample)    

  RMSE  MAE Resample
1 4.80 3.35   Fold01
2 4.80 3.32   Fold02
3 4.63 3.19   Fold03
4 4.79 3.29   Fold04
5 4.80 3.31   Fold05
6 4.57 3.18   Fold06
  

Ниже приведена простая реализация, и вы можете видеть, что мы получаем те же результаты. Сначала мы немного изменим метрическую функцию:

 mets <- function(obs,pred){
                 c( 
                   RMSE = sqrt(mean((obs-pred)^2)),
                   MAE = mean(abs(obs - pred))
                  )
}
  

Затем :

 results = lapply(1:length(testFolds),function(i){

trData = full_df[trFolds[[i]],]
testData = full_df[testFolds[[i]],]
fit = lm(medv ~., data = trData)

inSample = mets(trData$medv,fit$fitted.values)
outSample = mets(testData$medv,predict(fit,testData))

data.frame(
   folds = i,
   inSample_RMSE = inSample[1],
   inSample_MAE = inSample[2],
   outSample_RMSE = outSample[1],
   outSample_MAE = outSample[2]
   )
})

results = do.call(rbind,results)

          folds inSample_RMSE inSample_MAE outSample_RMSE outSample_MAE
RMSE      1          4.80         3.35           4.07          3.02
RMSE1     2          4.80         3.32           4.10          3.04
RMSE2     3          4.63         3.19           5.76          4.48
RMSE3     4          4.79         3.29           4.16          2.97
RMSE4     5          4.80         3.31           4.10          3.01
RMSE5     6          4.57         3.18           6.14          4.25