DATA 607 Presentation

Previously….

A brave fellow student gave a presentation using the KNN matching algorithm to predict the class of an unknown (and possibly alien) species….

KNN Example by Zach Dravis

Zach left us with a few questions at the end of the presentation, including:

• How to measure success [of the knn model]?
• How to empirically establish k?

In the comments section during the presentation, Prof. Catlin suggested using a confusion matrix to evaluate the models with different k values. In this example, I will present the concept of the confusion matrix and apply it to Zach’s KNN models.

Ewoks and Humans and Wookies (minus the Ewoks)

For Zach’s presentation, he created a data set containing 200 Ewoks, 200 humans, and 200 Wookies, then built a data frame with simulated height and weight data for each case. Then, he used a training set of 399 observations from his data set to build two models with different \(k\) values (\(k=3\) and \(k=9\)), which were then applied to the remaining 201 observations (the test data set).

To simplify the example today, I’ve reduced the problem to having only two classes - Humans and Wookies. Their scatterpoint of Height vs. Weight is shown here:

ggplot(SWSpecies, aes(x=Height, y=Weight, color=Species, shape=Species)) +
  geom_point()

Running the process with two different \(k\) values

Code from Zach Dravis to apply the two models:

\(k=3\)

SpeciesPrediction <- knn(train = select(TrainingData, Height, Weight), 
                         test = select(TestData, Height, Weight), 
                         cl = TrainingData$Species, 
                         k = 3)
FirstTest <- cbind(TestData, SpeciesPrediction)
FirstTest %>%  kable("html", caption = "Test1: k = 3") %>%
  kable_styling(bootstrap_options = c("striped")) %>%
  scroll_box(height = "500px")

\(k=9\)

SpeciesPrediction <- knn(train = select(TrainingData, Height, Weight), 
                         test = select(TestData, Height, Weight), 
                         cl = TrainingData$Species, 
                         k = 9)
SecondTest <- cbind(TestData, SpeciesPrediction)
SecondTest %>%  kable("html", caption = "Test2: k = 9") %>%
  kable_styling(bootstrap_options = c("striped")) %>%
  scroll_box(height = "500px")

Baseline: Random simulation

With the two given models from Zach’s presentation, I wanted to create a baseline model as a control to test against. I simulated data to assign the Species attribute randomly to a list of 67 Ewoks, 67 humans, and 67 Wookies.

From Data Science for Business: “Comparison against a random model establishes that there is some information to be extracted from the data.”

If the results of our models are better than a random simulation, we’re looking at the right features to use in our models.

simSpeciesPrediction <- c(rep("Wookie", 100), rep("Human", 100))
randOrder <- sample(1:200, 200, replace = FALSE)
simSpeciesPrediction <- simSpeciesPrediction[randOrder]
BaseTest <- cbind(TestData, simSpeciesPrediction)
BaseTest %>%  kable("html", caption = "Baseline: Random") %>%
  kable_styling(bootstrap_options = c("striped")) %>%
  scroll_box(height = "500px")

Is accuracy sufficient?

An intuitive first impulse to evaluate the model is to divide the number of correctly predicted results from the test data by the total number of observations in the test data. This is known as Accuracy.

#Accuracy of the Base model
(AccuracyBase <- sum(BaseTest$simSpeciesPrediction == BaseTest$Species)/length(BaseTest$simSpeciesPrediction))

## [1] 0.51

#Accuracy of the FirstTest model (k = 3)
(AccuracyFirst <- sum(FirstTest$SpeciesPrediction == FirstTest$Species)/length(FirstTest$SpeciesPrediction))

## [1] 0.84

#Accuracy of the SecondTest model (k = 9)
(AccuracySecond <- sum(SecondTest$SpeciesPrediction == SecondTest$Species)/length(SecondTest$SpeciesPrediction))

## [1] 0.805

The test models have much greater accuracy than the random assignment simulation, so it seems like we’re on the right track. But the accuracy of a model doesn’t tell the complete story of a model, and may in fact hide its flaws.

Defining the Confusion Matrix

Instead of relying on the single metric of accuracy, we can create a confusion matrix to examine the different types of results the model generated.

While accuracy gives us the proportion of correct results, the confusion matrix separates the correct results into two sets:

• True Positive (TP): the model correctly predicted YES
• True Negative (TN): the model correctly predicted NO

The incorrect results are also divided in two:

• False Positive (FP): the model incorrectly predicted YES (actual NO) AKA Type I Error
• False Negative (FN): the model incorrectly predicted NO (actual YES) AKA Type II Error

