Lecture 401

class: center, middle, inverse, title-slide

.title[
# Lecture 401
]
.author[
### Dr Stefano De Sabbata<br /><small>School of Geography, Geology, and the Env., University of Leicester<br /><a href="https://github.com/sdesabbata/r-for-geographic-data-science" style="color: white">github.com/sdesabbata/r-for-geographic-data-science</a><br /><a href="mailto:s.desabbata@le.ac.uk" style="color: white">s.desabbata@le.ac.uk</a> | <a href="https://twitter.com/maps4thought" style="color: white">@maps4thought</a><br />text licensed under <a href="https://creativecommons.org/licenses/by-sa/4.0/" style="color: white">CC BY-SA 4.0</a>, code licensed under <a href="https://www.gnu.org/licenses/gpl-3.0.html" style="color: white">GNU GPL v3.0</a></small>
]

---

class: inverse, center, middle

# R scripting

---
## Recap

.pull-left[

<br/>

**Prev**: Regression analysis

- Simple regression
- Multiple regression
- Comparing models

**Today**: R scripting

- Conditional statements
- Conditional and deterministic loops
- Working with functions
- Practical: *Group work!*

]
.pull-right[

```
## I am in a loop.
## I am in a loop..
## I am in a loop...
## I am in a loop....
## I am in a loop.....
## I am in a loop......
## I am in a loop.......
## I am in a loop........
## I am in a loop.........
## I am in a loop..........
## I am in a loop...........
## I am in a loop............
## I am in a loop.............
## I am in a loop..............
## I am in a loop...............
## I am in a loop................
## I am in a loop.................
## I am in a loop..................
## I am in a loop...................
## I am in a loop....................
## I am in a loop.....................
## I am in a loop......................
## I am in a loop.......................
## I am in a loop........................
## I am in a loop.........................
## I am in a loop..........................
## I am in a loop...........................
```

]

---
## Control structures

