iteration.Rmd

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

```{r echo=F, warning=F, message=F}
knitr::opts_chunk$set(echo = TRUE, warning = F, message = F)
install.packages(setdiff("pacman", rownames(installed.packages())))
library("pacman")
p_load(tidyr, ggplot2, dplyr, NHSRdatasets, glue, microbenchmark)

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

# Iteration {.tabset}
Iteration describes a section of code that repeats until some condition is met. The best example is a for-loop. For-loops run *for* a set number of repetitions. A very quick example of a for-loop in R:

```{r}
for (i in seq_along(1:10)) {
  cat(glue("{i} potato, "))
}
```

While for-loops are a basic building-block of many programming languages, they are found infrequently in R. There are a couple of good reasons for this. First, for-loops can be very slow in R, and writing high-performance code has a perennial appeal that surpasses its actual importance in day-to-day data analysis. Second, most functions in R are vectorised. Vectorised functions, as We'll explain later, usually allow us to avoid writing for-loops.

However, imperative programming using for-loops definitely has a place, even if a purist might avoid them for performance reasons. Computer time is cheaper than analyst time, and loops definitely have some strengths in real-world analysis. One important strength of for-loops is that they allow you to repeatedly apply a non-vectorised function elegantly. As some of the core Rmarkdown functions are not vectorised, for-loops are an important part of the Rmarkdown programmer's toolkit. So this training will give you a basic introduction to writing good loops in R, and we'll cover some strategies for avoiding the worst of the performance hit that iteration can cause.

This training session is part of a wider training programme designed as next steps for R users who have moved beyond introductory training. This programme covers:

+ tidy evaluation
+ functions
+ dplyr
+ purr

This iteration 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

### Ground rules

Some ground rules for this training session:

1. The training is **interactive**. You'll be working on code, answering questions, and helping other trainees. Do please ask questions whenever you like, or for extra clarification if anything isn't as clear as you'd like it to be. 

2. Please leave **cameras and mics on** as much as you reasonably can. Social learning is a vital part of this training, and the more discussion and chat that we get, the better the sessions run.

3. Things will go wrong, and code will misbehave. **Be ready to share your screen when this happens.** The aim is that we will all collaborate on solving any problems that we might run into. This is the best way of developing a set of strategies for solving problems which is such an important part of the learning journey in this field.

Once again, this training is influenced by the explanations and code from `r link("R4DS", "https://r4ds.had.co.nz/iteration.html#for-loops")`. It's impossible to recommend this book as a resource too strongly, and a quick read of the iteration chapter will be a useful adjunct to this session.

Loops are base R structures, which means that there's a bit more base R in this session than most of the KIND Learning Network training. We'll explain anything new that crops up, and most of the base R code is pretty straightforward. Some useful examples that we'll include here are the base R ways of selecting from tibbles. For some tibble called `df`:

+ `df[[]]`
  + `df[["val"]]` selects the column named `val` 
  + `df[[n]]` selects the n^th column from df
+ `df[(row, column)]`
  + `df[1,2]` selects the value in the first row, second column
+ `df$`
  + `df$val` selects the column named `val` 
  + `df$n` selects the nth column from df

We'll also introduce `setequal()`, which allows you to compare two objects in R. This is very helpful to check what you're selecting:

```{r}
setequal(3, 3)
setequal(3, 4)
```

For example, let's compare the two `df[[]]` methods above:
```{r}
setequal(synthetic_news_data[["age"]], synthetic_news_data[[2]])
```

Hopefully this code will return `TRUE`, telling us that there is no difference between the two methods. Now let's compare a tidyverse-style `select()` and `pull()` with `[[]]`:

```{r}
setequal(synthetic_news_data %>% select(age) %>% pull(), synthetic_news_data[[2]])
```

## For-loops

Let's begin with a simple example:

```{r}
word <- ""

x <- 1:10

for (i in seq_along(x)) {
  word[[i]] <- "iteration is"
}

