04-iteration-02.qmd

---
title: "useR to programmeR"
subtitle: "Iteration 2"
author: "Emma Rand and Ian Lyttle"
format: 
  revealjs:
    theme: [simple, styles.scss]
    footer: <https://pos.it/programming_r_24>
    slide-number: true
    chalkboard: true
    code-link: true
    code-line-numbers: false
    width: 1600
    height: 900
bibliography: references.bib
---

## Learning objectives

This session is (mostly) about functional programming:

::: {.incremental}
- Aside: managing file paths within your project
- Example: read a bunch of files, then put them in a single data frame
- Fundamental paradigms in {purrr}: 
   - `map()`, `keep()`, and `reduce()`
- Adverbs to handle failure
- More generally, using functions as arguments to functions 🤯
:::

. . .

<hr>

For coding, we will use `r-programming-exercises`:

-   Open `R/iteration-02-01-reading-files.R`.
-   Restart R.

## Aside: {here} package

For me, `here::here()` is a truly magical function:

::: {.incremental}
- useful in scripts: `.R` files (like today!)
- useful in documents: `.Rmd` and `.qmd` files
:::

. . .

If you need to:

  - refer to a file, and 
  - it's in a *fixed* place *within* your project

`here()` can make your life *much* simpler!

## Here: Example {auto-animate=true}

:::: {.columns}
::: {.column width="40px"}
```










👋

```
:::

::: {.column}
```{.text}
/Users/ijlyttle/repos/programming-r-exercises/ 
|-- programming-r-exercises.Rproj 
|-- README.md
|-- LICENCE.md
|-- data/
    |-- gapminder/
        |-- 1952.xlsx
        |-- ...
    |-- ...
|-- R/ 
    |-- iteration-02-01-reading-files.R 
    |-- ...
```
:::
::::

<hr>

Within `iteration-02-01-reading-files.R`:

- `here("data/gapminder/1952.xlsx")`

Works just as well for `.Rmd`, `.qmd` files.

## Here: Searches {auto-animate=true}

:::: {.columns}
::: {.column width="40px"}
```









🔎


```
:::

::: {.column}
```
/Users/ijlyttle/repos/programming-r-exercises/ 
|-- programming-r-exercises.Rproj 
|-- README.md
|-- LICENCE.md
|-- data/
    |-- gapminder/
        |-- 1952.xlsx
        |-- ...
    |-- ...
|-- R/ 
    |-- iteration-02-01-reading-files.R 
    |-- ...
```
:::
::::


<hr>

- Looks in directory for an `.Rproj` file (simplified)
- Doesn't find one

## Here: Moves up and searches {auto-animate=true}

:::: {.columns}
::: {.column width="40px"}
```
🔎











```
:::

::: {.column}
```
/Users/ijlyttle/repos/programming-r-exercises/ 
|-- programming-r-exercises.Rproj 
|-- README.md
|-- LICENCE.md
|-- data/
    |-- gapminder/
        |-- 1952.xlsx
        |-- ...
    |-- ...
|-- R/ 
    |-- iteration-02-01-reading-files.R 
    |-- ...
```
:::
::::

<hr>

- Moves up one directory
- Looks again

## Here: Finds `.Rproj` {auto-animate=true}

:::: {.columns}
::: {.column width="40px"}
```

✅










```
:::

::: {.column}
```
/Users/ijlyttle/repos/programming-r-exercises/ 
|-- programming-r-exercises.Rproj 
|-- README.md
|-- LICENCE.md
|-- data/
    |-- gapminder/
        |-- 1952.xlsx
        |-- ...
    |-- ...
|-- R/ 
    |-- iteration-02-01-reading-files.R 
    |-- ...
```
:::
::::


## Here: Flags project-root {auto-animate=true}

:::: {.columns}
::: {.column width="40px"}
```
🚩











```
:::

::: {.column}
```
/Users/ijlyttle/repos/programming-r-exercises/ 
|-- programming-r-exercises.Rproj 
|-- README.md
|-- LICENCE.md
|-- data/
    |-- gapminder/
        |-- 1952.xlsx
        |-- ...
    |-- ...
|-- R/ 
    |-- iteration-02-01-reading-files.R 
    |-- ...
```
:::
::::

<hr>

`/Users/ijlyttle/repos/programming-r-exercises/`

## Here: Returns full path {auto-animate=true}

:::: {.columns}
::: {.column width="40px"}
```






🎯





```
:::

::: {.column}
```
/Users/ijlyttle/repos/programming-r-exercises/ 
|-- programming-r-exercises.Rproj 
|-- README.md
|-- LICENCE.md
|-- data/
    |-- gapminder/
        |-- 1952.xlsx
        |-- ...
    |-- ...
|-- R/ 
    |-- iteration-02-01-reading-files.R 
    |-- ...
```
:::
::::

