Advanced R - Hadley Wickham Ch 10 Function Factories

class: center, middle, inverse, title-slide

# Advanced R - Hadley Wickham <br> Ch 10 Function Factories
## R Ladies Netherlands Boookclub
### Sarah Stolle, August 4, 2020

---

# Welcome!

- This is joint effort between RLadies Nijmegen, Rotterdam,
's-Hertogenbosch (Den Bosch), Amsterdam and Utrecht 
--

- We meet every 2 weeks to go through a chapter 
--

- Use the HackMD to present yourself, ask questions and see your breakout room 
--

- We split in breakout rooms after the presentation, and we return to the main jitsi link after xx min  
--

- There are still possibilities to present a chapter :) Sign up at https://rladiesnl.github.io/book_club/  
--

- https://advanced-r-solutions.rbind.io/ has some anwers and we could PR the ones missing  
--

- The R4DS book club repo has a Q&A section.https://github.com/r4ds/bookclub-Advanced_R

---

# Functional programming - Chp 9, 10 and 11

---
# What are Function factories?

> Functions that create functions

* Not super popular or known
* BUT good to know they exist
* helpful to write better code

---
# General explanation of Function factories

* Nested functions
* In most cases -> one internal function

---
# Code example of exponent function factory

A simple power function

```r
power1 <- function(exp) {
  function(x) {
    x ^ exp
  }
}

square <- power1(2)
cube <- power1(3)

square(2)
# 4

# also possible
power1(2)(2)
```

---
# Force evaluation - function in a state of suspense

* Calling the first function, creates an instance of it, but does not evaluate it
* To force execution of the variables in the first function upon instantiation, wrap variables with `force(var)`.

---
# Stateful functions

* The environment (scope) of the first function can "remember" variables, i.e. create a "state"
* Usually after the function is executed the "execution environment" is discarded. 
* In this case the execution environment is in the secondary internal function. The outer function continues to exist.

```r
generic_function(5)
# Output 
#> function() counter <<- counter + 
#> <bytecode: 0x4968f00>
#> <environment: 0x4a8f740>

generic_function(5)()
# counter = 6
```

---
# Examples: Ggplot - ggsave

- Option with multiple internal function -> `switch`

```r
plot_dev <- function(ext, dpi = 96) {
  force(dpi)
  
  switch(ext,
    pdf = function(filename, ...) grDevices::pdf(file = filename, ...),
    svg = function(filename, ...) svglite::svglite(file = filename, ...),
    png = function(...) grDevices::png(..., res = dpi, units = "in"),
    stop("Unknown graphics extension: ", ext, call. = FALSE)
  )
}

plot_dev("pdf")
#> function(filename, ...) grDevices::pdf(file = filename, ...)
#> <bytecode: 0x4968f00>
#> <environment: 0x4a8f740>
plot_dev("png")
#> function(...) grDevices::png(..., res = dpi, units = "in")
#> <bytecode: 0x5992f28>
#> <environment: 0x5f34518>
```

---
# Examples: Bootstrap sampling

- Save state in outer function
- Resample in inner function

```r
boot_model <- function(df, formula) {
  mod <- lm(formula, data = df)
  fitted <- unname(fitted(mod))
  resid <- unname(resid(mod))
  rm(mod)

function() {
    fitted + sample(resid)
  }
}

boot_mtcars2 <- boot_model(mtcars, mpg ~ wt)
head(boot_mtcars2())
#> [1] 25.0 24.0 21.7 19.2 24.9 16.0
head(boot_mtcars2())
#> [1] 27.4 21.0 20.3 19.4 16.3 21.3
```

---
# Exercises 1

.panelset[
.panel[.panel-name[Question]

> Why is it better to force(x) instead of just x?

Definition of force

```r
force
> function (x) 
> x
> <bytecode: 0x1fd9660>
> <environment: namespace:base>
```
]

.panel[.panel-name[Answer]

As you can see `force(x)` is just syntactic sugar for `x`. We prefer this explicit form, because “using this function clearly indicates that you’re forcing evaluation, not that you’ve accidentally typed `x`.” (Quote from the textbook).

]
]

---
# Exercise 2

.panelset[
.panel[.panel-name[Question]

> Base R contains two function factories, approxfun() and ecdf(). Read their documentation and experiment to figure out what the functions do and what they return.
]

.panel[.panel-name[Answer]

Let’s begin with `approxfun()` as it is used within `ecdf()`also:

- `approxfun()` takes a 2-dimensional combination of data points (`x` and `y`) as input and returns a stepwise interpolation function, which transforms new `x` values. Additional arguments control how the created function should behave. (The interpolation method may be linear or constant. `yleft`, `yright` and `rule` specify how the newly created function should map new values which are outside of `range(x)`. `f` controls the degree of right-left-continuity via a numeric value from `0` to `1` and `ties` expects a function name like min, mean etc. which defines how non-unique x-y-combinations should be handled when interpolating the data points.)

- `ecdf()` is an acronym for empirical cumulative distribution function. For a numeric vector, `ecdf()` returns the appropriate distribution function (of class “ecdf”, which is inheriting from class “stepfun”). Initially the (x, y) pairs for the nodes of the density function are calculated. Afterwards these pairs are passed to `approxfun()`, which then returns the desired function.

]
]