cat(word)
```

From the `r link("R4DS chapter", "https://r4ds.had.co.nz/iteration.html")` which - like the rest of that book - is essential reading, we can identify three parts to this for loop:

1. **Output** - what do you want out of the loop? Here, it's `word`, which is initially empty, but will gradually expand...
2. **Sequence** - what do you want to loop over? Here, it's `x`, which contains the numbers 1 to 10
3. **Body** - what do you want the loop to do? Writing the code is easier than explaining it, but the parts here are:
    + first, we have `for()` which starts the loop
    + next, inside the `for()` function, we take the first value of `x`, and store it in `i`
    + we then add the phrase "iteration is" into the `i`th position of the `word` vector
    + finally, we replace the current value of `i` with the next item in the sequence `x`, and re-run the code above. This goes on until we reach the end of the sequence `x`
    
This might be a bit more obvious if we tweak our code to include the value of `i` before each element we add into the `word` vector:
  
```{r}

word <- ""

x <- 1:10

for (i in seq_along(x)) {
  word[[i]] <- glue("iteration {i}")
}

cat(word)
```

And there's no reason we need to confine the output of our loop to a vector. Using the `df[(row, column)]` shorthand from the introduction, we could adapt our loop to produce a simple tibble:

```{r}

words <- tibble(iteration="",contents="")

x <- 1:5
for (i in seq_along(x)) {
  words[i, 1] <- as.character(i)
  words[i, 2] <- glue("iteration {i}")
}
words %>%
  knitr::kable()
```

## Output

One reason that many R programmers will avoid writing loops concerns performance. And there are some good reasons that loops in R are rather slower than some of the alternative ways of working. I think the first piece of useful advice here is that performance should be fairly low down on your list of concerns as someone working in R. Computer time is cheap - much cheaper than your time spent optimising performance. Exceptions obviously apply, particularly if you're writing code that will be widely and repeatedly used. That said, there are some quick and easy ways of speeding up code with loops if you need to. The most important lesson here is:

+ **never grow your output in the body of the loop**

In this section, we'll also look at benchmarking using `microbenchmark()` as a way of assessing performance. Let's have a very quick look at that now, and then we'll use the same syntax to compare a couple of approaches to building output in loops.

```{r}
mbm <- microbenchmark(multiplication={2*2*2}, addition = {2+2+2+2}, power = 2^3)
autoplot(mbm)

```

`microbenchmark()` shows processing time for repeated runs of an operation, and then plotting the results. Let's use it to look at the performance of a simple loop:

```{r cache=TRUE}
mbm <- microbenchmark(loop={
  
  x<-1:1000
  output <- vector("integer", length(x))
  
  for (i in seq_along(x)) {
    output[[i]] <- i^2
  }

})

autoplot(mbm)
```

That seems snappy enough - although running it a hundred times for the benchmark does slow down the knitting process, which is why the results for this section are cached.

Now let's compare two versions of the same loop - one which sets the length of the output, then assigns the results to the ith position of the output, and the other which creates an empty vector, and then just collapses each new piece of output to the end of it:

```{r cache=TRUE}
mbm <- microbenchmark(loop={
  
  x<-1:1000
  output <- vector("integer", length(x)) # an empty vector the same length as our intended output

  for (i in seq_along(x)) {
    output[[i]] <- i^2
  }

}, loop_short_output={

  x<-1:1000
  output_2 <- vector("integer", 0) # just an empty vector

  for (i in seq_along(x)) {
    output_2 <- c(output_2, i^2)
  }

})