<hr>

```r
here("data/gapminder/1952.xlsx")
```

`/Users/ijlyttle/repos/programming-r-exercises/data/gapminder/1952.xlsx`

. . .

<hr>

::: {.caution-note}
`here()` returns a string that represents a path. 

It makes **no** guarantee that the path exists.
:::


## Here: Epilogue

`here()` works *especially* well if you need to rearrange your source (e.g. `.R`) files.

. . .

However, if you move your target files (e.g. `.xlsx`), you need to modify your source.

. . .

<hr>

The *here* way:

```r
read_excel(here("data/gapminder/1952.xlsx"))
```

. . .

<hr>

::: {.callout-note icon=false title="🧐 Where `here()` can help"}
```r
read_excel("../data/gapminder/1952.xlsx")
```
:::

. . .

<hr>

::: {.callout-important icon=false title="🔥 Meme Alert"}
Do not do this:

```r
setwd("/Users/ijlyttle/repos/programming-r-exercises/data/gapminder")

read_excel("1952.xlsx")
```
:::

## Reading multiple files

Iteration functions in {purrr} can help with repetitive tasks.

. . .

### Example

Read Excel files from a directory, then combine into a single data-frame.

## Our turn: Reading data manually

Here's our starting code:

``` r
data1952 <- read_excel(here("data/gapminder/1952.xlsx"))
data1957 <- read_excel(here("data/gapminder/1957.xlsx"))
data1962 <- read_excel(here("data/gapminder/1952.xlsx"))
data1967 <- read_excel(here("data/gapminder/1967.xlsx"))

data_manual <- bind_rows(data1952, data1957, data1962, data1967)
```

. . .

What problems do you see?

(I see two real problems, and one philosophical problem)

Run this example code, discuss with your neighbor.

## Our turn: Make list of paths

I see this as a two step problem:

::: incremental
-   make a named list of paths, name is year
-   use list of paths to read data frames, combine
:::

. . .

Let's work together to improve this code to get paths:

``` r
paths <-
  # get the filepaths from the directory
  fs::dir_ls(here("data/gapminder")) |>
  # convert to list
  # extract the year as names
  print()
```

## Our turn: Read data

Let's work together to improve this code to read data:

``` r
data <-
  paths |>
  # read each file from excel, into data frame
  # keep only non-null elements
  # set list-names as column `year`
  # bind into single data-frame
  # convert year to number
  print()
```

## Fundamental paradigms

Functional programming has three fundamental paradigms; they act on lists or vectors:

::: incremental
-   `map` - do *this* to each element: `purrr::map()`
-   `filter` - like spaghetti, not coffee: `purrr::keep()`
-   `reduce` - combine into new thing: `purrr::reduce()`
:::

. . . 

Each of these takes a *function* as an argument, to tell the operator *what* to do.

```{r echo=FALSE}
library("purrr")
```

. . .

<hr>

For coding, we will use `r-programming-exercises`:

-   Open `R/iteration-02-02-fundamental-paradigms.R`.
-   Restart R.

## Map: Intro {auto-animate=true}

```r
num <- 1:4
num |> map(\(x) x + 1)
```

<hr>

`map()` takes:

  - list or atomic vector
  - function to apply to each member of the vector

## Map: Intermediate result {auto-animate=true}

```r
num <- 1:4
num |> map(\(x) x + 1)
```

<hr>

| Input   | Result |
|:-------:|:------:|
| 1       | 2      |
| 2       |        |        
| 3       |        |      
| 4       |        |      


## Map: Result {auto-animate=true, auto-animate-unmatched=false}

```r
num <- 1:4
num |> map(\(x) x + 1)
```

<hr>

| Input   | Result |
|:-------:|:------:|
| 1       | **2**  |
| 2       | **3**  |        
| 3       | **4**  |      
| 4       | **5**  |   

## Map: Atomic variants

:::: {.columns}

::: {.column width="50%"}

`map()` always returns a list:

```{r}
num <- 1:4
num |> map(\(x) x + 1)
```
:::

::: {.column width="50%"}

Use an atomic variant to specify type:

```{r}
num <- 1:4
num |> map_int(\(x) x + 1)
```
:::

::::

## Keep: Intro {auto-animate=true}


```r
num <- 1:4
num |> keep(\(x) x %% 2 == 0)
```

<hr>

Outside {purrr}: known as `filter()`, but {dplyr} took this name first. 

`keep()` takes:

  - list or vector
  - function, when applied to each member, returns `TRUE` or `FALSE`
    - this is called a *predicate* function

## Keep: Intermediate result {auto-animate=true, auto-animate-unmatched=false}

```r
num <- 1:4
num |> keep(\(x) x %% 2 == 0)
```

<hr>

