---
title: "nntrf hyper-parameter tuning"
author: "Ricardo Aler"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{nntrf hyper-parameter tuning}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

```{r}
library(nntrf)
library(mlr)
library(mlrCPO)
library(FNN)
```

# nntrf Hyper-parameter Tuning

**nntrf** has several hyper-parameters which are important in order to obtain good results. Those are:

- **size:** The number of hidden neurons
- **maxit:** The number of iterations
- **repetitions:** The number of training repetitions
- **xavier_ini:** Use Xavier initialization for sigmoid
- **orthog_ini:** Use Xavier initialization for sigmoid and orthogonal weights for the hidden layer
- **use_sigmoid:** Whether the transformation should use the sigmoid or not

Machine learning pipelines usually contain two kinds of steps: pre-processing and classifier/regressor. Both kinds of steps contain hyper-parameters and they are optimized together. **nntrf** is a preprocessing step. The classifier method that will be used after preprocessing is KNN, whose main hyper-parameter is the number of neighbors (**k**). Hyper-parameter tuning could be programmed from scratch, but it is more efficient to use the procedures already available in machine learning packages such as [mlr](https://mlr.mlr-org.com/) or Caret. In this case, **mlr** will be used. Code to do that is described below.

The next piece of code has nothing to do with **nntrf**. It just establishes that the doughnutRandRotated dataset is going to be used (with target variable "V11"), that grid search is going to be used for hyper-parameter tuning, that an external 3-fold crossvalidation is going to be used to evaluate models, while an inner 3-fold crossvalidation is going to be used for hyper-parameter tuning. 

```{r}
data("doughnutRandRotated")

doughnut_task <- makeClassifTask(data = doughnutRandRotated, target = "V11")
control_grid <- makeTuneControlGrid()
inner_desc <- makeResampleDesc("CV", iter=3)
outer_desc <-  makeResampleDesc("CV", iter=3)
set.seed(0)
outer_inst <- makeResampleInstance(outer_desc, doughnut_task)
```

A mlr subpakage, called mlrCPO, is going to be used to combine pre-processing and learning into a single pipeline. In order to do that, **nntrf** must be defined as a pipeline step, as follows. Basically, it defines **train** and **retrafo** methods. The former, trains the neural networks and stores the hidden layer weights, the latter applies the transformation on a dataset. **pSS** is used to define the main **nntrf** hyper-parameters.

```{r}
cpo_nntrf = makeCPO("nntrfCPO",  
                       # Here, the hyper-parameters of nntrf are defined
                       pSS(repetitions = 1 : integer[1, ],
                           xavier_ini = FALSE : logical,
                           orthog_ini = FALSE : logical,
                           size: integer[1, ],
                           maxit = 100 : integer[1, ],
                           use_sigmoid = FALSE: logical),
                       dataformat = "numeric",
                       cpo.train = function(data, target, 
                                            repetitions, xavier_ini, orthog_ini, 
                                            size, maxit, use_sigmoid) {
                         data_and_class <- cbind(as.data.frame(data), class=target[[1]])
                         nnpo <- nntrf(repetitions=repetitions,
                                       xavier_ini=xavier_ini,
                                       orthog_ini=orthog_ini,
                                       formula=class~.,
                                       data=data_and_class,
                                       size=size, maxit=maxit, trace=FALSE)
                       },
                       cpo.retrafo = function(data, control, 
                                              repetitions, xavier_ini, orthog_ini, 
                                              size, maxit, use_sigmoid) {
                       
                         trf_x <- control$trf(x=data,use_sigmoid=use_sigmoid)
                         trf_x
                       })
```

Next, the pipeline of pre-processing + classifier method (KNN in this case) is defined.

```{r}
# knn is the machine learning method. The knn available in the FNN package is used
knn_lrn <- makeLearner("classif.fnn")
# Then, knn is combined with nntrf's preprocessing into a pipeline
knn_nntrf <- cpo_nntrf() %>>% knn_lrn
# Just in case, we fix the values of the hyper-parameters that we do not require to optimize
# (not necessary, because they already have default values. Just to make their values explicit)
knn_nntrf <- setHyperPars(knn_nntrf, nntrfCPO.repetitions=1, nntrfCPO.maxit=100, 
                          nntrfCPO.xavier_ini=FALSE, nntrfCPO.orthog_ini=FALSE,
                          nntrfCPO.use_sigmoid=FALSE)

# However, we are going to use 2 repetitions here, instead of 1 (the default):

knn_nntrf <- setHyperPars(knn_nntrf, nntrfCPO.repetitions=2)
```

Next, the hyper-parameter space for the pipeline is defined. Only two hyper-parameters will be optimized: the number of KNN neighbors (k), from 1 to 7, and the number of hidden neurons (size), from 1 to 10. The remaining hyper-parameters are left to some default values.

```{r}
ps <- makeParamSet(makeDiscreteParam("k", values = 1:7),
                   makeDiscreteParam("nntrfCPO.size", values = 1:10)
)
```

Next, a mlr wrapper is used to give the **knn_nntrf** pipeline the ability to do hyper-parameter tuning.

```{r}
knn_nntrf_tune <- makeTuneWrapper(knn_nntrf, resampling = inner_desc, par.set = ps, 
                                     control = control_grid, measures = list(acc), show.info = FALSE)
```

Finally, the complete process (3-fold hyper-parameter tuning) and 3-fold outer model evaluation is run. It takes some time. 

```{r}
set.seed(0)
# Please, note that in order to save time, results have been precomputed
cached <- system.file("extdata", "error_knn_nntrf_tune.rda", package = "nntrf")
if(file.exists(cached)){load(cached)} else {
error_knn_nntrf_tune <- resample(knn_nntrf_tune, doughnut_task, outer_inst, 
                                 measures = list(acc), 
                                 extract = getTuneResult, show.info =  FALSE)
save(error_knn_nntrf_tune, file="../inst/extdata/error_knn_nntrf_tune.rda")
}

```

Errors and optimal hyper-parameters are as follows (the 3-fold inner hyper-parameter tuning crossvalidation accuracy is also shown in **acc.test.mean** ).

```{r}
print(error_knn_nntrf_tune$extract)
```

And the final outer 3-fold crossvalition accuracy is displayed below. Please, note that this **acc.test.mean** corresponds to the outer 3-fold crossvalidation, while the **acc.test.mean** above, corresponds to the inner 3-fold crossvalidation accuracy (computed during hyper-parameter tuning).

```{r}
print(error_knn_nntrf_tune$aggr)
```

Although not required, mlr allows to display the results of the different hyper-parameter values, sorted by the **inner** 3-fold crossvalidation accuracy, from best to worse.

```{r}
library(dplyr)
results_hyper <- generateHyperParsEffectData(error_knn_nntrf_tune)
head(arrange(results_hyper$data, -acc.test.mean))
```

We can also check directly what would happen with only 4 neurons (and 5 neighbors).

```{r}
knn_nntrf <- cpo_nntrf() %>>% makeLearner("classif.fnn")

knn_nntrf <- setHyperPars(knn_nntrf, nntrfCPO.repetitions=2, nntrfCPO.maxit=100,
                          nntrfCPO.xavier_ini=FALSE, nntrfCPO.orthog_ini=FALSE,
                          nntrfCPO.use_sigmoid=FALSE, k=5, nntrfCPO.size=4)

set.seed(0)
# Please, note that in order to save time, results have been precomputed
cached <- system.file("extdata", "error_knn_nntrf.rda", package = "nntrf")
if(file.exists(cached)){load(cached)} else {
  error_knn_nntrf <- resample(knn_nntrf, doughnut_task, outer_inst, measures = list(acc), 
                            show.info =  FALSE)
save(error_knn_nntrf, file="../inst/extdata/error_knn_nntrf.rda")
}


```


```{r}
# First, the three evaluations of the outer 3-fold crossvalidation, one per fold:
print(error_knn_nntrf$measures.test)
# Second, their average
print(error_knn_nntrf$aggr)
```

## Hyper-parameter tuning with PCA

In order to compare a supervised transformation method (**nntrf**) with an unsupervised one (PCA), it is very easy to do exactly the same pre-processing with PCA. In this case, the main hyper-parameters are **k** (number of KNN neighbors) and **Pca.rank** (the number of PCA components to be used, which would be the counterpart of **size**, the number of hidden neurons used by **nntrf**).

```{r}
knn_pca <- cpoPca(center=TRUE, scale=TRUE, export=c("rank")) %>>% knn_lrn

ps_pca <- makeParamSet(makeDiscreteParam("k", values = 1:7),
                       makeDiscreteParam("pca.rank", values = 1:10)
)

knn_pca_tune <- makeTuneWrapper(knn_pca, resampling = inner_desc, par.set = ps_pca, 
                                     control = control_grid, measures = list(acc), show.info = FALSE)
```

```{r}
set.seed(0)
# Please, note that in order to save time, results have been precomputed

cached <- system.file("extdata", "error_knn_pca_tune.rda", package = "nntrf")
if(file.exists(cached)){load(cached)} else {
error_knn_pca_tune <- resample(knn_pca_tune, doughnut_task, outer_inst, 
                               measures = list(acc), 
                               extract = getTuneResult, show.info =  FALSE)
save(error_knn_pca_tune, file="../inst/extdata/error_knn_pca_tune.rda")
}

```

It can be seen below that while **nntrf** was able to get a high accuracy, **PCA** only gets to nearly 0.65. Also the number of components required by **PCA** is the maximum allowed (pca.rank=10)

```{r}
print(error_knn_pca_tune$extract)
print(error_knn_pca_tune$aggr)
results_hyper <- generateHyperParsEffectData(error_knn_pca_tune)
head(arrange(results_hyper$data, -acc.test.mean))
```
## Hyper-parameter tuning with just KNN

For completeness sake, below are the results with, no pre-processing, just KNN (results are very similar to the ones with PCA):

```{r}

ps_knn <- makeParamSet(makeDiscreteParam("k", values = 1:7))


knn_tune <- makeTuneWrapper(knn_lrn, resampling = inner_desc, par.set = ps_knn, 
                                     control = control_grid, measures = list(acc), show.info = FALSE)

set.seed(0)
# Please, note that in order to save time, results have been precomputed
cached <- system.file("extdata", "error_knn_tune.rda", package = "nntrf")
if(file.exists(cached)){load(cached)} else {
error_knn_tune <- resample(knn_tune, doughnut_task, outer_inst, measures = list(acc), 
                           extract = getTuneResult, show.info =  FALSE)
save(error_knn_tune, file="../inst/extdata/error_knn_tune.rda")
}

```

```{r}
print(error_knn_tune$extract)
print(error_knn_tune$aggr)
results_hyper <- generateHyperParsEffectData(error_knn_tune)
head(arrange(results_hyper$data, -acc.test.mean))
```
## nntrf Hyper-parameter Tuning with Xavier initialization

Just for the record, let's see results with Xavier initialization, instead of the standard nnet weight initialization.

```{r}
# knn is the machine learning method. The knn available in the FNN package is used
knn_lrn <- makeLearner("classif.fnn")
# Then, knn is combined with nntrf's preprocessing into a pipeline
knn_nntrf <- cpo_nntrf() %>>% knn_lrn
# Just in case, we fix the values of the hyper-parameters that we do not require to optimize
# (not necessary, because they already have default values. Just to make their values explicit)
knn_nntrf <- setHyperPars(knn_nntrf, nntrfCPO.repetitions=1, nntrfCPO.maxit=100, 
                          nntrfCPO.xavier_ini=FALSE, nntrfCPO.orthog_ini=FALSE,
                          nntrfCPO.use_sigmoid=FALSE)

# However, we are going to use 2 repetitions here, instead of 1 (the default):

knn_nntrf <- setHyperPars(knn_nntrf, nntrfCPO.repetitions=2, nntrfCPO.xavier_ini=TRUE,
                          nntrfCPO.orthog_ini=FALSE)
```

```{r}
ps <- makeParamSet(makeDiscreteParam("k", values = 1:7),
                   makeDiscreteParam("nntrfCPO.size", values = 1:10)
)
```


```{r}
knn_nntrf_tune <- makeTuneWrapper(knn_nntrf, resampling = inner_desc, par.set = ps, 
                                     control = control_grid, measures = list(acc), show.info = FALSE)
```

```{r}
set.seed(0)
# Please, note that in order to save time, results have been precomputed
cached <- system.file("extdata", "error_knn_nntrf_xavier_tune.rda", package = "nntrf")
if(file.exists(cached)) {load(cached)} else {
error_knn_nntrf_xavier_tune <- resample(knn_nntrf_tune, doughnut_task, outer_inst, 
                                 measures = list(acc), 
                                 extract = getTuneResult, show.info =  FALSE)
save(error_knn_nntrf_xavier_tune, file="../inst/extdata/error_knn_nntrf_xavier_tune.rda")
}

```


```{r}
print(error_knn_nntrf_xavier_tune$extract)
```

```{r}
print(error_knn_nntrf_xavier_tune$aggr)
```

```{r}
library(dplyr)
results_hyper <- generateHyperParsEffectData(error_knn_nntrf_xavier_tune)
head(arrange(results_hyper$data, -acc.test.mean))
```

And now Xavier + Orthogonal initialization.

```{r}
knn_nntrf <- setHyperPars(knn_nntrf, nntrfCPO.repetitions=2, 
                          nntrfCPO.xavier_ini=TRUE,
                          nntrfCPO.orthog_ini=TRUE)
knn_nntrf_tune <- makeTuneWrapper(knn_nntrf, resampling = inner_desc, par.set = ps, 
                                     control = control_grid, measures = list(acc), show.info = FALSE)
```

```{r}
set.seed(0)
# Please, note that in order to save time, results have been precomputed
cached <- system.file("extdata", "error_knn_nntrf_xavier_orthog_tune.rda", package = "nntrf")
if(file.exists(cached)) {load(cached)} else {
error_knn_nntrf_xavier_tune <- resample(knn_nntrf_tune, doughnut_task, outer_inst, 
                                 measures = list(acc), 
                                 extract = getTuneResult, show.info =  FALSE)
save(error_knn_nntrf_xavier_tune, file="../inst/extdata/error_knn_nntrf_xavier_orthog_tune.rda")
}
```

```{r}
print(error_knn_nntrf_xavier_tune$extract)
print(error_knn_nntrf_xavier_tune$aggr)
library(dplyr)
results_hyper <- generateHyperParsEffectData(error_knn_nntrf_xavier_tune)
head(arrange(results_hyper$data, -acc.test.mean))
```