autoplot(mbm)
```

The outputs are identical:
```{r}
setequal(output, output_2)
```

Okay, so in this example the time saved is minimal - a few milliseconds. But when the output is bigger - like iteratively adding rows to a tibble - the time taken to knit your code can be a serious problem. Creating a sensibly-sized container for your output at the start of the loop, and then filling that container by indexing, is simple enough to do, and can help your loops run rapidly.

## Sequences

This section gives some tips for efficiently generating sequences, and then using them safely in loops. The obvious place to start are the base-R methods of using either `c()`, or `:` to produce ranges:

```{r}
c(1,2,3,4)
1:10
```

`rep()` - short for repetition - allows us to build longer sequences from short ones by specifying the number of repeats (5 in this case):

```{r}
rep(c(1:5), 5)
```

You can use the related `rep_len()` if you know the final length that you want, but not the number of repetitions. To get the alphabet repeated from a to z until 100 letters have been produced:

```{r}
rep_len(letters, length.out=100)
```

As we've shown in the code above, R comes with a few useful built-in sequences:

```{r}
letters 
LETTERS
month.abb
```

A common job is generating a sequence from some data. This can easily be done in base R:

```{r eval=F}
sort(unique(ae_attendances$org_code)) # giving a sorted list of all values in a column
```
(not run here, because it's really long!)

You can also subset this using an index range:

```{r}
sort(unique(ae_attendances$org_code))[1:10] # giving a sorted list of the first 10 values in a column
```
  
```{r}
colnames(ae_attendances) # giving column names
```

As you might expect, the tidyverse versions are easier to understand but rather longer:

```{r}
synthetic_news_data  %>%
  distinct(NEWS) %>%
  pull() %>%
  sort()
```

Now that we've covered a few ways of generating sequences, we can also dip into some methods for working through sequences, as you might do while setting up your loop. `seq_along()` cycles through a sequence numerically:

```{r}
seq_along(synthetic_news_data) # cycles through the columns of a tibble

seq_along(letters) # seq_along() also works with vectors etc.
```

You can use `names()` to cycle through sequences by column name:
```{r}
names(synthetic_news_data) # cycles through the sequence by column name (tibbles / data frames only)
```

It's generally best to avoid rownames if at all possible, but there is also a `rownames()` function that might be needed while working with unusual or transposed data:

```{r}
t(synthetic_news_data) %>%
  rownames()
```

## While loops

While-loops are built in a very similar way to for-loops. Rather than repeating a set number of times, though, they run until the condition in the `while ()` is met:

```{r results='markup'}
bottles <- 10

while (bottles >= 1) {
cat(glue("{bottles} green bottles...  \n"))
bottles = bottles - 1
}
```

## Vectorised functions

Most functions in R are vectorised. That means that:

+ they can take a vector (like `c(3,6,5,4,3)`) as input
+ they will then work over that vector, and return a vector as output

That's even the case when we haven't necessarily *tried* to make a function work in a vectorised way. For instance, we can sling together a tiny function:

```{r}
cube <- function(num) {num ^3}
```

And then when we call it over a vector, we get vectorised output:
```{r}
cube_inputs <- c(3,6,5,4,3)
cube(cube_inputs)
```

So what's the problem? Let's fiddle with our `cube()` function so that it will cube even numbers, but square odd numbers:

```{r}
conditional_cube <- function(num) {
  if(num %% 2 == 0) {
    num ^ 3 }
  else {
    num ^ 2 }
}
```

The updated function works perfectly on single digits:

```{r}
conditional_cube(3) # should square the input for odd numbers
conditional_cube(4) # should cube the input for even numbers
```

However, `conditional_cube()` won't work properly on a vector. Let's try it now, using the useful function `try()`, which attempts to run code, and returns the error message if it doesn't work. That allows us to test out dodgy code in Rmarkdown without breaking the knitting process, as would usually happen when we encounter an error:

```{r}
try(conditional_cube(cube_inputs))
```

That `condition has length > 1` in the error message is R's way of telling us that `conditional_cube()` is a *scalar* function. Scalar functions require one item to be supplied to them at a time. While there aren't that many scalar functions in widespread R use now, one major exception is `if()`/`else()`. These are the basis of our `conditional_cube()` misfire, and as conditional execution is a common reason for writing your own functions, unexpectedly encountering a scalar function can be an irritating little problem.

Here, we can solve this problem with `conditional_cube()` in a few different ways:

1. we can use the `Vectorize()` - with a capital V - function as a wrapper for our function:

```{r}
vector_conditional_cube <- Vectorize(conditional_cube)
vector_conditional_cube(cube_inputs)
```

2. we can re-build our function so that it no longer depends on a scalar function. So we can replace `if()`/`else()` with the vectorised `ifelse()`:

```{r}
ifelse_conditional_cube <- function(num){
  ifelse(num %% 2 == 0, num^3, num^2 )
}