---
# Exercise 3

.panelset[
.panel[.panel-name[Question]

> Create a function `pick()` that takes an index, `i`, as an argument and returns a function with an argument `x` that subsets `x` with `i`.

```r
pick(1)(x)
# should be equivalent to
x[[1]]

lapply(mtcars, pick(5))
# should be equivalent to
lapply(mtcars, function(x) x[[5]])
```

]

.panel[.panel-name[Answer]

```r
pick <- function(i) {
  force(i)

function(x) x[[i]]
}

x <- 1:3
identical(x[[1]], pick(1)(x))
#> [1] TRUE
identical(lapply(mtcars, function(x) x[[5]]),
          lapply(mtcars, pick(5)))
#> [1] TRUE
```
]
]

---
# Exercise 4

.panelset[
.panel[.panel-name[Question]

> Create a function that creates functions that compute the ith central moment of a numeric vector. You can test it by running the following code:

```r
m1 <- moment(1)
m2 <- moment(2)

x <- runif(100)
stopifnot(all.equal(m1(x), 0))
stopifnot(all.equal(m2(x), var(x) * 99 / 100))
```
]

.panel[.panel-name[Answer]

The first moment is closely related to the mean and describes the average deviation from the mean, which is 0 (within numerical margin of error). The second moment describes the variance of the input data. If we want compare it to var, we need to undo [Bessel’s correction](https://en.wikipedia.org/wiki/Bessel%27s_correction) correction by multiplying with (N−1)/N.

```r
moment <- function(i){
  force(i)

function(x) sum((x - mean(x)) ^ i) / length(x)
}

m1 <- moment(1)
m2 <- moment(2)

x <- runif(100)
all.equal(m1(x), 0)  # removed stopifnot() for clarity
#> [1] TRUE
all.equal(m2(x), var(x) * 99 / 100)
#> [1] TRUE
```

]
]

---
# Exercise 5

.panelset[
.panel[.panel-name[Question]

> What happens if you don’t use a closure? Make predictions, then verify with the code below.

```r
i <- 0
new_counter2 <- function() {
  i <<- i + 1
  i
}
```
]

.panel[.panel-name[Answer]

```r
new_counter2()
#> [1] 1
i
#> [1] 1
new_counter2()
#> [1] 2
i
#> [1] 2

i <- 0
new_counter2()
#> [1] 1
i
#> [1] 1
```
]
]

---
# Exercise 6

.panelset[
.panel[.panel-name[Question]

> What happens if you use `<-` instead of `<<-`? Make predictions, then verify with the code below.

```r
new_counter3 <- function() {
  i <- 0
  function() {
    i <- i + 1
    i
  }
}
```
]

.panel[.panel-name[Answer]

Without the super assignment `<<-`, the counter will always return `1`. The counter always starts in a new execution environment within the same enclosing environment, which contains an unchanged value for `i` (in this case it remains `0`).

```r
new_counter_3 <- new_counter3()

new_counter_3()
#> [1] 1
new_counter_3()
#> [1] 1
```

]
]

---
# Exercise 7

.panelset[
.panel[.panel-name[Question]

> In `boot_model()`, why don’t I need to force the evaluation of `df` or `model`?

]

.panel[.panel-name[Answer]

`boot_model()` ultimately returns a function, and whenever you return a function you need to make sure all the inputs are explicitly evaluated. Here that happens automatically because we use df and formula in `lm()`.

```r
boot_model <- function(df, formula) {
  mod <- lm(formula, data = df)
  fitted <- unname(fitted(mod))
  resid <- unname(resid(mod))
  rm(mod)

function() {
    fitted + sample(resid)
  }
} 
```

]
]

---
# Exercise 8

.panelset[
.panel[.panel-name[Question]

> Why might you formulate the Box-Cox transformation like this?

```r
boxcox3 <- function(x) {
  function(lambda) {
    if (lambda == 0) {
      log(x)
    } else {
      (x ^ lambda - 1) / lambda
    }
  }  
}
```

]

.panel[.panel-name[Answer]

`boxcox3()` returns a function where `x` is fixed (though it is not forced, so it may manipulated later). This allows us to apply and test different transformations for different inputs and give them a descriptive name.
 
]
]

---
# Exercise 9

.panelset[
.panel[.panel-name[Question]

> Why don’t you need to worry that `boot_permute()` stores a copy of the data inside the function that it generates?

]

.panel[.panel-name[Answer]

Because it doesn’t actually store a copy; it’s just a name that points to the same underlying object in memory.

```r
boot_permute <- function(df, var) {
  n <- nrow(df)
  force(var)

function() {
    col <- df[[var]]
    col[sample(n, replace = TRUE)]
  }
}
boot_mtcars1 <- boot_permute(mtcars, "mpg")

lobstr::obj_size(mtcars)
#> 7,208 B
lobstr::obj_size(boot_mtcars1)
#> 23,296 B
lobstr::obj_sizes(mtcars, boot_mtcars1)
#> *  7,208 B
#> * 16,088 B
```
]
]

---
# Exercise 10

.panelset[
.panel[.panel-name[Question]

> How much time does `ll_poisson2()` save compared to `ll_poisson1()`? Use `bench::mark()` to see how much faster the optimisation occurs. How does changing the length of `x`change the results?

```r
# Definition of ll_poisson1 and ll_poisson2 
ll_poisson1 <- function(x) {
  n <- length(x)

function(lambda) {
    log(lambda) * sum(x) - n * lambda - sum(lfactorial(x))
  }
}

ll_poisson2 <- function(x) {
  n <- length(x)
  sum_x <- sum(x)
  c <- sum(lfactorial(x))

function(lambda) {
    log(lambda) * sum_x - n * lambda - c
  }
}
```

]

.panel[.panel-name[Answer]

A benchmark with this data reveals a performance improvement of factor 2 for `ll_poisson2()` over `ll_poisson1()`

```r
# provided test data
x1 <- c(41, 30, 31, 38, 29, 24, 30, 29, 31, 38)

bench::mark(
  llp1 = optimise(ll_poisson1(x1), c(0, 100), maximum = TRUE),
  llp2 = optimise(ll_poisson2(x1), c(0, 100), maximum = TRUE)
)
#> # A tibble: 2 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 llp1         30.2µs   34.1µs    28225.    12.8KB     22.6
#> 2 llp2           15µs   17.1µs    55183.        0B     22.1
```

]
.panel[.panel-name[Answer 2]

Regarding differing lengths of x1, we expect even further performance improvements of `ll_poisson2()` compared to `ll_poisson1()`, as the redundant calculations within `ll_poisson1()`, become more expensive with growing length of `x1`. The following results imply that for a length of `x1` of `100000`, `ll_poisson2()` is about 20+ times as fast as `ll_poisson1()`:

]
]

---
# Exercise 11

.panelset[
.panel[.panel-name[Question]

> Which of the following commands is equivalent to `with(x, f(z))`?

1. `x$f(x$z)`.
2. `f(x$z)`.
3. `x$f(z)`.
4. `f(z)`.
5. It depends.

]

.panel[.panel-name[Answer]

5) “It depends” is the correct answer. Usually `with()` is used with a data frame, so you’d usually expect (2), but if `x` is a list, it could be any of the options.

```r
f <- mean
z <- 1
x <- list(f = mean, z = 1)

identical(with(x, f(z)), x$f(x$z))
#> [1] TRUE
identical(with(x, f(z)), f(x$z))
#> [1] TRUE
identical(with(x, f(z)), x$f(z))
#> [1] TRUE
identical(with(x, f(z)), f(z))
#> [1] TRUE
```

]
]

