Comparing Models Using the AUC of ROC Curves 📂Machine Learning

Comparing Models Using the AUC of ROC Curves

Theorem

ROC curves are essentially better as they fill up the rectangle $[0,1]^2$ more, and it is preferable for the curve’s turning point in the upper left to be closer to $(0,1)$.

Description

$20190210\_232535.png$

Given the two ROC curves above, the right side can comfortably be considered ‘better’. This ‘better’ refers to the model generating the ROC curve being superior. Naturally, the two models being compared are derived from the same training data, and this comparison disregards elements like test data or optimal cutoffs.

However, the problem involves the perennial issue in statistics of ’eyeballing’.

Consider the following three ROC curves drawn by three different models.

$20190210\_234007.png$ Without much thought, it is easy to see that red is worse than blue or green. However, choosing between blue and green becomes tricky.

This is where calculating the area under the curve comes in. The area of the rectangle is necessarily $1$, so AUC will always fall between $0$ and $1$. This makes it easier to compare which model is better.

Fortunately, calculating this AUC in R is very easy.

Practice

(Following the ROC curve drawing method)

prf <- performance(pr, measure = "tpr", x.measure = "fpr")
auc <- performance(pr, measure = "auc")
auc <- auc@y.values[[1]]; auc

Running the above code results in the following AUC calculation.

$20190210\_235303.png$ Considering AUC as a kind of variable selection criterion, it is similar to $R^2$ and serves as a meaningful metric in itself, not just for comparing with other models but also for assessing the performance of the model itself.

Code

Below is the example code.

install.packages("car")
install.packages("ResourceSelection")
install.packages("ROCR")
 
library(car)
library(ResourceSelection)
library(ROCR)
 
set.seed(150421)
 
?Chile
str(Chile)
nrow(Chile)
head(Chile); tail(Chile)
 
DATA<-na.omit(Chile)
DATA$vote[DATA
          $vote!='Y']<-'N'
DATA$vote<-factor(DATA$vote)
head(DATA); tail(DATA)
 
DATANUM<-nrow(DATA)
train<-sample(1:DATANUM)<(DATANUM*0.8)
test<-DATA[!train,]; head(test)
train<-DATA[train,]; head(train)
 
out0<-glm(vote~.,family=binomial(),data=train); summary(out0)
p <- predict(out0, newdata=test, type="response"); p
 
pr <- prediction(p, test$vote)
win.graph(5,5); plot(prf, main='ROC')
 
prf <- performance(pr, measure = "tpr", x.measure = "fpr")
auc <- performance(pr, measure = "auc")
auc <- auc@y.values[[1]]; auc