B2-Distance.qmd

---
output: html_document
editor_options:
  chunk_output_type: console
---

# Distance-based Algorithms

In this chapter, we introduce support-vector machines (SVMs) and other distance-based methods **Hint**: Distance-based models need scaling!

## K-Nearest-Neighbor

K-nearest-neighbor (kNN) is a simple algorithm that stores all the available cases and classifies the new data based on a similarity measure. It is mostly used to classify a data point based on how its $k$ nearest neighbors are classified.

Let us first see an example:

```{r chunk_chapter4_32}
x = scale(iris[,1:4])
y = iris[,5]
plot(x[-100,1], x[-100, 3], col = y)
points(x[100,1], x[100, 3], col = "blue", pch = 18, cex = 1.3)
```

Which class would you decide for the blue point? What are the classes of the nearest points? Well, this procedure is used by the k-nearest-neighbors classifier and thus there is actually no "real" learning in a k-nearest-neighbors classification.

For applying a k-nearest-neighbors classification, we first have to scale the data set, because we deal with distances and want the same influence of all predictors. Imagine one variable has values from -10.000 to 10.000 and another from -1 to 1. Then the influence of the first variable on the distance to the other points is much stronger than the influence of the second variable. On the iris data set, we have to split the data into training and test set on our own. Then we will follow the usual pipeline.

```{r chunk_chapter4_33}
data = iris
data[,1:4] = apply(data[,1:4],2, scale)
indices = sample.int(nrow(data), 0.7*nrow(data))
train = data[indices,]
test = data[-indices,]
```

Fit model and create predictions:

```{r chunk_chapter4_34}
library(kknn)
set.seed(123)

knn = kknn(Species~., train = train, test = test)
summary(knn)
table(test$Species, fitted(knn))
```

## Support Vector Machines (SVMs)

Support vectors machines have a different approach. They try to divide the predictor space into sectors for each class. To do so, a support-vector machine fits the parameters of a hyperplane (a $n-1$ dimensional subspace in a $n$-dimensional space) in the predictor space by optimizing the distance between the hyperplane and the nearest point from each class.

Fitting a support-vector machine:

```{r chunk_chapter4_35}
library(e1071)

data = iris
data[,1:4] = apply(data[,1:4], 2, scale)
indices = sample.int(nrow(data), 0.7*nrow(data))
train = data[indices,]
test = data[-indices,]

sm = svm(Species~., data = train, kernel = "linear")
pred = predict(sm, newdata = test)
```

```{r chunk_chapter4_36}
oldpar = par(mfrow = c(1, 2))
plot(test$Sepal.Length, test$Petal.Length,
     col =  pred, main = "predicted")
plot(test$Sepal.Length, test$Petal.Length,
     col =  test$Species, main = "observed")
par(oldpar)

mean(pred == test$Species) # Accuracy.
```

Support-vector machines can only work on linearly separable problems. (A problem is called linearly separable if there exists at least one line in the plane with all of the points of one class on one side of the hyperplane and all the points of the others classes on the other side).

If this is not possible, we however, can use the so called *kernel trick*, which maps the predictor space into a (higher dimensional) space in which the problem is linear separable. After having identified the boundaries in the higher-dimensional space, we can project them back into the original dimensions.

```{r chunk_chapter4_37, eval=FALSE, purl=FALSE}
x1 = seq(-3, 3, length.out = 100)
x2 = seq(-3, 3, length.out = 100)
X = expand.grid(x1, x2)
y = apply(X, 1, function(t) exp(-t[1]^2 - t[2]^2))
y = ifelse(1/(1+exp(-y)) < 0.62, 0, 1)

image(matrix(y, 100, 100))
animation::saveGIF(
  {
    for(i in c("truth", "linear", "radial", "sigmoid")){
      if(i == "truth"){
        image(matrix(y, 100,100),
        main = "Ground truth", axes = FALSE, las = 2)
      }else{
        sv = e1071::svm(x = x, y = factor(y), kernel = i)
        image(matrix(as.numeric(as.character(predict(sv, x))), 100, 100),
        main = paste0("Kernel: ", i), axes = FALSE, las = 2)
        axis(1, at = seq(0,1, length.out = 10),
        labels = round(seq(-3, 3, length.out = 10), 1))
        axis(2, at = seq(0,1, length.out = 10),
        labels = round(seq(-3, 3, length.out = 10), 1), las = 2)
      }
    }
  },
  movie.name = "svm.gif", autobrowse = FALSE, interval = 2
)
```

```{r chunk_chapter4_38, message=FALSE, warning=FALSE, echo=FALSE, purl=FALSE}
knitr::include_graphics("./images/svm.gif")
```

As you have seen, this does not work with every kernel. Hence, the problem is to find the actual correct kernel, which is again an optimization procedure and can thus be approximated.

## Exercises

::: {.callout-caution icon="false"}
#### Question: Hyperparameter tuning of kNN

Combing back to the titanic dataset from the morning, we want to optimize the number of neighbors (k) and the kernel of the kNN:

Prepare the data:

```{r}
library(EcoData)
library(dplyr)
library(missRanger)
data(titanic_ml)
data = titanic_ml
data = 
  data %>% select(survived, sex, age, fare, pclass)
data[,-1] = missRanger(data[,-1], verbose = 0)

data_sub =
  data %>%
    mutate(age = scales::rescale(age, c(0, 1)),
           fare = scales::rescale(fare, c(0, 1))) %>%
    mutate(sex = as.integer(sex) - 1L,
           pclass = as.integer(pclass - 1L))
data_new = data_sub[is.na(data_sub$survived),] # for which we want to make predictions at the end
data_obs = data_sub[!is.na(data_sub$survived),] # data with known response
```

