Expressions.rmd

---
title: Metaprogramming
layout: default
---

# Metaprogramming
```{r, echo = FALSE}
library(pryr)
```

```{r, echo = FALSE, eval = FALSE}
funs <- find_uses(
  c("package:base", "package:utils", "package:stats"),
  c("substitute", "call", "as.call", "quote", "expression", "enquote", "bquote")
)
```

In [non-standard evaluation](#nse), you learned the basics of accessing the expressions underlying computation in R, and evaluating them in new ways. In this chapter, you'll learn how to manipulate expressions with code. In other words, you're going to learn how to write code with code, which is also called metaprogramming or computing on the language.

FIXME: chapter preview.

* more about the underlying structure of expressions, and how you can compute on them directly.

* The structure of expressions (a tree made up of constants, names and calls) and how you can create and modify them directly

* How to flexibly convert expressions between their tree form and their text form, and how `source()` works.

* Create functions by hand as an alternative instead of using a closure, so that viewing the source of the function shows something meaningful.

* Walk the code tree using recursive functions to understand how many of the functions in the codetools package work, and to you write your own functions that detect if a function uses logical abbreviations, list all assignments inside a function and understand how `bquote()` works.

The techniques in this chapter give an alternative approach to writing code in strings with, `paste()`, `parse()` and `eval()`. Here

```{r}
adder1 <- function(x) function(y) y + x
adder2 <- function(x) {
  code <- paste0("function(y) y + ", x)
  eval(parse(text = code))
}
adder3 <- function(x) {
  make_function(alist(x = ), substitute(y + x, list(x = x)))
}
adder1(10)
adder2(10)
adder3(10)
```

It's generally a bad idea to create code by operating on its string representation: there is no guarantee that you'll create valid code.  Don't get me wrong: pasting strings together will often allow you to solve your problem in the least amount of time, but it may create subtle bugs that will take your users hours to track down. Learning more about the structure of the R language and the tools that allow you to modify it is an investment that will pay off by allowing you to make more robust code.

### Prereqs

Thoroughout this chapter we're going to use tools from the `pryr` package to help see what's going on.  If you don't already have it, install it by running `devtools::install_github("hadley/pryr")`.

## Structure of expressions

To compute on the language, we first need to understand the structure of the language. That's going to require some new vocabulary, some new tools and some new ways of thinking about R code. The first thing you need to understand is the distinction between an operation and its result:

```{r}
x <- 4
y <- x * 10
y
```

We want to distinguish action of multiplying x by 10 and assigning the results to `y` from the actual result (40).  As you've seen in the previous chapter, we can capture the action with `quote()`:

```{r}
z <- quote(y <- x * 10)
z
```

`quote()` gives us back an __expression__, an object that represents an action that can be performed by R.

(Unfortunately the `expression()` function does not produce an expression in this sense. Instead, it returns something more like a list of expressions, with some special behaviour for `eval()`. However, you never need to use `expression()`, and they definition of expression that follows match more closely to the use of the term in R, and in other programming languages. FIXME)

An expression is also called an abstract syntax tree (AST) because it represents the abstract structure of the code in a tree form. We can use `pryr::ast()` to see the hierarchy more clearly:

```{r}
ast(y <- x * 10)
```

There are three components of an expression: constants, names and calls.

* __constants__ are length one atomic vectors, like `"a"` or `10`.
  `ast()` displays them as is.

    ```{r}
    ast("a")
    ast(1)
    ast(1L)
    ast(TRUE)
    ```

    Quoting an length one atomic vector returns it unchanged.

    ```{r}
    is.atomic(quote(1))
    identical(1, quote(1))
    is.atomic(quote("test"))
    identical("test", quote("test"))
    ```

* __names__ which the name of an object, not its value. Names are
  also called symbols. Names are prefixed with `'` by `call_tree()`.

    ```{r}
    ast(x)
    ast(mean)
    ast(`an unusual name`)
    ```

* __calls__ represent the action of calling a function. Calls are recursive
  and work like lists: you can extract the `i`th element of call `x` with
  `x[[i]]`, not its result. `ast()` prints `()` after calls, then lists
  the arguments of call.

    ```{r}
    ast(f())
    ast(f(1, 2))
    ast(f(a, b))
    ast(f(g(), h(1, a)))
    ```

    As mentioned in [every operation is a function call]
    (#every-operation-is-a-function-call), even things that don't look like
    function calls still follow this same hierarchical structure:

    ```{r}
    ast(a + b)
    ast(if (x > 1) x else 1/x)
    ast(function(x, y) {x * y})
    ```

Collectively names and calls are sometimes called language objects, and can be tested for with `is.language()`. Note that `str()` is somewhat inconsistent with respect to this naming convention, describing names as symbols, and calls as a language objects:

```{r}
str(quote(a))
str(quote(a + b))
```

Using low-level functions, it is possible to create call trees that contain objects other can constants, calls and names. The following example uses `substitute()` to insert a data frame into a call tree. As you can see, this is a bad idea because the object does not print correctly. The printed call looks like it should return "list", but when evaluated, it returns the "data.frame".

```{r}
class_df <- substitute(class(df), list(df = data.frame(x = 10)))
class_df
eval(class_df)
```

Together, constants, names and calls define the structure of all R code. The following two sections provides more detail about names and calls.

### Exercises

1.  `pryr::ast()` uses non-standard evaluation. What equivalent uses standard
    evaluation?

1.   Why can't an expression contain an atomic vector of length greater than 1?

1.   One of the the six types of atomic vector can't appear in an
     expression. Which one and why?

1.   Complex numbers with only an imaginary component, e.g. `1i`, print like
     `0+1i`. Is this reprsented internally as addition?

## Names

As well as capturing names with `quote()`, you can convert a string to a name with `as.name()`. This is mostly useful when your function receives strings as input, as otherwise it's more typing than using `quote()`. Use `is.name()` to test if an object is a name.

```{r}
as.name("name")
identical(quote(name), as.name("name"))

is.name("name")
is.name(quote(name))
is.name(quote(f(name)))
```

(Names are also called symbols. `as.symbol()` and `is.symbol()` are identical to `as.name()` and `is.name()`.)

Names that would otherwise be invalid are automatically surrounded by backticks:

```{r}
as.name("a b")
as.name("if")
```

There's one special name that needs a little extra discussion: the empty name, used to represent missing arguments. This object behaves strangely. You can't bind it to a variable: if you do, it triggers an error about missing arguments. It's only useful if you want to programmatically create a function with missing arguments.

```{r, error = TRUE}
f <- function(x) 10
formals(f)$x
is.name(formals(f)$x)
as.character(formals(f)$x)

missing_arg <- formals(f)$x
# Doesn't work!
is.name(missing_arg)
```

To explicitly create it when needed, call `quote()` with a named argument:

```{r}
quote(expr =)
```

### Exercises

* You can use `formals()` to both get and set the arguments of a function.
  Use `formals()` to modify the following function so that the default value
  of `x` is missing and `y` is 10.

    ```{r}
    g <- function(x = 20, y) {
      x + y
    }
    ```

* Write an equivalent to `get()` using `as.name()` and `eval()`. Write an
  equivalent to `assign()` using `as.name()`, `substitute()` and `eval()`.
  (Don't worry about the multiple ways of choosing an environment, assume
  that the user supplies it explicitly.)

## Calls

A call is very similar to a list. It has a has `length`, `[[` and `[` methods, is recursive because calls can contain other calls. The length of a call minus 1 gives the number of arguments:

```{r}
x <- quote(read.csv("important.csv", row.names = FALSE))
length(x) - 1
```

The first element of the call is usually the _name_ of a function:

```{r}
x[[1]]
is.name(x[[1]])
```

But it can also be another call:

```{r}
y <- quote(add(10)(20))
y[[1]]
is.call(y[[1]])
```

The remaining elements are the arguments. They can be extracted by name or by position.

```{r}
x <- quote(read.csv("important.csv", row.names = FALSE))
x[[2]]
x$row.names

names(x)
```

You can add, modify and delete elements of the call with the standard replacement operators, `$<-` and `[[<-`:

```{r}
y <- quote(read.csv("important.csv", row.names = FALSE))
y$row.names <- TRUE
y$col.names <- FALSE
y

y[[2]] <- "less-important.csv"
y[[4]] <- NULL
y

y$file <- quote(paste0(filename, ".csv"))
y
```

Calls also support the `[` method, but use it with care: removing the first element is unlikely to create a useful call.

```{r}
x[-3] # remove the second argument
x[-1] # remove the function name - but it's still a call!
x
```

Generally, getting or setting arguments by position is dangerous, because R's function calling semantics are so flexible. For example, the following three calls all have the same effect, even though the values at each position are call:

```{r}
m1 <- quote(read.delim("data.txt", sep = "|"))
m2 <- quote(read.delim(s = "|", "data.txt"))
m3 <- quote(read.delim(file = "data.txt", , "|"))
```

To work around this problem, pryr provides `standardise_call()`. It uses the base `match.call()` function to convert all positional arguments to named arguments:

```{r}
standardise_call(m1)
standardise_call(m2)
standardise_call(m3)
```

If you want to get a list of the unevaluated arguments, explicitly convert it to a list:

```{r}
# A list of the unevaluated arguments
as.list(x[-1])
```

To create a new call from its components you can use `call()` or `as.call()`. The first argument to `call()` is a string giving a function name. The other arguments are expressions that represent the arguments of the call.

```{r}
call(":", 1, 10)
call("mean", quote(1:10), na.rm = TRUE)
```

`as.call()` is a minor variation that takes a list. The first element is the _name_ of a function (not a string), and the subsequent elements are the arguments.

```{r}
x_call <- quote(1:10)
mean_call <- as.call(list(quote(mean), x_call))
identical(mean_call, quote(mean(1:10)))
```

You can not use `call()` to call that has a call as the first component:

```{r}
call("adder(1)", 10)
# But you can with as.call
as.call(list(quote(adder(1)), 10))
```

### Exercises

1.  The following two calls look the same, but are actually different:

    ```{r}
    (a <- call("mean", 1:10))
    (b <- call("mean", quote(1:10)))
    identical(a, b)
    ```

    What's the different and which one should you prefer?

1.  Implement a pure R version of `do.call()`.

1.  Concatenating a call and an expression with `c()` creates a list. Create
    a method that yields a call with additional argument.

    ```{r, eval = FALSE}
    concat(quote(f), a = 1, b = quote(mean(a)))
    #> f(a = 1, b = mean(a))
    ```

1.  There is no existing base function that checks where an element is
    a valid component of an expression (i.e. it's a constant, name or
    call). Implement one using what you've learned so far. Use it to
    make your `concat()` function safer.

1.  Since `list()`s don't belong in expressions, we could create a more
    convenient call construction function that automatically combined
    lists into the argument. Implement `make_call()` so that the following
    code works.

    ```{r, eval = FALSE}
    make_call(quote(mean), list(quote(x), na.rm = TRUE))
    make_call(quote(mean), quote(x), na.rm = TRUE)
    ```

    Use the function you wrote above to check that all inputs are valid.

1.  How does `mode<-` work? How does it use `call()`?

1.  Read the source for `pryr::standardise_call()`. How does it work?
    Why is `is.primitive()` needed?

1.  `standardise_call()` doesn't work so well for the following calls.
    Why?

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

1.  Read the documentation for `pryr::modify_call()`. How do you think
    it works? Read the source code.

1.  When writing functionals, it's often useful to accept the name of a
    function as a string, or the function object itself. Use `substitute()`
    and what you know about expressions to create a function that returns a
    list containing the name of the function (where you can determine it) and
    the function itself. Your function should return the same results as the
    following code:

    ```{r, eval = FALSE}
    fname(mean)
    #> list(name = "mean", f = mean)
    fname("mean")
    #> list(name = "mean", f = mean)
    fname(function(x) sum(x) / length(x))
    #> list(name = "<anonymous>", f = function(x) sum(x) / length(x))
    ```

    Create a version that uses standard evaluation suitable for calling
    from another function (Hint: it should have two arguments: an expression
    and an environment).

## Creating a function

There's one function call that's so special it's worth devoting a little extra attention to: the `function()` function that creates functions. This is one place we'll see "dotted" pair lists (the object type that predated lists in R's history).  The arguments of a function are stored as a pairlist: for our purposes we can treat a pairlist like a list, but we need to remember to cast arguments with `as.pairlist()`.

```{r}
str(quote(function(x, y = 1) x + y)[[2]])
````

Building up a function by hand is also useful when you can't use a closure because you don't know in advance what the arguments will be. We'll use `pryr::make_function()` to build up a function from its component pieces: an argument list, a quoted body (the code to run) and the environment in which it is defined (which defaults to the.current environment). The function itself is fairly simple: it creates a call to `function` with the args and body as arguments, and then evaluates that in the correct environment so that the function has the right scope.

```{r, eval = FALSE}
make_function <- function(args, body, env = parent.frame()) {
  args <- as.pairlist(args)

  eval(call("function", args, body), env)
}
```

(`pryr::make_function()` includes a little more error checking but is otherwise identical.)

Let's see a simple example

```{r}
add <- make_function(alist(a = 1, b = 2), quote(a + b))
add(1)
add(1, 2)
```

Note our use of the `alist()` (**a**rgument list) function.  We used this earlier when capturing unevaluated `...`, and we use it again here. Note that `alist()` doesn't evaluate its arguments and supports arguments with and without defaults (although if you don't want a default you need to be explicit). There's one small trick if you want to have `...` in the argument list: you need to use it on the left-hand side of an equals sign.

```{r}
make_function(alist(a = , b = a), quote(a + b))
make_function(alist(a = , b = ), quote(a + b))
make_function(alist(a = , b = , ... =), quote(a + b))
```

If you want to mix evaluated and unevaluated arguments, it might be easier to make the list by hand:

```{r}
x <- 1
args <- list()
args$a <- x
args$b <- quote(expr = )

make_function(args, quote(a + b))
```

### Unenclose

Most of the time it's simpler to use closures to create new functions, but `make_function()` is useful if we want to make it obvious to the user what the function does (printing out a closure isn't usually that helpful because all the variables are present by name, not by value).

We could use `make_function()` to create an `unenclose()` function that takes a closure and modifies it so when you look at the source you can see what's going on:

```{r}
unenclose <- function(f) {
  env <- environment(f)
  new_body <- substitute2(body(f), env)
  make_function(formals(f), new_body, parent.env(env))
}

f <- function(x) {
  function(y) x + y
}
f(1)
unenclose(f(1))
```

### Exercises

* Why does `unenclose()` use `substitute2()`, not `substitute()`?

* Modify `unenclose` so it only substitutes in atomic vectors, not more complicated objects. (Hint: think about what the parent environment should be.)

* Read the documentation and source for `pryr::partial()` - what does it do? How does it work?


## Parsing and deparsing

You can convert quoted calls back and forth between text with `parse()` and `deparse()`. You've seen `deparse()` already it: takes an expression and returns a character vector. `parse()` does the opposite: it takes a character vector and returns an expression object.

Since the primary use of `parse()` is parsing files of code on disk, the first argument is a file path, and if you have the code in a character vector, you need to use the `text` argument.

```{r}
z <- quote(y <- x * 10)
deparse(z)

parse(text = deparse(z))
```

`parse()` can't return just a single expression, because there might be many top-level calls in an file. So instead it returns expression objects, or expression lists. You should never need to create expression objects yourself, and all you need to know about them is that they work like a list of expressions:

```{r}
exp <- parse(text = c("x <- 4\nx\n5"))
length(exp)
exp[[1]]
exp[[2]]
exp[[3]]
call_tree(exp)
```

You can create expression objects by hand with `expression()`, but I don't recommend it. You already know how to work with lists of expressions, you don't need a special class for them.

With `parse()` and `eval()` you can write your own simple version of `source()`. We read in the file on disk, `parse()` it and then `eval()` each component in the specified environment. This version defaults to a new environment, so it doesn't affect existing objects. `source()` invisibly returns the result of the last expression in the file, so `simple_source()` does the same.

```{r}
simple_source <- function(file, envir = new.env()) {
  stopifnot(file.exists(file))
  stopifnot(is.environment(envir))

  lines <- readLines(file, warn = FALSE)
  exprs <- parse(text = lines, n = -1)

  n <- length(exprs)
  if (n == 0L) return(invisible())

  for (i in seq_len(n - 1)) {
    eval(exprs[i], envir)
  }
  invisible(eval(exprs[n], envir))
}
```

The real `source()` is considerably more complicated because it can `echo` input and output, and has many additional settings to control behaviour.

### Exercises

1.  What are the differences between `quote()` and `expression()`?

1.  Read the help for `deparse()` and construct a call that `deparse()`
    and `parse()` do not operate symmetrically on.

1.  Modify `simple_source()` so it returns the result of _every_ expression,
    not just the last one.

1.  What's the difference between `source()` and `sys.source()`?

1.  The most important missing feature in `simple_source()` is that it
    drops source referencs. Read the source code for `sys.source()` and
    the help for `srcfilecopy()`, then modify `simple_source()` to maintain
    source references. You can test your code by sourcing a function that
    contains a comment. If successful, when you look at the function,
    you'll see the comment, not just the source code.

## Capturing the current call

```{r, eval = FALSE, echo = FALSE}
std <- c("package:base", "package:utils", "package:stats")
names(find_uses(std, "sys.call"))
names(find_uses(std, "match.call"))
```

You may want to capture the expression that caused the current function to run. There are two ways to do this:

* `sys.call()` captures exactly what the user typed.

* `match.call()` makes a call that only uses named matching. It's like
  automatically calling `pryr::standardise_call()` on the result of
  `sys.call()`

The following example illustrates the difference:

```{r}
f <- function(abc = 1, def = 2, ghi = 3, ...) {
  list(sys = sys.call(), match = match.call())
}
f(d = 2, 2)
```

Many modelling functions use `match.call()` to capture the call used to create the model. This makes it possible to `update()` a model, re-fitting the model after modifying a selection of the original parameters. Here's an example of `update()` in action:

```{r}
mod <- lm(mpg ~ wt, data = mtcars)
update(mod, formula = . ~ . + cyl)
update(mod, subset = cyl == 4)
```

How does `update()` work?  We can rewrite it using some tools from pryr to focus on the essense of the algorithm.

```{r}
update_call <- function (object, formula., ...) {
  call <- object$call

  # Use update.formula to deal with formulas like . ~ .
  if (!missing(formula.)) {
    call$formula <- update.formula(formula(object), formula.)
  }

  modify_call(call, dots(...))
}
update_model <- function(object, formula., ...) {
  call <- update_call(object, formula., ...)
  eval(call, parent.frame())
}
update_model(mod, formula = . ~ . + cyl)
update_model(mod, subset = cyl == 4)
```

The original `update()` has an `evaluate` argument that controls whether the function returns a call or the result, but I think it's good principle for a function to only return one type of object, not different types depending on the arguments.

This rewrite also allows us to fix a small bug in `update()`: it evaluates the call in the global environment, when really we want to re-evaluate it in the environment where the model was originally fit. This happens to be stored in the formula.

```{r, error = TRUE}
f <- function() {
  n <- 3
  lm(mpg ~ poly(wt, n), data = mtcars)
}
mod <- f()
update(mod, data = mtcars)

update_model <- function(object, formula., ...) {
  call <- update_call(object, formula., ...)
  eval(call, environment(formula(object)))
}
update_model(mod, data = mtcars)
```

This is a good principle to remember: if you want to replay code captured with `match.call()`, you also need to capture the environment in which it was evaluated. There is a downside to this. Capturing the environment will capture any large objects in that environment, preventing their memory from being freed. This topic is explored in more detail in [garbage collection](#garbarge-collection).

Some base R functions use `match.call()` where it's not necessary.  For example,  `write.csv()` captures call to `write.csv()` and mangles it to call `write.table()`:

```{r}
write.csv <- function (...) {
  Call <- match.call(expand.dots = TRUE)
  for (argname in c("append", "col.names", "sep", "dec", "qmethod")) {
    if (!is.null(Call[[argname]])) {
      warning(gettextf("attempt to set '%s' ignored", argname), domain = NA)
    }
  }
  rn <- eval.parent(Call$row.names)
  Call$append <- NULL
  Call$col.names <- if (is.logical(rn) && !rn) TRUE else NA
  Call$sep <- ","
  Call$dec <- "."
  Call$qmethod <- "double"
  Call[[1L]] <- as.name("write.table")
  eval.parent(Call)
}
```

We could implement `write.csv()` using regular function call semantics:

```{r}
write.csv <- function(x, file = "", sep = ",", qmethod = "double", ...) {
  write.table(x = x, file = file, sep = sep, qmethod = qmethod, ...)
}
```

This is much easier to understand: it's just calling `write.table()` with different defaults. This also fixes a subtle bug in the original `write.csv()`: `write.csv(mtcars, row = FALSE)` raises an error, but `write.csv(mtcars, row.names = FALSE)` does not. There's also no reason that `write.csv` shouldn't accept the `append` argument. Generally, you always want to use the simplest tool that will solve a problem - that makes it more likely that others will understand your code.

### Exercises

1.  Compare `update_model()` with `upate.default()`. What's different?
    What's the same?

1.  Why doesn't `write.csv(mtcars, "mtcars.csv", row = FALSE)` work?
    What property of argument matching has the original author forgotten
    about?

1.  Rewrite `update.formula()` using only R code.

1.  Sometimes it's necessary to figure out the function that called the
    function that called the current function (i.e. the grandparent, not
    the parent). How can you use `sys.call()` or `match.call()` to find
    this function?

## Walking the call tree with recursive functions

We've seen a couple of examples modifying a single call using `substitute()` or `modify_call()`. What if we want to do something more complicated, drilling down into a nested set of function calls and either extracting useful information or modifying the calls.  The `codetools` package, included in the base distribution, provides some built-in tools for automated code inspection that use these ideas:

* `findGlobals()`: locates all global variables used by a function.
  This can be useful if you want to check that your functions don't inadvertently rely on variables defined in their parent
  environment.

* `checkUsage()`: checks for a range of common problems including
  unused local variables, unused parameters and use of partial
  argument matching.

In this section you'll learn how to write functions that do things like that.

Because code is a tree, we're going to need recursive functions to work with it. You now have basic understanding of how code in R is put together internally, and so we can now start to write some useful functions. The key to any function that works with the parse tree right is getting the recursion right, which means making sure that you know what the base case is (the leaves of the tree) and figuring out how to combine the results from the recursive case. The nodes of a tree are always calls (except in the rare case of function arguments, which are pairlists), and the leaves are names, single argument calls or constants. R provides a helpful function to distinguish whether an object is a node or a leaf: `is.recursive()`.

### Finding F and T

We'll start with a function that returns a single logical value, indicating whether or not a function uses the logical abbreviations `T` and `F`.  Using `T` and `F` is generally considered to be poor coding practice, and it's something that `R CMD check` will warn about.

When writing a recursive function, it's useful to first think about the simplest case: how do we tell if a leaf is a `T` or a `F`?  This is very simple since the set of possibilities is small enough to enumerate explicitly:

```{r}
is_logical_abbr <- function(x) {
  identical(x, quote(T)) || identical(x, quote(F))
}
is_logical_abbr(quote(T))
is_logical_abbr(quote(TRUE))
is_logical_abbr(quote(true))
is_logical_abbr(quote(10))
```

Next we write the recursive function. The base case is simple: if the object isn't recursive, then we just return the value of `is_logical_abbr()` applied to the object. If the object is not a node, then we work through each of the elements of the node in turn, recursively calling `logical_abbr()`. We need a special case for functions because we can't iterate through their components, instead we need to explicitly operate on the body and formals separately.

```{r}
logical_abbr <- function(x) {
  # Base case
  if (!is.recursive(x)) return(is_logical_abbr(x))

  # Recursive cases
  if (is.function(x)) {
    if (logical_abbr(body(x))) return(TRUE)
    if (logical_abbr(formals(x))) return(TRUE)
  } else {
    for (i in seq_along(x)) {
      if (logical_abbr(x[[i]])) return(TRUE)
    }
  }

  FALSE
}

logical_abbr(quote(T))
logical_abbr(quote(mean(x, na.rm = T)))

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

### Finding all variables created by assignment

In this section, we will write a function that figures out all variables that are created by assignment in an expression. We'll start simply, and make the function progressively more rigorous. One reason to start with this function is because the recursion is a little bit simpler - we never need to go all the way down to the leaves because we are looking for assignment, a call to `<-`.

This means that our base case is simple: if we're at a leaf, we've gone too far and can immediately return. We have two other cases: we have hit a call, in which case we should check if it's `<-`, otherwise it's some other recursive structure and we should call the function recursively on each element. Note the use of `identical()` to compare the call to the name of the assignment function, and recall that the second element of a call object is the first argument, which for `<-` is the left hand side: the object being assigned to.

```{r}
is_call_to <- function(x, name) {
  is.call(x) && identical(x[[1]], as.name(name))
}

find_assign <- function(obj) {
  # Base case
  if (!is.recursive(obj)) return()

  if (is_call_to(obj, "<-")) {
    obj[[2]]
  } else {
    lapply(obj, find_assign)
  }
}
find_assign(quote(a <- 1))
find_assign(quote({
  a <- 1
  b <- 2
}))
```

This function seems to work for these simple cases, but the output is rather verbose. Instead of returning a list, let's keep it simple and stick with a character vector. We'll also test it with two slightly more complicated examples:

```{r}
find_assign <- function(obj) {
  # Base case
  if (!is.recursive(obj)) return(character())

  if (is_call_to(obj, "<-")) {
    as.character(obj[[2]])
  } else {
    unlist(lapply(obj, find_assign))
  }
}
find_assign(quote({
  a <- 1
  b <- 2
  a <- 3
}))

find_assign(quote({
  system.time(x <- print(y <- 5))
}))
```

This is better, but we have two problems: repeated names, and we miss assignments inside function calls. The fix for the first problem is easy: we need to wrap `unique()` around the recursive case to remove duplicate assignments. The second problem is a bit more subtle: it's possible to do assignment within the arguments to a call, but we're failing to recurse down in to this case.

```{r}
find_assign <- function(obj) {
  # Base case
  if (!is.recursive(obj)) return(character())

  if (is_call_to(obj, "<-")) {
    call <- as.character(obj[[2]])
    c(call, unlist(lapply(obj[[3]], find_assign)))
  } else {
    unique(unlist(lapply(obj, find_assign)))
  }
}
find_assign(quote({
  a <- 1
  b <- 2
  a <- 3
}))

find_assign(quote({
  system.time(x <- print(y <- 5))
}))
```

There's one more case we need to test:

```{r}
find_assign(quote({
  ls <- list()
  ls$a <- 5
  names(ls) <- "b"
}))

call_tree(quote({
  ls <- list()
  ls$a <- 5
  names(ls) <- "b"
}))
```

This behaviour might be ok, but we probably just want assignment into whole objects, not assignment that modifies some property of the object. Drawing the tree for that quoted object helps us see what condition we should test for - we want the object on the left hand side of assignment to be a name.  This gives the final version of the `find_assign` function.

```{r}
find_assign <- function(obj) {
  # Base case
  if (!is.recursive(obj)) return(character())

  if (is_call_to(obj, "<-")) {
    call <- if (is.name(obj[[2]])) as.character(obj[[2]])
    c(call, unlist(lapply(obj[[3]], find_assign)))
  } else {
    unique(unlist(lapply(obj, find_assign)))
  }
}
find_assign(quote({
  ls <- list()
  ls$a <- 5
  names(ls) <- "b"
}))
```

Making this function work absolutely correct requires quite a lot more work, because we need to figure out all the other ways that assignment might happen: with `=`, `assign()`, or `delayedAssign()`. But a static tool can never be perfect: the best you can hope for is a set of heuristics that catches the most common 90% of cases.

### Modifying the call tree

Instead of returning vectors computed from the contents of an expression, you can also return a modified expression, such as base R's `bquote()`. `bquote()` is a slightly more flexible form of quote: it allows you to optionally quote and unquote some parts of an expression (it's similar to the backtick operator in Lisp).  Everything is quoted, _unless_ it's encapsulated in `.()` in which case it's evaluated and the result is inserted.

```{r}
a <- 1
b <- 3
bquote(a + b)
bquote(a + .(b))
bquote(.(a) + .(b))
bquote(.(a + b))
```

This provides a fairly easy way to control what gets evaluated when you call `bquote()`, and what gets evaluated when the expression is evaluated. How does `bquote()` work? Below, I've rewritten `bquote()` to use the same style as our other functions: it expects input to be quoted already, and makes the base and recursive cases more explicit:

```{r}
bquote2 <- function (x, where = parent.frame()) {
  # Base case
  if (!is.recursive(x)) return(x)

  if (is.call(x)) {
    if (identical(x[[1]], quote(.))) {
      # Call to .(), so evaluate
      eval(x[[2]], where)
    } else {
      as.call(lapply(x, bquote2, where = where))
    }
  } else if (is.pairlist(x)) {
    as.pairlist(lapply(x, bquote2, where = where))
  } else {
    stop("Unknown case")
  }
}
x <- 1
bquote2(quote(x == .(x)))
y <- 2
bquote2(quote(function(x = .(x)) {
  x + .(y)
}))
```

Note that functions that modify the source tree are most useful for creating expressions that are used at run-time, not saved back into the original source file.  That's because all non-code information is lost:

```{r}
bquote2(quote(function(x = .(x)) {
  # This is a comment
  x +  # funky spacing
    .(y)
}))
```

It is possible to work around this problem using `srcrefs` and `getParseData`, but neither solution naturally fits this hierarchical framework. You effectively end up having to recreate huge chunks of R's internal code in order to handle the majority of R code.  So the above approach can be useful in simple cases (particularly when you don't care what the output code looks like), but it's very hard to automatically transform R code, and is beyond the scope of this book.

`bquote()` is rather like a macro from a languages like Lisp. But unlike macros the modifications occur at runtime, not compile time (which doesn't have any meaning in R). And unlike a macro there is no restriction to return an expression: a macro-like function in R can return anything. More like `fexprs`. a fexpr is like a function where the arguments aren't evaluated by default; or a macro where the result is a value, not code.

[Programmer’s Niche: Macros in R](http://www.r-project.org/doc/Rnews/Rnews_2001-3.pdf#page=11) by Thomas Lumley.

### Exercises

* Write a function that extracts all calls to a function. Compare your function to `pryr::fun_calls()`.


## Evaluating code in a new environment

In the process of performing a data analysis, you may create variables that are necessarily because they help break a complicated sequence of steps down in to easily digestible chunks, but are not needed afterwards. For example, in the following example, we might only want to keep the value of x:

```{r}
a <- 10
b <- 30
x <- a + b
```

It's useful to be able to store only the final result, preventing the intermediate results from cluttering your workspace.  We already know one way of doing this, using a function:

```{r}
x <- (function() {
  a <- 10
  b <- 30
  a + b
})()
```

(In JavaScript this is called the immediately invoked function expression (IIFE), and is used extensively in modern JavaScript to encapsulate different JavaScript libraries)

R provides another tool that's a little less verbose, the `local()` function:

```{r}
x <- local({
  a <- 10
  b <- 30
  a + b
})
```

The idea of local is to create a new environment (inheriting from the current environment) and run the code in that.  The essence of `local()` is captured in this code:

```{r}
local2 <- function(expr) {
  envir <- new.env(parent = parent.frame())
  eval(substitute(expr), envir)
}
```

The real `local()` code is considerably more complicated because it adds a second environment parameter. I don't think this is necessary because if you have an explicit environment parameter, then you can already evaluate code in that environment with `evalq()`. The original code is also hard to understand because it is very concise and uses some sutble features of evaluation (including non-standard evaluation of both arguments). If you have read [non-standard evaluation](#nse), you might be able to puzzle it out, but to make it a bit easier I have rewritten it in a simpler style below.

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

  eval(call, env)
}
a <- 100
local2({
  b <- a + sample(10, 1)
  my_get <<- function() b
})
my_get()
```

You might wonder we can't simplify to this:

```{r}
local3 <- function(expr, envir = new.env()) {
  eval(substitute(expr), envir)
}
```

But it's because of how the arguments are evaluated - default arguments are evalauted in the scope of the function so that `local(x)` would not be the same as `local(x, new.env())` without special effort.

### Exercises

```{r, error = TRUE}
check_logical_abbr <- function(code, env = parent.frame()) {
  new_env <- new.env(parent = env)
  delayedAssign("T", stop("Use TRUE not T"), assign.env = new_env)
  delayedAssign("F", stop("Use FALSE not F"), assign.env = new_env)

  eval(substitute(code), new_env)
}

check_logical_abbr(c(FALSE, T, FALSE))
```

## Anaphoric functions

Another variant along these lines is an "[anaphoric](http://en.wikipedia.org/wiki/Anaphora_(linguistics)) function", or a function that uses a pronoun. This is easiest to understand with an example using an interesting anaphoric function in base R: `curve()`.`curve()` draws a plot of the specified function, but interestingly you don't need to use a function, you just supply an expression that uses `x`:

```{r curve-demo}
curve(x ^ 2)
curve(sin(x), to = 3 * pi)
curve(sin(exp(4 * x)), n = 1000)
```

Here `x` plays a role like a pronoun in an English sentence: it doesn't represent a single concrete value, but instead is a place holder that varies over the range of the plot. Note that it doesn't matter what the value of `x` outside of `curve()` is: the expression is evaluated in a special environment where `x` has a special meaning:

```{r curve}
x <- 1
curve(sin(exp(4 * x)), n = 1000)
```

`curve()` works by evaluating the expression in a special environment in which the appropriate `x` exists. The essence of `curve()`, omitting many useful but incidental details like plot labelling, looks like this:

```{r curve2}
curve2 <- function(expr, xlim = c(0, 1), n = 100, env = parent.frame()) {
  env2 <- new.env(parent = env)
  env2$x <- seq(xlim[1], xlim[2], length = n)

  y <- eval(substitute(expr), env2)
  plot(env2$x, y, type = "l", ylab = deparse(substitute(expr)))
}
curve2(sin(exp(4 * x)), n = 1000)
```

Creating a new environment containing the pronoun is the key technique for implementing anaphoric functions.

Another way to solve the problem would be to turn the expression into a function using `make_function()`:

```{r curve3}
curve3 <- function(expr, xlim = c(0, 1), n = 100, env = parent.frame()) {
  f <- pryr::make_function(alist(x = ), substitute(expr), env)

  x <- seq(xlim[1], xlim[2], length = n)
  y <- f(x)

  plot(x, y, type = "l", ylab = deparse(substitute(expr)))
}
curve3(sin(exp(4 * x)), n = 1000)
```

The approaches take about as much code, and require knowledge of  the same number of fundamental R concepts. I would have a slight preference for the second because it would be easier to reuse the part of the `curve3()` that turns an expression into a function. All anaphoric functions need careful documentation so that the user knows that some variable will have special properties inside the anaphoric function and must otherwise be avoided.

If you're interesting in learning more, there are some good resources for anaphoric functions in  [Arc](http://www.arcfn.com/doc/anaphoric.html) (a list like language), [Perl](http://www.perlmonks.org/index.pl?node_id=666047) and [Clojure](http://amalloy.hubpages.com/hub/Unhygenic-anaphoric-Clojure-macros-for-fun-and-profit)