18_Expressions.Rmd

```{r, include = FALSE}
source("common.R")
```

# (PART) Metaprogramming {-} 
\stepcounter{chapter}
\stepcounter{chapter}

# Expressions
<!-- 18 -->

## Prerequisites {-}
<!-- 18.0 -->

To capture and compute on expressions, and to visualise them, we will load the `{rlang}` [@rlang] and the `{lobstr}` [@lobstr] packages.

```{r setup, message = FALSE}
library(rlang)
library(lobstr)
```

\stepcounter{section}
## Abstract syntax trees
<!-- 18.2 -->

__[Q1]{.Q}__: Reconstruct the code represented by the trees below:

```{r, echo = FALSE}
ast(f(g(h())))

ast(1 + 2 + 3)

ast((x + y) * z)
```

__[A]{.solved}__: Let the source (of the code chunks above) be with you and show you how the ASTs (abstract syntax trees) were produced.

```{r}
ast(f(g(h())))

ast(1 + 2 + 3)

ast((x + y) * z)
```

__[Q2]{.Q}__: Draw the following trees by hand then check your answers with `ast()`.

```{r, eval = FALSE}
f(g(h(i(1, 2, 3))))
f(1, g(2, h(3, i())))
f(g(1, 2), h(3, i(4, 5)))
```

__[A]{.solved}__: Let us delegate the drawing to the `{lobstr}` package.

```{r}
ast(f(g(h(i(1, 2, 3)))))

ast(f(1, g(2, h(3, i()))))

ast(f(g(1, 2), h(3, i(4, 5))))
```

__[Q3]{.Q}__: What's happening with the ASTs below? (Hint: carefully read `?"^"`)

```{r}
ast(`x` + `y`)
ast(x ** y)
ast(1 -> x)
```

__[A]{.solved}__: ASTs start function calls with the name of the function. This is why the call in the first expression is translated into its prefix form. In the second case, `**` is translated by R's parser into `^`. In the last AST, the expression is flipped when R parses it:

```{r}
str(expr(x ** y))
str(expr(a -> b))
```