---
# Exercise 12

.panelset[
.panel[.panel-name[Question]

> Compare and contrast the effects of env_bind() vs. attach() for the following code.

```r
funs <- list(
  mean = function(x) mean(x, na.rm = TRUE),
  sum = function(x) sum(x, na.rm = TRUE)
)

attach(funs)
#> The following objects are masked from package:base:
#> 
#>     mean, sum
mean <- function(x) stop("Hi!")
detach(funs)

env_bind(globalenv(), !!!funs)
mean <- function(x) stop("Hi!") 
env_unbind(globalenv(), names(funs))
```
]

.panel[.panel-name[Answer]

`attach()` adds funs to the search path. Therefore, the provided functions are found before their respective versions from the base package. Further, they can not get accidently overwritten by similar named functions in the global environment. One annoying downsinde of using `attach()` is the possibility to attach the same object multiple times, making it necessary to call `detach()` equally often.

In contrast `rlang::env_bind()` just adds the functions in fun to the global environment. No further side effects are introduced and the functions are overwritten when similarly named functions are defined.

]
]

---

# Thanks to:

- Hadley Wickham for writing [AdvancedR](https://adv-r.hadley.nz/)
- R Core Team (2020). R: A language and environment for statistical computing. R Foundation for Statistical Computing,
  Vienna, Austria. [URL](https://www.R-project.org/).  
- Yihui Xie (2020). [xaringan](https://CRAN.R-project.org/package=xaringan): Presentation Ninja. R package version 0.16. 
- Garrick Aden-Buie (2020). [xaringanExtra](https://github.com/gadenbuie/xaringanExtra): Extras And Extensions for Xaringan Slides. R package version 0.0.17.

and all the authors of R packages used in this presentation

---