train_knn <- train(y ~ ., method = "knn",
                   data = mnist_27$train,
                   tuneGrid = data.frame(k = 5))
train_knn$finalModel

5-nearest neighbor model
Training set outcome distribution:

  2   7 
379 421 

y_hat_knn <- predict(train_knn, mnist_27$test, type = "raw")
confusionMatrix(data = y_hat_knn, reference = mnist_27$test$y)

# Or:
# fit_knn <- knn3(y ~ ., data=mnist_27$train, k=5)
# y_hat_knn <- predict(fit_knn, mnist_27$test, type = "class")

Confusion Matrix and Statistics

          Reference
Prediction  2  7
         2 91 22
         7 15 72
                                          
               Accuracy : 0.815           
                 95% CI : (0.7541, 0.8663)
    No Information Rate : 0.53            
    P-Value [Acc > NIR] : <2e-16          
                                          
                  Kappa : 0.6271          
                                          
 Mcnemar's Test P-Value : 0.3239          
                                          
            Sensitivity : 0.8585          
            Specificity : 0.7660          
         Pos Pred Value : 0.8053          
         Neg Pred Value : 0.8276          
             Prevalence : 0.5300          
         Detection Rate : 0.4550          
   Detection Prevalence : 0.5650          
      Balanced Accuracy : 0.8122          
                                          
       'Positive' Class : 2               
                                          

confusionMatrix(data = y_hat_knn, reference = mnist_27$test$y)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_knn, reference = mnist_27$test$y))

Accuracy: 0.815

F1 Score: 0.8310502

y_hat_knn <- predict(train_knn, mnist_27$true_p, type="prob")[,2]

options(repr.plot.width=12, repr.plot.height=7)
grid.arrange(plot_cond_prob(),
             plot_cond_prob(y_hat_knn, title = "knn-5 estimate"),
             ncol = 2)

In this problem, with k = 5, it occurs overtraining and the conditional probability is too wiggly. We can see this by seeing the difference between the accuracy over the training and the test set.

y_hat_knn <- predict(train_knn, mnist_27$train, type = "raw") 
confusionMatrix(data = y_hat_knn, reference = mnist_27$train$y)$overall["Accuracy"]
y_hat_knn <- predict(train_knn, mnist_27$test, type = "raw")  
confusionMatrix(data = y_hat_knn, reference = mnist_27$test$y)$overall["Accuracy"]

Accuracy: 0.8825

Accuracy: 0.815

To show the other direction, when the data is oversmoothing, we propositally use k = 401.

train_knn_401 <- train(y ~ ., method = "knn",
                       data = mnist_27$train,
                       tuneGrid = data.frame(k = 401))
y_hat_knn_401 <- predict(train_knn_401, mnist_27$true_p, type = "prob")[,2]

grid.arrange(plot_cond_prob(),
             plot_cond_prob(y_hat_knn_401, title = "knn-401 estimate"),
             ncol = 2)

y_hat_knn_401 <- predict(train_knn_401, mnist_27$test, type = "raw")
confusionMatrix(data=y_hat_knn_401, reference=mnist_27$test$y)$overall["Accuracy"]

Accuracy: 0.79

Now we tune for the best k, which will be a value between the overtraining and oversmoothing cases:

train_knn <- train(y ~ ., method = "knn", 
                 data = mnist_27$train,
                 tuneGrid = data.frame(k = seq(9, 71, 2)))
train_knn$bestTune
train_knn$finalModel

A data.frame: 1 × 1

	k
	<dbl>
15	37

37-nearest neighbor model
Training set outcome distribution:

  2   7 
379 421 

y_hat_knn <- predict(train_knn, mnist_27$test, type = "raw")
confusionMatrix(data = y_hat_knn, reference = mnist_27$test$y)

Confusion Matrix and Statistics

          Reference
Prediction  2  7
         2 93 16
         7 13 78
                                          
               Accuracy : 0.855           
                 95% CI : (0.7984, 0.9007)
    No Information Rate : 0.53            
    P-Value [Acc > NIR] : <2e-16          
                                          
                  Kappa : 0.7084          
                                          
 Mcnemar's Test P-Value : 0.7103          
                                          
            Sensitivity : 0.8774          
            Specificity : 0.8298          
         Pos Pred Value : 0.8532          
         Neg Pred Value : 0.8571          
             Prevalence : 0.5300          
         Detection Rate : 0.4650          
   Detection Prevalence : 0.5450          
      Balanced Accuracy : 0.8536          
                                          
       'Positive' Class : 2               
                                          

confusionMatrix(data = y_hat_knn, reference = mnist_27$test$y)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_knn, reference = mnist_27$test$y))

Accuracy: 0.855

F1 Score: 0.8651163

ggplot(train_knn, highlight = TRUE)

The model automatically uses bootstrap samples for tuning the parameter k.
We can visualize the accuracy and standard deviation of this tuning process.

train_knn$results %>% 
  ggplot(aes(x = k, y = Accuracy)) +
  geom_line() +
  geom_point() +
  geom_errorbar(aes(x = k, 
                    ymin = Accuracy - AccuracySD,
                    ymax = Accuracy + AccuracySD))

The user can also manually create bootstrap samples:

indexes <- createResample(mnist_27$train$y, 10)

Following we see the conditional probability of the best k tunned and how it approximates the real conditional probability.

train_knn <- train(y ~ ., method = "knn",
                   data = mnist_27$train,
                   tuneGrid = data.frame(k = train_knn$bestTune$k))
y_hat_knn <- predict(train_knn, mnist_27$true_p, type = "prob")[,2]

grid.arrange(plot_cond_prob(),
             plot_cond_prob(y_hat_knn, title = "knn-37 estimate"),
             ncol = 2)

Kernel methods such as knn suffer from the curse of dimensionality, when they face multiple predictors. With around 100 predictors, the neighborhood is no longer very local, once it covers almost the entire dataset.