tidyr and purrr

class: center, middle, inverse, title-slide

# tidyr and purrr
### Colin Rundel
### 2019-10-07

---

exclude: true

---
class: middle

.center[
<img src="imgs/hex-tidyr.png" width="50%" />
]

---

## Example - Grades

Is the following data tidy?

```r
(grades = tibble(
  name  = c("Alice", "Bob", "Carol", "Dave"),
  hw_1   = c(19, 18, 18, 19),
  hw_2   = c(19, 20, 20, 19),
  hw_3   = c(18, 18, 18, 18),
  hw_4   = c(20, 16, 17, 19),
  exam_1 = c(89, 77, 96, 86),
  exam_2 = c(95, 88, 99, 82)
))
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 4 x 7
## name hw_1 hw_2 hw_3 hw_4 exam_1 exam_2
## &lt;chr&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt;
## 1 Alice 19 19 18 20 89 95
## 2 Bob 18 20 18 16 77 88
## 3 Carol 18 20 18 17 96 99
## 4 Dave 19 19 18 19 86 82
</CODE></PRE>

.center[
This is an example of *wide* data, which is almost never *tidy*.
]

---

## Updating `tidyr`

The current version of tidyr installed in Noteable is slightly out of date (v0.8.3 vs v1.0.0). To fix this run the following,

```r
lib = Sys.getenv("R_LIBS_USER")
dir.create(lib, recursive=TRUE, showWarnings=FALSE)
install.packages("tidyr", lib=lib)
```

---

## Wider <-> Longer

.footnote[ From Mara Averick's [tidyexplain](https://github.com/batpigandme/tidyexplain/tree/pivot) repo]

---

---

## `pivot_longer`

```r
pivot_longer(table, cols = -country, names_to = "year", values_to = "cases")
```

---

## `pivot_wider`

```r
pivot_wider(table, id_cols = country:year, names_from = type, values_from = count)
```

---

## Separate

```r
separate(table, col = rate, sep = "/", into = c("cases", "pop"))
```

---

## Unite

```r
unite(table, century, year, col = "year", sep = "")
```

---

## Example 1 - Summarizing Grades

Is the following data tidy?

How would we calculate a final score based on the following formula,
`$$\text{score} = 0.6\,\frac{\sum\text{hw}_i}{80} + 0.4\,\frac{\sum\text{exam}_j}{200}$$`

---

## Semi-tidy approach

```r
grades %>%
  mutate(
    hw_avg = (hw_1+hw_2+hw_3+hw_4)/4,
    exam_avg = (exam_1+exam_2)/2
  ) %>%
  mutate(
    overall = 0.4*(exam_avg/100) + 0.6*(hw_avg/20)
  )
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 4 x 10
## name hw_1 hw_2 hw_3 hw_4 exam_1 exam_2 hw_avg exam_avg overall
## &lt;chr&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt;
## 1 Alice 19 19 18 20 89 95 19 92 0.938
## 2 Bob 18 20 18 16 77 88 18 82.5 0.87 
## 3 Carol 18 20 18 17 96 99 18.2 97.5 0.938
## 4 Dave 19 19 18 19 86 82 18.8 84 0.899
</CODE></PRE>

.center[
What is problematic about this approach?
]

---

## Wide -> Long (`pivot_longer`)