| Input   | Evaluation | Result |
|:-------:|:---------- |:------:|
| 1       | `FALSE`    |        | 
| 2       | `TRUE`     | 2      |
| 3       |            |        |              
| 4       |            |        |

## Keep: Result {auto-animate-unmatched=false}

```r
num <- 1:4
num |> keep(\(x) x %% 2 == 0)
```

<hr>

| Input   | Evaluation | Result |
|:-------:|:----------- |:------:|
| 1       | **`FALSE`** |        | 
| 2       | **`TRUE`**  | **2**  |
| 3       | **`FALSE`** |        |              
| 4       | **`TRUE`**  | **4**  |

## Reduce: Intro {auto-animate=true}

```r
num <- 1:4
num |> reduce(\(acc, x) acc + x)
```

<hr>

`reduce()` takes:

  - a list or vector
  - a *reducer* function, which takes two arguments:
    - the accumulated value
    - the "next" value of the input
    
## Reduce: First result {auto-animate=true}

```r
num <- 1:4
num |> reduce(\(acc, x) acc + x)
```

<hr>

| Input   | Result |
|:-------:|:------:|
| 1       | 1      |
| 2       |        |        
| 3       |        |      
| 4       |        |   

## Reduce: Intermediate result {auto-animate=true, auto-animate-unmatched=false}

```r
num <- 1:4
num |> reduce(\(acc, x) acc + x)
```

<hr>

| Input   | Result |
|:-------:|:------:|
| 1       |        |
| 2       | 3      |        
| 3       |        |      
| 4       |        |   

## Reduce: Result {auto-animate=true, auto-animate-unmatched=false}

```r
num <- 1:4
num |> reduce(\(acc, x) acc + x)
```

<hr>

| Input   | Result |
|:-------:|:------:|
| 1       |        |
| 2       |        |        
| 3       |        |      
| 4       | **10** |   

## Reduce: Initialize {auto-animate=true}

```r
num <- 1:4
num |> reduce(\(acc, x) acc + x, .init = 1)
```

<hr>

| Input   | Result |
|:-------:|:------:|
| 1       |        |
| 2       |        |        
| 3       |        |      
| 4       | **11** |  

## Reduce: Use existing functions

```r
num <- 1:4
num |> reduce(sum, .init = 1)
```

<hr>

| Input   | Result |
|:-------:|:------:|
| 1       |        |
| 2       |        |        
| 3       |        |      
| 4       | **11** |  

## Additional arguments

```{r}
num <- c(1, 2, 3, NA, 4)
num |> reduce(sum)
```

. . .

The default behavior for `sum()` is not to remove `NA` values.

. . .

<hr>

To change the behavior, use an anonymous function:

```{r}
num |> reduce(\(acc, x) sum(acc, x, na.rm = TRUE))
```

. . .

::: {.callout-caution title="No longer recommended"}

```r
# TODO: check that newer Quarto will fix font-size here
num |> reduce(sum, na.rm = TRUE)
```
::: 

Using an anonymous function will:

 - make it more explicit which argument goes to which function.
 - tend to yield better error messages.

## Variants and adverbs

Some useful variants, can mix and match:

::: incremental
 - `map_lgl()` , `map_int()`, `map_dbl()`, `map_chr()`
 - `walk()`: like `map()`, but called for side-effect
 - `imap()`, `lmap()`: use index or list-name as argument
 - `map2()`, `pmap()`: apply over sets of inputs
:::

. . .

Adverbs modify verbs (functions):

::: incremental
 - `possibly()`, `quietly()`, `slowly()`, `insistently()`, `safely()`
 - `negate()`: return the negative of a predicate
 - `compose()`: put two functions together
 - `partial()`: pre-fill some arguments of a function
:::

## Handling failures with adverbs

If we have a failure, we may not want to stop everything.

. . .

```{r}
#| error: true
library("readr")
read_csv("not/a/file.csv")
```

. . .

<hr>

For coding, we will use `r-programming-exercises`:

-   Open `R/iteration-02-03-adverbs.R`.
-   Restart R.

## Function operators a.k.a. adverbs

Function operators:

-   take a function 
-   return a modified function

. . .

```{r}
library("purrr")

poss_read_csv <- possibly(read_csv, otherwise = NULL, quiet = FALSE)
```

. . .

<hr>

```{r}
#| message: true
poss_read_csv("not/a/file.csv")
```

. . .

<hr>

```{r}
poss_read_csv(I("a, b\n 1, 2"), col_types = "dd")
```

## Our turn: Handle failure

In the `programming-r-exercises` repository:

-   look at `data/gapminder_party/`
-   try running your script using this directory

Create a new function:

``` r
possibly_read_excel <- possibly() # we do the rest
```

Use this function in your script.

## Our turn: Re-implement `list_rbind()`

Re-implement `list_rbind()` using functional-programming techniques:

``` r
data_reimplemented <-
  paths_party |>
  map(poss_read_excel) |>
  # keep(negate(is.null)) |>
  # imap(\(df, name) mutate(df, "year" := parse_number(name))) |>
  # reduce(rbind) |>
  print()
```

Let's run this, uncommenting one line at a time.

::: incremental
-   *keeps* not-`NULL` values, `purrr::keep()`
-   *maps* name of element to data-column, `purrr::imap()`
-   *reduces* list to single data-frame, `purrr::reduce()`
:::

## Functions as arguments

We have seen functions as arguments in:

::: incremental
- `map()`, `keep()`, `reduce()`: tells them what to do
- adverbs, like `possibly()`: tells what behavior to modify
:::

. . .

Using functions, themselves, as arguments takes a little getting used-to.

Once you wrap your mind around it, it's like seeing in more dimensions.

. . .

<hr>

For coding, we will use `r-programming-exercises`:

-   Open `R/iteration-02-04-functions-as-arguments.R`.
-   Restart R.

## Labelling scales

```{r}
library("tidyverse")
library("palmerpenguins")

ggplot(penguins, aes(x = bill_length_mm, y = bill_depth_mm, color = species)) +
  geom_point()
```

. . .

What if we want lower-case names for the species?

## Specify labels

```{r}
ggplot(penguins, aes(x = bill_length_mm, y = bill_depth_mm, color = species)) +
  geom_point() + 
  scale_color_discrete(labels = c("adelaide", "chinstrap", "gentoo"))
```

. . .

We can do it manually, but what if we get a dataset with more species?

## Use a labelling function

```{r}
ggplot(penguins, aes(x = bill_length_mm, y = bill_depth_mm, color = species)) +
  geom_point() + 
  scale_color_discrete(labels = tolower) # tolower is a function
```

. . .

Look at `?discrete_scale`: `labels` can take a function.

## Function factories

Function operators (adverbs) return modified functions 🤯

Function factories return functions "out of thin air" 🤯🤯

. . .

<hr>

