Advanced R (Metaprogramming)

exercises

advanced-r

Author

John Benninghoff

Published

February 19, 2023

Modified

November 11, 2023

Workbook for completing quizzes and exercises from the “Metaprogramming” chapters of Advanced R, second edition, with comparisons to solutions from Advanced R Solutions.

library(lobstr)
library(rlang)

# from https://github.com/hadley/adv-r/blob/master/common.R
knitr::opts_chunk$set(
  comment = "#>",
  fig.align = "center"
)

knitr::knit_hooks$set(
  small_mar = function(before, options, envir) {
    if (before) {
      par(mar = c(4.1, 4.1, 0.5, 0.5))
    }
  }
)

Introduction

This workbook includes answers and solutions to the quizzes and exercises from Advanced R and Advanced R Solutions, organized by chapter. It includes excerpts from both books, copied here.

WARNING, SPOILERS! If you haven’t read Advanced R and intend to complete the quizzes and exercises, don’t read this notebook. It contains my (potentially wrong) answers to both.

Important: advice on tidy evaluation has changed since these chapters were written; see the “Programming with dplyr” vignette.

17 Big picture

Metaprogramming is the hardest topic in this book because it brings together many formerly unrelated topics and forces you grapple with issues that you probably haven’t thought about before. You’ll also need to learn a lot of new vocabulary, and at first it will seem like every new term is defined by three other terms that you haven’t heard of. Even if you’re an experienced programmer in another language, your existing skills are unlikely to be much help as few modern popular languages expose the level of metaprogramming that R provides. So don’t be surprised if you’re frustrated or confused at first; this is a natural part of the process that happens to everyone!

But I think it’s easier to learn metaprogramming now than ever before. Over the last few years, the theory and practice have matured substantially, providing a strong foundation paired with tools that allow you to solve common problems. In this chapter, you’ll get the big picture of all the main pieces and how they fit together.

18 Expressions

To compute on the language, we first need to understand its structure. That requires some new vocabulary, some new tools, and some new ways of thinking about R code. The first of these is the distinction between an operation and its result. Take the following code, which multiplies a variable x by 10 and saves the result to a new variable called y. It doesn’t work because we haven’t defined a variable called x:

rm(x)

#> Warning in rm(x): object 'x' not found

try(y <- x * 10)

#> Error in eval(expr, envir, enclos) : object 'x' not found

It would be nice if we could capture the intent of the code without executing it. In other words, how can we separate our description of the action from the action itself?

One way is to use rlang::expr():

z <- rlang::expr(y <- x * 10)
z

#> y <- x * 10

expr() returns an expression, an object that captures the structure of the code without evaluating it (i.e. running it). If you have an expression, you can evaluate it with base::eval():

x <- 4
eval(z)
y

#> [1] 40

The focus of this chapter is the data structures that underlie expressions. Mastering this knowledge will allow you to inspect and modify captured code, and to generate code with code. We’ll come back to expr() in Chapter 19, and to eval() in Chapter 20.

18.2.4 Exercises

Reconstruct the code represented by the trees below:

#> █─f
#> └─█─g
#>   └─█─h
#> █─`+`
#> ├─█─`+`
#> │ ├─1
#> │ └─2
#> └─3
#> █─`*`
#> ├─█─`(`
#> │ └─█─`+`
#> │   ├─x
#> │   └─y
#> └─z

Answer: code below.

lobstr::ast(f(g(h())))

#> █─f 
#> └─█─g 
#>   └─█─h

lobstr::ast(1 + 2 + 3)

#> █─`+` 
#> ├─█─`+` 
#> │ ├─1 
#> │ └─2 
#> └─3

lobstr::ast((x + y) * z)

#> █─`*` 
#> ├─█─`(` 
#> │ └─█─`+` 
#> │   ├─x 
#> │   └─y 
#> └─z

AR Solutions: Let the source (of the code chunks above) be with you and show you how the ASTs (abstract syntax trees) were produced.

ast(f(g(h())))

#> █─f 
#> └─█─g 
#>   └─█─h

ast(1 + 2 + 3)

#> █─`+` 
#> ├─█─`+` 
#> │ ├─1 
#> │ └─2 
#> └─3

ast((x + y) * z)

#> █─`*` 
#> ├─█─`(` 
#> │ └─█─`+` 
#> │   ├─x 
#> │   └─y 
#> └─z

Draw the following trees by hand and then check your answers with lobstr::ast().

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

Answer: code below, expression 1:

#> █─f
#> └─█─g
#>   └─█─h
#>     └─█─i
#>       └─1
#>       └─2
#>       └─3
lobstr::ast(f(g(h(i(1, 2, 3)))))

#> █─f 
#> └─█─g 
#>   └─█─h 
#>     └─█─i 
#>       ├─1 
#>       ├─2 
#>       └─3

Expression 2:

#> █─f
#> └─1
#> └─█─g
#>   └─2
#>   └─█─h
#>     └─3
#>     └─█─i
lobstr::ast(f(1, g(2, h(3, i()))))

#> █─f 
#> ├─1 
#> └─█─g 
#>   ├─2 
#>   └─█─h 
#>     ├─3 
#>     └─█─i

Expression 3:

#> █─f
#> └─█─g
#> | └─1
#> | └─2
#> └─█─h
#>   └─3
#>   └─█─i
#>     └─4
#>     └─5
lobstr::ast(f(g(1, 2), h(3, i(4, 5))))

#> █─f 
#> ├─█─g 
#> │ ├─1 
#> │ └─2 
#> └─█─h 
#>   ├─3 
#>   └─█─i 
#>     ├─4 
#>     └─5

AR Solutions: Let us delegate the drawing to the lobstr package.

What’s happening with the ASTs below? (Hint: carefully read ?"^".)

lobstr::ast(`x` + `y`)

#> █─`+` 
#> ├─x 
#> └─y

lobstr::ast(x ** y) # styler: off

#> █─`^` 
#> ├─x 
#> └─y

lobstr::ast(1 -> x)

#> █─`<-` 
#> ├─x 
#> └─1

Answer: all expressions are changed to their normal forms. In the first expression, the back ticks denoting symbols are not needed. In the third expression, the assignment operator is changed to the standard form. In the second expression, the operator is changed per this note in the R documentation:

** is translated in the parser to ^, but this was undocumented for many years. It appears as an index entry in Becker et al (1988), pointing to the help for Deprecated but is not actually mentioned on that page. Even though it had been deprecated in S for 20 years, it was still accepted in R in 2008.

AR Solutions: 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.

What is special about the AST below? (Hint: re-read Section 6.2.1.)

lobstr::ast(function(x = 1, y = 2) {})

#> █─`function` 
#> ├─█─x = 1 
#> │ └─y = 2 
#> ├─█─`{` 
#> └─<inline srcref>

Answer: the AST includes two of the three parts of the function, the formals(), x and y, the body(), represented by { and <inline srcref>.

AR Solutions: 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.

What does the call tree of an if statement with multiple else if conditions look like? Why?

Answer: the call tree shows nested if statements; this is because if-else is a function with three arguments, the cond, the cons.expr and the alt.expr. The alt.expr for each if-else statement is a new call to if.

lobstr::ast(
  if (v == 1) {
    print("one")
  } else if (v == 2) {
    print("two")
  } else if (v == 3) {
    print("three")
  } else if (v == 4) {
    print("four")
  }
)

#> █─`if` 
#> ├─█─`==` 
#> │ ├─v 
#> │ └─1 
#> ├─█─`{` 
#> │ └─█─print 
#> │   └─"one" 
#> └─█─`if` 
#>   ├─█─`==` 
#>   │ ├─v 
#>   │ └─2 
#>   ├─█─`{` 
#>   │ └─█─print 
#>   │   └─"two" 
#>   └─█─`if` 
#>     ├─█─`==` 
#>     │ ├─v 
#>     │ └─3 
#>     ├─█─`{` 
#>     │ └─█─print 
#>     │   └─"three" 
#>     └─█─`if` 
#>       ├─█─`==` 
#>       │ ├─v 
#>       │ └─4 
#>       └─█─`{` 
#>         └─█─print 
#>           └─"four"

AR Solutions: 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.

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

#> █─`if` 
#> ├─FALSE 
#> ├─█─`{` 
#> │ └─1 
#> └─█─`if` 
#>   ├─FALSE 
#>   ├─█─`{` 
#>   │ └─2 
#>   └─█─`if` 
#>     ├─TRUE 
#>     └─█─`{` 
#>       └─3

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

ast(
  # styler: off
  if (FALSE) 1
  else if (FALSE) 2
  else if (TRUE) 3
  # styler: on
)

#> █─`if` 
#> ├─FALSE 
#> ├─1 
#> └─█─`if` 
#>   ├─FALSE 
#>   ├─2 
#>   └─█─`if` 
#>     ├─TRUE 
#>     └─3

18.3.5 Exercises

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?

Answer: raw and some complex numbers can’t appear in an expression, since constructing both requires a function call (raw() and + respectively). Similarly, creating atomic vectors longer than one requires c().

expr(f(TRUE, 1L, 1.0, "x", 1i, raw(1L), 1 + 1i))

#> f(TRUE, 1L, 1, "x", 0+1i, raw(1L), 1 + (0+1i))

expr(c(1, 2))

#> c(1, 2)

AR Solutions: 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:

# Atomic
is_atomic(expr(1))

#> [1] TRUE

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

#> [1] FALSE

is_call(expr(c(1, 1)))

#> [1] TRUE

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

Answer: as the result demonstrates, this removes the function call which makes the first argument the new function call in the expression, since the AST structure (call object) is preserved, and the first element of the call object is the function position.

expr(read.csv("foo.csv", header = TRUE))[-1]

#> "foo.csv"(header = TRUE)

AR Solutions: 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).