The correct predictions fall along the main diagonal of the matrix.

From the confusion matrix, many helpful statistics can be calculated to aid in analyzing the model. The figure below gives a visual representation of the different statistics.

https://en.wikipedia.org/wiki/Positive_and_negative_predictive_values

This figure also shows how simple accuracy can be misleading. The accuracy = \(\frac{20 + 1820}{2030} \approx 90.6\%\); however, looking at the confusion matrix gives better information - for example, the Positive predictive value is only 10%.

The Data School is a good resource for defining the statistics evaluated from the confusion matrix.

Back to our Star Wars example

In R, the confusionMatrix function from the caret package returns the confusion matrix as well as several of the summary statistics we reviewed in the previous section.

We can create confusion matrices for our three species prediction models to evaluate their performance. Since our data has three levels, the confusion matrix returns summary statistics for each feature separately.

Comparing the three models, we see that the two knn models fare significantly better than the baseline model based on random assignment.

library(caret)
confusionMatrix(BaseTest$Species, BaseTest$simSpeciesPrediction, dnn = c("Prediction", "Actual"))

## Confusion Matrix and Statistics
## 
##           Actual
## Prediction Human Wookie
##     Human     51     49
##     Wookie    49     51
##                                           
##                Accuracy : 0.51            
##                  95% CI : (0.4385, 0.5812)
##     No Information Rate : 0.5             
##     P-Value [Acc > NIR] : 0.416           
##                                           
##                   Kappa : 0.02            
##  Mcnemar's Test P-Value : 1.000           
##                                           
##             Sensitivity : 0.510           
##             Specificity : 0.510           
##          Pos Pred Value : 0.510           
##          Neg Pred Value : 0.510           
##              Prevalence : 0.500           
##          Detection Rate : 0.255           
##    Detection Prevalence : 0.500           
##       Balanced Accuracy : 0.510           
##                                           
##        'Positive' Class : Human           
## 

confusionMatrix(FirstTest$Species, FirstTest$SpeciesPrediction, dnn = c("Prediction", "Actual"))

## Confusion Matrix and Statistics
## 
##           Actual
## Prediction Human Wookie
##     Human     87     13
##     Wookie    19     81
##                                           
##                Accuracy : 0.84            
##                  95% CI : (0.7817, 0.8879)
##     No Information Rate : 0.53            
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.68            
##  Mcnemar's Test P-Value : 0.3768          
##                                           
##             Sensitivity : 0.8208          
##             Specificity : 0.8617          
##          Pos Pred Value : 0.8700          
##          Neg Pred Value : 0.8100          
##              Prevalence : 0.5300          
##          Detection Rate : 0.4350          
##    Detection Prevalence : 0.5000          
##       Balanced Accuracy : 0.8412          
##                                           
##        'Positive' Class : Human           
## 

confusionMatrix(SecondTest$Species, SecondTest$SpeciesPrediction, dnn = c("Prediction", "Actual"))

## Confusion Matrix and Statistics
## 
##           Actual
## Prediction Human Wookie
##     Human     86     14
##     Wookie    25     75
##                                           
##                Accuracy : 0.805           
##                  95% CI : (0.7432, 0.8575)
##     No Information Rate : 0.555           
##     P-Value [Acc > NIR] : 9.481e-14       
##                                           
##                   Kappa : 0.61            
##  Mcnemar's Test P-Value : 0.1093          
##                                           
##             Sensitivity : 0.7748          
##             Specificity : 0.8427          
##          Pos Pred Value : 0.8600          
##          Neg Pred Value : 0.7500          
##              Prevalence : 0.5550          
##          Detection Rate : 0.4300          
##    Detection Prevalence : 0.5000          
##       Balanced Accuracy : 0.8087          
##                                           
##        'Positive' Class : Human           
## 

It appears that the \(k=3\) model performs better than the \(k=9\) model. How do you choose the correct k?

Values for \(k\)

From several sources online, a rule of thumb emerged to choose \(k\) as the square root of the number of observations in the training set. With our training set of 400 observations, how would the knn model fare with \(k=20\)?

source 1 source 2

## square root of 400 is 20
k_pref <- TrainingData$Species %>%
  length() %>%
  sqrt() %>%
  round()

SpeciesPrediction <- knn(train = select(TrainingData, Height, Weight), 
                         test = select(TestData, Height, Weight), 
                         cl = TrainingData$Species, 
                         k = k_pref)
