---
title: "Tutorial"
author: "Ricardo Aler"
date: "1 Agosto 2019"
output:
  pdf_document: default
  html_document: default
  word_document: default
---
# Tutorial sobre datos desbalanceados en mlR

## Introducci�n

Vamos a usar el conjunto de datos *ubIonosphere*, que tiene un ligero desbalanceo (proporci�n de positivos frente a negativos = `r 126/225`). Podemos ver que dado que la clase mayoritaria es un 64% de los datos, un clasificador trivial que predijera siempre "0" tendr�a un 64% de aciertos.

```{r}
data(ubIonosphere, package = "unbalanced")

# Comprobamos que la clase es un factor. Lo es, pero si no, habr�a que convertirla a factor.
class(ubIonosphere$Class)

(conteo <- table(ubIonosphere$Class))

conteo/sum(conteo)

#GRADO DE DESBALANCEO
conteo[2]/conteo[1]
```

El problema que tienen los datos desbalanceados es que las clases minoritarias se clasifican mal. Veamos si eso es as� con k-vecinos. Tenemos que definir una tarea de clasificaci�n. Es importante que digamos cual de las dos es la clase positiva (la minoritaria), que en este caso es la "1". Tambi�n, cuando definamos el m�todo para evaluar el modelo (con "Holdout" en este caso), tenemos que especificar que las particiones tienen que estar estratificadas. Por �ltimo, entrenamos / evaluamos el modelo con *resample*. Vamos a computar las medidas de error *tpr* y *tnr* (true positive rate y true negative rate), que son la tasa de aciertos de la clase positiva y negativa, respectivamente. Tambi�n vamos a computar la tasa de aciertos (*acc*) y el "balanced accuracy", que es la media de *tpr* y *tnr*.

```{r}
library(mlr)

# Primero definimos la tarea. N�tese que definimos cual es la clase positiva
task_io <- makeClassifTask(data=ubIonosphere, target="Class", positive = "1")
learner_kknn <- makeLearner("classif.kknn")

# Al definir el m�todo de evaluaci�n, tenemos que especificar que las particiones sean estratificadas
metodo_evaluacion <- makeResampleDesc("Holdout", stratify=TRUE) 
set.seed(0)
particion_datos <- makeResampleInstance(metodo_evaluacion, task_io)
                         
set.seed(0) 
errores_kknn <- resample(learner_kknn, task_io, particion_datos, measures = list(acc, bac, tpr, tnr))
```

Vemos que la clase negativa (mayoritaria) se aprende mucho mejor que la positiva: tnr = `r errores_kknn$aggr["tnr.test.mean"]` y tpr = `r errores_kknn$aggr["tpr.test.mean"]`. A�n as�, dado que *acc* (83%) supera el 65% de aciertos, el clasificador construido con *knn* es mejor que un clasificador trivial. Vemos tambi�n que el error *bac* representa mejor que *acc* la precisi�n del clasificador, sobre todo con respecto a la clase positiva (minoritaria).

```{r}
errores_kknn$aggr
```
La matriz de confusi�n muestra similares resultados 

```{r}
calculateConfusionMatrix(errores_kknn$pred, relative = TRUE)
```
## Mostrando curvas ROC

Vamos a hacer una curva ROC para *kknn*. Para ello es necesario hacer predicciones probabil�sticas. Aqu� las podemos ver:

```{r}

learner_kknn_prob <- makeLearner("classif.kknn", predict.type = "prob")
model_kknn_prob <- train(learner_kknn_prob, task_io, subset = particion_datos$train.inds[[1]])
predicciones <- predict(model_kknn_prob,  task_io, subset = particion_datos$test.inds[[1]])
head(predicciones$data)

```
Pero en este momento, no nos interesan las predicciones, vamos a calcular los errores directamente con *resample*. Ahora que hacemos predicciones probabil�sticas, podemos aprovechar para calcular tambi�n el �rea bajo la curva (auc), como se puede ver abajo.

```{r}
set.seed(0) 
errores_kknn <- resample(learner_kknn_prob, task_io, particion_datos, measures = list(acc, bac, tpr, tnr, auc))
```
Para generar la curva ROC, primero tenemos que generar cierta informaci�n con la funci�n *generateThreshVsPerfData*, a partir de los errores computados anteriormente. Necesitaremos *fpr* y *tpr* para construir la curva ROC, pero podemos generar informaci�n tambi�n para otras medidas de error, como *tnr* y *bac*. Vemos que la informaci�n generada no es mas que un data.frame que contiene una l�nea para cada valor del threshold.