Describe the differences between the following call objects.

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)

Answer: the objects differ in their use of expr(). When using bare median and x, the object uses the evaluated function and value of x where using expr() prevents evaluation.

median

#> function (x, na.rm = FALSE, ...) 
#> UseMethod("median")
#> <bytecode: 0x107d85df8>
#> <environment: namespace:stats>

expr(median)

#> median

#>  [1]  1  2  3  4  5  6  7  8  9 10

expr(x)

#> x

AR Solutions: 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.

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

#> (function (x, na.rm = FALSE, ...) 
#> UseMethod("median"))(1:10, na.rm = TRUE)

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

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

#> median(1:10, na.rm = TRUE)

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

#> (function (x, na.rm = FALSE, ...) 
#> UseMethod("median"))(x, na.rm = TRUE)

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

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

#> median(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.

rlang::call_standardise() doesn’t work so well for the following calls. Why? What makes mean() special?

call_standardise(quote(mean(1:10, na.rm = TRUE)))

#> Warning: `call_standardise()` is deprecated as of rlang 0.4.11
#> This warning is displayed once every 8 hours.

#> mean(x = 1:10, na.rm = TRUE)

call_standardise(quote(mean(n = T, 1:10)))

#> mean(x = 1:10, n = T)

call_standardise(quote(mean(x = 1:10, , TRUE)))

#> mean(x = 1:10, , TRUE)

Answer: as noted in the book, “If the function uses ... it’s not possible to standardise all arguments.” mean() has a single argument, x, and uses ... for the remaining arguments, although the default S3 method is mean(x, trim = 0, na.rm = FALSE, ...).

AR Solutions: 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.

Why does this code not make sense?

x <- expr(foo(x = 1))
names(x) <- c("x", "y")

Answer: as the code below demonstrates, the only symbol (name) in the expression is x. Assigning a name to both components changes x to y but doesn’t change the function call foo.

ex <- expr(foo(x = 1))
names(ex)

#> [1] ""  "x"

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

#> foo(y = 1)

AR Solutions: 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

x <- expr(foo(x = 1))
x

#> foo(x = 1)

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

#> foo(1)

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

#> foo(x = 1)

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

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?

Answer: code below. The call2() structure mirrors the AST of the if expression.

call2("if", call2(">", expr(x), 1), "a", "b")

#> if (x > 1) "a" else "b"

lobstr::ast(if (x > 1) "a" else "b")

#> █─`if` 
#> ├─█─`>` 
#> │ ├─x 
#> │ └─1 
#> ├─"a" 
#> └─"b"

AR Solutions: Similar to the prefix version we get

call2("if", call2(">", sym("x"), 1), "a", "b")

#> if (x > 1) "a" else "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.

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

#> █─`if` 
#> ├─█─`>` 
#> │ ├─x 
#> │ └─1 
#> ├─"a" 
#> └─"b"

18.4.4 Exercises

R uses parentheses in two slightly different ways as illustrated by these two calls:

f((1))
`(`(1 + 1)

Compare and contrast the two uses by referencing the AST.

Answer: R uses parentheses both as a function and as part of a function call. In the first call, the outer parentheses are for f and the inner represent ( with a single parameter. In the second call, equivalent to (1 + 1), the parentheses are for the ( function call.

lobstr::ast(f((1)))

#> █─f 
#> └─█─`(` 
#>   └─1

lobstr::ast(`(`(1 + 1))

#> █─`(` 
#> └─█─`+` 
#>   ├─1 
#>   └─1

lobstr::ast((1 + 1))

#> █─`(` 
#> └─█─`+` 
#>   ├─1 
#>   └─1

AR Solutions: 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):

ast(f((1)))

#> █─f 
#> └─█─`(` 
#>   └─1

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

ast(`(`(1 + 1))

#> █─`(` 
#> └─█─`+` 
#>   ├─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:

ast(((1 + 1)))

#> █─`(` 
#> └─█─`(` 
#>   └─█─`+` 
#>     ├─1 
#>     └─1

= can also be used in two ways. Construct a simple example that shows both uses.

Answer: = can be used for assignment and also for function parameters.

lobstr::ast(`=`(val, sum(10, na.rm = TRUE)))

#> █─`=` 
#> ├─val 
#> └─█─sum 
#>   ├─10 
#>   └─na.rm = TRUE

AR Solutions: = is used both for assignment, and for naming arguments in function calls:

b = c(c = 1) # styler: off

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

try(ast(b = c(c = 1)))

#> Error in ast(b = c(c = 1)) : unused argument (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 {}.

ast({b = c(c = 1)})  # styler: off

#> █─`{` 
#> └─█─`=` 
#>   ├─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.

Does -2^2 yield 4 or -4? Why?

Answer: the result is -4, because ^ has higher precedence than -:

-2^2

#> [1] -4

lobstr::ast(-2^2)

#> █─`-` 
#> └─█─`^` 
#>   ├─2 
#>   └─2

AR Solutions: 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"):

-2^2

#> [1] -4

ast(-2^2)

#> █─`-` 
#> └─█─`^` 
#>   ├─2 
#>   └─2

What does !1 + !1 return? Why?

Answer: FALSE. As the AST demonstrates, the ! operator takes precedence.

!1 + !1

#> [1] FALSE

lobstr::ast(!1 + !1)

#> █─`!` 
#> └─█─`+` 
#>   ├─1 
#>   └─█─`!` 
#>     └─1

The result can be demonstrated by evaluating the AST in steps:

!1 # FALSE

#> [1] FALSE

1 + FALSE # 1

#> [1] 1

!1 # FALSE

#> [1] FALSE

AR Solutions: The answer is a little surprising:

!1 + !1

#> [1] FALSE

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

ast(!1 + !1)

#> █─`!` 
#> └─█─`+` 
#>   ├─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.

Why does x1 <- x2 <- x3 <- 0 work? Describe the two reasons.

Answer: assignment is right-associative: x1 <- (x2 <- 0) and x1 <- x2 <- 0 are equivalent, and the rightmost assignment operator is evaluated first.

lobstr::ast(x1 <- x2 <- x3 <- 0)

#> █─`<-` 
#> ├─x1 
#> └─█─`<-` 
#>   ├─x2 
#>   └─█─`<-` 
#>     ├─x3 
#>     └─0

AR Solutions: One reason is that <- is right-associative, i.e. evaluation takes place from right to left:

x1 <- (x2 <- (x3 <- 0))

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

(x3 <- 0)

#> [1] 0

Note: I forgot that <- returns the value invisibly.

Compare the ASTs of x + y %+% z and x ^ y %+% z. What have you learned about the precedence of custom infix functions?

Answer: custom infix functions have higher precedence than + and lower precedence than ^.

lobstr::ast(x + y %+% z)

#> █─`+` 
#> ├─x 
#> └─█─`%+%` 
#>   ├─y 
#>   └─z

lobstr::ast(x ^ y %+% z) # styler: off

#> █─`%+%` 
#> ├─█─`^` 
#> │ ├─x 
#> │ └─y 
#> └─z

AR Solutions: Let’s take a look at the syntax trees:

ast(x + y %+% z)

#> █─`+` 
#> ├─x 
#> └─█─`%+%` 
#>   ├─y 
#>   └─z

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

ast(x ^ y %+% z) # styler: off

#> █─`%+%` 
#> ├─█─`^` 
#> │ ├─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 /).

What happens if you call parse_expr() with a string that generates multiple expressions? e.g. parse_expr("x + 1; y + 1")

Answer: parse_expr() throws an error. Use parse_exprs() with strings containing multiple expressions.

try(parse_expr("x + 1; y + 1"))

#> Error in parse_expr("x + 1; y + 1") : 
#>   `x` must contain exactly 1 expression, not 2.

parse_exprs("x + 1; y + 1")

#> [[1]]
#> x + 1
#> 
#> [[2]]
#> y + 1

AR Solutions: In this case parse_expr() notices that more than one expression would have to be generated and throws an error.

try(parse_expr("x + 1; y + 1"))

#> Error in parse_expr("x + 1; y + 1") : 
#>   `x` must contain exactly 1 expression, not 2.

What happens if you attempt to parse an invalid expression? e.g. "a +" or "f())".

Answer: parse_expr() throws an error.

try(parse_expr("a +"))

#> Error in parse(text = x, keep.source = FALSE) : 
#>   <text>:2:0: unexpected end of input
#> 1: a +
#>    ^

try(parse_expr("f())"))

#> Error in parse(text = x, keep.source = FALSE) : 
#>   <text>:1:4: unexpected ')'
#> 1: f())
#>        ^

AR Solutions: Invalid expressions will lead to an error in the underlying parse() function.

try(parse_expr("a +"))

#> Error in parse(text = x, keep.source = FALSE) : 
#>   <text>:2:0: unexpected end of input
#> 1: a +
#>    ^

try(parse_expr("f())"))

#> Error in parse(text = x, keep.source = FALSE) : 
#>   <text>:1:4: unexpected ')'
#> 1: f())
#>        ^

try(parse(text = "a +"))

#> Error in parse(text = "a +") : <text>:2:0: unexpected end of input
#> 1: a +
#>    ^

try(parse(text = "f())"))

#> Error in parse(text = "f())") : <text>:1:4: unexpected ')'
#> 1: f())
#>        ^

deparse() produces vectors when the input is long. For example, the following call produces a vector of length two:

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 + o + "
#> [2] "    p + q + r + s + t + u + v + w + x + y + z)"

What does expr_text() do instead?

Answer: expr_text() adds a newline (\n) instead.

expr_text(expr)

#> [1] "g(a + b + c + d + e + f + g + h + i + j + k + l + m + n + o + \n    p + q + r + s + t + u + v + w + x + y + z)"

AR Solutions: expr_text() will paste the results from deparse(expr) together and use a linebreak (\n) as separator.

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)"