**Hints:**

-   check the help of the kNN function to get an idea about the hyperparameters

::: {.callout-tip collapse="true" appearance="minimal"}
## Code template

```{r, eval=FALSE}
library(kknn)
set.seed(42)
data_obs = data_sub[!is.na(data_sub$survived),] 
cv = 3

outer_split = as.integer(cut(1:nrow(data_obs), breaks = cv))

hyper_k = ... # must be integer vector
hyper_kernel = ... # must be character vector

results = data.frame(
  set = rep(NA, cv),
  k = rep(NA, cv),
  kernel = rep(NA, cv),
  AUC = rep(NA, cv)
)

for(i in 1:cv) {
  train_outer = data_obs[outer_split != i, ]
  test_outer = data_obs[outer_split == i, ]
  
  tuning_results = 
      sapply(1:length(hyper_k), function(k) {
        predictions = kknn(as.factor(survived)~., train = train_outer, test = test_outer, k = hyper_k[k], scale = FALSE, kernel = hyper_kernel[k])
        return(Metrics::auc(test_outer$survived, predictions$prob[,2]))
      })
  
  results[i, 1] = i
  results[i, 2] = hyper_k[which.max(tuning_results)]
  results[i, 3] = hyper_kernel[which.max(tuning_results)]  
  results[i, 4] = max(tuning_results)
}

print(results)
```
:::

`r hide("Click here to see the solution")`

```{r}
library(kknn)
set.seed(42)
data_obs = data_sub[!is.na(data_sub$survived),] 
cv = 3

outer_split = as.integer(cut(1:nrow(data_obs), breaks = cv))

# sample minnodesize values (must be integers)
hyper_k = sample(10, 10)
hyper_kernel = sample(c("triangular", "inv", "gaussian", "rank"), 10, replace = TRUE)

results = data.frame(
  set = rep(NA, cv),
  k = rep(NA, cv),
  kernel = rep(NA, cv),
  AUC = rep(NA, cv)
)

for(i in 1:cv) {
  train_outer = data_obs[outer_split != i, ]
  test_outer = data_obs[outer_split == i, ]
  
  tuning_results = 
      sapply(1:length(hyper_k), function(k) {
        predictions = kknn(as.factor(survived)~., train = train_outer, test = test_outer, k = hyper_k[k], scale = FALSE, kernel = hyper_kernel[k])
        return(Metrics::auc(test_outer$survived, predictions$prob[,2]))
      })
  
  results[i, 1] = i
  results[i, 2] = hyper_k[which.max(tuning_results)]
  results[i, 3] = hyper_kernel[which.max(tuning_results)]  
  results[i, 4] = max(tuning_results)
}

print(results)
```

Make predictions:

```{r, results='hide', warning=FALSE, message=FALSE}
prediction_ensemble = 
  sapply(1:nrow(results), function(i) {
    predictions = kknn(as.factor(survived)~., train = data_obs, test = data_new, k = results$k[i], scale = FALSE, kernel = results$kernel[i])
    return(predictions$prob[,2])
  })

# Single predictions from the ensemble model:
write.csv(data.frame(y = apply(prediction_ensemble, 1, mean)), file = "Max_titanic_ensemble.csv")
```

`r unhide()`
:::


::: {.callout-caution icon="false"}
#### Question: kNN and SVM

Fit a standard k-nearest-neighbor classifier and a support vector machine with a linear kernel (check help) on the Sonar dataset, and report what fitted better.

Prepare dataset:

```{r}
library(mlbench)
set.seed(123)

data(Sonar)
data = Sonar
#str(data)

# Do not forget scaling! This may be done implicitly by most functions.
# Here, it's done explicitly for teaching purposes.
data = cbind.data.frame(
  scale(data[,-length(data)]),
  "class" = data[,length(data)]
)

n = length(data[,1])
indicesTrain = sample.int(n, (n+1) %/% 2) # Take (at least) 50 % of the data.

train = data[indicesTrain,]
test = data[-indicesTrain,]
```

**Tasks:**

-   Fit a svm (from the e1071 package) on the train dataset and make predictions for the test dataset
-   Fit a kNN (from the kknn package) on the train dataset and make predictions for the test dataset
-   Calculate confusion matrices to compare the performance

`r hide("Click here to see the solution")`

```{r chunk_chapter4_task_33, include=TRUE}
library(e1071)
library(kknn)

knn = kknn(class~., train = train, test = test, scale = FALSE,
           kernel = "rectangular")
predKNN = predict(knn, newdata = test)

sm = svm(class~., data = train, scale = FALSE, kernel = "linear")
predSVM = predict(sm, newdata = test)
```

```{r chunk_chapter4_task_34, echo=FALSE, include=TRUE}
labelsTrain = train[,length(train)]
labelsTest = test[,length(test)]

contingency = table(predKNN, labelsTest)
cat("K-nearest-neighbor, standard (rectangular) kernel:\n\n")
print(contingency)
cat("Correctly classified: ", contingency[1, 1] + contingency[2, 2],
    " / ", sum(contingency))
```

```{r chunk_chapter4_task_35, echo=FALSE, include=TRUE}
contingency = table(predSVM, labelsTest)
cat("Support-vector machine, linear kernel:\n\n")
print(contingency)
cat("Correctly classified: ", contingency[1, 1] + contingency[2, 2],
    " / ", sum(contingency))
```

K-nearest neighbor fitted (slightly) better.

`r unhide()`
:::