O tidyverse para Aprendizado de Máquina

class:  title-slide
background-image: url(img/ap.png)
background-size: cover

.footnote[
# O `tidyverse` para Aprendizado de Máquina
### Bruna Wundervald,
### `satRday` São Paulo,
### Novembro, 2019
]

???

---
name: hello
class: inverse, left, bottom

.pull-left[
[GitHub: @brunaw](http://github.com/brunaw)  
[Site: http://brunaw.com/](http://brunaw.com/)  
[Twitter: @bwundervald](http://twitter.com/bwundervald)  
]

# Quem sou eu

- Doutoranda em Estatística no 
  [Hamilton Institute, Maynooth University](https://www.maynoothuniversity.ie/hamilton)
  
  - Especialmente interessada em modelos de árvore:
    - Regularização em Florestas Aleatórias
    - Árvores de Regressão Aditivas Bayesianas (BART)

???

Here is my contact information.

---
class: inverse, right, bottom

## Links

`pt-br`: http://brunaw.com/slides/satrday-sp/tidyverse-para-AM.html
`en`: http://brunaw.com/slides/satrday-sp/tidyverse-for-ml.html

Repositório no GitHub : https://github.com/brunaw/satRday-sp-talk

---

# Introdução

- Graças ao `tidyverse`, hoje em dia é muito fácil criar workflows
aninhados de análise e manipulação de dados no `R`

- Pórem, nós podemos ir muito além disso, e criar o processo
inteiro de modelagem com o `tidyverse`

- Como?

???

---

# Tidy-data

???

Then you may ask them to present their work.

---

# Dados

- Sobre a quantidade diária de pessoas (em milhares)  
usando a estação Clark and Lake em Chicago

> Objetivo: prever essa variável e encontrar as variáveis ótimas
para o modelo

- Preditoras:
  - Data  
  - Tempo/Clima
  - Jogos de futebol acontecendo na cidade
  - +

---

# Carregando dados e visualizando

```{r
library(tidyverse)
library(ranger)

data <- dials::Chicago

dim(data)
```

```
[1] 5698   50
```

```{r
data %>%  
  ggplot(aes(x = ridership)) +
  geom_density(fill = "#919c4c", alpha = 0.8) +
  labs(x = "Variável Resposta", y = "Densidade") +
  theme_classic()
```

---

---

.pull-left[

]

.pull-right[

- Distribuição interessante!
- Boa para modelos de árvores

]

---

## Replicando o mesmo conjunto de dados

```{r
data_tibble <- rep(list(data), 10) %>% 
  enframe(name = 'index', value = 'data')
data_tibble
```

```
# A tibble: 10 x 2
   index data                 
   <int> <list>               
 1     1 <tibble [5,698 × 50]>
 2     2 <tibble [5,698 × 50]>
 3     3 <tibble [5,698 × 50]>
 4     4 <tibble [5,698 × 50]>
 5     5 <tibble [5,698 × 50]>
 6     6 <tibble [5,698 × 50]>
 7     7 <tibble [5,698 × 50]>
 8     8 <tibble [5,698 × 50]>
 9     9 <tibble [5,698 × 50]>
10    10 <tibble [5,698 × 50]>
```

.callout[A coluna `data` é uma lista de novas tibbles!]

---

## Separando em treino (75%) e teste (25%)

```{r
treino_teste <- function(data){
  data %>% 
    mutate(base = ifelse(runif(n()) > 0.75, "teste", "treino")) %>% 
    split(.$base) %>% 
    purrr::map(~select(.x, -.data[["base"]])) }
data_tibble <- data_tibble %>% 
*  mutate(treino_teste = purrr::map(data, treino_teste))
print(data_tibble, n = 3)
```

```
# A tibble: 10 x 3
  index data                  treino_teste    
  <int> <list>                <list>          
1     1 <tibble [5,698 × 50]> <named list [2]>
2     2 <tibble [5,698 × 50]> <named list [2]>
3     3 <tibble [5,698 × 50]> <named list [2]>
# … with 7 more rows
```

.callout[A coluna `treino_teste` é uma lista com 2 elementos: os dados
de treino e os de teste]

---

---

## Modelagem: métodos baseados em árvores

- Diversos métodos similares com configurações de hiperparâmetros diferentes

.pull-left[
<img src="img/vars_space2.png" width="70%" style="display: block; margin: auto;" />
]

.pull-right[
<img src="img/vars_space.png" width="70%" style="display: block; margin: auto;" />
]

---

## Modelagem: métodos baseados em árvores

- Árvores (CART): 1 árvore, `$\texttt{mtry}$` = todas as variáveis 
  disponíveis
  
  - *Bagging*: média de várias árvores, `$\texttt{mtry}$` =  todas as variáveis 
  disponíveis

- Floresta Aleatória: média de várias árvores, `$\texttt{mtry} \approx \sqrt{\text{todas as variáveis disponíveis}}$`
  
  - Floresta Aleatória Regularizada: média de várias árvores, `$\texttt{mtry} \approx \text{todas as variáveis disponíveis}/2$`, 
  penalização do ganho das variáveis por um fator entre 0 e 1 para
  regularizar

(Mais sobre Florestas Aleatórias Regularizadas em: http://brunaw.com/slides/seminar-serie/presentation.html)

---
 Criando uma função para ajustar todos os modelos:

```{r
modelagem <- function(treino, 
                      mtry = NULL, 
                      num.trees = NULL, 
                      regularization = 1, 
                      formula = ridership ~ .) {
  
  ranger::ranger(formula, 
                 data = treino, 
                 num.trees = num.trees,
                 mtry = mtry, 
                 importance = "impurity", 
                 regularization.factor = regularization)
}
```

> Nota: essa é versão 0.11.8 do pacote `ranger`,  disponível em 
https://github.com/regularization-rf/ranger

---

Encadeando os modelos:

```{r
modelos <- list(
  arvores = list(mtry = ncol(data) - 1, num.trees = 1, regularization = 1),
  bagging = list(mtry = ncol(data) - 1, num.trees = 100, regularization = 1), 
  floresta = list(mtry = sqrt(ncol(data) - 1), num.trees = 100, regularization = 1),
  floresta_regularizada07 =  list(mtry = (ncol(data) - 1)/2, num.trees = 100, regularization = 0.7),
  floresta_regularizada02 =  list(mtry = (ncol(data) - 1)/2, num.trees = 100, regularization = 0.2)) %>% 
  enframe(name = 'modelo', value = 'parametros')

modelos
```

```
# A tibble: 5 x 2
  modelo                  parametros      
  <chr>                   <list>          
1 arvores                 <named list [3]>
2 bagging                 <named list [3]>
3 floresta                <named list [3]>
4 floresta_regularizada07 <named list [3]>
5 floresta_regularizada02 <named list [3]>
```

---

Adicionado os modelos à nossa `tibble` principal:

```{r
data_tibble <- data_tibble %>% 
*  crossing(modelos) %>% 
  arrange(modelo)

data_tibble
```

```
# A tibble: 50 x 5
   index data                  treino_teste     modelo  parametros      
   <int> <list>                <list>           <chr>   <list>          
 1     1 <tibble [5,698 × 50]> <named list [2]> arvores <named list [3]>
 2     2 <tibble [5,698 × 50]> <named list [2]> arvores <named list [3]>
 3     3 <tibble [5,698 × 50]> <named list [2]> arvores <named list [3]>
 4     4 <tibble [5,698 × 50]> <named list [2]> arvores <named list [3]>
 5     5 <tibble [5,698 × 50]> <named list [2]> arvores <named list [3]>
 6     6 <tibble [5,698 × 50]> <named list [2]> arvores <named list [3]>
 7     7 <tibble [5,698 × 50]> <named list [2]> arvores <named list [3]>
 8     8 <tibble [5,698 × 50]> <named list [2]> arvores <named list [3]>
 9     9 <tibble [5,698 × 50]> <named list [2]> arvores <named list [3]>
10    10 <tibble [5,698 × 50]> <named list [2]> arvores <named list [3]>
# … with 40 more rows
```

---

Finalmente treinando todos os modelos de uma vez só!

São vários
modelos, então é hora de deixar rodando, ir tomar um café, ler
uma revista...

```{r
treinando_modelos <- data_tibble %>% 
  mutate(
    full_parametros = 
*      map2(parametros, map(treino_teste, "treino"), ~list_modify(.x, treino = .y)),
*    modelo_treinado = invoke_map(modelagem, full_parametros))

print(treinando_modelos, n = 5)
```

```
# A tibble: 50 x 7
  index data  treino_teste modelo parametros full_parametros
  <int> <lis> <list>       <chr>  <list>     <list>         
1     1 <tib… <named list… arvor… <named li… <named list [4…
2     2 <tib… <named list… arvor… <named li… <named list [4…
3     3 <tib… <named list… arvor… <named li… <named list [4…
4     4 <tib… <named list… arvor… <named li… <named list [4…
5     5 <tib… <named list… arvor… <named li… <named list [4…
# … with 45 more rows, and 1 more variable: modelo_treinado <list>
```

---

---

# Quais modelos são os melhores?

- Métricas:

- Raiz do erro quadrático médio
  - Número total de variáveis usadas no modelo
  - R-quadrado

```{r
reqm <- function(modelo, teste){
  pp <- predict(modelo, teste)
  sqrt(mean((pp$predictions - teste$ridership)^2))
}

numero_variaveis <- function(modelo){
  sum(modelo$variable.importance > 0)
}
```

---

Resultados!

```{r
resultados <- treinando_modelos %>% 
  mutate(
*    reqm = map2_dbl(.x = modelo_treinado,
*                   .y = map(treino_teste, "teste"), 
*                   ~reqm(modelo = .x, teste = .y)),
*    numero_variaveis = map_int(modelo_treinado, numero_variaveis), 
*    rsquared = map_dbl(modelo_treinado, "r.squared"))

```

<table class="table table-condensed table-hover" style="width: auto !important; margin-left: auto; margin-right: auto;">
<caption>Média dos resultados por combinação de parâmetros</caption>
 <thead>
  <tr>
   <th style="text-align:left;"> modelo </th>
   <th style="text-align:left;"> reqm </th>
   <th style="text-align:left;"> numero_variaveis </th>
   <th style="text-align:left;"> rsquared </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> arvores </td>
   <td style="text-align:left;width: 3cm; "> 3.8 </td>
   <td style="text-align:left;"> 47.9 </td>
   <td style="text-align:left;"> 0.656 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> bagging </td>
   <td style="text-align:left;width: 3cm; "> 2.66 </td>
   <td style="text-align:left;"> 49 </td>
   <td style="text-align:left;"> 0.826 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> floresta </td>
   <td style="text-align:left;width: 3cm; "> <span style="display: inline-block; direction: rtl; border-radius: 4px; padding-right: 2px; background-color: lightgreen; width: 69.58%">2.644</span> </td>
   <td style="text-align:left;"> 49 </td>
   <td style="text-align:left;"> <span style="display: inline-block; direction: rtl; border-radius: 4px; padding-right: 2px; background-color: lightgreen; width: 100.00%">0.827</span> </td>
  </tr>
  <tr>
   <td style="text-align:left;"> floresta_regularizada02 </td>
   <td style="text-align:left;width: 3cm; "> 2.707 </td>
   <td style="text-align:left;"> <span style="display: inline-block; direction: rtl; border-radius: 4px; padding-right: 2px; background-color: lightgreen; width: 29.59%">14.5</span> </td>
   <td style="text-align:left;"> 0.82 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> floresta_regularizada07 </td>
   <td style="text-align:left;width: 3cm; "> 2.668 </td>
   <td style="text-align:left;"> 18.2 </td>
   <td style="text-align:left;"> 0.826 </td>
  </tr>
</tbody>
</table>

---

Todos os elementos em um objeto só!

```r
resultados 
```

```
# A tibble: 50 x 10
   index data  treino_teste modelo parametros full_parametros
   <int> <lis> <list>       <chr>  <list>     <list>         
 1     1 <tib… <named list… arvor… <named li… <named list [4…
 2     2 <tib… <named list… arvor… <named li… <named list [4…
 3     3 <tib… <named list… arvor… <named li… <named list [4…
 4     4 <tib… <named list… arvor… <named li… <named list [4…
 5     5 <tib… <named list… arvor… <named li… <named list [4…
 6     6 <tib… <named list… arvor… <named li… <named list [4…
 7     7 <tib… <named list… arvor… <named li… <named list [4…
 8     8 <tib… <named list… arvor… <named li… <named list [4…
 9     9 <tib… <named list… arvor… <named li… <named list [4…
10    10 <tib… <named list… arvor… <named li… <named list [4…
# … with 40 more rows, and 4 more variables: modelo_treinado <list>,
#   reqm <dbl>, numero_variaveis <int>, rsquared <dbl>
```

---

# Conclusões

- O `tidyverse` faz o fluxo de modelagem no `R` ser muito claro 
e compacto

- Pode-se construir um objeto que contém todos os elementos ao mesmo
tempo: dados, treino, teste, hiperparâmetros, modelos, resultados,
métricas, tempo computacional, etc
  - Muito útil para comparar os modelos rapidamente
  - Reprodutibilidade (artigos, relatórios)

---

# Conclusões

---

class: inverse, center, middle

# Obrigada!

<b>[@brunaw](https://github.com/brunaw)<b>