pairwise.t.test() assumes that deparse() always returns a length one character vector. Can you construct an input that violates this expectation? What happens?

Answer: an especially long input for x or g would create a character vector of length two or more. However, starting in R 4.0.0, pairwise.t.test() uses deparse1() which guarantees a string (character of length one), so it is no longer possible to break pairwise.t.test().

pairwise.t.test

#> function (x, g, p.adjust.method = p.adjust.methods, pool.sd = !paired, 
#>     paired = FALSE, alternative = c("two.sided", "less", "greater"), 
#>     ...) 
#> {
#>     if (paired && pool.sd) 
#>         stop("pooling of SD is incompatible with paired tests")
#>     DNAME <- paste(deparse1(substitute(x)), "and", deparse1(substitute(g)))
#>     g <- factor(g)
#>     p.adjust.method <- match.arg(p.adjust.method)
#>     alternative <- match.arg(alternative)
#>     if (pool.sd) {
#>         METHOD <- "t tests with pooled SD"
#>         xbar <- tapply(x, g, mean, na.rm = TRUE)
#>         s <- tapply(x, g, sd, na.rm = TRUE)
#>         n <- tapply(!is.na(x), g, sum)
#>         degf <- n - 1
#>         total.degf <- sum(degf)
#>         pooled.sd <- sqrt(sum(ifelse(degf, s^2, 0) * degf)/total.degf)
#>         compare.levels <- function(i, j) {
#>             dif <- xbar[i] - xbar[j]
#>             se.dif <- pooled.sd * sqrt(1/n[i] + 1/n[j])
#>             t.val <- dif/se.dif
#>             if (alternative == "two.sided") 
#>                 2 * pt(-abs(t.val), total.degf)
#>             else pt(t.val, total.degf, lower.tail = (alternative == 
#>                 "less"))
#>         }
#>     }
#>     else {
#>         METHOD <- if (paired) 
#>             "paired t tests"
#>         else "t tests with non-pooled SD"
#>         compare.levels <- function(i, j) {
#>             xi <- x[as.integer(g) == i]
#>             xj <- x[as.integer(g) == j]
#>             t.test(xi, xj, paired = paired, alternative = alternative, 
#>                 ...)$p.value
#>         }
#>     }
#>     PVAL <- pairwise.table(compare.levels, levels(g), p.adjust.method)
#>     ans <- list(method = METHOD, data.name = DNAME, p.value = PVAL, 
#>         p.adjust.method = p.adjust.method)
#>     class(ans) <- "pairwise.htest"
#>     ans
#> }
#> <bytecode: 0x11825b208>
#> <environment: namespace:stats>

deparse(c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18))

#> [1] "c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, "
#> [2] "18)"

pairwise.t.test(1:18, c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18))

#> 
#>  Pairwise comparisons using t tests with pooled SD 
#> 
#> data:  1:18 and c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18) 
#> 
#>    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
#> 2  - - - - - - - - - -  -  -  -  -  -  -  - 
#> 3  - - - - - - - - - -  -  -  -  -  -  -  - 
#> 4  - - - - - - - - - -  -  -  -  -  -  -  - 
#> 5  - - - - - - - - - -  -  -  -  -  -  -  - 
#> 6  - - - - - - - - - -  -  -  -  -  -  -  - 
#> 7  - - - - - - - - - -  -  -  -  -  -  -  - 
#> 8  - - - - - - - - - -  -  -  -  -  -  -  - 
#> 9  - - - - - - - - - -  -  -  -  -  -  -  - 
#> 10 - - - - - - - - - -  -  -  -  -  -  -  - 
#> 11 - - - - - - - - - -  -  -  -  -  -  -  - 
#> 12 - - - - - - - - - -  -  -  -  -  -  -  - 
#> 13 - - - - - - - - - -  -  -  -  -  -  -  - 
#> 14 - - - - - - - - - -  -  -  -  -  -  -  - 
#> 15 - - - - - - - - - -  -  -  -  -  -  -  - 
#> 16 - - - - - - - - - -  -  -  -  -  -  -  - 
#> 17 - - - - - - - - - -  -  -  -  -  -  -  - 
#> 18 - - - - - - - - - -  -  -  -  -  -  -  - 
#> 
#> P value adjustment method: holm

AR Solutions: 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.

# 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 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(.)).

# 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

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)
  )
}

18.5.3 Exercises

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?

AR Solutions: We can apply a similar logic as in the assignment example 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.

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
    )
  )
}

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:

logical_abbr(T(1, 2, 3))

#> [1] FALSE

logical_abbr(T(T, T(3, 4)))

#> [1] TRUE

logical_abbr(T(T))

#> [1] TRUE

logical_abbr(T())

#> [1] FALSE

logical_abbr()

#> [1] FALSE

logical_abbr(c(T, T, T))

#> [1] TRUE

Answer: taken from Advanced R solutions, we need to find function calls within the recursive call. The trick is to find and remove the T or F from the list:

find_tf_call <- function(x) {
  if (is_call(x, "T") || is_call(x, "F")) {
    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_tf_call(x)
  )
}

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

logical_abbr(T) # TRUE

#> [1] TRUE

logical_abbr(FALSE) # FALSE

#> [1] FALSE

logical_abbr(T(1, 2, 3)) # FALSE

#> [1] FALSE

logical_abbr(F(1, 2, 3)) # FALSE

#> [1] FALSE

Note: I was unable to solve this exercise on my own, and needed to consult AR Solutions. The AR Solutions version only implements T, adding F is trivial.

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?

logical_abbr(function(x = TRUE) {
  g(x + T)
})

AR Solutions: The function currently fails, because "closure" is not handled in switch_expr() within logical_abbr_rec().

f <- function(x = TRUE) {
  g(x + T)
}
try(logical_abbr(!!f))

#> Error : Don't know how to handle type closure

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.

Answer: the above example evaluates successfully as TRUE, however, the following fails, presumably because expr_type doesn’t handle closure:

try(logical_abbr(function(x = TRUE) {
  g(x)
}))

#> Error : Don't know how to handle type integer

is_closure(function(x = TRUE) {
  g(x)
})

#> [1] TRUE

typeof(function(x = TRUE) {
  g(x)
})

#> [1] "closure"

Note: I’m not sure why the error says integer instead of closure.

