Only one model, plus a ROC curve

First, fit a model…

fit <- train(lrn, sonar.task)

then predict the performance of this model on the training set…

pred <- predict(fit, task = sonar.task)

and visualize the training performance with a ROC curve.

roc <- generateThreshVsPerfData(pred, list(fpr, tpr))
plotROCCurves(roc) + theme_minimal() + coord_equal()

Comparing bootstrap and cross-validation

Boostrap and cross-validation can generate several (\(B\)) models and therefore several ROC curves. From them we can deduce a confidence interval on the mean ROC curve.

Let’s set \(B\) to 10.

The following graph represents the \(B\) curves.

roc_l <- generateThreshVsPerfData(list(boot = r, cv = r2), 
                                  list(fpr, tpr), 
                                  aggregate = FALSE)
plotROCCurves(roc_l) + theme_minimal() + coord_equal()

The process to generate a confidence interval of the first ROC curve is based on the function ci.coords. Of course it is not simple at all. Maybe the easiest way would be to generate a confidence interval on the AUC.

obj <- roc(pred$data$truth, pred$data$prob.R, ci=TRUE, plot=FALSE)
obj$ci

## 95% CI: 0.8858-0.959 (DeLong)

ciobj <- ci.se(obj, specificities=seq(0, 1, l=25))
dat.ci <- data.frame(x = as.numeric(rownames(ciobj)),
                     lower = ciobj[, 1],
                     upper = ciobj[, 3])

ggroc(obj) + theme_minimal() + geom_abline(slope=1, intercept = 1, linetype = "dashed", alpha=0.7, color = "grey") + coord_equal() + 
  geom_ribbon(data = dat.ci, aes(x = x, ymin = lower, ymax = upper), fill = "steelblue", alpha= 0.2) + ggtitle(capture.output(obj$ci))

Extracting a function from this code to automatically produce this graph is pretty easy.

roc_with_ci <- function(obj) {
  ciobj <- ci.se(obj, specificities = seq(0, 1, l = 25))
  dat.ci <- data.frame(x = as.numeric(rownames(ciobj)),
                       lower = ciobj[, 1],
                       upper = ciobj[, 3])
  
  ggroc(obj) +
    theme_minimal() +
    geom_abline(
      slope = 1,
      intercept = 1,
      linetype = "dashed",
      alpha = 0.7,
      color = "grey"
    ) + coord_equal() +
    geom_ribbon(
      data = dat.ci,
      aes(x = x, ymin = lower, ymax = upper),
      fill = "steelblue",
      alpha = 0.2
    ) + ggtitle(capture.output(obj$ci))
}