purrr.Rmd

---
title: "![](img/header.png) Intermediate R"
author: "Brendan Clarke"
date: "2022-10-22"
always_allow_html: true
output:
  html_document:
    toc: no
    toc_depth: 2
    number_sections: no
    toc_float:
      collapsed: no
  pdf_document:
    toc: yes
    toc_depth: '2'
    pandoc_args: ["--extract-media", "."]
  word_document:
    toc: yes
    toc_depth: '2'
editor_options: 
  chunk_output_type: console
---

```{r echo=F, warning=F, message=F}
knitr::opts_chunk$set(echo = TRUE, warning = F, message = F, results = 'asis')
install.packages(setdiff("pacman", rownames(installed.packages())))
library("pacman")
p_load(tidyr,readr,ggplot2,dplyr,lubridate,NHSRplotthedots,readxl,stringr,NHSRdatasets, purrr, rlang, glue, knitr)

# function to add new window links
link<-function(text,url) {
  target<-c('{target="_blank"}')
  glue('[{text}]({url}){target}')
}
```

# purrr {.tabset}

Purrr is a set of tools for working with functions. This training provides an introduction to using the purrr package. It has an R/Rmarkdown slant, and is based on examples drawn from health and care. It is part of a wider training programme designed as next steps for R users who have moved beyond introductory training. This programme covers:

+ iteration
+ functions
+ tidy evaluation
+ dplyr

This purrr training can be taken as a stand-alone session, or integrated into a more involved programme with the other sessions. You can find further details on the `r link("TURAS page", "https://learn.nes.nhs.scot/64644")`, join the `r link("KIND Learning Network", "https://forms.office.com/r/WQdd6HSCEW")` for social learning support, or contact [Brendan Clarke](mailto: brendan.clarke2@nhs.scot?subject=Intermediate R training) with any queries, comments, or suggestions. You can also find the source code for this training on the `r link("GitHub repository", "https://github.com/bclarke-nes/Intermediate-R")`.

## Introduction

`purrr()` gives us a powerful and standardised way of applying functions to more-or-less any R object that we like, and collecting the results of those functions in any format we choose. That power makes `purrr()` feel daunting, but actually using it is very simple. It's just a question of picking the right tool for the job. `purrr()` consists of a couple of families of systematically-named tools to let you apply functions in different ways. 

```{r eval=F, echo=F, cache=TRUE, fig.height=2, fig.width=8}
library(DiagrammeR)
DiagrammeR::mermaid("
graph TD

  do[What do you want to do?]
  return(Return something)
  display(Display something)
  cbind(map + list_cbind)
  rbind(map + list_rbind)
list --> map
do --> return
return -->  tibble
return -->  vector
return --> list

tibble --> rbind
tibble --> cbind
vector --> map_chr
vector --> map_dbl
vector --> map_lgl
vector --> map_int
do --> display
display --> walk
")
```

![](img/purrr.png)

`walk()` displays things, while `map()` returns things. So if you want to draw a series of graphs, you'll be using `walk()` or one of its relatives. On the other hand, if you want to return some data to another function, you'll use `map()` or one of its relatives.

With that high-level overview out of the way, let's begin at the beginning. As `purrr()` lets us pass things to functions, we'll need a test function to play with. Don't worry if you've never written a function before - the key idea is that functions are just a way of wrapping up bits of useful code so that they can be reused in your R scripts. We write functions like this:

```{r}
function_name <- function(argument1, argument2) {
  
  #some code here, using the two arguments
  argument1+argument2
  
}
```

Once we've written our own function, we can use it as we would any other R function. We can call it in a code chunk:

```{r results='markup'}
function_name(8,11)
```

Or use it in a calculation:
```{r results='markup'}
function_name(8,11) * function_name(9,105)
```

Or print it as an integrated code block in Rmarkdown: **`r function_name(8,11)`** is the result of our function.

There's potentially quite a lot to think about when turning code into functions (and you're very welcome to sign-up for the KIND Learning Network session on functions if that appeals). We'll keep it comparatively simple here though: we'll start with a basic function below to familiarise you with the process a little bit, before we move on to anything more complicated.

Here's our simple function - `non_admissions()`:

```{r}
non_admissions <- function(single_org_code) {
  ae_attendances %>%
    filter(org_code == {{single_org_code}}) %>%
    group_by(org_code, year=floor_date(period, unit="year")) %>%
    summarise(non_admissions = sum(attendances-admissions), year=unique(year(year)))
}
```