Modify find_assign to also detect assignment using replacement functions, i.e. names(x) <- y.

Answer: first compare the AST to normal assignment:

ast(x <- y)

#> █─`<-` 
#> ├─x 
#> └─y

ast(names(x) <- y)

#> █─`<-` 
#> ├─█─names 
#> │ └─x 
#> └─y

Assignment is a call object where the first element is the symbol <-, the second is a call object with the function and the name of the variable, and the third is the value to be assigned. The original code doesn’t detect name(x) <- y:

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

find_assign_call <- function(x) {
  if (is_call(x, "<-") && is_symbol(x[[2]])) {
    lhs <- as_string(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)
  )
}

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

find_assign(a <- b <- c <- 1)

#> [1] "a" "b" "c"

find_assign(names(x) <- y)

#> character(0)

To detect the new pattern, modify find_assign_call to detect when the second element is a call, and return the third:

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 <- as_string(x[[3]])
    children <- as.list(x)[-1]
  } else {
    lhs <- character()
    children <- as.list(x)
  }

  c(lhs, flat_map_chr(children, find_assign_rec))
}

find_assign(a <- b <- c <- 1)

#> [1] "a" "b" "c"

find_assign(names(x) <- y)

#> [1] "y"

AR Solutions: Let’s see what the AST of such an assignment looks like:

ast(names(x) <- x)

#> █─`<-` 
#> ├─█─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():

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:

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)

#> [1] "x"

find_assign(names(x))

#> character(0)

find_assign(names(x) <- y)

#> [1] "names(x)"

find_assign(names(x(y)) <- y)

#> [1] "names(x(y))"

find_assign(names(x(y)) <- y <- z)

#> [1] "names(x(y))" "y"

Note: using expr_text() instead of as_string() is preferable.

Write a function that extracts all calls to a specified function.

Answer: this is similar to the previous exercise. Here is a simple version that doesn’t properly walk the tree:

find_fun_call <- function(x, fun) {
  if (is_call(x, fun)) expr_text(x) else character()
}

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

    # Recursive cases
    pairlist = flat_map_chr(x, find_call_rec),
    call = find_fun_call(x, fun)
  )
}

find_call_fun <- function(x, fun) find_call_rec(enexpr(x), fun)

find_call_fun(1:10, "sum")

#> character(0)

find_call_fun(x, "sum")

#> character(0)

find_call_fun(sum(1:10), "sum")

#> [1] "sum(1:10)"

find_call_fun(sum(1:10), "mean")

#> character(0)

find_call_fun(sum(1:10) + sum(11:20), "sum")

#> character(0)

Updated version:

find_fun_call <- function(x, fun) {
  if (is_call(x, fun)) {
    parents <- expr_text(x)
    children <- as.list(x)[-1]
  } else {
    parents <- character()
    children <- as.list(x)
  }

  c(parents, flat_map_chr(children, find_call_rec, fun))
}

find_call_fun(1:10, "sum")

#> character(0)

find_call_fun(x, "sum")

#> character(0)

find_call_fun(sum(1:10), "sum")

#> [1] "sum(1:10)"

find_call_fun(sum(1:10), "mean")

#> character(0)

find_call_fun(sum(1:10) + sum(11:20), "sum")

#> [1] "sum(1:10)"  "sum(11:20)"

find_call_fun(sum(sum(1:10), sum(11:20)), "sum")

#> [1] "sum(sum(1:10), sum(11:20))" "sum(1:10)"                 
#> [3] "sum(11:20)"

AR Solutions: 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:

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)

#> [1] "x <- y"

find_assign(names(x(y)) <- y <- z)

#> [1] "names(x(y)) <- y <- z" "names(x(y))"           "x(y)"                 
#> [4] "y <- z"

find_assign(mean(sum(1:3)))

#> [1] "mean(sum(1:3))" "sum(1:3)"       "1:3"

Note: the AR Solutions version detects any function call, not a specific function call.

19 Quasiquotation

Now that you understand the tree structure of R code, it’s time to return to one of the fundamental ideas that make expr() and ast() work: quotation. In tidy evaluation, all quoting functions are actually quasiquoting functions because they also support unquoting. Where quotation is the act of capturing an unevaluated expression, unquotation is the ability to selectively evaluate parts of an otherwise quoted expression. Together, this is called quasiquotation. Quasiquotation makes it easy to create functions that combine code written by the function’s author with code written by the function’s user. This helps to solve a wide variety of challenging problems.

Quasiquotation is one of the three pillars of tidy evaluation. You’ll learn about the other two (quosures and the data mask) in Chapter 20. When used alone, quasiquotation is most useful for programming, particularly for generating code. But when it’s combined with the other techniques, tidy evaluation becomes a powerful tool for data analysis.

19.2.2 Exercises

For each function in the following base R code, identify which arguments are quoted and which are evaluated.

library(MASS) # nolint: unused_import_linter.

mtcars2 <- subset(mtcars, cyl == 4)

with(mtcars2, sum(vs))
sum(mtcars2$am)

rm(mtcars2)

Answer: using the technique described in the chapter, test arguments outside their functions:

library(MASS) # nolint: unused_import_linter.
try(MASS)

#> Error in eval(expr, envir, enclos) : object 'MASS' not found

mtcars2 <- subset(mtcars, cyl == 4)
mtcars

#>                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb
#> Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4
#> Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4
#> Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
#> Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1
#> Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
#> Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1
#> Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
#> Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
#> Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
#> Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4
#> Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4
#> Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
#> Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
#> Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
#> Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
#> Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
#> Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
#> Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
#> Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
#> Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
#> Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
#> Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
#> AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
#> Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
#> Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2
#> Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
#> Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
#> Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
#> Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
#> Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6
#> Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8
#> Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2

try(cyl)

#> Error in eval(expr, envir, enclos) : object 'cyl' not found

with(mtcars2, sum(vs))

#> [1] 10

mtcars2

#>                 mpg cyl  disp  hp drat    wt  qsec vs am gear carb
#> Datsun 710     22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1
#> Merc 240D      24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2
#> Merc 230       22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2
#> Fiat 128       32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1
#> Honda Civic    30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2
#> Toyota Corolla 33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1
#> Toyota Corona  21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1
#> Fiat X1-9      27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1
#> Porsche 914-2  26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2
#> Lotus Europa   30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2
#> Volvo 142E     21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2

try(vs)

#> Error in eval(expr, envir, enclos) : object 'vs' not found

sum(mtcars2$am)

#> [1] 8

mtcars2$am

#>  [1] 1 0 0 1 1 1 0 1 1 1 1

rm(mtcars2)

Results: MASS, cyl, vs are quoted, mtcars, mtcars2 and mtcars2$am are not.

AR Solutions: For each argument we first follow the advice from Advanced R and execute the argument outside of the respective function. Since MASS, cyl, vs and am are not objects contained in the global environment, their execution raises an “Object not found” error. This way we confirm that the respective function arguments are quoted. For the other arguments, we may inspect the source code (and the documentation) to check if any quoting mechanisms are applied or the arguments are evaluated.

library(MASS) # MASS is quoted # nolint: unused_import_linter.

library() also accepts character vectors and doesn’t quote when character.only is set to TRUE, so library(MASS, character.only = TRUE) would raise an error.

mtcars2 <- subset(mtcars, cyl == 4) # mtcars is evaluated
# cyl is quoted
with(mtcars2, sum(vs)) # mtcars2 is evaluated
# sum(vs) is quoted
sum(mtcars2$am) # matcars$am is evaluated
# am is quoted by $()

When we inspect the source code of rm(), we notice that rm() catches its ... argument as an unevaluated call (in this case a pairlist) via match.call(). This call is then converted into a string for further evaluation.

rm(mtcars2) # mtcars2 is quoted

For each function in the following tidyverse code, identify which arguments are quoted and which are evaluated.

library(dplyr)
library(ggplot2)

by_cyl <- mtcars %>%
  group_by(cyl) %>%
  summarise(mean = mean(mpg))

ggplot(by_cyl, aes(cyl, mean)) +
  geom_point()

Answer: library automatically quotes its arguments. cyl, mpg, and mean are all data.frame columns.

Quoted: dplyr, ggplot2, cyl, mpg, mean (in the final ggpot call)
Evaluated: by_cyl, mtcars

AR Solutions: From the previous exercise we’ve already learned that library() quotes its first argument.

library(dplyr) # dplyr is quoted
library(ggplot2) # ggplot2 is quoted

In similar fashion, it becomes clear that cyl is quoted by group_by().

by_cyl <- mtcars %>% # mtcars is evaluated
  group_by(cyl) %>% # cyl is quoted
  summarise(mean = mean(mpg)) # mean = mean(mpg) is quoted

