R Caret Hold-Out Probe und Testset ROC

Question

Ich baue zwei verschiedene Klassifikatoren, um einen binären Ausgang vorherzusagen. Dann möchte ich die Ergebnisse der beiden Modelle unter Verwendung einer ROC-Kurve und der Fläche darunter (AUC) vergleichen.

Ich habe den Datensatz in ein Trainings- und Testset aufgeteilt. Auf dem Trainingssatz führe ich eine Form der Kreuzvalidierung durch. Aus den zurückgehaltenen Beispielen der Kreuzvalidierung kann ich eine ROC-Kurve pro Modell erstellen. Dann verwende ich die Modelle auf dem Test-Set und baue einen weiteren Satz von ROC-Kurven.

Die Ergebnisse sind widersprüchlich, die mich verwirren. Ich bin mir nicht sicher, welches Ergebnis das Richtige ist oder ob ich etwas komplett falsch mache. Die vorgehaltene ROC-Kurve zeigt, dass RF das bessere Modell ist und die ROC-Kurve des Trainingssatzes zeigt, dass SVM das bessere Modell ist.

Analyse

library(ggplot2) 
library(caret) 
library(pROC) 
library(ggthemes) 
library(plyr) 
library(ROCR) 
library(reshape2) 
library(gridExtra) 

my_data <- read.csv("http://www.ats.ucla.edu/stat/data/binary.csv") 

str(my_data) 
names(my_data)[1] <- "Class" 
my_data$Class <- ifelse(my_data$Class == 1, "event", "noevent") 

my_data$Class <- factor(emr$Class, levels = c("noevent", "event"), ordered = TRUE) 

set.seed(1732) 
ind <- createDataPartition(my_data$Class, p = 2/3, list = FALSE) 
train <- my_data[ ind,] 
test <- my_data[-ind,] 

Next trainiere ich zwei Modelle: Random Wald und SVM. Hier benutze ich auch Max Kuhns Funktion, um die gemittelten ROC-Kurven aus den herausgehaltenen Stichproben für beide Modelle zu erhalten und diese Ergebnisse zusammen mit der AUC aus den Kurven in einem anderen Datenrahmen zu speichern.

#Train RF 
ctrl <- trainControl(method = "repeatedcv", 
       number = 5, 
       repeats = 3, 
       classProbs = TRUE, 
       savePredictions = TRUE, 
       summaryFunction = twoClassSummary) 

grid <- data.frame(mtry = seq(1,3,1)) 

set.seed(1537) 
rf_mod <- train(Class ~ ., 
       data = train, 
       method = "rf", 
       metric = "ROC", 
       tuneGrid = grid, 
       ntree = 1000, 
       trControl = ctrl) 


rfClasses <- predict(rf_mod, test) 

#This is the ROC curve from held out samples. Source is from Max Kuhns 2016 UseR! code here: https://github.com/topepo/useR2016 
roc_train <- function(object, best_only = TRUE, ...) { 


    lvs <- object$modelInfo$levels(object$finalModel) 

    if(best_only) { 
    object$pred <- merge(object$pred, object$bestTune) 
    } 

    ## find tuning parameter names 
    p_names <- as.character(object$modelInfo$parameters$parameter) 
    p_combos <- object$pred[, p_names, drop = FALSE] 

    ## average probabilities across resamples 
    object$pred <- plyr::ddply(.data = object$pred, 
         .variables = c("obs", "rowIndex", p_names), 
         .fun = function(dat, lvls = lvs) { 
          out <- mean(dat[, lvls[1]]) 
          names(out) <- lvls[1] 
          out 
         }) 

    make_roc <- function(x, lvls = lvs, nms = NULL, ...) { 
    out <- pROC::roc(response = x$obs, 
       predictor = x[, lvls[1]], 
       levels = rev(lvls)) 

    out$model_param <- x[1,nms,drop = FALSE] 
    out 
    } 
    out <- plyr::dlply(.data = object$pred, 
       .variables = p_names, 
       .fun = make_roc, 
       lvls = lvs, 
       nms = p_names) 
    if(length(out) == 1) out <- out[[1]] 
    out 
} 

temp <- roc_train(rf_mod) 

plot_data_ROC <- data.frame(Model='Random Forest', sens =  temp$sensitivities, spec=1-temp$specificities) 

#This is the AUC of the held-out samples roc curve for RF 
auc.1 <- abs(sum(diff(1-temp$specificities) *  (head(temp$sensitivities,-1)+tail(temp$sensitivities,-1)))/2) 

#Build SVM 
set.seed(1537) 
svm_mod <- train(Class ~ ., 
       data = train, 
       method = "svmRadial", 
       metric = "ROC", 
       trControl = ctrl) 

svmClasses <- predict(svm_mod, test) 

#ROC curve into df 
temp <- roc_train(svm_mod) 
plot_data_ROC <- rbind(plot_data_ROC, data.frame(Model='Support Vector Machine', sens = temp$sensitivities, spec=1-temp$specificities)) 

#This is the AUC of the held-out samples roc curve for SVM 
auc.2 <- abs(sum(diff(1-temp$specificities) * (head(temp$sensitivities,-1)+tail(temp$sensitivities,-1)))/2) 

nächstes werde ich die Ergebnisse plotten