```{r}
df <- generateThreshVsPerfData(errores_kknn, measures = list(fpr, tpr, tnr, bac))
head(df$data)
```
Ahora imprimimos la curva ROC. Normalmente, imprime s�lo la l�nea, pero si queremos que dibuje tambi�n los puntos, usamos *geom_point()*. mlR genera los plots mediante *ggplot2*.

```{r}
library(ggplot2)
plotROCCurves(df, measures=list(fpr, tpr)) + geom_point()
```
Se puede usar *plotly* para hacer plots ligeramente interactivos. Podemos ver que podr�amos mejorar bastante el *tpr*, sin empeorar demasiado el *tnr*. Originalmente obten�amos un *tpr* de 0.59, con un *tnr* de 0.96 (o lo que es lo mismo, un fpr = 1-tnr = 0.04). Vemos que cambiando el threshold, podr�amos subir el *tpr* a 0.88 y el *tnr=1-fpr* s�lo bajar�a a 1-0.05 = 0.95.

```{r}
library(ggplot2)
library(plotly)
gg <- plotROCCurves(df, measures=list(fpr, tpr)) + geom_point()

ggplotly(gg)
```

## Ajustando el threshold a mano

Desgraciadamente, en la curva ROC, no se puede ver el threshold que tendr�amos que utilizar para obtener dicho resultado. Vamos a generar otra curva, en cuyo eje x viene el threshold, y en el eje y vienen los distintos errores. Haremos el plot con *ggplot2*. Para ello, primero tenemos que poner los datos en modo *largo* (long)

```{r}
# Primero p
df_long <- tidyr::gather(df$data, variable, value, -threshold)
head(df_long)
```

Ahora hacemos el plot. Vamos a hacerlo interactivo. Podemos ver que para un threshold de 0.01 se alcanza un buen equilibrio entre *tpr* y *tnr*. Podemos usar para medirlo la media de los dos *bac*.

```{r}
library(ggplot2)
df_long_tpr_tnr_bac <- df_long[df_long$variable %in% c("tpr", "tnr", "bac"), ]
gg <- ggplot(df_long_tpr_tnr_bac, aes(x=threshold, y=value, col=variable )) + geom_point() + geom_line()
ggplotly(gg)

```
Podemos calcular directamente el threshold, como aquel lugar donde se alcanza el m�ximo *bac*, as�:

```{r}
th <- df$data[which.max(df$data$bac), "threshold"]
th
```

Vamos a fijar dicho threshold con *setThreshold* al hacer las predicciones.

```{r}
preds_kknn_th <- setThreshold(errores_kknn$pred, th)
performance(preds_kknn_th, measures=list(tpr, tnr, bac))
```
## Ajustando el threshold autom�ticamente

Tambi�n podemos ajustarlo autom�ticamente con *tuneThreshold* Hay que fijarse que estamos encontrando el threshold que optimiza *bac*

```{r}
# El threshold �ptimo es
(th <- tuneThreshold(errores_kknn$pred, measure=list(bac), nsub=100))

preds_kknn_th <- setThreshold(errores_kknn$pred, th$th)
errores_kknn_tuned <- performance(preds_kknn_th, measures=list(tpr, tnr, bac))
```

Vemos que obtenemos el mismo *bac* que cuando ajustamos el threshold a mano.

```{r}
errores_kknn_tuned
```
## Ajustando el threshold como cualquier otro hiper-par�metro

En los ajustes de threshold que hemos hecho anteriormente hab�a un aspecto que no era del todo correcto. Tanto las curvas ROC que visualizamos, como el ajuste visual o autom�tico del threshold, lo hicimos con las predicciones en la partici�n de test, lo cual no es correcto, dado que estamos usando el conjunto de test para ajustar un par�metro del modelo (en este caso, el threshold). Viene bien para visualizar como var�an los distintos errores (tpr, tnr, bac, etc.) a medida que cambia el threshold. Pero el ajuste del threshold habr�a que hacerlo como si fuera cualquier otro hiper-par�metro (la manera m�s sencilla es con un conjunto de validaci�n, distinto al de test). Eso es lo que vamos a hacer a continuaci�n. En mlR, esto se puede hacer usando el ajuste de hiper-par�metros que ya conocemos, excepto que en *makeTuneControlGrid*, tenemos que añadir los argumentos *tune.threshold* y *tune.threshold.args*, como vemos en el siguiente c�digo. Nötese que estamos pidiendo que ajuste el threshold optimizando *bac* (podr�amos optimizar cualquier otra medida).

Si quisieramos, podr�amos ajustar a la vez el hiper-par�metro *k*, pero en este caso, s�lo ajustaremos el threshold. Esa es al raz�n por la que hemos fijado la lista de valores de *k* a un �nico valor, el 7 (pero podr�amos poner una lista de valores, por ejemplo, de 1 a 10). 