ifelse_conditional_cube(cube_inputs)
```

3. (and the reason for this apparent digression here) we can just loop over the scalar function, and not bother to re-work it at all:

```{r}
cube_outputs <- vector("double", length(cube_inputs))

for(i in seq_along(cube_inputs)) {
  cube_outputs[[i]] <- conditional_cube(cube_inputs[[i]])
}

cube_outputs
```

Okay, so it seems like writing a loop isn't worth the trouble for a really simple function like `cube()`. Let's use a slightly more complicated function to demonstrate where that trade-off might feel rather different.

Here's our function, `perd()`:
```{r}
perd <- function(x) {
  glue("This value here is {x}")
}
```

Let's try `perd()` inside `mutate()`:

```{r}
synthetic_news_data %>%
  select(1:3) %>%
  mutate(age = perd(age))
```

So what happens when we try to use this function across everything?

```{r}
synthetic_news_data %>%
  mutate(across(everything(), perd))
```

That works straightforwardly enough, even if it ruins our tibble completely. Things get more complicated when we try to add extra arguments to `perd()` though:

```{r}
perd_v <- function(var_name, x) {
  glue("This value of {var_name} here is {x}")
}
```

We can use dplyr's `r link("context dependent expressions", "https://dplyr.tidyverse.org/reference/context.html")` here:

```{r}
synthetic_news_data %>%
  mutate(across(everything(), ~ perd_v(cur_column(),.)))
```

But, particularly as a beginner, this kind of syntax is hard to write and understand. A simpler option is to use a loop to do this reworking;

```{r}
output <- synthetic_news_data
x <- names(output)

for (i in seq_along(x)) {
  output[[i]] <- perd_v(names(output[i]), output[[i]])
}
glimpse(output[1,])

```

## Breaks and next

### `break`
When encountered, `break` completely stops the execution of the loop. For example, say we have some random numbers:
```{r}

random_sample <- sample(seq(from=1, to=340, by=sample(1:10, 1, replace=T)), 10)

```
Say we want to loop through some `random_numbers` and do something until we get to a number larger than a threshold value:

```{r}
threshold_value <- 300
```

We can use a `break`, which will stop the loop when an `if()` condition is met:

```{r}
for(i in random_sample) {
  cat(glue("{i  }, "))
}

for(i in random_sample) {
  if(i > threshold_value) break
  cat(glue("{i  }, "))
}


```
If you're using nested loops, and a `break` is encountered in the inner loop, it will return you to the outer loop (or the next level up):

```{r}
for(i in 1:5) {
  for (j in 1:5) {
  cat(glue("{i+j} "))
    if(i+ j >= 7) break # breaks the inner loop at 7 each time
  }
      cat("  \n")
}
```


### `next`
When encountered, `next` moves on to the next iteration of the loop. It's usual to combine it with a test condition (using an `if()` statement). For example, we could use `next` to write a simple [fizz buzz](https://en.wikipedia.org/wiki/Fizz_buzz) programme:

```{r}

for(i in 1:20) {
  if(i %% 15 == 0) {
    cat("fizzbuzz, ")
    next
  }
  if(i %% 3 == 0) {
    cat("fizz, ")
    next
  }
  if(i %% 5 == 0) {
    cat("buzz, ")
    next
  }
cat(glue("{i}, "))
}