#Plotting Final 

#ROC of held-out samples 
q <- ggplot(data=plot_data_ROC, aes(x=spec, y=sens, group = Model, colour =  Model)) 
q <- q + geom_path() + geom_abline(intercept = 0, slope = 1) + xlab("False  Positive Rate (1-Specificity)") + ylab("True Positive Rate (Sensitivity)") 
q + theme(axis.line = element_line(), axis.text=element_text(color='black'), 
     axis.title = element_text(colour = 'black'),  legend.text=element_text(), legend.title=element_text()) 

#ROC of testing set 
rf.probs <- predict(rf_mod, test,type="prob") 
pr <- prediction(rf.probs$event, factor(test$Class, levels = c("noevent", "event"), ordered = TRUE)) 
pe <- performance(pr, "tpr", "fpr") 
roc.data <- data.frame(Model='Random Forest',fpr=unlist(pe@x.values),  tpr=unlist(pe@y.values)) 

svm.probs <- predict(svm_mod, test,type="prob") 
pr <- prediction(svm.probs$event, factor(test$Class, levels = c("noevent",  "event"), ordered = TRUE)) 
pe <- performance(pr, "tpr", "fpr") 
roc.data <- rbind(roc.data, data.frame(Model='Support Vector  Machine',fpr=unlist(pe@x.values), tpr=unlist(pe@y.values))) 

q <- ggplot(data=roc.data, aes(x=fpr, y=tpr, group = Model, colour = Model)) 
q <- q + geom_line() + geom_abline(intercept = 0, slope = 1) + xlab("False  Positive Rate (1-Specificity)") + ylab("True Positive Rate (Sensitivity)") 
q + theme(axis.line = element_line(), axis.text=element_text(color='black'), 
     axis.title = element_text(colour = 'black'),  legend.text=element_text(), legend.title=element_text()) 


#AUC of hold out samples 
data.frame(Rf = auc.1, Svm = auc.2) 

#AUC of testing set. Source is from Max Kuhns 2016 UseR! code here: https://github.com/topepo/useR2016 
test_pred <- data.frame(Class = factor(test$Class, levels = c("noevent",  "event"), ordered = TRUE)) 
test_pred$Rf <- predict(rf_mod, test, type = "prob")[, "event"] 
test_pred$Svm <- predict(svm_mod, test, type = "prob")[, "event"] 

get_auc <- function(pred, ref){ 
    auc(roc(ref, pred, levels = rev(levels(ref)))) 
} 

apply(test_pred[, -1], 2, get_auc, ref = test_pred$Class) 

Die Ergebnisse aus den gehaltenen aus Proben und aus der Testsatz sind völlig anders (ich weiß, dass sie anders sein wird durch diese aber viel?).

Aus den herausgehaltenen Proben würde man das RF-Modell wählen, aber aus dem Test-Set würde man das SVM-Modell auswählen.

Welches ist die "richtige" oder "bessere" Art, das Modell zu wählen? Mache ich irgendwo einen großen Fehler oder verstehe ich etwas nicht richtig?

Answer 1

Wenn ich dann richtig verstehen, haben Sie 3 markierte Datensätze:

1. Ausbildung
2. Hold-out CV Probe vom Training
3. "Testing" CV Probe

Während ja Bei einer Hold-Out-Beispiel-CV-Strategie wählen Sie normalerweise Ihr Modell basierend auf dem Hold-Out-Beispiel aus. Normalerweise haben Sie auch kein größeres Validierungsdaten-Sample.

Wenn sowohl die Hold-out- als auch die Testdatensätze (a) beschriftet sind und (b) so nahe wie möglich an der Orthogonalität der Trainingsdaten liegen, wählen Sie Ihr Modell basierend auf welcher auch immer die größere Stichprobengröße hat.

In Ihrem Fall sieht es so aus, als ob Sie das Hold-Out-Beispiel nennen, ist nur das wiederholte CV Resampling vom Training. In diesem Fall haben Sie noch mehr Grund, die Ergebnisse aus der Validierung des Testdatensatzes zu bevorzugen. Siehe Steffen's note auf wiederholten CV.

In der Theorie hat Random Forest-Packing eine vererbte Form der Kreuzvalidierung durch die OOB-Stats und der CV, der innerhalb der Trainingsphase durchgeführt wurde, sollte Ihnen ein gewisses Maß an Validierung geben.In der Praxis ist es jedoch üblich, einen Mangel an Orthogonalität und eine erhöhte Wahrscheinlichkeit einer Überanpassung zu beobachten, da die Stichproben von den Trainingsdaten selbst stammen und möglicherweise den Fehler einer Überanpassung für die Genauigkeit verstärken.

Ich kann das theoretisch wie oben einigermaßen erklären, darüber hinaus muss ich Ihnen nur sagen, dass ich empirisch festgestellt habe, dass die Leistungsergebnisse aus dem so genannten CV- und OOB-Fehler berechnet aus den Trainingsdaten sein können sehr irreführend und die wahren Hold-out (Testing) Daten, die nie während des Trainings berührt wurde, ist die weitaus bessere Validierung.

Ihr wahres Hold-out-Beispiel ist der Testdatensatz, da keine seiner Daten während des Trainings verwendet werden. Verwenden Sie diese Ergebnisse.