`non_admissions()` is just a bit of `dplyr` that:

+ takes the ae_attendances data from the NHSRdatasets package
+ filters it for the supplied org_code
+ then groups the data into years
+ summarises the number of non-admissions (so attendances - admissions)
+ finally, returns a tibble with that summary

Calling this function gets us a small tibble with our non-attendance statistic grouped into year ranges:

```{r results='markup'}
non_admissions("AJN")
```

This tibble will behave like any other, so we can assign it to a name, or pipe it to other functions, or we can display it. Let's display this tibble properly, using `kable()`:

```{r}
non_admissions("AJN") %>%
  kable()
```

Here's how `purrr()` is useful. Let's imagine that we now would like to apply our `non_attendance_range()` over all the `r nrow(ae_attendances %>% distinct(org_code))` organisations in our data. We *could* do this manually by calling our `non_attendance_range()` function on each org_code one-by-one: 

```{r eval=F}
non_admissions("8J094")
non_admissions("AAH")
...
```

And it we want to use the `non_admissions()` function a couple of times, hand-coding like this is probably the right approach. However, if we're using the function programmatically - so in this case generating graphs for each of the orgs that meet our conditions, hand-coding will cause us problems as our data changes. What if we update the `ae_attendances` data, and the list of organisations meeting our conditions changes? That would require us to do a lot of careful and tedious work to update the list of organisations that we apply `non_attendance_range()` to. Surely there must be a lazier way?

This is where `purrr()` comes in. `purrr()` lets us apply functions to lists or vectors. In this case, we'll make a vector containing org_codes, and then use `map()` to apply our `non_admissions()` function over each of those org codes. We'll start that process in the next section.

## `map()` introduction

So, we want to apply `non_admissions()` to lots of org_codes, but we don't want to write repetitious code that needs manual updating. A much more trustworthy way through all of our our organisations is to use `purrr::map()`. Looking at the `r link("reference manual", "https://purrr.tidyverse.org/reference/map.html")`, `map()` takes two arguments:
  
+ `.x` - a list or vector
+ `.f` - a function (or formula)
  
Let's try this out now. First, we'll make a vector of three organisations and assign it to `short_org_codes`:

```{r}
short_org_codes <- ae_attendances %>%
  distinct(org_code) %>%
  arrange(org_code) %>%
  slice(80:82) %>%
  pull()
```

Note that we can happily use more than three organisations if we need to, although this will make for a slower knit, and a longer output document. Once we have our vector of organisations, applying our function to each is easy:

```{r results='markup'}
purrr::map(.x = short_org_codes, .f = non_admissions)
```

As long as our function only takes one argument, we can use *any* function in this call to `map()`. We can even create a one-off anonymous function (which we should properly call a *formula*) inside the call to `map()`:

```{r results='markup'}
daft_codes <- map(.x = short_org_codes, ~ glue("ThIs OrG CoDe iS {.x}  \n  \n"))
daft_codes
```

You might also see anonymous functions expressed using `\(x)` in very recent bits of R code. This should be equivalent to the formula above using `~`:
```{r results="markup"}
daft_codes <- map(.x = short_org_codes, \(x) glue("ThIs OrG CoDe iS {x}  \n  \n"))
daft_codes
```

In this formula, we use `glue()` to create a short string from each item in short_org_codes. These individual items are represented using the shorthand `.x`. We then assign the results into a `list`:

```{r results='markup'}
class(daft_codes)
```

If you've never worked with lists in R before, a few words of introduction might be useful. Lists are a data structure that allow you to store different data types together. If we look at the `daft_codes` list that we just created using `summary()`, we can see that it's made up of three sublists, each with a single entry:

```{r results='markup'}
summary(daft_codes)
```

If we want to access the contents of our list, we use `[]` to access the sublists, and `[[]]` to access the contents of those sublists:

```{r results='markup'}
daft_codes[1] # returns everything in the first sublist
daft_codes[[1]] # returns just the first item in the first sublist
```

And you can access the contents of the list in all the ways you might expect. For instance, we can iterate using a for-loop:

```{r results='markup'}
for(i in seq_along(1:length(daft_codes))) {
  cat(daft_codes[[i]])
}
```

And - no surprise given the topic of this training - we can incorporate bits of the list into our Rmarkdown, like this: **`r daft_codes[[2]]`**