.pull-left[

<br/>

Building blocks of programming

- So far, *simple scripting*
   - series of single steps to achieve an output
   - independent from input or current environment

- Control flow
  - actual (imperative) programming
  - including
    - choice statements
    - loops

]
.pull-right[

![](data:image/png;base64,#images/control-flow-example.png)

.referencenote[
Example of control flow for a correlation analysis
]

]

---
## Conditional statements: if

<br/>

Format: **if** (*condition*) *statement*

- *condition*: expression returning a logic value (`TRUE` or `FALSE`)
- *statement*: any valid R statement
- *statement* only executed if *condition* is `TRUE`

```r
a_value <- -7
if (a_value < 0) cat("Negative")
```

```
## Negative
```

```r
a_value <- 8
if (a_value < 0) cat("Negative")
```

---
## Conditional statements: if / else

Format: **if** (*condition*) *statement1* **else** *statement2*

- *condition*: expression returning a logic value (`TRUE` or `FALSE`)
- *statement1* and *statement2*: any valid R statements
- *statement1*  executed if *condition* is `TRUE`
- *statement2*  executed if *condition* is `FALSE`

```r
a_value <- -7
if (a_value < 0) cat("Negative") else cat("Positive")
```

```
## Negative
```

```r
a_value <- 8
if (a_value < 0) cat("Negative") else cat("Positive")
```

```
## Positive
```

```r
a_value <- 0
if (a_value < 0) cat("Negative") else if (a_value == 0) cat("Zero") else cat("Positive")
```

```
## Zero
```

---
## Code blocks

**Code blocks** allow to encapsulate **several** statements in a single group

- `{` and `}` contain code blocks
- the statements are execute together

.pull-left[

```r
first_value <- 8
second_value <- 5

if (first_value > second_value) {
  cat("The first value is higher\n")
  difference <- first_value - second_value
  cat("The difference is ", difference, "\n")
}
```

```
## The first value is higher
## The difference is  3
```

]
.pull-right[

```r
first_value <- 2
second_value <- 5

if (first_value > second_value) {
  cat("The first value is higher\n")
  difference <- first_value - second_value
  cat("The difference is ", difference, "\n")
} else {
  cat("The first value is lower or equal\n")
  difference <- first_value - second_value
  cat("The difference is ", difference, "\n")
}
```

```
## The first value is lower or equal
## The difference is  -3
```

]

---
## dplyr::if_else

Allows to use conditional statements in `mutate`

.pull-left[

```r
leicester_2011OAC %>% 
  select(OA11CD, u006) %>% 
  slice_head(n = 5) %>% 
  kable()
```

]
.pull-right[

```r
leicester_2011OAC %>% 
  select(OA11CD, u006) %>% 
  mutate(
    density_cat = if_else(
      u006 < 100,
      "low density", "high density"
    )
  ) %>% 
  slice_head(n = 5) %>% 
  kable()
```

]

.pull-left[

]
.pull-right[

]

---
## dplyr::case_when

Allows to specify multiple conditions in a sort manner

- similar to base R [`switch`](https://stat.ethz.ch/R-manual/R-devel/library/base/html/switch.html)

.pull-left[

```r
leicester_2011OAC %>% 
  select(OA11CD, u006) %>% 
  mutate(
    density_cat = case_when(
      u006 < 1 ~ "very low",
      u006 < 10 ~ "low",
      u006 < 100 ~ "medium",
      u006 < 1000 ~ "high",
      TRUE ~ "very high",
    )
  ) %>% 
  slice_head(n = 5) %>% 
  kable()
```

]
.pull-right[

<table>
 <thead>
  <tr>
   <th style="text-align:left;"> OA11CD </th>
   <th style="text-align:right;"> u006 </th>
   <th style="text-align:left;"> density_cat </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> E00069517 </td>
   <td style="text-align:right;"> 33.69214 </td>
   <td style="text-align:left;"> medium </td>
  </tr>
  <tr>
   <td style="text-align:left;"> E00069514 </td>
   <td style="text-align:right;"> 131.30081 </td>
   <td style="text-align:left;"> high </td>
  </tr>
  <tr>
   <td style="text-align:left;"> E00169516 </td>
   <td style="text-align:right;"> 240.14085 </td>
   <td style="text-align:left;"> high </td>
  </tr>
  <tr>
   <td style="text-align:left;"> E00169048 </td>
   <td style="text-align:right;"> 104.22961 </td>
   <td style="text-align:left;"> high </td>
  </tr>
  <tr>
   <td style="text-align:left;"> E00169044 </td>
   <td style="text-align:right;"> 99.07692 </td>
   <td style="text-align:left;"> medium </td>
  </tr>
  <tr>
   <td style="text-align:left;"> E00069041 </td>
   <td style="text-align:right;"> 51.30568 </td>
   <td style="text-align:left;"> medium </td>
  </tr>
  <tr>
   <td style="text-align:left;"> E00169049 </td>
   <td style="text-align:right;"> 42.53165 </td>
   <td style="text-align:left;"> medium </td>
  </tr>
  <tr>
   <td style="text-align:left;"> E00068806 </td>
   <td style="text-align:right;"> 57.77778 </td>
   <td style="text-align:left;"> medium </td>
  </tr>
  <tr>
   <td style="text-align:left;"> E00068886 </td>
   <td style="text-align:right;"> 122.87105 </td>
   <td style="text-align:left;"> high </td>
  </tr>
  <tr>
   <td style="text-align:left;"> E00068807 </td>
   <td style="text-align:right;"> 76.21053 </td>
   <td style="text-align:left;"> medium </td>
  </tr>
</tbody>
</table>

]

---
class: inverse, center, middle

# Loops

---
## Loops

.pull-left[

<br/>

Loops are a fundamental component of (procedural) programming

- they allow to execute the same code multiple times

There are two main types of loops:

- **conditional** loops 
  - executed as long as a defined condition holds true
  - construct `while`
  - construct `repeat`
- **deterministic** loops 
  - are executed a pre-determined number of times
  - construct `for`

]
.pull-right[

```
## This is the output of a program in a loop... 1 
## This is the output of a program in a loop... 2 
## This is the output of a program in a loop... 3 
## This is the output of a program in a loop... 4 
## This is the output of a program in a loop... 5 
## This is the output of a program in a loop... 6 
## This is the output of a program in a loop... 7 
## This is the output of a program in a loop... 8 
## This is the output of a program in a loop... 9 
## This is the output of a program in a loop... 10 
## This is the output of a program in a loop... 11 
## This is the output of a program in a loop... 12 
## This is the output of a program in a loop... 13 
## This is the output of a program in a loop... 14 
## This is the output of a program in a loop... 15 
## This is the output of a program in a loop... 16 
## This is the output of a program in a loop... 17 
## This is the output of a program in a loop... 18 
## This is the output of a program in a loop... 19 
## This is the output of a program in a loop... 20 
## This is the output of a program in a loop... 21 
## This is the output of a program in a loop... 22 
## This is the output of a program in a loop... 23 
## This is the output of a program in a loop... 24 
## This is the output of a program in a loop... 25 
## This is the output of a program in a loop... 26 
## This is the output of a program in a loop... 27
```

]

---
## Loop construct: while

.pull-left[

- Defined using `while` (reserved word)
  - followed by a conditional statement between brackets
  - and a code block
- The instructions in the code block are re-executed 
  - as long as the result of the evaluation of the conditional statement is `TRUE`

```r
current_value <- 0

while (current_value <= 4) {
  cat("Start of the block")
  cat("  the value is", current_value, "\n")
  current_value <- current_value + 1
  cat("  after summing 1 to it\n")
  cat("  the value is now", current_value, "\n")
  cat("End of the block, loop back...\n")
  cat("\n")
}
cat("The loop ended, the value is now", current_value, "\n")
```

]
.pull-right[

```
## Start of the block  the value is 0 
##   after summing 1 to it
##   the value is now 1 
## End of the block, loop back...
## 
## Start of the block  the value is 1 
##   after summing 1 to it
##   the value is now 2 
## End of the block, loop back...
## 
## Start of the block  the value is 2 
##   after summing 1 to it
##   the value is now 3 
## End of the block, loop back...
## 
## Start of the block  the value is 3 
##   after summing 1 to it
##   the value is now 4 
## End of the block, loop back...
## 
## Start of the block  the value is 4 
##   after summing 1 to it
##   the value is now 5 
## End of the block, loop back...
```

```
## The loop ended, the value is now 5
```

]

---
## Loop construct: repeat

.pull-left[

- Defined using `repeat` (reserved word)
  - followed by a code block
- The instructions in the code block are re-executed 
  - until the command `break` is given

**CAN BE DANGEROUS, USE AT YOUR OWN PERIL** 😅

```r
current_value <- 0

repeat {
  cat("Start of the block")
  cat("  the value is", current_value, "\n")
  current_value <- current_value + 1
  cat("  after summing 1 to it\n")
  cat("  the value is now", current_value, "\n")
  cat("End of the block, loop back...\n")
  cat("\n")
  if(current_value > 4) break
}
cat("The loop ended, the value is now", current_value, "\n")
```

]
.pull-right[

```
## The loop ended, the value is now 5
```

]

<!--
## Repeat

The *repeat* construct can be defined using the `repeat` reserved word, followed by a code block. The instructions in the code block are re-executed until the command `break` is given. The latter is currently given through an `if` construct, which tests the condition that would stop the loop.

```r
current_value <- 0

repeat {
  cat("Current value is", current_value, "\n")
  current_value <- current_value + 1
  if (current_value >= 3) break
}
```

```
## Current value is 0 
## Current value is 1 
## Current value is 2
```

## While vs Repeat
The difference between `while` and `repeat` is mostly syntactical.

- Sometimes one or the other might fit better with the algorithm you have in mind
- Use the one that comes easier to you in the given situation
-->

---
## Loop construct: for

The *for* construct

- Defined using `for` (reserved word)
  - followed by the definition of an **iterator**
    - a variable which is assigned temporarily
    - with values from a vector
  - followed by a code block
- The construct iterates through all elements of the vector
  - the code block instructions are re-executed 
  - once for each element of the vector.

```r
cities <- c("Derby", "Leicester", "Lincoln", "Nottingham")
for (city in cities) {
  cat("Do you live in", city, "?\n")
}
```

```
## Do you live in Derby ?
## Do you live in Leicester ?
## Do you live in Lincoln ?
## Do you live in Nottingham ?
```

---
## Example: histogram for all supergrups

.pull-left[

For instance

- we can loop through all the 2011OAC supergrups
- plot a histogra of population for each one of them

```r
for (
  current_supgrp in
    leicester_2011OAC %>% 
      pull(supgrpname) %>% 
      unique()
  ) {
  current_hist <-
    leicester_2011OAC %>% 
    filter(supgrpname == current_supgrp) %>% 
    ggplot(aes(
      x = Total_Population
    )) +
    geom_histogram() +
    ggtitle(current_supgrp) +
    theme_bw() 
  print(current_hist)
}
```

]
.pull-right[

![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-23-1.png)![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-23-2.png)![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-23-3.png)![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-23-4.png)![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-23-5.png)![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-23-6.png)![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-23-7.png)

]

---
## Example: testing normality for all supergrups

.pull-left[

For instance

- we can loop through all the 2011OAC supergrups
- test the normality of each distribution

```r
for (
  current_supgrp in
    leicester_2011OAC %>% 
      pull(supgrpname) %>% 
      unique()
  ) {
  
  print(current_supgrp)
  leicester_2011OAC %>% 
    filter(supgrpname == current_supgrp) %>% 
    pull(Total_Population) %>%
    shapiro.test() %>% 
    print()
  
}
```

]
.pull-right[

```
## [1] "Suburbanites"
## 
## 	Shapiro-Wilk normality test
## 
## data:  .
## W = 0.96073, p-value = 0.07431
## 
## [1] "Cosmopolitans"
## 
## 	Shapiro-Wilk normality test
## 
## data:  .
## W = 0.88683, p-value = 2.468e-06
## 
## [1] "Multicultural Metropolitans"
## 
## 	Shapiro-Wilk normality test
## 
## data:  .
## W = 0.98359, p-value = 4.727e-06
## 
## [1] "Ethnicity Central"
## 
## 	Shapiro-Wilk normality test
## 
## data:  .
## W = 0.95109, p-value = 0.02205
## 
## [1] "Constrained City Dwellers"
## 
## 	Shapiro-Wilk normality test
## 
## data:  .
## W = 0.97723, p-value = 0.6514
## 
## [1] "Hard-Pressed Living"
## 
## 	Shapiro-Wilk normality test
## 
## data:  .
## W = 0.99088, p-value = 0.7297
## 
## [1] "Urbanites"
## 
## 	Shapiro-Wilk normality test
## 
## data:  .
## W = 0.97356, p-value = 0.1776
```

]

---
## Loops with conditional statements

.pull-left[

.small[

```r
for (
  current_supgrp in
    leicester_2011OAC %>% 
      pull(supgrpname) %>% 
      unique()
  ) {
  
  current_p_value <-
    leicester_2011OAC %>% 
    filter(supgrpname == current_supgrp) %>% 
    pull(Total_Population) %>%
    shapiro.test() %$% 
    p.value
  
  if (current_p_value > 0.01){
    current_hist <-
      leicester_2011OAC %>% 
      filter(supgrpname == current_supgrp) %>% 
      ggplot(aes(
        x = Total_Population
      )) +
      geom_histogram() +
      ggtitle(current_supgrp) +
      theme_bw() 
    print(current_hist)
  } else {
    print(
      paste(
        current_supgrp,
        "is not normally distributed"
      )
    )
  }
  
}
```

]

]
.pull-right[

![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-27-1.png)

```
## [1] "Cosmopolitans is not normally distributed"
## [1] "Multicultural Metropolitans is not normally distributed"
```

![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-27-2.png)![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-27-3.png)![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-27-4.png)![](data:image/png;base64,#/home/rstudio/r-for-geographic-data-science/docs/slides/401-slides-scripting_files/figure-html/unnamed-chunk-27-5.png)

]

---
class: inverse, center, middle

# Functions

---
## Defining functions

.pull-left[

A function can be defined

- using an **identifier** (e.g., `add_one`) 
- the **assignment operator** `<-`
- followed by the corpus of the function
  - starts with the reserved word `function`
  - followed by the **parameter(s)** (e.g., `input_value`) between brackets
  - and the instruction(s) to be executed in a code block
  - the value of the last statement is returned as output

After being defined

- a function can be invoked by specifying 
  - the **identifier**
  - the necessary **parameter(s)**

]
.pull-right[

```r
add_one <- 
  function (input_value) {
    output_value <- input_value + 1
    output_value
  }
```

```r
add_one(3)
```

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

```r
add_one(1024)
```

```
## [1] 1025
```

]

---
## Adding complexity

.pull-left[

- A function can be defined as having two or more **parameters** 
  - by specifying  more than one parameter name (separated by **commas**) in the function definition
- A function always take as input as many values as the number of parameters specified in the definition
  - otherwise an error is generated

```r
percentage_of <- 
  function (original_value, total) {
    prop <- original_value / total
    perc <- prop * 100
    perc
  }

percentage_of(4, 5)
```

```
## [1] 80
```

]
.pull-right[

Functions can contain both loops and conditional statements

```r
percentage_of <- 
  function (original_value, total) {
    if (
      (original_value < total) &
      (total > 0)
    ) {
      prop <- original_value / total
      perc <- prop * 100
      perc
    } else {
      NA
    }
  }

percentage_of(4, 5)
```

```
## [1] 80
```

```r
percentage_of(4, 3)
```

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

]

---
## Scope

.pull-left[

<br/>

The **scope of a variable** is the part of code in which the variable is *"visible"*

In R, variables have a **hierarchical** scope:

- a variable defined in a script can be used referred to from within a definition of a function in the same script
- a variable defined within a definition of a function will **not** be referable from outside the definition
- scope does **not** apply to `if` or loop constructs

]
.pull-right[

In the example

- `total` is now **global** to the function `times_x`
- `original_value` is **local** to the function `percentage_of`

```r
total <- 5

percentage_of <- 
  function (original_value) {
    prop <- original_value / total
    perc <- prop * 100
    perc
  }

percentage_of(4)
```

```
## [1] 80
```

**DO NOT DO THIS, IT'S VERY DANGEROUS!**  😅

]

---
## What is debugging?

.pull-left[

Hardly any reasonably sized function works first time!

- Two broad kinds of problem
    - The function crashes (i.e. throws up an error)
    - The function doesn't crash  but returns the wrong answer
      - More difficult to fix
- Prevention is better than cure, test the code as you write.

**Debugging** is the process of finding the problems in the code.

- *"Steping through"* the function line by line.
- Check the values of variables, and see if they are doing what they are supposed to.

]
.pull-right[

R has tools to help with this.

- Enter `debug( <<Function Name>> )`
- For example: `debug(area.tri)`
- Then just use the function - it goes into 'debug mode'.
- Prompt becomes `Browse>`
  - Return executes current line
  - Typing in any command executes it
  - Typing in `c` and the return runs to the end of a function/block
  - Typing in `Q` exits the function
- R can `see' variables that are specific to the function
- Enter `undebug(<<Function Name>>)` to return to normal

]

---
## Writing functions for dplyr

.pull-left[

This is a base R function, not designed to work within the Tidyverse

- each one of the input is expected to be a number
- can be applied to vectors
  - thus could work with dataframe columns
  - but not easily

]
.pull-right[

```r
percentage_of <- 
  function (original_value, total) {
    prop <- original_value / total
    perc <- prop * 100
    perc
  }

percentage_of(
  c(1, 2, 3, 4), 
  5
)
```

```
## [1] 20 40 60 80
```

```r
my_data <- data.frame(
  case_id = c("A", "B", "C", "D"),
  case_val = c(1, 2, 3, 4)
)

my_data %$% 
  percentage_of(case_val, 5)
```

```
## [1] 20 40 60 80
```

]

---
## Writing functions for dplyr

.pull-left[

To design functions for the Tidyverse

- first parameter should expect a tibble
- subsequent parameters should expect 
  - columns
    - need to **embrace** arguments with doubled braces `{{` to use it
  - additional parameters

]
.pull-right[

```r
percentage_of <- 
  function (data, var_col, total) {
    data %>% 
      mutate(
        perc = ({{ var_col }} / total) * 100
      )
  }

my_data <- tibble(
  case_id = c("A", "B", "C", "D"),
  case_val = c(1, 2, 3, 4)
)

my_data %>% 
  percentage_of(case_val, 5) %>% 
  kable()
```

]

---
## A more complex example

Using the operator `:=` to use input column names to create output column names

.pull-left[

```r
percentage_of <- 
  function (data, var_col, total_col) {
    data %>%
      mutate(
        "perc_{{var_col}}_over_{{total_col}}" :=
          ({{ var_col }} / {{ total_col }}) * 100
      )
  }
```

]
.pull-right[

```r
my_data_2 <- tibble(
  case_id = c("A", "B", "C", "D"),
  case_val = c(1, 2, 3, 4),
  case_total = c(4, 4, 6, 6)
)

my_data_2 %>% 
  percentage_of(case_val, case_total) %>% 
  kable()
```

]

<table>
 <thead>
  <tr>
   <th style="text-align:left;"> case_id </th>
   <th style="text-align:right;"> case_val </th>
   <th style="text-align:right;"> case_total </th>
   <th style="text-align:right;"> perc_case_val_over_case_total </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> A </td>
   <td style="text-align:right;"> 1 </td>
   <td style="text-align:right;"> 4 </td>
   <td style="text-align:right;"> 25.00000 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> B </td>
   <td style="text-align:right;"> 2 </td>
   <td style="text-align:right;"> 4 </td>
   <td style="text-align:right;"> 50.00000 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> C </td>
   <td style="text-align:right;"> 3 </td>
   <td style="text-align:right;"> 6 </td>
   <td style="text-align:right;"> 50.00000 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> D </td>
   <td style="text-align:right;"> 4 </td>
   <td style="text-align:right;"> 6 </td>
   <td style="text-align:right;"> 66.66667 </td>
  </tr>
</tbody>
</table>

---
## Summary

.pull-left[

<br/>

**Today**: R scripting

- Conditional statements
- Conditional and deterministic loops
- Working with functions
- Practical: *Group work!*

... and that's all folks! 👋 😊

<br/>

.referencenote[
Slides created via the R package [**xaringan**](https://github.com/yihui/xaringan). The chakra comes from [remark.js](https://remarkjs.com), [**knitr**](https://yihui.org/knitr), and [R Markdown](https://rmarkdown.rstudio.com).
]

]
.pull-right[

]