ThirdTest <- cbind(TestData, SpeciesPrediction)
ThirdTest %>%  kable("html", caption = "Test3: k = 20") %>%
  kable_styling(bootstrap_options = c("striped")) %>%
  scroll_box(height = "500px")

(AccuracyThird <- sum(ThirdTest$SpeciesPrediction == ThirdTest$Species)/length(ThirdTest$SpeciesPrediction))

## [1] 0.755

confusionMatrix(ThirdTest$Species, ThirdTest$SpeciesPrediction, dnn = c("Prediction", "Actual"))

## Confusion Matrix and Statistics
## 
##           Actual
## Prediction Human Wookie
##     Human     84     16
##     Wookie    33     67
##                                           
##                Accuracy : 0.755           
##                  95% CI : (0.6894, 0.8129)
##     No Information Rate : 0.585           
##     P-Value [Acc > NIR] : 3.611e-07       
##                                           
##                   Kappa : 0.51            
##  Mcnemar's Test P-Value : 0.02227         
##                                           
##             Sensitivity : 0.7179          
##             Specificity : 0.8072          
##          Pos Pred Value : 0.8400          
##          Neg Pred Value : 0.6700          
##              Prevalence : 0.5850          
##          Detection Rate : 0.4200          
##    Detection Prevalence : 0.5000          
##       Balanced Accuracy : 0.7626          
##                                           
##        'Positive' Class : Human           
## 

(https://cran.r-project.org/web/packages/heuristica/heuristica.pdf)

AccuracyVector <- numeric() 
Stats_df <- data.frame(Accuracy = double(),
                 Sensitivy = double(),
                 Specificity = double(),
                 Precision = double(),
                 stringsAsFactors=FALSE)
for(i in 1:30) {
  SpeciesPrediction <- knn(train = select(TrainingData, Height, Weight), 
                         test = select(TestData, Height, Weight), 
                         cl = TrainingData$Species, 
                         k = i)
  Test <- cbind(TestData, SpeciesPrediction)
  TestTable <- table(Test$Species, Test$SpeciesPrediction)
  
  Stats_df[i,1] <- sum(Test$SpeciesPrediction == Test$Species)/length(Test$SpeciesPrediction)
  Stats_df[i,2] <- sensitivity(TestTable)
  Stats_df[i,3] <- specificity(TestTable)
  Stats_df[i,4] <- precision(TestTable)
}
Stats_df

##    Accuracy Sensitivy Specificity Precision
## 1     0.830 0.8300000   0.8300000      0.83
## 2     0.810 0.7980769   0.8229167      0.83
## 3     0.840 0.8207547   0.8617021      0.87
## 4     0.795 0.7706422   0.8241758      0.84
## 5     0.810 0.7767857   0.8522727      0.87
## 6     0.810 0.7870370   0.8369565      0.85
## 7     0.805 0.7798165   0.8351648      0.85
## 8     0.810 0.7818182   0.8444444      0.86
## 9     0.805 0.7747748   0.8426966      0.86
## 10    0.790 0.7685185   0.8152174      0.83
## 11    0.790 0.7500000   0.8452381      0.87
## 12    0.780 0.7456140   0.8255814      0.85
## 13    0.780 0.7333333   0.8500000      0.88
## 14    0.770 0.7213115   0.8461538      0.88
## 15    0.765 0.7226891   0.8271605      0.86
## 16    0.765 0.7226891   0.8271605      0.86
## 17    0.755 0.7179487   0.8072289      0.84
## 18    0.750 0.7118644   0.8048780      0.84
## 19    0.745 0.7058824   0.8024691      0.84
## 20    0.750 0.7155172   0.7976190      0.83
## 21    0.740 0.7105263   0.7790698      0.81
## 22    0.725 0.6991150   0.7586207      0.79
## 23    0.735 0.7079646   0.7701149      0.80
## 24    0.740 0.7142857   0.7727273      0.80
## 25    0.725 0.7027027   0.7528090      0.78
## 26    0.740 0.7142857   0.7727273      0.80
## 27    0.735 0.7155963   0.7582418      0.78
## 28    0.740 0.7181818   0.7666667      0.79
## 29    0.735 0.7155963   0.7582418      0.78
## 30    0.735 0.7155963   0.7582418      0.78

k <- 1:30
ggplot(Stats_df, aes(x = 1:30)) + 
  geom_line(aes(y = Accuracy), colour="black") +
  geom_line(aes(y = Sensitivy), colour="red") +
  geom_line(aes(y = Specificity), colour="green") +
  geom_line(aes(y = Precision), colour="blue") + 
  ylab(label="Statistic") + 
  xlab("k")