To find out what happens in summarise(), we inspect the source code. Tracing down the S3-dispatch of summarise(), we see that the ... argument is quoted in dplyr:::summarise_cols() which is called in the underlying summarise.data.frame() method.

dplyr::summarise

#> function (.data, ..., .by = NULL, .groups = NULL) 
#> {
#>     by <- enquo(.by)
#>     if (!quo_is_null(by) && !is.null(.groups)) {
#>         abort("Can't supply both `.by` and `.groups`.")
#>     }
#>     UseMethod("summarise")
#> }
#> <bytecode: 0x12f5764d0>
#> <environment: namespace:dplyr>

dplyr:::summarise.data.frame

#> function (.data, ..., .by = NULL, .groups = NULL) 
#> {
#>     by <- compute_by({
#>         {
#>             .by
#>         }
#>     }, .data, by_arg = ".by", data_arg = ".data")
#>     cols <- summarise_cols(.data, dplyr_quosures(...), by, "summarise")
#>     out <- summarise_build(by, cols)
#>     if (!cols$all_one) {
#>         summarise_deprecate_variable_size()
#>     }
#>     if (!is_tibble(.data)) {
#>         out <- as.data.frame(out)
#>     }
#>     if (identical(.groups, "rowwise")) {
#>         out <- rowwise_df(out, character())
#>     }
#>     out
#> }
#> <bytecode: 0x11a0d9298>
#> <environment: namespace:dplyr>

dplyr:::summarise_cols
#> function (.data, ...)
#> {
#>     mask <- DataMask$new(.data, caller_env())
#>     dots <- enquos(...)
#>     dots_names <- names(dots)
#>     auto_named_dots <- names(enquos(..., .named = TRUE))
#>     cols <- list()
#>     sizes <- 1L
#>     chunks <- vector("list", length(dots))
#>     types <- vector("list", length(dots))
#>
#>     ## function definition abbreviated for clarity ##
#> }
#> <bytecode: 0x55b540c07ca0>
#> <environment: namespace:dplyr>

In the following {ggplot2} expression the cyl- and mean-objects are quoted.

ggplot(
  by_cyl, # by_cyl is evaluated
  aes(cyl, mean) # aes() is evaluated
) +
  # cyl, mean is quoted (via aes)
  geom_point()

We can confirm this also by inspecting aes()’s source code.

ggplot2::aes

#> function (x, y, ...) 
#> {
#>     xs <- arg_enquos("x")
#>     ys <- arg_enquos("y")
#>     dots <- enquos(...)
#>     args <- c(xs, ys, dots)
#>     args <- Filter(Negate(quo_is_missing), args)
#>     local({
#>         aes <- function(x, y, ...) NULL
#>         inject(aes(!!!args))
#>     })
#>     aes <- new_aes(args, env = parent.frame())
#>     rename_aes(aes)
#> }
#> <bytecode: 0x11e9281a0>
#> <environment: namespace:ggplot2>

19.3.6 Exercises

How is expr() implemented? Look at its source code.

Answer: reviewing the source code:

rlang::expr

#> function (expr) 
#> {
#>     enexpr(expr)
#> }
#> <bytecode: 0x1290ba6a8>
#> <environment: namespace:rlang>

rlang::enexpr

#> function (arg) 
#> {
#>     .Call(ffi_enexpr, substitute(arg), parent.frame())
#> }
#> <bytecode: 0x11f561978>
#> <environment: namespace:rlang>

expr() simply calls enexpr(), which uses the C++ function ffi_enexpr and uses the base R function substitute().

AR Solutions: expr() acts as a simple wrapper, which passes its argument to enexpr().

Compare and contrast the following two functions. Can you predict the output before running them?

f1 <- function(x, y) {
  exprs(x = x, y = y)
}
f2 <- function(x, y) {
  enexprs(x = x, y = y)
}
f1(a + b, c + d)
f2(a + b, c + d)

Answer: per Advanced R, exprs(x = x, y = y) is shorthand for list(x = expr(x), y = expr(y)), and expr() will capture the argument exactly as provided. enexpr() captures what the caller supplied, with enexprs() returning a list.

Test the predictions in comments:

f1 <- function(x, y) {
  exprs(x = x, y = y)
}
f2 <- function(x, y) {
  enexprs(x = x, y = y)
}
# returns $x x $y y
f1(a + b, c + d)

#> $x
#> x
#> 
#> $y
#> y

# returns $x a + b $y c + d
f2(a + b, c + d)

#> $x
#> a + b
#> 
#> $y
#> c + d

Correct!

AR Solutions: Both functions are able to capture multiple arguments and will return a named list of expressions. f1() will return the arguments defined within the body of f1(). This happens because exprs() captures the expressions as specified by the developer during the definition of f1().

f1(a + b, c + d)

#> $x
#> x
#> 
#> $y
#> y

f2() will return the arguments supplied to f2() as specified by the user when the function is called.

f2(a + b, c + d)

#> $x
#> a + b
#> 
#> $y
#> c + d