```r
tidyr::pivot_longer(grades, cols = hw_1:exam_2, 
                    names_to = "assignment", 
                    values_to = "score")
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 24 x 3
## name assignment score
## &lt;chr&gt; &lt;chr&gt; &lt;dbl&gt;
## 1 Alice hw_1 19
## 2 Alice hw_2 19
## 3 Alice hw_3 18
## 4 Alice hw_4 20
## 5 Alice exam_1 89
## 6 Alice exam_2 95
## 7 Bob hw_1 18
## 8 Bob hw_2 20
## 9 Bob hw_3 18
## 10 Bob hw_4 16
## # … with 14 more rows
</CODE></PRE>

---

```r
tidyr::pivot_longer(grades, cols = hw_1:exam_2, 
                    names_to = c("type", "id"), names_sep = "_", 
                    values_to = "score")
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 24 x 4
## name type id score
## &lt;chr&gt; &lt;chr&gt; &lt;chr&gt; &lt;dbl&gt;
## 1 Alice hw 1 19
## 2 Alice hw 2 19
## 3 Alice hw 3 18
## 4 Alice hw 4 20
## 5 Alice exam 1 89
## 6 Alice exam 2 95
## 7 Bob hw 1 18
## 8 Bob hw 2 20
## 9 Bob hw 3 18
## 10 Bob hw 4 16
## # … with 14 more rows
</CODE></PRE>

---

## Tidy approach?

<PRE class="fansi fansi-output"><CODE>## # A tibble: 8 x 3
## # Groups: name [4]
## name type total
## &lt;chr&gt; &lt;chr&gt; &lt;dbl&gt;
## 1 Alice exam 184
## 2 Alice hw 76
## 3 Bob exam 165
## 4 Bob hw 72
## 5 Carol exam 195
## 6 Carol hw 73
## 7 Dave exam 168
## 8 Dave hw 75
</CODE></PRE>

---

## Long -> Wide (`pivot_wider`)

```r
grades %>%
  tidyr::pivot_longer(
    cols = hw_1:exam_2, 
    names_to = c("type", "id"), names_sep = "_", 
    values_to = "score"
  ) %>% 
  group_by(name, type) %>%
  summarize(total = sum(score)) %>%
  tidyr::pivot_wider(
    names_from = type, values_from = total
  )
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 4 x 3
## # Groups: name [4]
## name exam hw
## &lt;chr&gt; &lt;dbl&gt; &lt;dbl&gt;
## 1 Alice 184 76
## 2 Bob 165 72
## 3 Carol 195 73
## 4 Dave 168 75
</CODE></PRE>

---

## Finishing up

<PRE class="fansi fansi-output"><CODE>## # A tibble: 4 x 4
## # Groups: name [4]
## name exam hw score
## &lt;chr&gt; &lt;dbl&gt; &lt;dbl&gt; &lt;dbl&gt;
## 1 Alice 184 76 0.938
## 2 Bob 165 72 0.87 
## 3 Carol 195 73 0.938
## 4 Dave 168 75 0.899
</CODE></PRE>

---
class: middle
count: false

# Functional Programming

---
class: middle
count: false

# Apply functions

---

## Apply functions

The apply functions are a collection of tools for functional programming in R, they are variations of the `map` function found in many other languages

```r
??apply
---

