Performance Evaluation of a Classifier

In this tutorial, I will show how to use caret and gains packages to evaluate the performance of a classifier such as the one from Logistic Regression. The dataset being used is “ownership.csv” which has two columns. First column is “owner” which has two values (1 = yes, 0 = no). The second column is “probability” which indicates the likelihood of that observation belonging to the positive class (owner = 1).

This dataset has 24 rows and 2 columns as shown below.

df <- read.csv("data/ownership.csv")
df

##    owner probability
## 1      1       0.347
## 2      1       0.826
## 3      1       0.445
## 4      1       0.377
## 5      1       0.844
## 6      1       0.975
## 7      1       0.971
## 8      1       0.790
## 9      1       0.535
## 10     1       0.901
## 11     1       0.197
## 12     1       0.764
## 13     0       0.659
## 14     0       0.222
## 15     0       0.445
## 16     0       0.111
## 17     0       0.807
## 18     0       0.173
## 19     0       0.335
## 20     0       0.471
## 21     0       0.152
## 22     0       0.049
## 23     0       0.197
## 24     0       0.407

##Change the colname to 'actual' from 'owner'
names(df)[names(df) == 'owner'] <- 'actual'

Let us create a confusion matrix and then display all the output as below.

options(digits = 2)

##estimated prob. > cutoff implies class 1 (owner)
cutoff <- 0.5  

##Need to convert the numerical values into factors
actual <- factor(df$actual)
predicted <- factor(ifelse(df$probability > cutoff, 1, 0))

conf <- confusionMatrix(predicted, actual, positive = "1")
conf$table

##           Reference
## Prediction  0  1
##          0 10  4
##          1  2  8

t(t(conf$byClass))

##                      [,1]
## Sensitivity          0.67
## Specificity          0.83
## Pos Pred Value       0.80
## Neg Pred Value       0.71
## Precision            0.80
## Recall               0.67
## F1                   0.73
## Prevalence           0.50
## Detection Rate       0.33
## Detection Prevalence 0.42
## Balanced Accuracy    0.75

The Receiver Operating Curve (ROC) is shown below. The Area Under the Curve (AUC) is 0.83, which is an overall measure of the quality of this classifier. An ideal classifier would have a value of 1.

r <- roc(df$actual, df$probability)

title <- paste("ROC Curve with AUC = ", round(r$auc,2))
plot.roc(r, legacy.axes = TRUE, main = title)

print(r$auc)

## Area under the curve: 0.83

##Create a data frame for ggplot
df1 <- data.frame(thr =r$thresholds, sens = r$sensitivities, spec = r$specificities)

xlab <- "Cut-off threshold"
ylab <- "Sensitivity/Specificity"

p1 <- ggplot(df1, aes(x = thr)) 
p1 <- p1 + geom_line(aes(y = sens))+geom_point(aes(y = sens))
p1 <- p1 + geom_line(aes(y = spec), col = "red") + geom_point(aes(y = spec),       col = "red")
p1 <- p1 + annotate("text", x=0.25, y=0.37, label="specificity", size=4,     family="serif")
p1 <- p1 + annotate("text", x=0.75, y=0.37, label="Sensitivity", size=4, family="serif")

p1 + labs(title = "Sensitivity/specificity",
         subtitle = "As a function of cut-off threshold",
         caption = "Figure 1",
         x = xlab, y = ylab)+
     theme(
    plot.title = element_text(hjust = 0.5, size = 14),
    plot.subtitle = element_text(hjust = 0.5),
    plot.caption = element_text(hjust = 0, face = "italic")
  )

##Create a lift chart
lift1 <- lift(relevel(as.factor(actual), ref="1") ~ probability, data = df)
xyplot(lift1, plot = "gain", main= "Lift Chart for Classification")

##Create a decile chart
library(gains)
df$actual <- as.numeric(df$actual)  ##Convert back to numerical
gain <- gains(df$actual, df$probability)
barplot(gain$mean.resp / mean(df$actual), names.arg = gain$depth, xlab = "Percentile", ylab = "Mean Response", main = "Decile-wise lift chart", ylim = c(0,2))