```

## Rmarkdown with loops {.tabset}

### Introduction

One area where loops excel is generating a mixture of R and Rmarkdown. We'll demonstrate an example of this in the next subsection. This loop uses the attendances data from the `ae_attendances` dataset, which looks like this:

```{r}
ae_attendances %>%
  slice(1:5) %>%
  knitr::kable()
```

The aim here is to demonstrate how to write a loop that performs the same bit of analysis for each of the orgs in the data, and inserts that bit of analysis for one org into a separate Rmarkdown subsection. This is a great way of standardising and organising your report - we write the code once only, and then use the loop to run it over different values of org_code. In a bit more detail, our loop will:

+ set up a sequence composed of each of the org_codes in the data
  + actually, I will cheat here. There are 274 orgs in the dataset, and so we'll just look at a random sample of 10 to avoid making a document that takes an eternity to knit.
+ we'll then loop over that sequence, and for each org code it will:
  + print an Rmarkdown header in a new subsection tab
  + print a little bit of explanatory text
  + print a table summarising the admissions data for that organisation
  + display a small graph, showing how the total admissions for that organisation compares with the other 273 orgs in the data

Let's look at the example first, with no code, and then we'll work through each of the stages above to explain how all of the parts fit together.

### Example {.tabset}

```{r loop-ex, echo=F, fig.height=1.5, fig.width=4, results='asis'}
# worth looking at the chunk headers for the example and explanation. We don't repeat the code in this section, but we just re-use the example chunk with different chunk options to show the code rather than the output. https://bookdown.org/yihui/rmarkdown-cookbook/reuse-chunks.html is a good place to start if this is of interest.

# note that our loop just displays things in our document, so we don't bother to create an output here

# create a vector of sample orgs to simplify the for() call and filter() indirection later on
orgs_seq <- as.character(sample(ae_attendances %>% 
                                  distinct(org_code) %>% 
                                  arrange(org_code) %>% 
                                  pull(), 20)
                         ) 

# print a single header message outside the body of the loop telling the reader what to expect
cat(glue("In this section we present a summary of admissions data, grouped by type of admission, for a sample of {length(orgs_seq)} organisations.  \n  \n")) 

# set up the main body of the loop
for (i in seq_along(orgs_seq)) {
  
    # calculating the total admissions for our org - we use this in the explanatory text, and in the graph
    org_total_admissions <- ae_attendances %>%
            filter(org_code == orgs_seq[i]) %>%
            summarise(sum(attendances)) %>%
            pull()
    
    # customised 4th level header containing org_code
    cat("  \n")
    cat(glue("  \n  \n#### {orgs_seq[i]} attendances  \n  \n"))
    cat("  \n")
    
    # customised explanatory text
    cat(glue("Some explanatory text: {orgs_seq[i]} had a total of {org_total_admissions} admissions.  \n"))
    
    # use kable() to display a summary of the data
    print(ae_attendances %>%
      drop_na(org_code) %>%
      filter(org_code == orgs_seq[i]) %>%
      group_by(type) %>%
      summarise(attendances = sum(attendances)) %>%
      knitr::kable()
      )
    
    cat("  \n") # otherwise the graph won't print - see https://github.com/yihui/knitr/issues/886
    
    # histogram of admissions across orgs, for comparison
    print(ae_attendances %>%
      group_by(org_code) %>%
      summarise(attendances = sum(attendances)) %>%
      ggplot() +
      geom_histogram(aes(x=attendances), bins=10) +
      geom_vline(xintercept=org_total_admissions) +
      xlab("Total admissions") +
      ylab("n orgs") +
      geom_label(aes(x=org_total_admissions, y=60), label = paste0(org_total_admissions, " total"), nudge_x = 0.35, size = 3)) + # label showing value of admissions for this org
      xlim(0,2000000) #little cheat to keep the label from being cut off for very high values

    cat("  \n") # absolutely essential - see https://github.com/yihui/knitr/issues/886
}

```

### Explanation
```{r, loop-ex, eval=F}
```