## 
## Help files with alias or concept or title matching ‘apply’ using fuzzy
## matching:
## 
## base::apply             Apply Functions Over Array Margins
## base::.subset           Internal Objects in Package 'base'
## base::by                Apply a Function to a Data Frame Split by Factors
## base::eapply            Apply a Function Over Values in an Environment
## base::lapply            Apply a Function over a List or Vector
## base::mapply            Apply a Function to Multiple List or Vector Arguments
## base::rapply            Recursively Apply a Function to a List
## base::tapply            Apply a Function Over a Ragged Array
```

---

## lapply

Usage: `lapply(X, FUN, ...)`

`lapply` returns a list of the same length as `X`, each element of which is the result of applying `FUN` to the corresponding element of `X`.

.pull-left[

```r
lapply(1:8, sqrt) %>% str()
```

```
## List of 8
##  $ : num 1
##  $ : num 1.41
##  $ : num 1.73
##  $ : num 2
##  $ : num 2.24
##  $ : num 2.45
##  $ : num 2.65
##  $ : num 2.83
```
]

.pull-right[

```r
lapply(1:8, function(x) (x+1)^2) %>% str()
```

```
## List of 8
##  $ : num 4
##  $ : num 9
##  $ : num 16
##  $ : num 25
##  $ : num 36
##  $ : num 49
##  $ : num 64
##  $ : num 81
```
]

---

```r
lapply(1:8, function(x, pow) x^pow, pow=3) %>% str()
```

```
## List of 8
##  $ : num 1
##  $ : num 8
##  $ : num 27
##  $ : num 64
##  $ : num 125
##  $ : num 216
##  $ : num 343
##  $ : num 512
```

```r
lapply(1:8, function(x, pow) x^pow, x=2) %>% str()
```

```
## List of 8
##  $ : num 2
##  $ : num 4
##  $ : num 8
##  $ : num 16
##  $ : num 32
##  $ : num 64
##  $ : num 128
##  $ : num 256
```

---

## sapply

Usage: `sapply(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE)`

`sapply` is a *user-friendly* version and wrapper of `lapply`, it is a *simplifying* version of lapply. Whenever possible it will return a vector, matrix, or an array.

```r
sapply(1:8, sqrt)
```

```
## [1] 1.000000 1.414214 1.732051 2.000000 2.236068 2.449490 2.645751 2.828427
```

```r
sapply(1:8, function(x) (x+1)^2)
```

```
## [1]  4  9 16 25 36 49 64 81
```

---

```r
sapply(1:8, function(x) c(x, x^2, x^3, x^4))
```

```
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,]    1    2    3    4    5    6    7    8
## [2,]    1    4    9   16   25   36   49   64
## [3,]    1    8   27   64  125  216  343  512
## [4,]    1   16   81  256  625 1296 2401 4096
```

```r
sapply(1:8, function(x) list(x, x^2, x^3, x^4))
```

```
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,] 1    2    3    4    5    6    7    8   
## [2,] 1    4    9    16   25   36   49   64  
## [3,] 1    8    27   64   125  216  343  512 
## [4,] 1    16   81   256  625  1296 2401 4096
```

---

```r
sapply(2:6, seq)
```

```
## [[1]]
## [1] 1 2
## 
## [[2]]
## [1] 1 2 3
## 
## [[3]]
## [1] 1 2 3 4
## 
## [[4]]
## [1] 1 2 3 4 5
## 
## [[5]]
## [1] 1 2 3 4 5 6
```

---

## [ls]apply and data frames

We can use these functions with data frames, the key is to remember that a data frame is just a fancy list.

```r
df = data.frame(a = 1:6, b = letters[1:6], c = c(TRUE,FALSE))
lapply(df, class) %>% str()
```

```
## List of 3
##  $ a: chr "integer"
##  $ b: chr "factor"
##  $ c: chr "logical"
```

```r
sapply(df, class)
```

```
##         a         b         c 
## "integer"  "factor" "logical"
```

---

## other less common applies

* `apply(X, MARGIN, FUN, ...)` - applies a function over the rows or columns of a data frame, matrix or array

* `vapply(X, FUN, FUN.VALUE, ..., USE.NAMES = TRUE)` - is similar to `sapply`, but has a enforced return type and size

* `mapply(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES = TRUE)` -  like `sapply` but will iterate over multiple vectors at the same time.

* `rapply(object, f, classes = "ANY", deflt = NULL, how = c("unlist", "replace", "list"), ...)` - a recursive version of `lapply`, behavior depends largely on the `how` argument

* `eapply(env, FUN, ..., all.names = FALSE, USE.NAMES = TRUE)` -  apply a function over an environment.

---

## Exercise 1

Using the `sw_people` data set in the `repurrrsive` package, extract the names of all of the characters using:

* a for loop

* one of the apply functions

Start by examining the structure of the data using RStudio's viewer,

```r
library(repurrrsive)
View(sw_people)
```

---
class: middle

.center[
<img src="imgs/hex-purrr.png" width="50%" />
]

---

## Map functions

Basic functions for looping over an object and returning a value (of a specific type) - replacement for `lapply`/`sapply`/`vapply`.

* `map()` - returns a list.

* `map_lgl()` - returns a logical vector.

* `map_int()` - returns a integer vector.

* `map_dbl()` - returns a double vector.

* `map_chr()` - returns a character vector.

* `map_dfr()` - returns a data frame by row binding.

* `map_dfc()` - returns a data frame by column binding.

* `walk()` - returns nothing, call function exclusively for its side effects

---

## Type Consistency

R is a weakly / dynamically typed language which means there is no simple way to define a function which enforces the argument or return types. This flexibility can be useful at times, but often it makes it hard to reason about your code and requires more verbose code to handle edge cases.

```r
x = list(rnorm(1e3),rnorm(1e3),rnorm(1e3))
```

```r
map_dbl(x, mean)
```

```
## [1] -0.009105024  0.035028661 -0.027726877
```

```r
map_chr(x, mean)
```

```
## [1] "-0.009105" "0.035029"  "-0.027727"
```

```r
map_int(x, mean)
```

```
## Error: Can't coerce element 1 from a double to a integer
```

---

## Shortcut - Anonymous Functions

An anonymous function is one that is never given a name (assigned to a variable)

```r
sapply(1:5, function(x) x^(x+1))
```

```
## [1]     1     8    81  1024 15625
```

purrr lets us write anonymous functions using one sided formulas where the argument is given by `.` or `.x` for `map` and related functions.

```r
map_dbl(1:5, ~ .^(.+1))
```

```
## [1]     1     8    81  1024 15625
```

```r
map_dbl(1:5, ~ .x^(.x+1))
```

```
## [1]     1     8    81  1024 15625
```

---

## Shortcut - Anonymous Functions - `map2`

Functions with the `map2` prefix work the same as the `map` functions but they iterate over two objects instead of one. Arguments in an anonymous function are instead given by `.x` and `.y` (or `..1` and `..2`) respectively.

```r
map2_dbl(1:5, 1:5, ~ .x^(.y+1))
```

```
## [1]     1     8    81  1024 15625
```

```r
map2_dbl(1:5, 1:5, ~ ..1^(..2+1))
```

```
## [1]     1     8    81  1024 15625
```

```r
map2_chr(letters[1:5], LETTERS[1:5], paste0)
```

```
## [1] "aA" "bB" "cC" "dD" "eE"
```

---

## Purrr shortcut - Lookups

Very often we want to extract only certain (named) values from a list, `purrr` provides a shortcut for this operation when you provide either a character or numeric value instead of a function to apply.

```r
x = list(list(a=1L,b=2L,c=list(d=3L,e=4L)),
         list(a=5L,b=6L,c=list(d=7L,e=8L,f=9L)))