[{scales}](https://scales.r-lib.org/index.html), used for {ggplot2} is full of these function factories!

## Our turn: Labeller

```{r}
## use scales:: notation, vs. library(), to help autocomplete
percent_labeller <- scales::label_percent(accuracy = 1)
```

. . .

<hr>

```{r}
# percent_labeller is a function
percent_labeller(c(0, 0.01, 0.1, 1))
```

Play around with:

 - `accuracy`
 - values sent to `percent_labeller`
 - whatever else seems interesting to you
 
## Your turn: Labeller

```{r}
ggplot(penguins, aes(x = bill_length_mm, color = species)) +
  stat_ecdf()
```

Add `scale_y_continuous()` to this plot, to use a percentage-labeller.

 
## Your turn: Labeller (solution)

```{r}
ggplot(penguins, aes(x = bill_length_mm, color = species)) +
  stat_ecdf() +
  scale_y_continuous(labels = scales::label_percent(accuracy = 1))
```

To me, this is a cleaner solution than mutating the data from decimal to percent.

## If we have time

Three fundamental paradigms in functional programming

Given a list and a function:

::: incremental
-   `filter()`: make a new list, subset of old list
-   `map()`: make a new list, operating on each element
-   `reduce()`: make a new "thing"
:::

. . .

<hr>

For coding, we will use `r-programming-exercises`:

-   Open `R/iteration-02-05-dpurrr.R`.
-   Restart R.

## dplyr using purrr?

We can use `purrr::keep()`, `purrr::map()`, `purrr::reduce()` to "implement":

-   `dplyr::filter()`
-   `dplyr::mutate()`
-   `dplyr::summarise()`

. . .

I claim it's possible, I don't claim it's a good idea.

## Our turn: Simplified penguins

```{r}
library("conflicted")
library("palmerpenguins")
library("dplyr")
library("purrr")

# simplify penguins (Sorry Allison!)
penguins_local <-
  penguins |>
  mutate(across(where(is.factor), as.character)) |> # use strings, not factors
  select(species, island, body_mass_g, sex) |>      # fewer columns
  print()
```

## Tabular data: Two perspectives

::: incremental
-   column-based: named list of column vectors

    ``` json
    {
      "species": ["Adelie", "Adelie", ...],
      "island": ["Torgersen", "Torgersen", ...],
      "body_mass_g": [3750, 3800, ...],
      "sex": ["male", "female", ...]
    }
    ```

-   row-based: collection of rows, each a named list

    ``` json
    [
      {"species": "Adelie", "island": "Torgersen", "body_mass_g": 3750, "sex": "male"}, 
      {"species": "Adelie", "island": "Torgersen", "body_mass_g": 3800, "sex": "female"}, 
      ...
    ]
    ```
:::

## Our turn: Helper functions

We have a couple of helper functions to convert to:

- Data frames: column-based

  ```{r}
  #' @param .d unnamed list of named lists, i.e. transposed data frame
  #'
  #' @return tibble
  dpurrr_to_tibble <- function(.d) {
    .d |>
      purrr::list_transpose() |>
      tibble::as_tibble()
  }  
  ```

- Lists of lists: row-based
 
  ```{r}
  #' @param .data data frame or tibble
  #'
  #' @return unnamed list of named lists, i.e. transposed data frame
  dpurrr_to_list <- function(.data) {
    .data |>
      as.list() |>
      purrr::list_transpose(simplify = FALSE)
  }
  ```
 
## Our turn: Experiment

```{r}
# experiment with helpers
penguins_local |>
  head(2) |>
  dpurrr_to_list() |>
  # dpurrr_to_tibble() |>
  str()
```

Comment and change lines as you see fit.

## Our turn: dpurrr filter (first element) {auto-animate=true}

```{.r code-line-numbers="1-3"}
# filter is just purrr::keep()
penguins_local |>
  dpurrr_to_list() |>
  keep(\(d) d$sex == "female" && !is.na(d$sex)) |>
  dpurrr_to_tibble() 
```

Predicate function acts on each "row", `d`, which is a list:

```{r echo=FALSE}
penguins_list <- penguins_local |> dpurrr_to_list()
str_element <- \(.x, i) .x[[i]] |> str()
```

:::: {.columns}

::: {.column .opacity-67 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 1)
```
:::

::: {.column .opacity-00 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 2)
```
:::

::: {.column .opacity-00 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 3)
```
:::

::::

## Our turn: dpurrr filter (more elements) {auto-animate=true}

```{.r code-line-numbers="1-3"}
# filter is just purrr::keep()
penguins_local |>
  dpurrr_to_list() |>
  keep(\(d) d$sex == "female" && !is.na(d$sex)) |>
  dpurrr_to_tibble() 
```

Predicate function acts on each "row", `d`, which is a list:

:::: {.columns}

::: {.column .opacity-67 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 1)
```
:::

::: {.column .opacity-67 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 2)
```
:::

::: {.column .opacity-67 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 3)
```
:::

::::

## Our turn: dpurrr filter (element results) {auto-animate=true}

```{.r code-line-numbers="1-4"}
# filter is just purrr::keep()
penguins_local |>
  dpurrr_to_list() |>
  keep(\(d) d$sex == "female" && !is.na(d$sex)) |>
  dpurrr_to_tibble() 
```

Predicate function acts on each "row", `d`, which is a list:

:::: {.columns}

::: {.column .opacity-33 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 1)
```
:::

::: {.column width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 2)
```
:::

::: {.column width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 3)
```
:::

::::


## Our turn: dpurrr filter (result) {auto-animate=true}

```{.r code-line-numbers="1-5"}
# filter is just purrr::keep()
penguins_local |>
  dpurrr_to_list() |>
  keep(\(d) d$sex == "female" && !is.na(d$sex)) |>
  dpurrr_to_tibble() 
```

Re-assembled into a tibble:

```{r echo=FALSE}
# filter is just purrr::keep()
penguins_local |>
  dpurrr_to_list() |>
  keep(\(d) d$sex == "female" && !is.na(d$sex)) |>
  dpurrr_to_tibble() 
```


## Our turn: dpurrr mutate {auto-animate=true}

```{r}
#' @param .d unnamed list of named lists, i.e. transposed data frame
#' @param mapper function applied to each member of `.d`
#' 
#' @return unnamed list of named lists, i.e. transposed data frame
dpurrr_mutate <- function(.d, mapper) {
  # modifyList() used to keep current elements
  .d |> purrr::map(\(d) modifyList(d, mapper(d)))
}
```

This version of mutate operates on every "row", modifying its list.

```r
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_mutate(\(d) list(body_mass_kg = d$body_mass_g / 1000)) |>
  dpurrr_to_tibble() |>
  print()
```

## Our turn: dpurrr mutate (start) {auto-animate=true}

```{.r code-line-numbers="1-1"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_mutate(\(d) list(body_mass_kg = d$body_mass_g / 1000)) |>
  dpurrr_to_tibble()
```

<hr>

```{r echo=FALSE}
penguins_local
```

## Our turn: dpurrr mutate (by row, before) {auto-animate=true}

```{.r code-line-numbers="1-2"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_mutate(\(d) list(body_mass_kg = d$body_mass_g / 1000)) |>
  dpurrr_to_tibble()
```

<hr>

:::: {.columns}

::: {.column .opacity-67 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 1)
```
:::

::: {.column .opacity-67 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 2)
```
:::

::: {.column .opacity-67 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 3)
```
:::

::::

## Our turn: dpurrr mutate (by row, after) {auto-animate=true auto-animate-unmatched=false}

```{.r code-line-numbers="1-3"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_mutate(\(d) list(body_mass_kg = d$body_mass_g / 1000)) |>
  dpurrr_to_tibble()
```

<hr>

```{r echo=FALSE}
penguins_mutate_list <- 
  penguins_local |>
  dpurrr_to_list() |>
  dpurrr_mutate(\(d) list(body_mass_kg = d$body_mass_g / 1000)) 
```

:::: {.columns}

::: {.column width="33%"}
```{r echo=FALSE}
str_element(penguins_mutate_list, 1)
```
:::

::: {.column width="33%"}
```{r echo=FALSE}
str_element(penguins_mutate_list, 2)
```
:::

::: {.column width="33%"}
```{r echo=FALSE}
str_element(penguins_mutate_list, 3)
```
:::

::::

## Our turn: dpurrr mutate (result) {auto-animate=true}

```{.r code-line-numbers="1-4"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_mutate(\(d) list(body_mass_kg = d$body_mass_g / 1000)) |>
  dpurrr_to_tibble()
```

<hr>

```{r echo=FALSE}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_mutate(\(d) list(body_mass_kg = d$body_mass_g / 1000)) |>
  dpurrr_to_tibble() |>
  print()
```

## Our turn: dpurrr summarise

```{r}
#' @param .d unnamed list of named lists, i.e. transposed data frame
#' @param reducer function applied accumulator and to each member of `.d`
#' @param .init initial value of accumulator, if empty: first element of `.d`
#' @param ... other arguments passed to `purrr::reduce()`
#'
#' @return unnamed list of named lists, i.e. transposed data frame
dpurrr_summarise <- function(.d, reducer, .init, ...) {
  # wrap result in a list, to return a transposed data frame
  .d |> purrr::reduce(reducer, .init = .init, ...) |> list()
}
```

Takes a transposed data frame, returns a transposed data frame with a single "row".

```r
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_summarise(
    \(acc, d) list(
      body_mass_g_min = min(acc$body_mass_g_min, d$body_mass_g, na.rm = TRUE),
      body_mass_g_max = max(acc$body_mass_g_max, d$body_mass_g, na.rm = TRUE)
    )
  ) |>
  dpurrr_to_tibble() |>
  print()
```

## Our turn: dpurrr summarise (start) {auto-animate=true}

```{.r code-line-numbers="1-1,10"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_summarise(
    \(acc, d) list(
      body_mass_g_min = min(acc$body_mass_g_min, d$body_mass_g, na.rm = TRUE),
      body_mass_g_max = max(acc$body_mass_g_max, d$body_mass_g, na.rm = TRUE)
    )
  ) |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

```{r echo=FALSE}
penguins_local
```

## Our turn: dpurrr summarise (by row, before) {auto-animate=true}

```{.r code-line-numbers="1-2,10"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_summarise(
    \(acc, d) list(
      body_mass_g_min = min(acc$body_mass_g_min, d$body_mass_g, na.rm = TRUE),
      body_mass_g_max = max(acc$body_mass_g_max, d$body_mass_g, na.rm = TRUE)
    )
  ) |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

:::: {.columns}

::: {.column .opacity-67 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 1)
```
:::

::: {.column .opacity-67 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 2)
```
:::

::: {.column .opacity-67 width="33%"}
```{r echo=FALSE}
str_element(penguins_list, 3)
```
:::

::::


## Our turn: dpurrr summarise (by row, after) {auto-animate=true}

```{.r code-line-numbers="1-8,10"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_summarise(
    \(acc, d) list(
      body_mass_g_min = min(acc$body_mass_g_min, d$body_mass_g, na.rm = TRUE),
      body_mass_g_max = max(acc$body_mass_g_max, d$body_mass_g, na.rm = TRUE)
    )
  ) |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

```{r echo=FALSE}
penguins_summarise_list <- 
  penguins_local |>
  dpurrr_to_list() |>
  dpurrr_summarise(
    \(acc, d) list(
      body_mass_g_min = min(acc$body_mass_g_min, d$body_mass_g, na.rm = TRUE),
      body_mass_g_max = max(acc$body_mass_g_max, d$body_mass_g, na.rm = TRUE)
    )
  )
```

```{r echo=FALSE}
str_element(penguins_summarise_list, 1)
```

## Our turn: dpurrr summarise (result) {auto-animate=true}

```{.r code-line-numbers="1-10"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_summarise(
    \(acc, d) list(
      body_mass_g_min = min(acc$body_mass_g_min, d$body_mass_g, na.rm = TRUE),
      body_mass_g_max = max(acc$body_mass_g_max, d$body_mass_g, na.rm = TRUE)
    )
  ) |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

```{r echo=FALSE}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_summarise(
    \(acc, d) list(
      body_mass_g_min = min(acc$body_mass_g_min, d$body_mass_g, na.rm = TRUE),
      body_mass_g_max = max(acc$body_mass_g_max, d$body_mass_g, na.rm = TRUE)
    )
  ) |>
  dpurrr_to_tibble() |>
  print()
```

## Our turn: dpurrr summarise with grouping

We need a couple more functions to split and combine, also for our reducer:

```r
#' @param .d unnamed list of named lists, i.e. transposed data frame
#' @param name string, name of variable on which to split
#'
#' @return named list of transposed data frames, names: values of split variable
dpurrr_split <- function(.d, name) {
  # uses purrr::map(), purrr::set_names(), purrr::keep()
}
```

. . .

<hr>

```r
#' @param .nd named list of transposed data frames
#' @param name string, name of variable to put into combined list
#'
#' @return transposed data frame
dpurrr_combine <- function(.nd, name) {
  # uses purrr::imap(), purrr::reduce()
}
```

. . .

<hr>

```{r}
body_mass_g_min_max <- function(acc, d) {
  list(
    body_mass_g_min = min(acc$body_mass_g_min, d$body_mass_g, na.rm = TRUE),
    body_mass_g_max = max(acc$body_mass_g_max, d$body_mass_g, na.rm = TRUE)
  )
}
```

```{r echo=FALSE}
#' @param .d unnamed list of named lists, i.e. transposed data frame
#' @param name string, name of variable on which to split
#'
#' @return named list of transposed data frames, names: values of split variable
dpurrr_split <- function(.d, name) {

  # named list, names and values are unique values of .d[[name]]
  d_name <- .d |> purrr::map(\(d) d[[name]]) |> unique() |> purrr::set_names()

  # for each element, keep rows that "contain" the name
  d_name |> purrr::map(\(x) .d |> purrr::keep(\(d) d[[name]] == x))
}
```

```{r echo=FALSE}
#' @param .nd named list of transposed data frames
#' @param name string, name of variable to put into combined list
#'
#' @return transposed data frame
dpurrr_combine <- function(.nd, name) {

  .nd |>
    # for each transposed data frame, set name within
    purrr::imap(
      function(d, id) {
        d |> dpurrr_mutate(\(d) list(id) |> purrr::set_names(name))
      }
    ) |>
    # reduce to single transposed data frame
    purrr::reduce(c)
}
```

## Our turn: dpurrr summarise with grouping (start) {auto-animate=true}

```{.r code-line-numbers="1,7"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_split("species") |>
  map(\(d) d |> dpurrr_summarise(body_mass_g_min_max)) |>
  dpurrr_combine("species") |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

```{r echo=FALSE}
penguins_local
```

## Our turn: dpurrr summarise with grouping (by row) {auto-animate=true}

```{.r code-line-numbers="1-2,7"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_split("species") |>
  map(\(d) d |> dpurrr_summarise(body_mass_g_min_max)) |>
  dpurrr_combine("species") |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

```{r echo=FALSE}
# function to write indented output
indent <- function(...) {
  # thanks: https://stackoverflow.com/a/42542382
  writeLines(paste("  ", capture.output(...), sep=""))
}

penguins_list_split <-
  penguins_list |>
  dpurrr_split("species")
```

::::: {.columns width="100%" .border .padding-4 .height-auto .display-flex}

:::: {.column width="32%" .opacity-67 .margin-4}
::: {.padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_split$Adelie, 1))
indent(str_element(penguins_list_split$Adelie, 2))
```
:::
::::

:::: {.column width="31%" .opacity-67 .margin-4}
::: {.padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_split$Gentoo, 1))
indent(str_element(penguins_list_split$Gentoo, 2))
```
:::
::::

:::: {.column width="32%" .opacity-67 .margin-4}
::: {.padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_split$Chinstrap, 1))
indent(str_element(penguins_list_split$Chinstrap, 2))
```
:::
::::


:::::

## Our turn: dpurrr summarise with grouping (split) {auto-animate=true}

```{.r code-line-numbers="1-3,7"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_split("species") |>
  map(\(d) d |> dpurrr_summarise(body_mass_g_min_max)) |>
  dpurrr_combine("species") |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

::::: {.columns width="100%" .padding-4 .height-auto .display-flex}

:::: {.column width="32%" .opacity-67 .margin-4}
```{r echo=FALSE}
cat("$Adelie")
```
::: {.border .padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_split$Adelie, 1))
indent(str_element(penguins_list_split$Adelie, 2))
```
:::
::::

:::: {.column width="31%" .opacity-67 .margin-4}
```{r echo=FALSE}
cat("$Gentoo")
```
::: {.border .padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_split$Gentoo, 1))
indent(str_element(penguins_list_split$Gentoo, 2))
```
:::
::::

:::: {.column width="32%" .opacity-67 .margin-4}
```{r echo=FALSE}
cat("$Chinstrap")
```
::: {.border .padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_split$Chinstrap, 1))
indent(str_element(penguins_list_split$Chinstrap, 2))
```
:::
::::

:::::

## Our turn: dpurrr summarise with grouping (summarise) {auto-animate=true}

```{.r code-line-numbers="1-4,7"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_split("species") |>
  map(\(d) d |> dpurrr_summarise(body_mass_g_min_max)) |>
  dpurrr_combine("species") |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

```{r echo=FALSE}
penguins_list_summarise <-
  penguins_list_split |>
  map(\(d) d |> dpurrr_summarise(body_mass_g_min_max))
```

::::: {.columns width="100%" .padding-4 .height-auto .display-flex}

:::: {.column width="32%" .margin-4}
```{r echo=FALSE}
cat("$Adelie")
```
::: {.border .padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_summarise$Adelie, 1))
```
:::
::::

:::: {.column width="31%" .margin-4}
```{r echo=FALSE}
cat("$Gentoo")
```
::: {.border .padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_summarise$Gentoo, 1))
```
:::
::::

:::: {.column width="32%" .margin-4}
```{r echo=FALSE}
cat("$Chinstrap")
```
::: {.border .padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_summarise$Chinstrap, 1))
```
:::
::::

:::::

## Our turn: dpurrr summarise with grouping (combine 🌗) {auto-animate=true}

```{.r code-line-numbers="1-5,7"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_split("species") |>
  map(\(d) d |> dpurrr_summarise(body_mass_g_min_max)) |>
  dpurrr_combine("species") |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

```{r echo=FALSE}
penguins_list_combine <-
  penguins_list_summarise |>
  dpurrr_combine("species")
```

::::: {.columns width="100%" .padding-4 .height-auto .display-flex}

:::: {.column width="32%" .margin-4}
```{r echo=FALSE}
cat("$Adelie")
```
::: {.border .padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_combine, 1))
```
:::
::::

:::: {.column width="31%" .margin-4}
```{r echo=FALSE}
cat("$Gentoo")
```
::: {.border .padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_combine, 2))
```
:::
::::

:::: {.column width="32%" .margin-4}
```{r echo=FALSE}
cat("$Chinstrap")
```
::: {.border .padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_combine, 3))
```
:::
::::

:::::

## Our turn: dpurrr summarise with grouping (combine 🌕) {auto-animate=true}

```{.r code-line-numbers="1-5,7"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_split("species") |>
  map(\(d) d |> dpurrr_summarise(body_mass_g_min_max)) |>
  dpurrr_combine("species") |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

::::: {.columns .border width="100%" .padding-4 .height-auto .display-flex}

:::: {.column width="32%" .margin-4}
::: {.padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_combine, 1))
```
:::
::::

:::: {.column width="31%" .margin-4}
::: {.padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_combine, 2))
```
:::
::::

:::: {.column width="32%" .margin-4}
::: {.padding-4}
```{r echo=FALSE}
indent(str_element(penguins_list_combine, 3))
```
:::
::::

:::::

## Our turn: dpurrr summarise with grouping (result) {auto-animate=true}

```{.r code-line-numbers="1-7"}
penguins_local |>
  dpurrr_to_list() |>
  dpurrr_split("species") |>
  map(\(d) d |> dpurrr_summarise(body_mass_g_min_max)) |>
  dpurrr_combine("species") |>
  dpurrr_to_tibble() |>
  print()
```

<hr>

```{r echo=FALSE}
penguins_list_combine |> dpurrr_to_tibble()
```


## Our turn: Finally...

We can agree this presents no danger to dplyr.

. . .

In JavaScript, data frames are often arrays of objects (lists); you can use tools like [**tidyjs**](https://observablehq.com/@pbeshai/tidy-js-intro-demo?collection=@pbeshai/tidy-js):

![](images/tidyjs.png){width=70% fig-align="center" fig-alt="Screenshot of tidyjs Observable page"}

## Summary

::: incremental
- {here} can help you manage file paths within projects.
- Functional programming has three fundamental paradigms:
  - filter (`purrr::keep()`), map, reduce
- {purrr} offers variants and adverbs.
- Adverbs can help you handle failure.
- Functions can be used as arguments to functions.
- Functions can be returned functions.
- Another view of data frames (if we had time).
:::

## Wrap-up

Please go to [pos.it/conf-workshop-survey](https://pos.it/conf-workshop-survey).

Your feedback is crucial!

Data from the survey informs curriculum and format decisions for future conf workshops, and we really appreciate you taking the time to provide it.

<hr>

### Thank you!

::: incremental
-   Emma
-   Lionel and Jonathan
-   Mine Çetinkaya-Rundel, Posit
-   **You** 🤗
:::