---
title: "Functional programming
& purrr"
subtitle: "Lecture 08"
author: "Dr. Colin Rundel"
footer: "Sta 323 - Spring 2025"
format:
live-revealjs:
theme: slides.scss
transition: fade
slide-number: true
self-contained: true
execute:
echo: true
warning: true
engine: knitr
---
```{r setup}
#| message: False
#| warning: False
#| include: False
options(
width=70
)
library(tidyverse)
library(repurrrsive)
```
# Functional Programming
## Functions as objects
We have mentioned in passing that in R functions are treated as 1st class objects (like vectors), meaning they can be assigned names, stored in lists, passed as arguments, etc.
:::: {.columns .medium}
::: {.column width='50%'}
```{r}
f = function(x) {
x*x
}
f(2)
```
```{r}
g = f
g(2)
```
:::
::: {.column width='50%'}
```{r}
#| error: True
l = list(f = f, g = g)
l$f(3)
l[[2]](4)
```
```{r}
#| error: True
l[1](3)
```
:::
::::
## Functions as arguments
We can pass in functions as arguments to other functions,
```{r}
do_calc = function(v, func) {
func(v)
}
```
. . .
```{r}
do_calc(1:3, sum)
do_calc(1:3, mean)
do_calc(1:3, sd)
```
## Anonymous functions
These are short functions that are created without ever assigning a name,
::: {.medium}
```{r}
function(x) {x+1}
(function(y) {y-1})(10)
```
:::
. . .
this can be particularly helpful for implementing certain types of tasks,
::: {.medium}
```{r}
integrate(function(x) x, 0, 1)
integrate(function(x) x^2-2*x+1, 0, 1)
```
:::
## Base R - anonymous function shorthand
Along with the base pipe (`|>`), R v4.1.0 introduced a shortcut for anonymous functions using `\()`,
:::: {.columns .xsmall}
::: {.column width='50%'}
```{r}
(\(x) {1+x})(1:5)
```
```{r}
(\(x) x^2)(10)
```
```{r}
integrate(\(x) sin(x)^2, 0, 1)
```
:::
::: {.column width='50%'}
```{r}
(function(x) {1+x})(1:5)
```
```{r}
(function(x) x^2)(10)
```
```{r}
integrate(function(x) sin(x)^2, 0, 1)
```
:::
::::
. . .
We can use this with the base pipe to avoid using `_`,
::: {.xsmall}
```{r}
#| output-location: column
data.frame(x = runif(10), y = runif(10)) |>
(\(d) lm(y~x, data = d))()
```
:::
# apply (base R)
## Apply functions
The apply functions are a collection of tools for functional programming in base R, they are variations of the `map` function found in many other languages and apply a function over the elements of an input (vector).
```{r, eval=FALSE}
??base::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 (Aliases: lapply, sapply, vapply)
## 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`.
. . .
:::: {.columns .small}
::: {.column width='50%'}
```{r}
lapply(1:8, sqrt) |>
str()
```
:::
::: {.column width='50%'}
```{r}
lapply(1:8, function(x) (x+1)^2) |>
str()
```
:::
::::
## Argument matching
:::: {.columns .small}
::: {.column width='50%'}
```{r}
lapply(
1:8, function(x, pow) x^pow, pow=3
) |>
str()
```
:::
::: {.column width='50%'}
```{r}
lapply(
1:8, function(x, pow) x^pow, x=2
) |>
str()
```
:::
::::
## 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.
. . .
::: {.medium}
```{r}
sapply(1:8, sqrt)
```
:::
. . .
::: {.medium}
```{r}
sapply(1:8, function(x) (x+1)^2)
```
:::
. . .
::: {.medium}
```{r}
sapply(1:8, function(x) c(x, x^2, x^3))
```
:::
## Length mismatch?
:::: {.columns}
::: {.column width='50%'}
```{r}
sapply(1:6, seq) |> str()
```
:::
::: {.column width='50%'}
```{r}
lapply(1:6, seq) |> str()
```
:::
::::
## Type mismatch?
```{r}
l = list(a = 1:3, b = 4:6, c = 7:9, d = list(10, 11, "A"))
```
```{r}
sapply(l, function(x) x[1]) |> str()
```
. . .
```{r}
sapply(l, function(x) x[[1]]) |> str()
```
. . .
```{r}
sapply(l, function(x) x[[3]]) |> str()
```
## `*`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.
::: {.medium}
```{r}
df = data.frame(
a = 1:6,
b = letters[1:6],
c = c(TRUE,FALSE)
)
```
:::
. . .
::: {.medium}
```{r}
lapply(df, class) |> str()
sapply(df, class)
```
:::
## A more useful example
Some sources of data (e.g. some US government agencies) will encode missing values with `-999`, if want to replace these with `NA`s lapply is not a bad choice.
::: {.xsmall}
```{r}
d = tibble::tribble(
~patient_id, ~age, ~bp, ~o2,
1, 32, 110, 97,
2, 27, 100, 95,
3, 56, 125, -999,
4, 19, -999, -999,
5, 65, -999, 99
)
```
:::
. . .
:::: {.columns .xsmall}
::: {.column width='50%'}
```{r}
fix_missing = function(x) {
x[x == -999] = NA
x
}
lapply(d, fix_missing) |> str()
```
:::
::: {.column width='50%'}
```{r}
lapply(d, fix_missing) |>
as_tibble()
```
:::
::::
## dplyr alternative
dplyr is also a viable option here using the `across()` helper,
:::: {.columns .medium}
::: {.column width='50%'}
```{r}
d |>
mutate(
across(
bp:o2,
fix_missing
)
)
```
:::
::: {.column width='50%' .fragment}
```{r}
d |>
mutate(
across(
where(is.numeric),
fix_missing
)
)
```
:::
::::
## other less common apply functions
* `apply()` - applies a function over the rows or columns of a matrix or array (data frames also work but are bad idea)
* `vapply()` - is similar to `sapply`, but has a enforced return type and size
* `mapply()` - like `sapply` but will iterate over multiple vectors at the same time.
* `rapply()` - a recursive version of `lapply`, behavior depends largely on the `how` argument
* `eapply()` - apply a function over an environment.
#
{fig-align="center" width="50%"}
## Map functions
Basic functions for looping over objects and returning a value (of a specific type) - type consistent replacements for `lapply`/`sapply`/`vapply`.
* `map()` - returns a list, equivalent to `lapply()`
* `map_lgl()` - returns a logical vector.
* `map_int()` - returns a integer vector.
* `map_dbl()` - returns a double vector.
* `map_chr()` - returns a character vector.
* `walk()` - returns nothing, used for side effects
## Type Consistency
R is a weakly / dynamically typed language which means there is no syntactic way to define a function which enforces 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.
::: {.xsmall}
```{r}
x = list(rnorm(1e3), rnorm(1e3), rnorm(1e3))
```
:::
. . .
:::: {.columns .xsmall}
::: {.column width='50%'}
```{r}
#| error: True
map_dbl(x, mean)
map_int(x, mean)
```
:::
::: {.column width='50%'}
```{r}
#| error: True
map_chr(x, mean)
```
:::
::::
. . .
:::: {.columns .xsmall}
::: {.column width='50%'}
```{r}
map(x, mean) |> str()
```
:::
::: {.column width='50%'}
```{r}
lapply(x, mean) |> str()
```
:::
::::
## Working with Data Frames
purrr offers the functions `map_dfr` and `map_dfc` (which were superseded as of v1.0.0) - these allow for the construction of a data frame by row or by column respectively.
:::: {.columns .small}
::: {.column width='50%'}
```{r}
d = tibble::tribble(
~patient_id, ~age, ~bp, ~o2,
1, 32, 110, 97,
2, 27, 100, 95,
3, 56, 125, -999,
4, 19, -999, -999,
5, 65, -999, 99
)
```
:::
::: {.column width='50%'}
```{r}
fix_missing = function(x) {
x[x == -999] = NA
x
}
```
:::
::::
. . .
:::: {.columns .small}
::: {.column width='50%'}
```{r}
purrr::map_dfc(d, fix_missing)
```
:::
::: {.column width='50%'}
```{r}
purrr::map(d, fix_missing) |>
bind_cols()
```
:::
::::
## Building by row
::: {.small}
```{r}
map(sw_people, function(x) x[1:5]) |> bind_rows()
```
:::
. . .
::: {.small}
```{r}
#| error: True
map(sw_people, function(x) x) |> bind_rows()
```
:::
## purrr style anonymous functions
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, function(x) x/(x+1))
```
. . .
```{r}
map_dbl(1:5, ~ ./(.+1))
```
. . .
```{r}
map_dbl(1:5, ~ .x/(.x+1))
```
. . .
Generally, the latter option is preferred to avoid confusion with magrittr.
## Multiargument anonymous functions
Functions with the `map2` prefix work the same as the `map` prefixed functions but they iterate over two objects instead of one. Arguments for an anonymous function are given by `.x` and `.y` (or `..1` and `..2`) respectively.
```{r}
map2_dbl(1:5, 1:5, function(x,y) x / (y+1))
```
. . .
```{r}
map2_dbl(1:5, 1:5, ~ .x/(.y+1))
```
. . .
```{r}
map2_dbl(1:5, 1:5, ~ ..1/(..2+1))
```
. . .
```{r}
map2_chr(LETTERS[1:5], letters[1:5], paste0)
```
## Indexed maps
purrr also has a collection of `imap` prefixed functions which are short hand for mapping over an object and the indexes of that object (i.e. `seq_along(obj)`).
```{r}
iwalk(
letters[1:5],
~cat("index: ", .y, ", value: ", .x, "\n", sep="")
)
```
## Lookups
Very often we want to extract only certain values by name or position from a list, `purrr` provides a shorthand for this operation - instead of a function you can provide either a character or numeric vector, those values will be used to sequentially subset the elements being iterated.
. . .
::: {.small}
```{r}
purrr::map_chr(sw_people, "name") |> head()
```
:::
. . .
::: {.small}
```{r}
purrr::map_chr(sw_people, 1) |> head()
```
:::
. . .
::: {.small}
```{r}
purrr::map_chr(sw_people, list("films", 1)) |> head(n=10)
```
:::
## Length coercion?
::: {.xsmall}
```{r error = TRUE}
purrr::map_chr(sw_people, list("starships", 1))
```
:::
. . .
:::: {.columns .xsmall}
::: {.column width='50%'}
```{r}
sw_people[[2]]$name
```
:::
::: {.column width='50%'}
```{r}
sw_people[[2]]$starships
```
:::
::::
. . .
::: {.xsmall}
```{r error = TRUE}
purrr::map_chr(sw_people, list("starships", 1), .default = NA) |> head()
```
:::
. . .
::: {.xsmall}
```{r error = TRUE}
purrr::map(sw_people, list("starships", 1)) |> head() |> str()
```
:::
## list columns
:::: {.columns .xsmall}
::: {.column width='50%'}
```{r}
(chars = tibble(
name = purrr::map_chr(
sw_people, "name"
),
starships = purrr::map(
sw_people, "starships"
)
))
```
:::
::: {.column width='50%' .fragment}
```{r}
chars |>
mutate(
n_starships = map_int(
starships, length
)
)
```
:::
::::
# Example
::: {.xlarge}
List columns and approximating pi
:::
## Complex heirarchical data
Often we may encounter complex data structures where our goal is not to rectangle every value (which may not even be possible) but rather to rectangle a small subset of the data.
. . .
::: {.xsmall}
```{r}
str(repurrrsive::discog, max.level = 3)
```
:::
## Partial vs complete rectangling
In the case of `discog` we may want to rectangle the `id`, `year`, `title`, `artist`, and `label` fields but leave the rest of the data as is.
In cases like this using tidyr's `unnest_wider()` and `unnest_long()` is not ideal as they will attempt to rectangle the entire data set when we only want a subset. There is no need to do the expensive work of unnesting columns we will never use.
purrr's `map_*()` functions and tidyr's `hoist()` function are useful for targeting specific columns to rectangle.
## purrr
::: {.small}
```{r}
#| output-location: fragment
tibble(disc = repurrrsive::discog) |>
mutate(
id = purrr::map_int(disc, "id"),
year = purrr::map_int(disc, c("basic_information", "year")),
title = purrr::map_chr(disc, c("basic_information", "title")),
artist = purrr::map_chr(disc, list("basic_information", "artists", 1, "name")),
label = purrr::map_chr(disc, list("basic_information", "labels", 1, "name"))
)
```
:::
## `hoist()`
::: {.small}
```{r}
#| output-location: fragment
tibble(disc = repurrrsive::discog) %>%
hoist(
disc,
id = "id",
year = c("basic_information", "year"),
title = c("basic_information", "title"),
artist = list("basic_information", "artists", 1, "name"),
label = list("basic_information", "labels", 1, "name")
)
```
:::