```

.pull-left[

```r
map_int(x, "a")
```

```
## [1] 1 5
```

```r
map_dbl(x, c("c","e"))
```

```
## [1] 4 8
```

```r
map_chr(x, list(3,"d"))
```

```
## [1] "3" "7"
```
]

.pull-right[

```r
map_df(x, 3)
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 2 x 3
## d e f
## &lt;int&gt; &lt;int&gt; &lt;int&gt;
## 1 3 4 NA
## 2 7 8 9
</CODE></PRE>

```r
map_dfc(x, 3)
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 1 x 5
## d e d1 e1 f
## &lt;int&gt; &lt;int&gt; &lt;int&gt; &lt;int&gt; &lt;int&gt;
## 1 3 4 7 8 9
</CODE></PRE>
]

---

```r
x = list(list(a=1L,b=2L,c=list(d=3L,e=4L)),
         list(a=5L,b=6L,c=list(d=7L,e=8L,f=9L)))
```

```r
map(x, list(3,"f"))
```

```
## [[1]]
## NULL
## 
## [[2]]
## [1] 9
```

```r
map_int(x, list(3,"f"))
```

```
## Result 1 must be a single integer, not NULL of length 0
```

```r
map_int(x, list(3,"f"), .default=NA)
```

```
## [1] NA  9
```

---

## Exercise 2

Using the `sw_people` data set again, generate a tidy data frame (tibble) containing as many details as possible.

---

## list columns

```r
d = tibble(
  name = purrr::map_chr(sw_people, "name"),
  starships = purrr::map(sw_people, "starships")
)

