08_purrr.Rmd

---
title: "08_purrr"
output: html_document
---

class: middle, center, inverse
layout: false

# 4.6 `purrr`:<br><br>Functional Programming Tools

---

background-image: url(https://raw.githubusercontent.com/tidyverse/purrr/master/man/figures/logo.png)
background-position: 97.5% 2.5%
background-size: 7.5%
layout: true

---

## 4.6 `purrr`: Functional Programming Tools

`purrr` facilitates [*functional programming*](https://en.wikipedia.org/wiki/Functional_programming) (FP) with data frame objects in `R`. Whenever you would normally refer to a `for`-loop for solving an iterative problem, the family of `map_*()` functions allows you to rephrase your problem as a `tidyverse` pipeline.

**Four main types of `map_*()` functions:**
- `map(.x, .f, ...)` takes the input `.x` and applies `.f` to each element in `.x`.
- `map2(.x, .y, .f, ...)` takes the inputs `.x` and `.y` and applies `.f` to `.x` and `.y` in parallel.
- `pmap(.l, .f, ...)` takes a list `.l` of inputs and applies `.f` to each element in `.l` in parallel.
- `group_map(.data, .f, ...)` takes a grouped `tibble` and applies `.f` to each subgroup.

--

.pull-left[
By default `map()` returns a list. If you want to be more explicit about the output you may refer to
- `map_lgl()` to receive a logical output type,
- `map_chr()` to receive a character output type,
- `map_int()` to receive an integer output type,
- `map_dbl()` to receive a double output type ,
- `map_df()` to receive a data frame output.
]

--

.pull-right[
The input `.x` to any `map()_*` function can be either a vector, a list or a data frame.
- **Vector:** Iteration over vector elements
- **List:** Iteration over list elements
- **Data frame:** Iteration over columns
]

???
In functional programming, your code is organised into functions that perform the operations you need.

Your scripts will only be a sequence of calls to these functions, making them easier to understand.

---

## 4.6 `purrr`: Functional Programming Tools

```{r, echo=F, out.width='60%', fig.align='center'}
knitr::include_graphics("https://upload.wikimedia.org/wikipedia/commons/0/06/Mapping-steps-loillibe-new.gif")
```

.center[
_Src: [Rodrigues (2010)](https://b-rodrigues.github.io/modern_R/functional-programming.html)_
]

---

## 4.6 `purrr`: Functional Programming Tools

**Use Case:** Let's assume we have multiple data samples and require each of the samples to be $z$-normalized for further modeling. First, we would probably write a *named function* for performing $z$-normalization which takes our sample `.x` as input.
```{r}
z_transform <- function(.x) {
  mean <- mean(.x, na.rm = T)
  sd <- sd(.x , na.rm = T)
  return( (.x - mean) / sd )
}
```

--

Second, we draw samples from the `penguins` data set and store them as double vectors in a list.
```{r}
samples <- list(
  sample1 = slice_sample(penguins, n = 10)$bill_length_mm,
  sample2 = slice_sample(penguins, n = 10)$bill_depth_mm,
  sample3 = slice_sample(penguins, n = 10)$flipper_length_mm
)

samples[1]
```

???
- here: different means and sd

---

## 4.6 `purrr`: Functional Programming Tools

Third, perform the $z$-normalization.

.panelset[
.panel[.panel-name[for-loop]
```{r}
for (sample in samples) {
  print(z_transform(.x = sample)) 
}
```
]
.panel[.panel-name[map()]
```{r}
map(.x = samples, .f = ~ z_transform(.x))
```
]
]

???
often times, `map` statements are more efficient than for for-loops

---

## Excursus: Tilde-Shorthand

Within the `tidyverse`, the tilde-shorthand regularly occurs whenever an external function is required as an argument to one of the `tidyverse` functions. In general, you have different ways of including the second function call, one of which is the tilde-shorthand notation.

.panelset[
.panel[.panel-name[Option 1]
Referring to the external function using its name.
```{r, eval=F}
map(.x = samples, .f = z_transform)
```
<br> Note that other function arguments can be passed on to the function as additional positional arguments beyond `.f`, e.g., `map(.x = samples, .f = mean, na.rm = T)` 
]
.panel[.panel-name[Option 2]
Defining an anonymous function inline.
```{r, eval=F}
map(
  .x = samples,
  .f = function(.x) { (.x - mean(.x, na.rm = T)) / sd(.x, na.rm = T) }
)
```
<br> Note that here you could also omit `{ }`, since there is only a single expression involved in the function.
]
.panel[.panel-name[Option 3]
Defining an anonymous function inline using the tilde-shorthand.
```{r, eval=F}
map(
  .x = samples,
  .f = ~ (.x - mean(.x, na.rm = T)) / sd(.x, na.rm = T)
)
```
<br> Note that whenever we use the tilde-shorthand, we refer to the argument of the anonymous function by `.x` or simply by `.` (if it only requires one input).
]
]

???
The tilde indicates: what comes next should be considered as a function

Most of the time, explicitly defining named functions and then choosing option 1 only makes sense if you require them at least more than once. Otherwise, I would strongly recommend using anonymous function, i.e. option 2. or 3.

---

## 4.6 `purrr`: Functional Programming Tools

```{r, echo=F, out.width='50%', fig.align='center'}
knitr::include_graphics(
  "https://media1.tenor.com/images/f72cb542d6b3e3c3421889e0a3d9628d/tenor.gif"
)
```
<br><br>
.center[`r emo::ji("man_dancing")` Now let us look at some other practical use cases! `r emo::ji("woman_dancing")`]

---

## 4.6 `purrr`: Functional Programming Tools

.pull-left[
Check the columns' data types.
```{r}
penguins %>%
  map_df(class) %>% 
  glimpse
```
]
.pull-right[
Check the number of missing values per column.
```{r}
penguins %>%
  map_df(~ .x %>% is.na %>% sum) %>% 
  glimpse
```
]

???
1: I give `map` a data frame as input (`penguins`), so it iterates over each column. And to each column I apply the `class()` function. I want the output to be returned as a data frame (`map_df`)

---

## 4.6 `purrr`: Functional Programming Tools

Check the number of distinct values per column.
```{r}
penguins %>%
  map_df(dplyr::n_distinct) %>% 
  glimpse
```

---

## 4.6 `purrr`: Functional Programming Tools

Check the highest value in each subset of the data (e.g., largest `flipper_length_mm` per `sex`).
```{r}
penguins %>%
  tidyr::drop_na() %>% 
  dplyr::group_by(sex) %>%
  group_map(~ dplyr::slice_max(.x, flipper_length_mm, n = 1), .keep = T)
```

???
- drop_na: because otherwise I would also have a subgroup of NA

---

## 4.6 `purrr`: Functional Programming Tools

Produce a series of identical plots, each depicting a separate subset of the underlying data.
```{r, out.height='20%', out.width='20%'}
species <- penguins %>%
  dplyr::distinct(species, year) %>%
  dplyr::pull(species)  # .x argument for map()

years <- penguins %>%
  dplyr::distinct(species, year) %>%
  dplyr::pull(year)  # .y argument for map()

penguin_plots <- map2(
  .x = species,
  .y = years,
  .f = ~ {
    penguins %>%
      tidyr::drop_na() %>% 
      dplyr::filter(species == .x, year == .y) %>% 
      ggplot2::ggplot() +
      geom_point(aes(x = bill_length_mm, y = body_mass_g)) +
      labs(title = glue::glue("Scatter Plot Bill Length vs. Body Mass ({.x}, {.y})"))
  }
)
```

---

## 4.6 `purrr`: Functional Programming Tools

.pull-left[
```{r, fig.width=8, fig.asp=0.618, fig.retina=3, fig.align='center'}
penguin_plots[[1]]
```
]
.pull-right[
```{r, fig.width=8, fig.asp=0.618, fig.retina=3, fig.align='center'}
penguin_plots[[4]]
```
]

---

## 4.6 `purrr`: Functional Programming Tools

Finally, `map()` is really powerful in the context of modeling. In the following, we fit a linear regression model for each `species`-`island` subset.

First, we create a nested data frame that contains a `tibble` to each `species`-`island` combination.
```{r}
nested_penguins <- penguins %>% 
  tidyr::drop_na() %>% 
  dplyr::group_by(species, island) %>% 
  tidyr::nest()

nested_penguins
```

.pull-right[.footnote[
*Note: For accessing elements in a nested `tibble` you may use the `pluck()` function. For example, for accessing the first `tibble` in the column `data`, you may run `nested_penguins %>% pluck("data", 1)` (also see [section 4.4](#nested-data)).*
]]

---

## 4.6 `purrr`: Functional Programming Tools

Second, we fit a linear model to each data subset. In our model, `body_mass_g` is regressed (`~`) on all other variables (denoted by a dot in the `lm()` formula).
```{r}
nested_penguins <- nested_penguins %>% 
  dplyr::mutate(lin_reg = map(
    .x = data,
    .f = ~ lm(body_mass_g ~ ., data = .x)
  ))

nested_penguins
```

---

## 4.6 `purrr`: Functional Programming Tools

Third, for each linear model, we generate a model summary using `summary()` and extract the model coefficients as a `tibble`. Finally, we use `unnest()` to receive a tidy data frame.
```{r}
nested_penguins <- nested_penguins %>% 
  dplyr::mutate(coefs = map(
    .x = lin_reg,
    .f = ~ summary(.) %>% .$coefficients %>% as_tibble(rownames = "variable")
  ))

nested_penguins
```
---

## 4.6 `purrr`: Functional Programming Tools

Third, for each linear model, we generate a model summary using `summary()` and extract the model coefficients as a `tibble`. Finally, we use `unnest()` to receive a tidy data frame.
```{r}
nested_penguins %>% tidyr::unnest(coefs)
```

.footnote[.pull-right[
*Note: There are specific packages (e.g., `broom`) for tidying model outputs. These provide convenient functions that help you achieve the same thing with much less code.*
]]

---

## 4.6 `purrr`: Functional Programming Tools

.pull-left[
.center[
`r emo::ji("thinking_face")` How you may probably feel right now<br><br>
```{r, echo=F, fig.align='center'}
knitr::include_graphics("https://tenor.com/view/matg-calculate-confusing-figure-out-gif-6237717.gif")
```
]]

--

.pull-right[
.center[
`r emo::ji("nerd_face")` After having mastered the intricacies of FP<br><br>
```{r, echo=F, fig.align='center'}
knitr::include_graphics("https://tenor.com/view/cat-computer-gif-5368357.gif")
```
]]

.footnote[
*Note: Find more information about `purrr` by consulting the official [cheat sheet](https://raw.githubusercontent.com/rstudio/cheatsheets/master/purrr.pdf). For a great tutorial that helps you master the notion of functional programming with `R` see [this blogpost](http://www.rebeccabarter.com/blog/2019-08-19_purrr/#simplest-usage-repeated-looping-with-map) by Rebecca Barter.*
]

---

## 4.6 `purrr`: Functional Programming Tools

Finally, `purrr` also provides convenient [wrapper functions](https://en.wikipedia.org/wiki/Wrapper_function) for **error handling**. These come in handy if you are iterating over a very large data set and your program would simply stop if an error occurs. This is particularly frustrating as you would loose the whole progress.

For example, at some point you might want to train a separate prediction model (`lm`) for each unique value of `species` (`r penguins$species %>% unique`). Unfortunately, the following code is throwing an error ...
```{r}
grouped_penguins <- penguins %>% 
  dplyr::mutate(across(c(sex, island), as.factor)) %>% 
  dplyr::group_by(species)
```
```{r, eval=F}
grouped_penguins %>% 
  group_map(.f = ~ lm(flipper_length_mm ~ bill_length_mm + island, data = .x))
```
```
> Error in `contrasts<-`(`*tmp*`, value = contr.funs[1 + isOF[nn]]) :
> contrasts can be applied only to factors with 2 or more levels
```

--

<br><br>
`r emo::ji("thinking")` **Which group is eventually responsible for the error?**

???
- wrapper functions: wrap a function around another function, i.e. you call a function when applying another function

---

## 4.6 `purrr`: Functional Programming Tools

`purrr::possibly()` returns a list containing the function's result respectively a user-defined value (`otherwise`) if an error occurs.
```{r}
possibly_lm <- possibly(.f = lm, otherwise = "Error message")

grouped_penguins %>% 
  group_map(.f = ~ possibly_lm(flipper_length_mm ~ bill_length_mm + island, data = .x))
```

.footnote[.pull-right[
*Note: Use `purrr::discard(. == "Error message")` (`purrr::keep()`) at the end of the pipeline to drop (keep) function calls that yielded an error.<br>These work like `dplyr::select()` and `dplyr::filter()` in the context of `tibbles`.*
]]

---

## 4.6 `purrr`: Functional Programming Tools

`purrr::safely()` returns a named list containing the function's result (or `otherwise` if an error occurs) as well as an error object that captures the error message.
```{r, eval=F}
safely_lm <- safely(.f = lm, otherwise = NULL)

grouped_penguins %>% 
  group_map(.f = ~ safely_lm(flipper_length_mm ~ bill_length_mm + island, data = .x)) 
``` 
<br><br>
- Use `purrr::map(., "result")` at the end of the pipeline to access the results of each function call stored in the list.<br><br>
- Use `purrr::map(., "error")` at the end of the pipeline to access the errors of each function call stored in the list.

.footnote[
*Note: Similarly, use `purrr::quietly()`  to return a named list containing not only the function's results and error but also other kinds of output, such as warnings or messages.*
]

???
- quietly: useful to capture warning messages that the code throws, e.g., `summarise()` frequently throws a warning if you do not specify the `.drop` argument