__[Q4]{.Q}__: What is special about the AST below? (Hint: re-read section [6.2.1](https://adv-r.hadley.nz/functions.html#fun-components))

```{r}
ast(function(x = 1, y = 2) {})
```

__[A]{.solved}__: The last leaf of the AST is not explicitly specified in the expression. Instead, the `srcref` attribute, which points to the functions source code, is automatically created by base R.

__[Q5]{.Q}__: What does the call tree of an `if` statement with multiple `else if` conditions look like? Why?

__[A]{.solved}__: The AST of nested `else if` statements might look a bit confusing because it contains multiple curly braces. However, we can see that in the `else` part of the AST just another expression is being evaluated, which happens to be an `if` statement and so forth.

```{r}
ast(
  if (FALSE) {
    1
  } else if (FALSE) {
    2
  } else if (TRUE) {
    3
  }
)
```

We can see the structure more clearly if we avoid the curly braces:

```{r}
ast(
  if (FALSE) 1 
  else if (FALSE) 2 
  else if (TRUE) 3
)
```

## Expressions
<!-- 18.3 -->

__[Q1]{.Q}__: Which two of the six types of atomic vector can't appear in an expression?  Why? Similarly, why can't you create an expression that contains an atomic vector of length greater than one?

__[A]{.solved}__: There is no way to create raws and complex atomics without using a function call (this is only possible for imaginary scalars like `i`, `5i` etc.). But expressions that include a function are *calls*. Therefore, both of these vector types cannot appear in an expression.

Similarly, it is not possible to create an expression that evaluates to an atomic of length greater than one without using a function (e.g. `c()`).

Let's make this observation concrete via an example:

```{r}
# Atomic
is_atomic(expr(1))

# Not an atomic (although it would evaluate to an atomic)
is_atomic(expr(c(1, 1)))
is_call(expr(c(1, 1)))
```

__[Q2]{.Q}__: What happens when you subset a call object to remove the first element, e.g. `expr(read.csv("foo.csv", header = TRUE))[-1]`. Why?

__[A]{.solved}__: When the first element of a call object is removed, the second element moves to the first position, which is the function to call. Therefore, we get `"foo.csv"(header = TRUE)`.

__[Q3]{.Q}__: Describe the differences between the following call objects.

```{r, results = FALSE}
x <- 1:10

call2(median, x, na.rm = TRUE)
call2(expr(median), x, na.rm = TRUE)
call2(median, expr(x), na.rm = TRUE)
call2(expr(median), expr(x), na.rm = TRUE)
```

__[A]{.solved}__: The call objects differ in their first two elements, which are in some cases evaluated before the call is constructed. In the first one, both `median()` and `x` are evaluated and inlined into the call.  Therefore, we can see in the constructed call that median is a generic and the `x` argument is 1:10.

```{r}
call2(median, x, na.rm = TRUE)
```

In the following calls we remain with differing combinations. Once, only `x` and once only `median()` gets evaluated. 

```{r}
call2(expr(median), x, na.rm = TRUE)
call2(median, expr(x), na.rm = TRUE)
```

In the final call neither `x` nor `median()` is evaluated.

```{r}
call2(expr(median), expr(x), na.rm = TRUE)
```

Note that all these calls will generate the same result when evaluated. The key difference is when the values bound to the `x` and `median` symbols are found.

__[Q4]{.Q}__: `rlang::call_standardise()` doesn't work so well for the following calls.
Why? What makes `mean()` special?

```{r}
call_standardise(quote(mean(1:10, na.rm = TRUE)))
call_standardise(quote(mean(n = T, 1:10)))
call_standardise(quote(mean(x = 1:10, , TRUE)))
```

__[A]{.solved}__: The reason for this unexpected behaviour is that `mean()` uses the `...` argument and therefore cannot standardise the regarding arguments. Since `mean()` uses S3 dispatch (i.e. `UseMethod()`) and the underlying `mean.default()` method specifies some more arguments, `call_standardise()` can do much better with a specific S3 method.

```{r}
call_standardise(quote(mean.default(1:10, na.rm = TRUE)))
call_standardise(quote(mean.default(n = T, 1:10)))
call_standardise(quote(mean.default(x = 1:10, , TRUE)))
```

__[Q5]{.Q}__: Why does this code not make sense?

```{r, eval = FALSE}
x <- expr(foo(x = 1))
names(x) <- c("x", "")
```

__[A]{.solved}__: As stated in *Advanced R*

> The first element of a call is always the function that gets called.

Let's see what happens when we run the code

```{r}
x <- expr(foo(x = 1))
x

names(x) <- c("x", "")
x

names(x) <- c("", "x")
x
```

So, giving the first element a name just adds metadata that R ignores.

__[Q6]{.Q}__: Construct the expression `if(x > 1) "a" else "b"` using multiple calls to `call2()`. How does the code structure reflect the structure of the AST?

__[A]{.solved}__: Similar to the prefix version we get

```{r}
call2("if", call2(">", sym("x"), 1), "a", "b")
```

When we read the AST from left to right, we get the same structure: Function to evaluate, expression, which is another function and is evaluated first, and two constants which will be evaluated next.

```{r}
ast(`if`(x > 1, "a", "b"))
```

## Parsing and grammar
<!-- 18.4 -->

__[Q1]{.Q}__: R uses parentheses in two slightly different ways as illustrated by these two calls:

```{r, eval = FALSE}
f((1))
`(`(1 + 1)
```

Compare and contrast the two uses by referencing the AST.

__[A]{.solved}__: The trick with these examples lies in the fact that `(` can be a part of R's general prefix function syntax but can also represent a call to the `(` function.

So, in the AST of the first example, we will not see the outer `(` since it is prefix function syntax and belongs to `f()`. In contrast, the inner `(` is a function (represented as a symbol in the AST):

```{r}
ast(f((1)))
```

In the second example, we can see that the outer `(` is a function and the inner `(` belongs to its syntax:

```{r}
ast(`(`(1 + 1))
```

For the sake of clarity, let's also create a third example, where none of the `(` is part of another function's syntax:

```{r}
ast(((1 + 1)))
```

__[Q2]{.Q}__: `=` can also be used in two ways. Construct a simple example that shows both uses.

__[A]{.solved}__: `=` is used both for assignment, and for naming arguments in function calls:

```{r}
b = c(c = 1)
```

So, when we play with `ast()`, we can directly see that the following is not possible:

```{r, error = TRUE}
ast(b = c(c = 1))
```

We get an error because `b = ` makes R looking for an argument called `b`. Since `x` is the only argument of `ast()`, we get an error.

The easiest way around this problem is to wrap this line in `{}`.

```{r}
ast({b = c(c = 1)})
```

When we ignore the braces and compare the trees, we can see that the first `=` is used for assignment and the second `=` is part of the syntax of function calls.

__[Q3]{.Q}__: Does `-2^2` yield 4 or -4? Why?

__[A]{.solved}__: It yields `-4`, because `^` has a higher operator precedence than `-`, which we can verify by looking at the AST (or looking it up under `?"Syntax"`):

```{r}
-2^2

ast(-2^2)
```

__[Q4]{.Q}__: What does `!1 + !1` return? Why?

__[A]{.solved}__: The answer is a little surprising:

```{r}
!1 + !1
```

To answer the "why?", we take a look at the AST:

```{r}
ast(!1 + !1)
```

The right `!1` is evaluated first. It evaluates to `FALSE`, because R coerces every non 0 numeric to `TRUE`, when a logical operator is applied. The negation of `TRUE` then equals `FALSE`.

Next `1 + FALSE` is evaluated to `1`, since `FALSE` is coerced to `0`.

Finally `!1` is evaluated to `FALSE`.

Note that if `!` had a higher precedence, the intermediate result would be `FALSE + FALSE`, which would evaluate to `0`.

__[Q5]{.Q}__: Why does `x1 <- x2 <- x3 <- 0` work? Describe the two reasons.

__[A]{.solved}__: One reason is that `<-` is right-associative, i.e. evaluation takes place from right to left:

```{r}
x1 <- (x2 <- (x3 <- 0))
```

The other reason is that `<-` invisibly returns the value on the right-hand side.

```{r}
(x3 <- 0)
```

__[Q6]{.Q}__: Compare the ASTs of `x + y %+% z` and `x ^ y %+% z`. What have you learned about the precedence of custom infix functions?

__[A]{.solved}__: Let's take a look at the syntax trees:

```{r}
ast(x + y %+% z)
```

Here `y %+% z` will be calculated first and the result will be added to `x`.

```{r}
ast(x ^ y %+% z)
```

Here `x ^ y` will be calculated first, and the result will be used as first argument to `%+%()`.

We can conclude that custom infix functions have precedence between addition and exponentiation.

The exact precedence of infix functions can be looked up under `?"Syntax"` where we see that it lies directly behind the sequence operator (`:`) and in front of the multiplication and division operators (`*` and `/`).

__[Q7]{.Q}__: What happens if you call `parse_expr()` with a string that generates multiple expressions, e.g. `parse_expr("x + 1; y + 1")`?

__[A]{.solved}__: In this case `parse_expr()` notices that more than one expression would have to be generated and throws an error.

```{r, error = TRUE}
parse_expr("x + 1; y + 1")
```

__[Q8]{.Q}__: What happens if you attempt to parse an invalid expression, e.g. `"a +"` or `"f())"`?

__[A]{.solved}__: Invalid expressions will lead to an error in the underlying `parse()` function.

```{r, error = TRUE}
parse_expr("a +")
parse_expr("f())")

parse(text = "a +")
parse(text = "f())")
```

__[Q9]{.Q}__: `deparse()` produces vectors when the input is long. For example, the following call produces a vector of length two:

```{r, eval = FALSE}
expr <- expr(g(a + b + c + d + e + f + g + h + i + j + k + l + m + 
                 n + o + p + q + r + s + t + u + v + w + x + y + z))

deparse(expr)
```

What does `expr_text()` do instead?

__[A]{.solved}__: `expr_text()` will paste the results from `deparse(expr)` together and use a linebreak (`\n`) as separator.

```{r, eval = FALSE}
expr <- expr(g(a + b + c + d + e + f + g + h + i + j + k + l + m + 
                 n + o + p + q + r + s + t + u + v + w + x + y + z))
deparse(expr)
#> [1] "g(a + b + c + d + e + f + g + h + i + j + k + l + m + n + "
#> [2] "o + p + q + r + s + t + u + v + w + x + y + z)"
expr_text(expr)
#> [1] "g(a + b + c + d + e + f + g + h + i + j + k + l + m + n 
#> + \n    o + p + q + r + s + t + u + v + w + x + y + z)"
```

__[Q10]{.Q}__: `pairwise.t.test()` assumes that `deparse()` always returns a length one character vector. Can you construct an input that violates this expectation? What happens?

__[A]{.solved}__: The function `pairwise.t.test()` captures its data arguments (`x` and `g`) so it can print the input expressions along the computed p-values. Prior to R 4.0.0 this used to be implemented via `deparse(substitute(x))` in combination with `paste()`. This could lead to unexpected output, if one of the inputs exceeded the default `width.cutoff` value of 60 characters within `deparse()`. In this case, the expression would be split into a character vector of length greater 1.

```{r, eval = FALSE}
# Output in R version 3.6.2
d <- 1
pairwise.t.test(2, d + d + d + d + d + d + d + d + 
                  d + d + d + d + d + d + d + d + d)
#> 	Pairwise comparisons using t tests with pooled SD 
#> 
#> data:  2 and d + d + d + d + d + d + d + d + d + d + d + d + d + d
#> + d + d +  2 and     d 
#> 
#> <0 x 0 matrix>
#> 
#> P value adjustment method: holm 
```

In [R 4.0.0](https://cran.r-project.org/doc/manuals/r-release/NEWS.html) `pairwise.t.test()` was updated to use the newly introduced `deparse1()`, which serves as a wrapper around `deparse()`.

> deparse1() is a simple utility added in R 4.0.0 to ensure a string result (character vector of length one), typically used in name construction, as deparse1(substitute(.)).

```{r, eval = FALSE}
# Output since R 4.0.0
d <- 1
pairwise.t.test(2, d + d + d + d + d + d + d + d + 
                  d + d + d + d + d + d + d + d + d)
#> 	Pairwise comparisons using t tests with pooled SD 
#> 
#> data:  2 and d + d + d + d + d + d + d + d + d + d + d + d + d + d
#> + d + d + d
#> 
#> <0 x 0 matrix>
#> 
#> P value adjustment method: holm 
```

## Walking AST with recursive functions {#ast-funs}
<!-- 18.5 -->

__[Q1]{.Q}__: `logical_abbr()` returns `TRUE` for `T(1, 2, 3)`. How could you modify `logical_abbr_rec()` so that it ignores function calls that use `T` or `F`?

__[A]{.solved}__: We can apply a similar logic as in the [assignment example](https://adv-r.hadley.nz/expressions.html#finding-all-variables-created-by-assignment) from *Advanced R*. We just treat it as a special case handled within a sub function called `find_T_call()`, which finds `T()` calls and "bounces them out". Therefore, we also repeat the `expr_type()` helper which tells us if we are in the base or in the recursive case.

```{r}
expr_type <- function(x) {
  if (rlang::is_syntactic_literal(x)) {
    "constant"
  } else if (is.symbol(x)) {
    "symbol"
  } else if (is.call(x)) {
    "call"
  } else if (is.pairlist(x)) {
    "pairlist"
  } else {
    typeof(x)
  }
}

switch_expr <- function(x, ...) {
  switch(expr_type(x),
         ...,
         stop("Don't know how to handle type ", 
              typeof(x), call. = FALSE))
}
```

```{r}
find_T_call <- function(x) {
  if (is_call(x, "T")) {
    x <- as.list(x)[-1]
    purrr::some(x, logical_abbr_rec)
  } else {
    purrr::some(x, logical_abbr_rec)
  }
}

logical_abbr_rec <- function(x) {
  switch_expr(
    x,
    # Base cases
    constant = FALSE,
    symbol = as_string(x) %in% c("F", "T"),
    
    # Recursive cases
    pairlist = purrr::some(x, logical_abbr_rec),
    call = find_T_call(x)
  )
}

logical_abbr <- function(x) {
  logical_abbr_rec(enexpr(x))
}
```

Now let's test our new `logical_abbr()` function:

```{r}
logical_abbr(T(1, 2, 3))
logical_abbr(T(T, T(3, 4)))
logical_abbr(T(T))
logical_abbr(T())
logical_abbr()
logical_abbr(c(T, T, T))
```

__[Q2]{.Q}__: `logical_abbr()` works with expressions. It currently fails when you give it a function. Why? How could you modify `logical_abbr()` to make it work? What components of a function will you need to recurse over?

```{r, eval = TRUE}
f <- function(x = TRUE) {
  g(x + T)
}
```

__[A]{.solved}__: The function currently fails, because `"closure"` is not handled in `switch_expr()` within `logical_abbr_rec()`. 

```{r, error = TRUE}
logical_abbr(!!f)
```

If we want to make it work, we have to write a function to also iterate over the formals and the body of the input function.

__[Q3]{.Q}__: Modify `find_assign` to also detect assignment using replacement functions, i.e. `names(x) <- y`.

__[A]{.solved}__: Let's see what the AST of such an assignment looks like:

```{r}
ast(names(x) <- x)
```

So, we need to catch the case where the first two elements are both calls. Further the first call is identical to `<-` and we must return only the second call to see which objects got new values assigned.

This is why we add the following block within another `else` statement in `find_assign_call()`:

```{r, eval = FALSE}
if (is_call(x, "<-") && is_call(x[[2]])) {
  lhs <- expr_text(x[[2]])
  children <- as.list(x)[-1]
}
```

Let us finish with the whole code, followed by some tests for our new function:

```{r}
flat_map_chr <- function(.x, .f, ...) {
  purrr::flatten_chr(purrr::map(.x, .f, ...))
}

find_assign <- function(x) unique(find_assign_rec(enexpr(x)))

find_assign_call <- function(x) {
  if (is_call(x, "<-") && is_symbol(x[[2]])) {
    lhs <- as_string(x[[2]])
    children <- as.list(x)[-1]
  } else {
    if (is_call(x, "<-") && is_call(x[[2]])) {
      lhs <- expr_text(x[[2]])
      children <- as.list(x)[-1]
    } else {
      lhs <- character()
      children <- as.list(x)
    }}
  
  c(lhs, flat_map_chr(children, find_assign_rec))
}

find_assign_rec <- function(x) {
  switch_expr(
    x,
    # Base cases
    constant = ,symbol = character(),
    # Recursive cases
    pairlist = flat_map_chr(x, find_assign_rec),
    call = find_assign_call(x)
  )
}

# Tests functionality
find_assign(x <- y)
find_assign(names(x))
find_assign(names(x) <- y)
find_assign(names(x(y)) <- y)
find_assign(names(x(y)) <- y <- z)
```

__[Q4]{.Q}__: Write a function that extracts all calls to a specified function.

__[A]{.solved}__: Here we need to delete the previously added else statement and check for a call (not necessarily `<-`) within the first `if()` in `find_assign_call()`. We save a call when we found one and return it later as part of our character output. Everything else stays the same:

```{r}
find_assign_call <- function(x) {
  if (is_call(x)) {
    lhs <- expr_text(x)
    children <- as.list(x)[-1]
  } else {
    lhs <- character()
    children <- as.list(x)
  }
  
  c(lhs, flat_map_chr(children, find_assign_rec))
}

find_assign_rec <- function(x) {
  switch_expr(
    x,
    # Base cases
    constant = ,
    symbol = character(),

    # Recursive cases
    pairlist = flat_map_chr(x, find_assign_rec),
    call = find_assign_call(x)
  )
}

find_assign(x <- y)
find_assign(names(x(y)) <- y <- z)
find_assign(mean(sum(1:3)))
```