---
title: "Lecture 5: Classification"
output: html_document
runtime: shiny
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

## Load Libraries

```{r}
library(tidyverse)
library(shiny)
library(class)
```

## Data Preparation

### Read in CORIS data

Download the accompanying [CORIS data ZIP](lecture5_coris_data.zip) and extract
`coris.csv` into the same folder as this notebook. In RStudio, use **Run Document**
to run the notebook and its interactive app. The code also finds the archived
data when run from the repository root or its `lectures/code/` directory.

```{r}
data.paths = c("coris.csv", "../../Archives/datasets/coris.csv",
               "Archives/datasets/coris.csv")
data.path = data.paths[file.exists(data.paths)][1]
if (is.na(data.path)) {
  stop("Extract coris.csv from lecture5_coris_data.zip beside this notebook.")
}
coris = as_tibble(read.csv(data.path)) %>%
  select(-row.names) %>%
  mutate(across(-chd, ~ as.numeric(scale(.))), chd = (chd != 0))
```

### Train/Test Separation

```{r}
set.seed(12345)
train.ind = sample(1:nrow(coris), nrow(coris) * 0.5)
coris.train = coris[train.ind,]
coris.test = coris[-train.ind,]

# Construct predictor matrices excluding chd.
X.train = as.matrix(select(coris.train, -chd))
X.test = as.matrix(select(coris.test, -chd))
```

## KNN Model

### Ranging over k and L, run KNN

```{r}
knn.err <- map_dfr(c(1,2,3,4,seq(5, nrow(coris.train), 5)), function(K) {
  # Run KNN 
  knn.raw <- knn(train = X.train,
                 test = X.test,
                 cl = coris.train$chd,
                 k = K, l = 0,
                 use.all = FALSE, # Use exactly K neighbors, breaking distance ties randomly.
                 prob = TRUE)
  
  # Compute the fraction of neighbors with chd = TRUE.
  knn.probs <- map_dbl(1:length(knn.raw), function(i) {
    if (knn.raw[i] == TRUE) {
      return(attributes(knn.raw)$prob[i])
    } else {
      return(1 - attributes(knn.raw)$prob[i])
    }
  })

  # Convert vote fractions to integer counts.
  knn.votes <- round(K * knn.probs)
  
  # Compute the TP, FP, FN, TN from the model on the test data
  confusion <- map_dfr(seq(0, 1.05, 0.01), function(thresh) {
    L <- round(thresh * K, 10) # Round the vote threshold to 10 decimal places.
    knn.out <- as.numeric(knn.votes >= L)
    TP <- sum(coris.test$chd * knn.out)
    FP <- sum((1 - coris.test$chd) * knn.out)
    FN <- sum(coris.test$chd * (1 - knn.out))
    TN <- sum((1 - coris.test$chd) * (1 - knn.out))
    tibble(K, L, TP, FP, TN, FN, thresh)
  })
  
  return(confusion)
})
```

### Compute accuracy, TPR, FPR

```{r}
knn.err$accuracy = (knn.err$TP + knn.err$TN)/nrow(coris.test)
knn.err$TPR = (knn.err$TP)/(knn.err$TP + knn.err$FN)
knn.err$FPR = (knn.err$FP)/(knn.err$FP + knn.err$TN)
```

### Plot the ROC curve for K = 20

```{r}
knn.err.ksubset = subset(knn.err, K == 20)
roc.plot = ggplot(data = arrange(knn.err.ksubset, desc(thresh)),
                  aes(x = FPR, y = TPR)) +
  geom_path(linewidth = 1, alpha = 0.7) +
  geom_point(aes(size = thresh)) +
  scale_x_continuous(limits = c(0, 1)) +
  scale_y_continuous(limits = c(0, 1)) +
  labs(x = "False positive rate", y = "True positive rate",
       size = "Threshold L/k") +
  theme_minimal(base_size = 13)
roc.plot
```

### Plot 0-1 loss at a fixed threshold

```{r}
loss_plot <- function(threshold) {
  knn.err.subset <- knn.err %>%
    filter(abs(thresh - threshold) < 1e-9)
  ggplot(data = knn.err.subset, aes(x = K, y = 1 - accuracy)) +
    geom_line() +
    ylim(0, 1) +
    labs(x = "Number of neighbors k", y = "Average 0-1 Loss on Test Set") +
    theme_minimal(base_size = 13)
}
loss.plot = loss_plot(0.32)
loss.plot
```

## R Shiny App to Explore Role of Threshold

### User Interface (UI)

```{r}
ui <- fluidPage(
  titlePanel("Average 0-1 Loss on Test Set with Varying Threshold"),
  mainPanel(
    sliderInput("thresh_slider", 
                  "Threshold L/k:",
                  min = 0,
                  max = 1.05,
                  value = 0.32,
                  step = 0.01,
                  ticks = FALSE),
    plotOutput("loss_plot")
  )
)
```

### Server Logic

```{r}
server <- function(input, output, session) {
  
  # This renders the plot based on user input
  output$loss_plot <- renderPlot({
    req(!is.null(input$thresh_slider)) # Check that the slider has a value.
    loss_plot(input$thresh_slider)
  })
}
```

### Run the shiny app

```{r, eval=TRUE}
shinyApp(ui = ui, server = server)
```

The notebook uses `runtime: shiny`, and the final block embeds the app when you
use **Run Document** in RStudio. You can also run the code chunks interactively.