```{r}
getParamSet(learner_kknn_prob)

ps = makeParamSet(
  makeDiscreteParam("k", values = 7)
)

control_grid <- makeTuneControlGrid(tune.threshold = TRUE, tune.threshold.args = list(measure=list(bac)))
evaluacion_grid <- makeResampleDesc("Holdout", stratify = TRUE)

learner_ajuste_kknn <- makeTuneWrapper(learner_kknn_prob, resampling = evaluacion_grid, par.set = ps, control = control_grid, measures = list(bac))

set.seed(0)
errores_ajuste_kknn <- resample(learner_ajuste_kknn, task_io, particion_datos, measures = list(acc, bac, tpr, tnr), extract = getTuneResult, models = TRUE)
```
Vemos que el threshold es ligeramente distinto al de antes, y tambi�n los errores. Esta diferencia es debida a que antes optimizabamos el threshold directamente con el conjunto de test (que ya sabemos que no es correcto), y ahora lo estamos optimizando con un conjunto de validaci�n. Una vez optimizado el threshold, evaluamos el modelo con este threshold sobre el conjunto de test.

```{r}
errores_ajuste_kknn$models[[1]]$learner.model$opt.result$threshold
errores_ajuste_kknn
```
Podemos aprovechar para ajustar tambi�n otros hiper-par�metros (como k), adem�s del threshold:

```{r}

ps = makeParamSet(
  makeDiscreteParam("k", values = 2:10)
)

control_grid <- makeTuneControlGrid(tune.threshold = TRUE, tune.threshold.args = list(measure=list(bac)))
evaluacion_grid <- makeResampleDesc("Holdout", stratify = TRUE)

learner_ajuste_kknn <- makeTuneWrapper(learner_kknn_prob, resampling = evaluacion_grid, par.set = ps, control = control_grid, measures = list(bac))

set.seed(0)
errores_ajuste_kknn <- resample(learner_ajuste_kknn, task_io, particion_datos, measures = list(acc, bac, tpr, tnr), extract = getTuneResult, models = TRUE)
```



```{r}
errores_ajuste_kknn$models[[1]]$learner.model$opt.result$threshold
errores_ajuste_kknn$models[[1]]$learner.model$opt.result$x
errores_ajuste_kknn
```
## Usando SMOTE para abordar problemas de muestras desbalanceadas

En primer lugar, vamos a rebalancear la muestra "a mano", haciendo que las dos clases tengan el mismo n�mero de instancias. Si la clase mayoritaria tuviera el doble de instancias que la minoritaria, habr�a que duplicar el n�mero de instancias positivas (o sea, un *rate* de 2). En este caso, usaremos un *rate* de instancias mayoritaria / instancias minoritaria. Para usar SMOTE, montaremos un m�todo h�brido, cuya primera fase hace el rebalanceo con SMOTE, y cuya segunda fase aplica *knn* sobre la muestra desbalanceada.

```{r}
tabla <- table(getTaskTargets(task_io))
tabla

rate <- tabla["0"]/tabla["1"]
rate

#task_m_smote <- smote(task_m, rate = rate)
#table(getTaskTargets(task_m_smote))

learner_smote_kknn = makeSMOTEWrapper(learner_kknn_prob, sw.rate = rate)

set.seed(0) 
errores_smote_knn <- resample(learner_smote_kknn, task_io, particion_datos, measures = list(acc, bac, tpr, tnr), models = TRUE)

```

Vemos que con este *rate*, conseguimos un error parecido al que obtuvimos antes ajustando el threshold.

```{r}
errores_smote_knn$aggr
```
En lugar de poner el *rate* a mano, podemos ajustarlo autom�ticamente, dado que es un hiper-par�metro del m�todo h�brido *learner_smote_kknn*. Usaremos una validaci�n cruzada de 3 folds para ajustar *rate*.

```{r}
ps = makeParamSet(
  makeDiscreteParam("sw.rate", values = seq(1, 10, 1))
)

evaluacion_grid <- makeResampleDesc("CV", iters=3, stratify = TRUE)
control_grid <- makeTuneControlGrid()

learner_smote_kknn = makeSMOTEWrapper(learner_kknn_prob)

learner_ajuste_smote_kknn <- makeTuneWrapper(learner_smote_kknn, resampling = evaluacion_grid, par.set = ps, control = control_grid, 
                                              measures = list(bac, tpr, acc, tnr), show.info = FALSE)

set.seed(0) 
errores_ajuste_smote_kknn <- resample(learner_ajuste_smote_kknn, task_io, particion_datos, measures = list(acc, bac, tpr, tnr), extract = getTuneResult, models=TRUE)
```
Vemos que conseguimos un *bac* superior al que hemos ido obteniendo hasta el momento. Vemos que para obtener el mejor resultado, fue necesario utilizar una replicaci�n cuadruple de la clase minoritaria.