In the next section, we'll experiment with some of the related functions that give different outputs, but work in the exact same way: provide a vector and a function, and `map()` will apply that function over each member of the vector.

## `map()` variants {.tabset}

### `map_lgl()`, `map_int()`, `map_dbl()` and `map_chr()`

`map_lgl()`, `map_int()`, `map_dbl()` and `map_chr()` all work exactly like `map()`, except they return vectors, rather than lists. Each work in the same way, with similar syntax and usage to `map()`. To show you why these different functions exist, let's try to run `map_dbl` on our existing `non_admissions()` function:

```{r results='markup'}
try(map_dbl(short_org_codes, non_admissions))
```

The reason this code produces an error is that each of these `map_whatever()` functions will specifically try to return a vector in the appropriate format. If this is new to you, then `r link("R4DS is a great place to start", "https://r4ds.had.co.nz/vectors.html")`, but in summary:

+ `_lgl` is logical (TRUE)
+ `_int` is integer (14L)
+ `_dbl` is double (524.4)
+ `_chr` is character ("cheese")

So we'll need to tweak our function so that it returns a result in the format that `map_whatever()` expects. Let's do that now with `map_dbl()` in mind:

```{r}
non_admissions_v <- function(single_org_code) {
  non_admissions(single_org_code) %>% 
    filter(year == "2018") %>% 
    pull() %>% 
    sum()
  }
```

Our new function just returns the total non-admissions for the year 2018. Let's use `map_dbl()` to return a vector of doubles:

```{r results='markup'}
#dbl for doubles - ordinary decimal numbers
map_dbl(short_org_codes, non_admissions_v)
```

If our function returns a character vector we can use `map_chr()`:

```{r results='markup'}
non_admissions_c <- function(...) {
  non_admissions_v(...) %>%
    as.character()
  }

#chr for character
map_chr(short_org_codes, non_admissions_c)
```

We'll need to tweak our function again to demonstrate the other variants:

```{r results='markup'}

non_admissions_int <- function(...) {
  non_admissions_v(...) %>%
    as.integer()    # to convert the result to integer
}

#int for integers
map_int(short_org_codes, non_admissions_int)

#lgl for logical (true/false)
non_admissions_lgl <- function(...) {
  result <- non_admissions_v(...)
  
  result[1] %% 2 == 0 # to test if the answer is even
}

map_lgl(short_org_codes, non_admissions_lgl)
```

### `map_vec()`

If you don't know what kind of vector you'll need to supply, you can use `map_vec()`, which returns a vector to match the output from the function:

```{r}
map_vec(short_org_codes, non_admissions_v)
map_vec(short_org_codes, non_admissions_c)
map_vec(short_org_codes, non_admissions_int)
map_vec(short_org_codes, non_admissions_lgl)
```


### `list_rbind()` and `list_cbind()`

These were previously standalone `map` variants called `map_dfr()` and `map_dfc()`. Those functions are still available, but the `r link("purrr manual", "https://purrr.tidyverse.org/reference/map_dfr.html")` recommends switching to the new `list_whatever` formulations to avoid some tricky edge-cases.

`list_rbind()` is fantastically useful. It takes the list output of `map`, and *row binds the output* into a single big tibble: 

```{r} 
map(short_org_codes, non_admissions) %>% 
  list_rbind() %>%
  head() %>% 
  kable()
```

My favourite application for this is when using `read_csv()` over a directory of files, like we have in the "./data/sign_up_1" directory of this project:

```{r}
#the simple version
files <- list.files("./data/sign_up_1", full.names = T)

files %>% 
  map(read_csv) %>%
  list_rbind() %>%
  head() %>%
  kable()

# the slightly more involved version, wrapping read_csv into a new function to allow indexing
labeller <- function(file) {
  read_csv(file, id="file_name")
}

files %>% 
  map(labeller) %>%
  list_rbind() %>%
  head() %>%
  kable()
```

There's also a matching `list_cbind()`, which column-binds the individual tibbles together. This is more finicky than `list_cbind()`, and won't work if you have e.g. different numbers of rows in the tibbles. As a proof-of-concept:

```{r}
random_nonsense <- function(name) {
  tibble({{name}} := rnorm(1:5))
}

map(letters[1:7], random_nonsense) %>% 
  list_cbind() %>%
  kable()
```

Alternatively, you can either:

+ use dplyr's `left_join()`, or
+ `map() + list_rbind()` and then pivot the data:

```{r}
files %>% 
  map(labeller) %>%
  list_rbind() %>%
  pivot_wider(id_cols = c(email, reg_date), names_from = file_name, values_from = consent) %>%
  head() %>%
  kable()
```

## `walk()` introduction

`walk()` is used in exactly the same way as `map()`, but gives a different result. While `map()` and variants return something (like a vector or tibble), `walk()` just returns **any side effects of the code that you run as part of your function**. That makes `walk()` especially useful when drawing graphs, and when writing Rmarkdown. Let's start with a lightly-updated version of some code we've met before:

```{r results='asis'}
walk(short_org_codes, ~ cat(glue("\n+ ThIs OrG CoDe iS {.x}\n\n")))
```

Now let's translate that approach to a more complicated function, which draws a graph with appropriate headers for organisations in the ae_attendance data matching a set of admissions and breaches conditions:

```{r fig.height=2, fig.width=6}

admission_graphs <- function(org_code_arg) {
  
  if (nrow(ae_attendances %>% filter(admissions < 5 & breaches >= 400 & org_code == {{org_code_arg}})) == 0) {
    
    cat(glue("  \n  \nNo data exists for {org_code_arg}.  \n"))
  
    } else{
  
      cat(glue("  \n  \n### Results for {org_code_arg}  \n  \n"))
  
  print(ae_attendances %>% 
    filter(admissions < 5 & breaches >= 400 & org_code == {{org_code_arg}}) %>%
    group_by(year = year(period), month = month(period)) %>%
    mutate(end = period+days_in_month(month)-1) %>%
    arrange(year, month) %>%
    ggplot() +
    geom_rect(aes(xmin=period, xmax=end, ymin=0, ymax=attendances)) +
    labs(title = glue("{org_code_arg} admissions for months with < 5 admissions and > 400 breaches")) +
    scale_x_date(limits=ymd("2016-04-01", "2019-03-01")) )
  cat('  \n  \n')
    }
}

```

We'll pause here to review this code, because it's useful to have a very clear idea of how a function works before we start to use it with `purrr()`. The function:

+ takes the `ae_attendance` data from the NHS-R datasets package
+ filters the data by the organisation code supplied in the argument to the function (e.g. when calling with `my_fun("RJ2")`)
+ it then filters for dates with fewer than 5 admissions and 400 breaches or more
  + if no data is found, it prints a little error message
  + otherwise, it plots a graph of the attendances in those months identified by the admissions and breaches conditions, and embeds the graph in a bit of Rmarkdown for presentation purposes.

Let's try the function now. We'll start by looking at the first option: a case where the admission and breaches conditions are not met:

```{r}
admission_graphs("NLO10")
```

Now we'll look at the alternative:

```{r fig.height=2, fig.width=6}
admission_graphs("RJ2")
```

So `admission_graphs()` prints a graph with appropriate Rmarkdown headers if there is data that meets our admissions and breaches conditions, but otherwise just tells us that there is no matching data. This means that we can use `walk()` to generate sections of reports (like this one) from vectors. Just to illustrate using the short vector of organisations we that we used above:

```{r fig.height=2, fig.width=6}
walk(short_org_codes, admission_graphs)
```

## `map2()`

`map2()` works exactly like `map()` and friends, except that it takes two arguments. We'll need a two-argument function, so let's update the `non_admissions_v()` function from above to allow us specify the year:

```{r results='markup'}
non_admissions_year <- function(single_org_code, year) {
  non_admissions(single_org_code) %>% 
    filter(year == {{year}}) %>% 
    pull() %>% 
    sum()
  }

non_admissions_year("RF4", "2018")

map2(short_org_codes, "2018", non_admissions_year)

```

Again, that gives us a list as output - but all the `map()` variants that we discussed earlier will work in exactly the same way. A lovely, and useful, application for this `map2` and friends comes when we find that we'd like to specify how many rows of our .csv files we'd like to skip (perhaps because they have nonsense headers). I've added some of these to the /data/sign_up_2 folder. These are identical to the data files that we loaded using `list_rbind()`, but have a line of gibberish at the start, which we'll need to exclude. Their format is as follows:

1. `a row of utter nonsense` (some nonsense)
2. `reg_date,consent,email` (the headers we want)
3. `01/08/2022,Yes,3357@nhs.scot` (the data we want)
4. `...` (more data)

