Как представить точность разных моделей с помощью пакета каретки в одном списке

Я пытаюсь проверить производительность моделей с помощью пакета Caret. Я получил результаты для каждой из моделей, но я хотел бы получить список, который будет содержать точность и ROC всех моделей вместе. Как я могу это сделать? Вот мои игровые данные и две модели:

dat <- read.table(text = " target birds    wolfs     snakes
        0        3        9         7
        1        3        8         4
        1        1        2         8
        0        1        2         3
        0        1        8         3
        1        6        1         2
        0        6        7         1
        1        6        1         5
        0        5        9         7
        1        3        8         7
        1        4        2         7
        0        1        2         3
        0        7        6         3
        1        6        1         1
        0        6        3         9
        1        6        1         1   ",header = TRUE)

Вот две модели:

svmRadial <- train(target ~ ., data = dat, method='svmRadial')
glm <- train(target ~ ., data = dat, method='glm')

Я хотел бы получить такую ​​таблицу на выходе:

ModelName  Accuracy  ROC
svmRadial   0.95     0.74
glm         0.93     0.7

r r-caret
person mql4beginner    schedule 05.02.2015    source источник

Ответы (1)


arrow_upward
4
arrow_downward

По сути это вопрос по настройке summaryFunction. Вы можете увидеть аналогичный вопрос здесь. Вот функция, представляющая собой комбинацию функций defaultSummary и twoClassSummary.

mySummary <- function(data, lev = NULL, model = NULL)
{
    requireNamespace("pROC")
    if (!all(levels(data[, "pred"]) == levels(data[, "obs"]))) 
        stop("levels of observed and predicted data do not match")
    rocObject <- try(pROC::roc.default(data$obs, data[, lev[1]]), 
                     silent = TRUE)
    rocAUC <- if (class(rocObject)[1] == "try-error"){ 
        NA
    }else{rocObject$auc}

    if (!is.factor(data$obs)) 
        data$obs <- factor(data$obs, levels = lev)
    Acc <- postResample(data[, "pred"], data[, "obs"])[1]

    out <- c(Acc, rocAUC)
    names(out) <- c("Accuracy","ROC")
    out
}


fitControl <- trainControl(classProbs = TRUE,
                           summaryFunction = mySummary)

set.seed(123)
svmRadial_acc_roc <- train(as.factor(target) ~ ., data = dat, method='svmRadial', trControl=fitControl)
glm_acc_roc <- train(as.factor(target) ~ ., data = dat, method='glm', trControl=fitControl)

Я считаю, что лучше смотреть на распределение результатов. Для этого вы должны использовать функцию resamples.

results <- resamples(list(svm=svmRadial_acc_roc, glm=glm_acc_roc))
summary(results)

Call:
summary.resamples(object = results)

Models: svm, glm 
Number of resamples: 25 

Accuracy 
      Min. 1st Qu. Median   Mean 3rd Qu.   Max. NA's
svm 0.2500  0.5000  0.625 0.6034  0.6667 1.0000    0
glm 0.1667  0.4286  0.500 0.4993  0.6000 0.7143    0

ROC 
      Min. 1st Qu. Median   Mean 3rd Qu. Max. NA's
svm 0.4444  0.5608 0.6667 0.7422     1.0    1    1
glm 0.4444  0.6250 0.6667 0.7108     0.8    1    0

Тем не менее, если вы действительно хотите эту простую таблицу.

# svm had some cross-validation so pull 'best tune'
svm_result <- svmRadial_acc_roc$results[
    svmRadial_acc_roc$results$C == svmRadial_acc_roc$bestTune$C,
    c("Accuracy", "ROC")]
glm_result <- glm_acc_roc$results[,c("Accuracy", "ROC")]

# make data.frame
data.frame(ModelName = c("svmRadial", "glm"),
           Accuracy = c(svm_result$Accuracy, glm_result$Accuracy),
           ROC = c(svm_result$ROC, glm_result$ROC)
)

  ModelName  Accuracy       ROC
1 svmRadial 0.6034444 0.7421875
2       glm 0.4993333 0.7107778
person cdeterman    schedule 05.02.2015
comment
Существует также функция под названием getTrainPerf, которая будет извлекать оценки производительности с передискретизацией для оптимальных параметров. - person topepo; 16.02.2015