d
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 87 x 2
## name starships
## &lt;chr&gt; &lt;list&gt; 
## 1 Luke Skywalker &lt;chr [2]&gt;
## 2 C-3PO &lt;NULL&gt; 
## 3 R2-D2 &lt;NULL&gt; 
## 4 Darth Vader &lt;chr [1]&gt;
## 5 Leia Organa &lt;NULL&gt; 
## 6 Owen Lars &lt;NULL&gt; 
## 7 Beru Whitesun lars &lt;NULL&gt; 
## 8 R5-D4 &lt;NULL&gt; 
## 9 Biggs Darklighter &lt;chr [1]&gt;
## 10 Obi-Wan Kenobi &lt;chr [5]&gt;
## # … with 77 more rows
</CODE></PRE>

---

```r
d %>%
  mutate(
    n_starships = purrr::map_int(starships, length)
  )
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 87 x 3
## name starships n_starships
## &lt;chr&gt; &lt;list&gt; &lt;int&gt;
## 1 Luke Skywalker &lt;chr [2]&gt; 2
## 2 C-3PO &lt;NULL&gt; 0
## 3 R2-D2 &lt;NULL&gt; 0
## 4 Darth Vader &lt;chr [1]&gt; 1
## 5 Leia Organa &lt;NULL&gt; 0
## 6 Owen Lars &lt;NULL&gt; 0
## 7 Beru Whitesun lars &lt;NULL&gt; 0
## 8 R5-D4 &lt;NULL&gt; 0
## 9 Biggs Darklighter &lt;chr [1]&gt; 1
## 10 Obi-Wan Kenobi &lt;chr [5]&gt; 5
## # … with 77 more rows
</CODE></PRE>

---
class: middle

.center[
<img src="imgs/hex-tidyr.png" width="25%" />
 and 
<img src="imgs/hex-purrr.png" width="25%" />
]

---

## Tidy data from nested lists

The recent version of `tidyr` have added several functions that are designed to aide in the tidying of heirachical data. Since they are part of `tidyr` all of the following functions work with data frames.

From `tidyr`

> `hoist()`, `unnest_longer()`, and `unnest_wider()` provide tools for rectangling, collapsing deeply nested lists into regular columns.

---

```r
(d = tibble(people=sw_people))
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 87 x 1
## people 
## &lt;list&gt; 
## 1 &lt;named list [16]&gt;
## 2 &lt;named list [14]&gt;
## 3 &lt;named list [14]&gt;
## 4 &lt;named list [15]&gt;
## 5 &lt;named list [15]&gt;
## 6 &lt;named list [14]&gt;
## 7 &lt;named list [14]&gt;
## 8 &lt;named list [14]&gt;
## 9 &lt;named list [15]&gt;
## 10 &lt;named list [16]&gt;
## # … with 77 more rows
</CODE></PRE>