What happens if you try to use enexpr() with an expression (i.e. enexpr(x + y) ? What happens if enexpr() is passed a missing argument?

Answer: from the code below, arg must be a symbol, not an expression, and arg must exist.

try(enexpr(x + y))

#> Error in enexpr(x + y) : `arg` must be a symbol

try(enexpr(arg = foo))

#> Error in (function (arg)  : object 'foo' not found

AR Solutions: In the first case an error is thrown:

on_expr <- function(x) {
  enexpr(expr(x))
}
try(on_expr(x + y))

#> Error in enexpr(expr(x)) : `arg` must be a symbol

In the second case a missing argument is returned:

on_missing <- function(x) {
  enexpr(x)
}
on_missing()

is_missing(on_missing())

#> [1] TRUE

How are exprs(a) and exprs(a = ) different? Think about both the input and the output.

Answer: as the code below demonstrates, expr(a) creates an unnamed list with a as the first element. exprs(a = ) which creates an named list with an empty first element. Input of the form x = y creates a named list, while the form x creates an unnamed list.

exprs(a)

#> [[1]]
#> a

exprs(a = )

#> $a

exprs(a = a)

#> $a
#> a

AR Solutions: In exprs(a) the input a is interpreted as a symbol for an unnamed argument. Consequently, the output shows an unnamed list with the first element containing the symbol a.

out1 <- exprs(a)
str(out1)

#> List of 1
#>  $ : symbol a

In exprs(a = ) the first argument is named a, but then no value is provided. This leads to the output of a named list with the first element named a, which contains the missing argument.

out2 <- exprs(a = )
str(out2)

#> List of 1
#>  $ a: symbol

is_missing(out2$a)

#> [1] TRUE

What are other differences between exprs() and alist()? Read the documentation for the named arguments of exprs() to find out.

Answer: exprs() has three named arguments (alist() has none):

.named, which automatically adds names to the list
.ignore_empty, which selectively ignores empty arguments depending on the setting
.unquote_names, which treats use of := (which allows names injection) as =

AR Solutions: exprs() provides the additional arguments .named (= FALSE), .ignore_empty (c("trailing", "none", "all")) and .unquote_names (TRUE). .named allows to ensure that all dots are named. ignore_empty allows to specify how empty arguments should be handled for dots ("trailing") or all arguments ("none" and "all"). Further via .unquote_names one can specify if := should be treated like =. := can be useful as it supports unquoting (!!) on the left-hand side.

The documentation for substitute() says:
Substitution takes place by examining each component of the parse tree as follows:
- If it is not a bound symbol in env, it is unchanged.
- If it is a promise object (i.e., a formal argument to a function) the expression slot of the promise replaces the symbol.
- If it is an ordinary variable, its value is substituted, unless env is .GlobalEnv in which case the symbol is left unchanged.
Create examples that illustrate each of the above cases.

Answer: reviewing Google results for R bound symbol, R promise object, and chapter 6.5.1, construct the following code:

# ordinary variable in `.GlobalEnv`
foo <- "bar"
substitute(foo)

#> foo

# ordinary variable not in `.GlobalEnv`
local({
  foo <- "bar"
  substitute(foo)
})

#> [1] "bar"

# not a bound symbol in `env`
substitute(func)

#> func

# promise object
local({
  x <- 1:5
  y <- 1:10
  substitute(mean(x = y))
})

#> mean(x = 1:10)

In the promise example, y is substituted, but not x, since x is the formal argument to mean().

AR Solutions: Let’s create a new environment my_env, which contains no objects. In this case substitute() will just return its first argument (expr):

my_env <- env()
substitute(x, my_env)

#> x

When we create a function containing an argument, which is directly returned after substitution, this function just returns the provided expression:

foo <- function(x) substitute(x)

foo(x + y * sin(0))

#> x + y * sin(0)

In case substitute() can find (parts of) the expression in env, it will literally substitute. However, unless env is .GlobalEnv.

my_env$x <- 7
substitute(x, my_env)

#> [1] 7

x <- 7
substitute(x, .GlobalEnv)

#> x

19.4.8 Exercises

Given the following components:

xy <- expr(x + y)
xz <- expr(x + z)
yz <- expr(y + z)
abc <- exprs(a, b, c)

Use quasiquotation to construct the following calls:

(x + y) / (y + z)
-(x + z)^(y + z)
(x + y) + (y + z) - (x + y)
atan2(x + y, y + z)
sum(x + y, x + y, y + z)
sum(a, b, c)
mean(c(a, b, c), na.rm = TRUE)
foo(a = x + y, b = y + z)

Answer: code below.

# (x + y) / (y + z)
expr(!!xy / !!yz)

#> (x + y)/(y + z)

# -(x + z) ^ (y + z)
expr(-(!!xz)^!!yz)

#> -(x + z)^(y + z)

# (x + y) + (y + z) - (x + y)
expr(((!!xy)) + !!yz - !!xy)

#> (x + y) + (y + z) - (x + y)

# atan2(x + y, y + z)
expr(atan2(!!xy, !!yz))

#> atan2(x + y, y + z)

# sum(x + y, x + y, y + z)
expr(sum(!!xy, !!xy, !!yz))

#> sum(x + y, x + y, y + z)

# sum(a, b, c)
expr(sum(!!!abc))

#> sum(a, b, c)

# mean(c(a, b, c), na.rm = TRUE)
expr(mean(c(!!!abc), na.rm = TRUE))

#> mean(c(a, b, c), na.rm = TRUE)

# foo(a = x + y, b = y + z)
expr(foo(a = !!xy, b = !!yz))

#> foo(a = x + y, b = y + z)

Surprisingly, multiple parentheses are needed to construct (x + y) + (y + z) - (x + y).

AR Solutions We combine and unquote the given quoted expressions to construct the desired calls like this:

expr(!!xy / !!yz) # (1)

#> (x + y)/(y + z)

expr(-(!!xz)^(!!yz)) # (2)

#> -(x + z)^(y + z)

expr(((!!xy)) + !!yz - !!xy) # (3)

#> (x + y) + (y + z) - (x + y)

expr(atan2(!!xy, !!yz)) # (4)

#> atan2(x + y, y + z)

expr(sum(!!xy, !!xy, !!yz)) # (5)

#> sum(x + y, x + y, y + z)

expr(sum(!!!abc)) # (6)

#> sum(a, b, c)

expr(mean(c(!!!abc), na.rm = TRUE)) # (7)

#> mean(c(a, b, c), na.rm = TRUE)

expr(foo(a = !!xy, b = !!yz)) # (8)

#> foo(a = x + y, b = y + z)

The following two calls print the same, but are actually different:

(a <- expr(mean(1:10)))

#> mean(1:10)

(b <- expr(mean(!!(1:10))))

#> mean(1:10)

identical(a, b)

#> [1] FALSE

What’s the difference? Which one is more natural?

Answer: the key difference is the use of !! for the sequence 1:10. Comparing expr() for both of the arguments supplied to mean, !! changes the expression from a call to : to an integer vector:

arga <- expr(1:10)
argb <- expr(!!(1:10))
arga

#> 1:10

ast(!!arga)

#> █─`:` 
#> ├─1 
#> └─10

argb

#>  [1]  1  2  3  4  5  6  7  8  9 10

ast(!!argb)

#> <inline integer>

Use of !! creates a non-standard AST with an inline integer. The first form is more natural.

AR Solutions: It’s easiest to see the difference with lobstr::ast():

lobstr::ast(mean(1:10))

#> █─mean 
#> └─█─`:` 
#>   ├─1 
#>   └─10

lobstr::ast(mean(!!(1:10)))

#> █─mean 
#> └─<inline integer>

In the expression mean(!!(1:10)) the call 1:10 is evaluated to an integer vector, while still being a call object in mean(1:10).

The first version (mean(1:10)) seems more natural. It captures lazy evaluation, with a promise that is evaluated when the function is called. The second version (mean(!!(1:10))) inlines a vector directly into a call.

19.6.5 Exercises

One way to implement exec() is shown below. Describe how it works. What are the key ideas?

exec <- function(f, ..., .env = caller_env()) {
  args <- list2(...)
  do.call(f, args, envir = .env)
}

Answer: the implementation is a wrapper to do.call(), which requires a function, list of arguments, and environment (it also has a quote parameter which is set to FALSE by default). list2() is used to convert the function arguments into a list which is compatible with do.call().

AR Solutions: exec() takes a function (f), its arguments (...) and an environment (.env) as input. This allows to construct a call from f and ... and evaluate this call in the supplied environment. As the ... argument is handled via list2(), exec() supports tidy dots (quasiquotation), which means that arguments and names (on the left-hand side of :=) can be unquoted via !! and !!!.

Carefully read the source code for interaction(), expand.grid(), and par(). Compare and contrast the techniques they use for switching between dots and list behaviour.

Answer: reviewing the source code for each function, all three functions convert dots into a list using list(...). All three also allow passing multiple arguments as well as a list as a single argument.

interaction

#> function (..., drop = FALSE, sep = ".", lex.order = FALSE) 
#> {
#>     args <- list(...)
#>     narg <- length(args)
#>     if (narg < 1L) 
#>         stop("No factors specified")
#>     if (narg == 1L && is.list(args[[1L]])) {
#>         args <- args[[1L]]
#>         narg <- length(args)
#>     }
#>     for (i in narg:1L) {
#>         f <- as.factor(args[[i]])[, drop = drop]
#>         l <- levels(f)
#>         if1 <- as.integer(f) - 1L
#>         if (i == narg) {
#>             ans <- if1
#>             lvs <- l
#>         }
#>         else {
#>             if (lex.order) {
#>                 ll <- length(lvs)
#>                 ans <- ans + ll * if1
#>                 lvs <- paste(rep(l, each = ll), rep(lvs, length(l)), 
#>                   sep = sep)
#>             }
#>             else {
#>                 ans <- ans * length(l) + if1
#>                 lvs <- paste(rep(l, length(lvs)), rep(lvs, each = length(l)), 
#>                   sep = sep)
#>             }
#>             if (anyDuplicated(lvs)) {
#>                 ulvs <- unique(lvs)
#>                 while ((i <- anyDuplicated(flv <- match(lvs, 
#>                   ulvs)))) {
#>                   lvs <- lvs[-i]
#>                   ans[ans + 1L == i] <- match(flv[i], flv[1:(i - 
#>                     1)]) - 1L
#>                   ans[ans + 1L > i] <- ans[ans + 1L > i] - 1L
#>                 }
#>                 lvs <- ulvs
#>             }
#>             if (drop) {
#>                 olvs <- lvs
#>                 lvs <- lvs[sort(unique(ans + 1L))]
#>                 ans <- match(olvs[ans + 1L], lvs) - 1L
#>             }
#>         }
#>     }
#>     structure(as.integer(ans + 1L), levels = lvs, class = "factor")
#> }
#> <bytecode: 0x11abab928>
#> <environment: namespace:base>

expand.grid

#> function (..., KEEP.OUT.ATTRS = TRUE, stringsAsFactors = TRUE) 
#> {
#>     nargs <- length(args <- list(...))
#>     if (!nargs) 
#>         return(as.data.frame(list()))
#>     if (nargs == 1L && is.list(a1 <- args[[1L]])) 
#>         nargs <- length(args <- a1)
#>     if (nargs == 0L) 
#>         return(as.data.frame(list()))
#>     cargs <- vector("list", nargs)
#>     iArgs <- seq_len(nargs)
#>     nmc <- paste0("Var", iArgs)
#>     nm <- names(args)
#>     if (is.null(nm)) 
#>         nm <- nmc
#>     else if (any(ng0 <- nzchar(nm))) 
#>         nmc[ng0] <- nm[ng0]
#>     names(cargs) <- nmc
#>     rep.fac <- 1L
#>     d <- lengths(args)
#>     if (KEEP.OUT.ATTRS) {
#>         dn <- vector("list", nargs)
#>         names(dn) <- nmc
#>     }
#>     orep <- prod(d)
#>     if (orep == 0L) {
#>         for (i in iArgs) cargs[[i]] <- args[[i]][FALSE]
#>     }
#>     else {
#>         for (i in iArgs) {
#>             x <- args[[i]]
#>             if (KEEP.OUT.ATTRS) 
#>                 dn[[i]] <- paste0(nmc[i], "=", if (is.numeric(x)) 
#>                   format(x)
#>                 else x)
#>             nx <- length(x)
#>             orep <- orep/nx
#>             if (stringsAsFactors && is.character(x)) 
#>                 x <- factor(x, levels = unique(x))
#>             x <- x[rep.int(rep.int(seq_len(nx), rep.int(rep.fac, 
#>                 nx)), orep)]
#>             cargs[[i]] <- x
#>             rep.fac <- rep.fac * nx
#>         }
#>     }
#>     if (KEEP.OUT.ATTRS) 
#>         attr(cargs, "out.attrs") <- list(dim = d, dimnames = dn)
#>     rn <- .set_row_names(as.integer(prod(d)))
#>     structure(cargs, class = "data.frame", row.names = rn)
#> }
#> <bytecode: 0x11ac0d180>
#> <environment: namespace:base>

par

#> function (..., no.readonly = FALSE) 
#> {
#>     .Pars.readonly <- c("cin", "cra", "csi", "cxy", "din", "page")
#>     single <- FALSE
#>     args <- list(...)
#>     if (!length(args)) 
#>         args <- as.list(if (no.readonly) 
#>             .Pars[-match(.Pars.readonly, .Pars)]
#>         else .Pars)
#>     else {
#>         if (all(unlist(lapply(args, is.character)))) 
#>             args <- as.list(unlist(args))
#>         if (length(args) == 1) {
#>             if (is.list(args[[1L]]) || is.null(args[[1L]])) 
#>                 args <- args[[1L]]
#>             else if (is.null(names(args))) 
#>                 single <- TRUE
#>         }
#>     }
#>     value <- .External2(C_par, args)
#>     if (single) 
#>         value <- value[[1L]]
#>     if (!is.null(names(args))) 
#>         invisible(value)
#>     else value
#> }
#> <bytecode: 0x1072da278>
#> <environment: namespace:graphics>

AR Solutions: All three functions capture the dots via args <- list(...).

interaction() computes factor interactions between the captured input factors by iterating over the args. When a list is provided this is detected via length(args) == 1 && is.list(args[[1]]) and one level of the list is stripped through args <- args[[1]]. The rest of the function’s code doesn’t differentiate further between list and dots behaviour.

# styler: off
# Both calls create the same output
interaction(     a = c("a", "b", "c", "d"), b = c("e", "f"))  # dots

#> [1] a.e b.f c.e d.f
#> Levels: a.e b.e c.e d.e a.f b.f c.f d.f

interaction(list(a = c("a", "b", "c", "d"), b = c("e", "f"))) # list

#> [1] a.e b.f c.e d.f
#> Levels: a.e b.e c.e d.e a.f b.f c.f d.f

# styler: on

expand.grid() uses the same strategy and also assigns args <- args[[1]] in case of length(args) == 1 && is.list(args[[1]]).

par() does the most pre-processing to ensure a valid structure of the args argument. When no dots are provided (!length(args)) it creates a list of arguments from an internal character vector (partly depending on its no.readonly argument). Further, given that all elements of args are character vectors (all(unlist(lapply(args, is.character)))), args is turned into a list via as.list(unlist(args)) (this flattens nested lists). Similar to the other functions, one level of args gets stripped via args <- args[[1L]], when args is of length one and its first element is a list.

Explain the problem with this definition of set_attr()

set_attr <- function(x, ...) {
  attr <- rlang::list2(...)
  attributes(x) <- attr
  x
}
try(set_attr(1:10, x = 10))

#> Error in attributes(x) <- attr : attributes must be named

Answer: attributes(x) <- value requires value to be a named list, which is only generated for list2 calls of the form list2(a = 1, b = 2) - setting .named = TRUE doesn’t help in this case as it generates zero-length names which are not allowed by attributes(). Using dots will only work when each attribute is explicitly named.

set_attr <- function(x, ...) {
  attr <- rlang::list2(..., .named = TRUE)
  attributes(x) <- attr
  x
}
try(set_attr(1:10, x = 10))

#> Error in attributes(x) <- attr : attempt to use zero-length variable name

AR Solutions: set_attr() expects an object named x and its attributes, supplied via the dots. Unfortunately, this prohibits us to provide attributes named x as these would collide with the argument name of our object. Even omitting the object’s argument name doesn’t help in this case — as can be seen in the example where the object is consequently treated as an unnamed attribute.

However, we may name the first argument .x, which seems clearer and less likely to invoke errors. In this case 1:10 will get the (named) attribute x = 10 assigned:

set_attr <- function(.x, ...) {
  attr <- rlang::list2(...)

  attributes(.x) <- attr
  .x
}

set_attr(1:10, x = 10)

#>  [1]  1  2  3  4  5  6  7  8  9 10
#> attr(,"x")
#> [1] 10

19.7.5 Exercises

In the linear-model example, we could replace the expr() in reduce(summands, ~ expr(!!.x + !!.y)) with call2(): reduce(summands, call2, "+"). Compare and contrast the two approaches. Which do you think is easier to read?

Answer: both approaches add the first and second arguments. The call2() method implicitly passes the arguments, where the formula method explicitly adds them, making it easier to understand.

AR Solutions:

Re-implement the Box-Cox transform defined below using unquoting and new_function():

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

bc(0)

#> function(x) log(x)
#> <environment: 0x12eaab560>

bc(2)

#> function(x) (x^lambda - 1) / lambda
#> <bytecode: 0x12ab746e8>
#> <environment: 0x11f693b50>

bc(0)(2)

#> [1] 0.6931472

bc(2)(2)

#> [1] 1.5

Answer: code below.

bc <- function(lambda) {
  if (lambda == 0) {
    func <- expr({
      log(x)
    })
  } else {
    func <- expr({
      ((x^!!lambda) - 1) / !!lambda
    })
  }
  new_function(
    exprs(x = ),
    func,
    caller_env()
  )
}

bc(0)

#> function (x) 
#> {
#>     log(x)
#> }

bc(2)

#> function (x) 
#> {
#>     ((x^2) - 1)/2
#> }

bc(0)(2)

#> [1] 0.6931472

bc(2)(2)

#> [1] 1.5

AR Solutions: Here new_function() allows us to create a function factory using tidy evaluation.

bc2 <- function(lambda) {
  lambda <- enexpr(lambda)

  if (!!lambda == 0) { # nolint: if_not_else_linter.
    new_function(exprs(x = ), expr(log(x)))
  } else {
    new_function(exprs(x = ), expr((x^(!!lambda) - 1) / !!lambda))
  }
}

bc2(0)

#> function (x) 
#> log(x)
#> <environment: 0x11b4942e0>

bc2(2)

#> function (x) 
#> (x^2 - 1)/2
#> <environment: 0x11b4fc5c8>

bc2(2)(2)

#> [1] 1.5

Note: I prefer the base R approach to new_function().

Re-implement the simple compose() defined below using quasiquotation and new_function():

compose <- function(f, g) {
  function(...) f(g(...))
}

compose(sum, as.integer)

#> function(...) f(g(...))
#> <environment: 0x11abc43a8>

compose(sum, as.integer)(1:10)

#> [1] 55

Answer: (non-working) code below.

compose <- function(f, g) {
  new_function(
    expr(...),
    expr({
      (!!f)((!!g)(...))
    }),
    caller_env()
  )
}

compose(sum, as.integer)
compose(sum, as.integer)(1:10)

AR Solutions: The implementation is fairly straightforward, even though a lot of parentheses are required:

compose2 <- function(f, g) {
  f <- enexpr(f)
  g <- enexpr(g)

  new_function(exprs(... = ), expr((!!f)((!!g)(...))))
}

compose(sin, cos)

#> function(...) f(g(...))
#> <bytecode: 0x119843920>
#> <environment: 0x118560830>

compose(sin, cos)(pi)

#> [1] -0.841471

compose2(sin, cos)

#> function (...) 
#> sin(cos(...))
#> <environment: 0x1184944a0>

compose2(sin, cos)(pi)

#> [1] -0.841471

20 Evaluation

The user-facing inverse of quotation is unquotation: it gives the user the ability to selectively evaluate parts of an otherwise quoted argument. The developer-facing complement of quotation is evaluation: this gives the developer the ability to evaluate quoted expressions in custom environments to achieve specific goals.

This chapter begins with a discussion of evaluation in its purest form. You’ll learn how eval() evaluates an expression in an environment, and then how it can be used to implement a number of important base R functions. Once you have the basics under your belt, you’ll learn extensions to evaluation that are needed for robustness. There are two big new ideas:

The quosure: a data structure that captures an expression along with its associated environment, as found in function arguments.
The data mask, which makes it easier to evaluate an expression in the context of a data frame. This introduces potential evaluation ambiguity which we’ll then resolve with data pronouns.

Together, quasiquotation, quosures, and data masks form what we call tidy evaluation, or tidy eval for short. Tidy eval provides a principled approach to non-standard evaluation that makes it possible to use such functions both interactively and embedded with other functions. Tidy evaluation is the most important practical implication of all this theory so we’ll spend a little time exploring the implications. The chapter finishes off with a discussion of the closest related approaches in base R, and how you can program around their drawbacks.

20.2.4 Exercises

Carefully read the documentation for source(). What environment does it use by default? What if you supply local = TRUE? How do you provide a custom environment?

Answer: by default, source() uses the global environment, and uses the calling environment with local = TRUE, and doesn’t support other options; to provide a custom environment, you must use sys.source().

AR Solutions: By default, source() uses the global environment (local = FALSE). A specific evaluation environment may be chosen, by passing it explicitly to the local argument. To use current environment (i.e. the calling environment of source()) set local = TRUE.

# Create a temporary, sourceable R script that prints x
tmp_file <- tempfile()
writeLines("print(x)", tmp_file)

# Set `x` globally
x <- "global environment"
env2 <- env(x = "specified environment")

locate_evaluation <- function(file, local) {
  x <- "local environment"
  source(file, local = local)
}

# Where will source() evaluate the code?
locate_evaluation(tmp_file, local = FALSE) # default

#> [1] "global environment"

locate_evaluation(tmp_file, local = env2)

#> [1] "specified environment"

locate_evaluation(tmp_file, local = TRUE)

#> [1] "local environment"

Predict the results of the following lines of code:

eval(expr(eval(expr(eval(expr(2 + 2))))))
eval(eval(expr(eval(expr(eval(expr(2 + 2)))))))
expr(eval(expr(eval(expr(eval(expr(2 + 2)))))))

Answer: all of these should return 4, since the innermost expression is evaluated first.

eval(expr(eval(expr(eval(expr(2 + 2))))))

#> [1] 4

eval(eval(expr(eval(expr(eval(expr(2 + 2)))))))

#> [1] 4

expr(eval(expr(eval(expr(eval(expr(2 + 2)))))))

#> eval(expr(eval(expr(eval(expr(2 + 2))))))

Incorrect: let’s explore how these are evaluated:

expr(2 + 2)

#> 2 + 2

eval(expr(2 + 2))

#> [1] 4

expr(eval(expr(2 + 2)))

#> eval(expr(2 + 2))

eval(expr(eval(expr(2 + 2))))

#> [1] 4

expr(eval(expr(eval(expr(2 + 2)))))

#> eval(expr(eval(expr(2 + 2))))

eval(expr(eval(expr(eval(expr(2 + 2))))))

#> [1] 4

When expr() is on the outside, the expression isn’t evaluated, when eval() is on the outside the answer ‘collapses’ to 4.

AR Solutions: Let’s look at a quote from the first edition of Advanced R:

“expr() and eval() are opposites. […] each eval() peels off one layer of expr()’s”.

In general, eval(expr(x)) evaluates to x. Therefore, (1) evaluates to $2 + 2 = 4$. Adding another eval() doesn’t have impact here. So, also (2) evaluates to 4. However, when wrapping (1) into expr() the whole expression will be quoted.

eval(expr(eval(expr(eval(expr(2 + 2)))))) # (1)

#> [1] 4

eval(eval(expr(eval(expr(eval(expr(2 + 2))))))) # (2)

#> [1] 4

expr(eval(expr(eval(expr(eval(expr(2 + 2))))))) # (3)

#> eval(expr(eval(expr(eval(expr(2 + 2))))))

Fill in the function bodies below to re-implement get() using sym() and eval(), andassign() using sym(), expr(), and eval(). Don’t worry about the multiple ways of choosing an environment that get() and assign() support; assume that the user supplies it explicitly.

# name is a string
get2 <- function(name, env) {}
assign2 <- function(name, value, env) {}

Answer: code below.

get2 <- function(name, env) {
  eval(sym(name), envir = env)
}
assign2 <- function(name, value, env) {
  s <- sym(name)
  eval(expr(!!s <- !!value), envir = env)
}

test <- 1234
get2("test", caller_env())

#> [1] 1234

assign2("test", 2345, caller_env())
test

#> [1] 1234

AR Solutions: We reimplement these two functions using tidy evaluation. We turn the string name into a symbol, then evaluate it:

get2 <- function(name, env = caller_env()) {
  name_sym <- sym(name)
  eval(name_sym, env)
}

x <- 1
get2("x")

#> [1] 1

To build the correct expression for the value assignment, we unquote using !!.

assign2 <- function(name, value, env = caller_env()) {
  name_sym <- sym(name)
  assign_expr <- expr(!!name_sym <- !!value)
  eval(assign_expr, env)
}

assign2("x", 4)
x

#> [1] 4

Note: I had to review AR Solutions to discover the need to unquote using !!.

Modify source2() so it returns the result of every expression, not just the last one. Can you eliminate the for loop?

Answer: code below.

my_source2 <- function(path, env = caller_env()) {
  file <- paste(readLines(path, warn = FALSE), collapse = "\n")
  exprs <- parse_exprs(file)

  invisible(lapply(exprs, eval, env))
}

AR Solutions: The code for source2() was given in Advanced R as:

source2 <- function(path, env = caller_env()) {
  file <- paste(readLines(path, warn = FALSE), collapse = "\n")
  exprs <- parse_exprs(file)

  res <- NULL
  for (i in seq_along(exprs)) {
    res <- eval(exprs[[i]], env)
  }

  invisible(res)
}

In order to highlight the modifications in our new source2() function, we’ve preserved the differing code from the former source2() in a comment.

source2 <- function(path, env = caller_env()) {
  file <- paste(readLines(path, warn = FALSE), collapse = "\n")
  exprs <- parse_exprs(file)

  # res <- NULL
  # for (i in seq_along(exprs)) {
  #   res[[i]] <- eval(exprs[[i]], env)
  # }

  res <- purrr::map(exprs, eval, env)

  invisible(res)
}

Let’s create a file and test source2(). Keep in mind that <- returns invisibly.

tmp_file <- tempfile()
writeLines(
  "x <- 1
       x
       y <- 2
       y  # some comment",
  tmp_file
)

(source2(tmp_file))

#> [[1]]
#> [1] 1
#> 
#> [[2]]
#> [1] 1
#> 
#> [[3]]
#> [1] 2
#> 
#> [[4]]
#> [1] 2

Note: validate my_source2() returns the same results:

(my_source2(tmp_file))

#> [[1]]
#> [1] 1
#> 
#> [[2]]
#> [1] 1
#> 
#> [[3]]
#> [1] 2
#> 
#> [[4]]
#> [1] 2

We can make base::local() slightly easier to understand by spreading out over multiple lines:

local3 <- function(expr, envir = new.env()) {
  call <- substitute(eval(quote(expr), envir))
  eval(call, envir = parent.frame())
}

Explain how local() works in words. (Hint: you might want to print(call) to help understand what substitute() is doing, and read the documentation to remind yourself what environment new.env() will inherit from.)

Answer: adding print(call) shows that substitute() creates a call to evaluate the expression passed to local3() in new.env(), which inherits the environment from the caller. So:

local() works by evaluating an expression in a new child environment.

local3 <- function(expr, envir = new.env()) {
  call <- substitute(eval(quote(expr), envir))
  print(call)
  eval(call, envir = parent.frame())
}

local3(test <- 4567)

#> eval(quote(test <- 4567), new.env())

AR Solutions: Let’s follow the advice and add print(call) inside of local3():

local3 <- function(expr, envir = new.env()) {
  call <- substitute(eval(quote(expr), envir))
  print(call)
  eval(call, envir = parent.frame())
}

The first line generates a call to eval(), because substitute() operates in the current evaluation argument. However, this doesn’t matter here, as both, expr and envir are promises and therefore “the expression slots of the promises replace the symbols”, from ?substitute.

local3({
  x <- 10
  x * 2
})

#> eval(quote({
#>     x <- 10
#>     x * 2
#> }), new.env())

#> [1] 20

Next, call will be evaluated in the caller environment (aka the parent frame). Given that call contains another call eval() why does this matter? The answer is subtle: this outer environment determines where the bindings for eval, quote, and new.env are found.

eval(quote({
  x <- 10
  x * 2
}), new.env())

#> [1] 20

exists("x")

#> [1] TRUE