If we try to `map() + list_rbind()` over these files, we'll end up with a problem, because `read_csv()` will assume that all our data is in a single column:

```{r}
try(list.files("./data/sign_up_2", full.names = T) %>%
      map(read_csv) %>%
      list_rbind() %>%
      head() %>%
      kable()
)
```

Luckily, we can specify a number of rows to skip via the `skip` argument of `read_csv()`. We'll wrap this into a new two-argument function called `labeller_skips()`:

```{r}
labeller_skips <- function(file, skip_rows=0) {
  read_csv(file, id="file_name", skip=skip_rows)
}
```

We can then `map2()`. We would usually specify each of the arguments using `.x` and `.y`. Note that here, `map2()` will assume that the list that we pipe to it from `list.files()` will contain the first argument, so we can safely omit the `.x`:

```{r}
list.files("./data/sign_up_2", full.names = T) %>% 
  map2(.y=1, labeller_skips) %>%
  list_rbind() %>%
  head() %>%
  kable()
```

And, again, we can immediately set the tibble created by `map2() + list_rbind()` to work - here's a quick example where we group the data into weeks, and then plot the number of sign-ups by week:

```{r fig.height=2, fig.width=5}
list.files("./data/sign_up_2", full.names = T) %>% 
  map2(.y=1, labeller_skips) %>%
  list_rbind() %>%
  mutate(reg_week = floor_date(dmy(reg_date), unit="weeks")) %>%
  group_by(reg_week) %>%
  summarise(signups = n(), month=unique(file_name)) %>%
  ggplot() +
  geom_col(aes(x=reg_week, y=signups, fill=month)) +
  xlab("Registration week") +
  ylab("New signups") +
  theme(legend.position="none")

```


## `walk2()`
Say we now want to use the our `admission_graphs` function again. However, this time, we want to be able to vary the number of breaches that we filter our data on - perhaps we're not quite sure exactly where the most meaningful cut-off point is, and so we'll explore our data by building a new two-argument function.

```{r}

admission_graphs_breaches <- function(org_code_arg, breach_count) {
  
  if (nrow(ae_attendances %>% filter(admissions < 5 & breaches >= {{breach_count}} & org_code == {{org_code_arg}})) == 0) {
    
    cat(glue("  \n  \nNo data exists for {org_code_arg}.  \n"))
  
    } else{
  
      cat(glue("  \n  \n### Results for {org_code_arg}  \n  \n"))
  
  print(ae_attendances %>% 
    filter(admissions < 5 & breaches >= {{breach_count}} & org_code == {{org_code_arg}}) %>%
    group_by(year = year(period), month = month(period)) %>%
    mutate(end = period+days_in_month(month)-1) %>%
    arrange(year, month) %>%
    ggplot() +
    geom_rect(aes(xmin=period, xmax=end, ymin=0, ymax=attendances)) +
    labs(title= glue("{org_code_arg} admissions for months with < 5 admissions and > {breach_count} breaches")) +
    scale_x_date(limits=ymd("2016-04-01", "2019-03-01")) )
  cat('  \n  \n')
    }
}
```
We haven't made an enormous number of changes to the function. All that we've added is a bit of extra code (largely inside {{double curly brackets}}) to allow us to pass the `breach_count` argument to the appropriate places in the code. And we can still run the function in single cases:

```{r fig.height=2, fig.width=6}
admission_graphs_breaches("R1H", 75)
```

But now we can vary the cut-off point for our breaches to explore the data in a new way:

```{r fig.height=2, fig.width=6}

walk2(.x="R1H", .y=c(10,20,50,100,150),admission_graphs_breaches )

```

## Resources

+ `r link("purrr() cheat sheet", "https://github.com/rstudio/cheatsheets/blob/main/purrr.pdf")`
+ `r link("R4DS chapter on iteration", "https://r4ds.had.co.nz/iteration.html")` gives a useful overview, and compare-and-contrast with for loops and other similar techniques
+ `r link("purrr reference manual", "https://purrr.tidyverse.org/reference/index.html")` is, as you might expect, a mile deep, but it's generally very clearly written and informative
+ if you're interested in exploring the purrr family much more thoroughly, the `r link("functionals chapter in *Advanced R*", "https://adv-r.hadley.nz/functionals.html")` is highly recommended. Not an easy read, at all, but extremely clear and with lots of very helpful exercises and explanation.