```r
unnest_wider(d, people)
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 87 x 16
## name height mass hair_color skin_color eye_color birth_year gender
## &lt;chr&gt; &lt;chr&gt; &lt;chr&gt; &lt;chr&gt; &lt;chr&gt; &lt;chr&gt; &lt;chr&gt; &lt;chr&gt; 
## 1 Luke… 172 77 blond fair blue 19BBY male 
## 2 C-3PO 167 75 n/a gold yellow 112BBY n/a 
## 3 R2-D2 96 32 n/a white, bl… red 33BBY n/a 
## 4 Dart… 202 136 none white yellow 41.9BBY male 
## 5 Leia… 150 49 brown light brown 19BBY female
## 6 Owen… 178 120 brown, gr… light blue 52BBY male 
## 7 Beru… 165 75 brown light blue 47BBY female
## 8 R5-D4 97 32 n/a white, red red unknown n/a 
## 9 Bigg… 183 84 black light brown 24BBY male 
## 10 Obi-… 182 77 auburn, w… fair blue-gray 57BBY male 
## # … with 77 more rows, and 8 more variables: homeworld &lt;chr&gt;, films &lt;list&gt;,
## # species &lt;chr&gt;, vehicles &lt;list&gt;, starships &lt;list&gt;, created &lt;chr&gt;,
## # edited &lt;chr&gt;, url &lt;chr&gt;
</CODE></PRE>

---

```r
unnest_longer(d, people)
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 1,244 x 2
## people people_id 
## &lt;list&gt; &lt;chr&gt; 
## 1 &lt;chr [1]&gt; name 
## 2 &lt;chr [1]&gt; height 
## 3 &lt;chr [1]&gt; mass 
## 4 &lt;chr [1]&gt; hair_color
## 5 &lt;chr [1]&gt; skin_color
## 6 &lt;chr [1]&gt; eye_color 
## 7 &lt;chr [1]&gt; birth_year
## 8 &lt;chr [1]&gt; gender 
## 9 &lt;chr [1]&gt; homeworld 
## 10 &lt;chr [5]&gt; films 
## # … with 1,234 more rows
</CODE></PRE>

---

```r
unnest_wider(d, people) %>% 
  select(name, starships) %>%
  unnest_longer(starships, )
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 98 x 2
## name starships 
## &lt;chr&gt; &lt;chr&gt; 
## 1 Luke Skywalker http://swapi.co/api/starships/12/
## 2 Luke Skywalker http://swapi.co/api/starships/22/
## 3 C-3PO NA 
## 4 R2-D2 NA 
## 5 Darth Vader http://swapi.co/api/starships/13/
## 6 Leia Organa NA 
## 7 Owen Lars NA 
## 8 Beru Whitesun lars NA 
## 9 R5-D4 NA 
## 10 Biggs Darklighter http://swapi.co/api/starships/12/
## # … with 88 more rows
</CODE></PRE>

---

```r
tibble(people = sw_people) %>%
  hoist(
    people,
    name = "name",
    height = "height",
    mass = "mass",
    primary_starship = list("starships", 1)
  )
```

<PRE class="fansi fansi-output"><CODE>## # A tibble: 87 x 5
## name height mass primary_starship people 
## &lt;chr&gt; &lt;chr&gt; &lt;chr&gt; &lt;chr&gt; &lt;list&gt; 
## 1 Luke Skywalker 172 77 http://swapi.co/api/starships… &lt;named list [1…
## 2 C-3PO 167 75 NA &lt;named list [1…
## 3 R2-D2 96 32 NA &lt;named list [1…
## 4 Darth Vader 202 136 http://swapi.co/api/starships… &lt;named list [1…
## 5 Leia Organa 150 49 NA &lt;named list [1…
## 6 Owen Lars 178 120 NA &lt;named list [1…
## 7 Beru Whitesun la… 165 75 NA &lt;named list [1…
## 8 R5-D4 97 32 NA &lt;named list [1…
## 9 Biggs Darklighter 183 84 http://swapi.co/api/starships… &lt;named list [1…
## 10 Obi-Wan Kenobi 182 77 http://swapi.co/api/starships… &lt;named list [1…
## # … with 77 more rows
</CODE></PRE>

---
class: middle
count: false

# Acknowledgments

---

## Acknowledgments

Above materials are derived in part from the following sources:

* Hadley Wickham - [Adv-R Functionals](http://adv-r.had.co.nz/Functionals.html)

* Hadley Wickham - [R for Data Science](http://r4ds.had.co.nz/)

* Neil Saunders - [A brief introduction to "apply" in R](http://nsaunders.wordpress.com/2010/08/20/a-brief-introduction-to-apply-in-r/)

* Jenny Bryan - [Purrr Tutorial](https://jennybc.github.io/purrr-tutorial/)

* [R Language Definition](http://stat.ethz.ch/R-manual/R-devel/doc/manual/R-lang.html)