```{r}
errores_ajuste_smote_kknn

errores_ajuste_smote_kknn$models[[1]]$learner.model$opt.result

  

```
Puede ser interesante ver como cambia el error al cambiar el *rate*. Vemos que multiplicar por 8 las instancias de la clase minoritaria tiene un efecto beneficioso.

```{r}
efectos <- generateHyperParsEffectData(errores_ajuste_smote_kknn)
head(efectos)
plotHyperParsEffect(efectos, x="sw.rate", y="bac.test.mean", loess.smooth = TRUE)

```


Adem�s de ajustar el *rate* de SMOTE, tambi�n podemos optimizar el threshold (esto lo podemos hacer al ajustar hiper-par�metros, siempre que el m�todo permita predecir probabilidades, que es el caso de *knn*).

```{r}
ps = makeParamSet(
  makeDiscreteParam("sw.rate", values = seq(1, 10, 1))
)

evaluacion_grid <- makeResampleDesc("CV", iters=3, stratify = TRUE)
control_grid <- makeTuneControlGrid(tune.threshold = TRUE, tune.threshold.args = list(measure=list(bac)))

learner_smote_kknn = makeSMOTEWrapper(learner_kknn_prob)

learner_ajuste_smote_kknn <- makeTuneWrapper(learner_smote_kknn, resampling = evaluacion_grid, par.set = ps, control = control_grid, 
                                              measures = list(bac, tpr, acc, tnr), show.info = FALSE)

set.seed(0) 
errores_ajuste_smote_kknn <- resample(learner_ajuste_smote_kknn, task_io, particion_datos, measures = list(acc, bac, tpr, tnr), extract = getTuneResult, models=TRUE)
```
Parece que usando un *rate* de 10 y un threshold de 0.35, podemos mejorar un poco m�s el *bac*.

```{r}
errores_ajuste_smote_kknn

errores_ajuste_smote_kknn$models[[1]]$learner.model$opt.result

```
```{r}
efectos <- generateHyperParsEffectData(errores_ajuste_smote_kknn)
head(efectos)
plotHyperParsEffect(efectos, x="sw.rate", y="bac.test.mean", loess.smooth = TRUE)

```

Incluso podemos ajustar el mismo tiempo el hiper-par�metro *k*, aunque esto va a tardar m�s tiempo.

```{r}
library("parallelMap")
parallelStartSocket(4)

ps = makeParamSet(
  makeDiscreteParam("sw.rate", values = seq(1, 10, 1)),
  makeDiscreteParam("k", values = seq(1, 10, by=2))
)

evaluacion_grid <- makeResampleDesc("CV", iters=3, stratify = TRUE)
control_grid <- makeTuneControlGrid(tune.threshold = TRUE, tune.threshold.args = list(measure=list(bac)))

learner_smote_kknn = makeSMOTEWrapper(learner_kknn_prob)

learner_ajuste_smote_kknn <- makeTuneWrapper(learner_smote_kknn, resampling = evaluacion_grid, par.set = ps, control = control_grid, 
                                              measures = list(bac, tpr, acc, tnr), show.info = TRUE)

set.seed(0) 
errores_ajuste_smote_kknn <- resample(learner_ajuste_smote_kknn, task_io, particion_datos, measures = list(acc, bac, tpr, tnr), extract = getTuneResult, models=TRUE)

parallelStop()
```
Pero en este caso, ajustar *k* no permite mejorar *bac*.

```{r}
errores_ajuste_smote_kknn

errores_ajuste_smote_kknn$models[[1]]$learner.model$opt.result

```
```{r}
efectos <- generateHyperParsEffectData(errores_ajuste_smote_kknn)
head(efectos)
plotHyperParsEffect(efectos, x="sw.rate", y="bac.test.mean", loess.smooth = TRUE)
plotHyperParsEffect(efectos, x="k", y="bac.test.mean", loess.smooth = TRUE)
plotHyperParsEffect(efectos, x="k", y="sw.rate", z="bac.test.mean", plot.type = "heatmap")

```

Nota: hay m�todos que permiten dar pesos a las instancias. En ese caso, una aproximaci�n m�s r�pida que SMOTE podr�a ser usar *makeWeightedClassesWrapper* en lugar de *makeSMOTEWrapper*. En este caso, el nombre del hiper-par�metro que mide el peso (o importancia) de los datos de la clase minoritaria frente a los de la mayoritaria es *wcw.weight*. Desgraciadamente, **kknn** no permite usar pesos con las instancias (pero *rpart* si).