knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.path = "man/figures/README-", out.width = "100%" ) library(magrittr) library(foolbox)

The `foolbox`

package implements functionality for static analysis of R functions and for manipulating functions by rewriting the components they consist of. The package was written to collect similar functionality from the pmatch and tailr packages, that both have functions for rewriting other functions, but is a general framework for static analysis and function rewriting.

The functionality centres on depth-first traversals of expression trees, typically the body of functions. For example, if you have the function `f`

f <- function(x) { y <- 2 * x x + y }

then its body is an expression, a `call`

to the function `{`

with arguments `y <- 2 * x`

and `x + y`

:

expr <- body(f) expr[[1]] expr[[2]] expr[[3]]

The first statement inside `f`

's body is another `call`

, this time to the `<-`

function, and this
call takes two arguments, the `symbol`

`y`

and the expression `2 * x`

which is yet another call, to `*`

, with the `atomic`

2 and `symbol`

`x`

as arguments.

With `foolbox`

you can travers such expression structures and rewrite them based on callbacks. You can define callbacks for four base cases for expressions, `atomic`

, `pairlist`

, `symbol`

and `primitive`

, for the recurse `call`

expressions and a callback, called `topdown`

, invoked before the traversal recurses into a `call`

object.

You specify how you want to transform an expression by composing a set of callbacks for a transformation and you apply several transformations by specifying a pipeline of these.

Say, for example, you have functions

f <- function(x) 2 * x g <- function(y) f(y)

and you want to replace the function call `f(y)`

in the body of `g`

with the function body, `2 * x`

. You can do this by installing a callback for calls to `f`

and then rewrite with this:

callbacks <- rewrite_callbacks() %>% add_call_callback(f, function(expr, ...) quote(2 * x)) g %>% rewrite() %>% rewrite_with(callbacks)

Here, I've constructed the callbacks first, but a more natural approach might be to provide them inside the pipeline like this:

g %>% rewrite() %>% rewrite_with( rewrite_callbacks() %>% add_call_callback(f, function(expr, ...) quote(2 * x)) )

At least, that is what I find myself doing as I am experimenting with `foolbox`

.

If you have transformations you apply on more than one function, you can of course save them

subst_f <- . %>% rewrite() %>% rewrite_with( rewrite_callbacks() %>% add_call_callback(f, function(expr, ...) quote(2 * x)) )

and apply them later

```
g %>% subst_f
```

If you have such saved transformations you can also use them as part of function definition

h <- rewrites[subst_f] < function(x) f(x) + 2 * f(x) h

You can also put the full definition of a transformation in this syntax, but it is less readable.

The documentation is currently a bit sparse. All functions are documented, but I haven't written documentation for the overall design. That is on its way. For now, check the examples below.

# install.packages("devtools") devtools::install_github("mailund/foolbox")

Below are a few examples of things I thought up after writing the `foolbox`

. Serendipitous discoveries that I didn't design the package for, but that are easy to implement using it. I haven't taken the ideas very far — it is possible to do much more with them, but that would make the exampels harder to follow.

Say you want to add an invariant to a variable in a function. Whenever you assign to that variable, you want to make sure the invariant is `TRUE`

. We can insert invariant checking into an existing function using `foolbox`

.

(In this example, I do not include a test at the beginning of function, which I probably should, since that requires that I check if the variable is an argument or not — with `foolbox`

you can easily do this, but I keep it simple).

What you want to do is install an invariant that is called on all assignments, i.e. `call`

s to `<-`

or `=`

. That callback checks if the assignment is to the variable of interest, and if it is, it replaces the assignment with an assignment and a check.

We can write the following function for this. It expects `var`

to be a symbol and `predicate`

to be an expression. It creates a callback for assignments, and it then rewrites using that.

set_invariant <- function(fn, var, predicate) { var <- rlang::enexpr(var) stopifnot(rlang::is_symbol(var)) predicate <- rlang::enexpr(predicate) set_invariant_callback <- function(expr, ...) { if (expr[[2]] == var) { rlang::expr({ !!var <- !!expr[[3]] stopifnot(!!predicate) }) } else { expr } } fn %>% rewrite() %>% rewrite_with( rewrite_callbacks() %>% add_call_callback(`<-`, set_invariant_callback) %>% add_call_callback(`=`, set_invariant_callback) ) }

As an example, we can require that `a`

is always positive in the function below.

f <- function(x, y) { a <- x + y 2 * a^2 + a } f %>% set_invariant(a, a > 0)

However, what happens if we have nested functions?

f <- function(x, y) { a <- x + y g <- function(a) { a <- a + 42 a } h <- function(x) { a <<- -x a^2 } x <- h(y) 2 * a^2 + g(-x) } f %>% set_invariant(a, a > 0)

Here, we probably don't want to add the invariant inside the nested functions. An assignment there isn't an assignment to the variable in the scope of `f`

, after all. But we *do* want to capture `<<-`

assignments.

(For the `<<-`

assignment, it is a bit tricky to see if it is to the `a`

in the scope of `f`

, in general. It depends on whether that has been assigned to in `f`

before we call the nested function, and in the full generality of functions, we cannot determine this before we run `f`

. I am going to assume that all `<<-`

assignments are to the scope of `f`

for the rest of this example).

We can add `<<-`

as a function to call our callback on, and we can use a `topdown`

callback to pass information on whether we are in a nested function down the recursion.

set_invariant <- function(fn, var, predicate) { var <- rlang::enexpr(var) stopifnot(rlang::is_symbol(var)) predicate <- rlang::enexpr(predicate) set_invariant_callback <- function(expr, topdown, ...) { if (expr[[2]] == var) { if ( (expr[[1]] == "<-" || expr[[1]] == "=") && !(topdown$nested) ) { return(rlang::expr({ !!var <- !!expr[[3]] stopifnot(!!predicate) })) } if (expr[[1]] == '<<-') { return(rlang::expr({ !!var <<- !!expr[[3]] stopifnot(!!predicate) })) } } # if we don't return earlier, we keep the expression expr } nested_functions_callback <- function(expr, skip, topdown, ...) { topdown$nested <- TRUE topdown } fn %>% rewrite() %>% rewrite_with( rewrite_callbacks() %>% add_call_callback(`<-`, set_invariant_callback) %>% add_call_callback(`=`, set_invariant_callback) %>% add_call_callback(`<<-`, set_invariant_callback) %>% add_topdown_callback(`function`, nested_functions_callback), topdown = list(nested=FALSE) ) }

f <- function(x, y) { a <- x + y g <- function(a) { a <- a + 42 a } h <- function(x) { a <<- -x a^2 } x <- h(y) 2 * a^2 + g(-x) } f %>% set_invariant(a, a > 0)

If you want, you can add more than one invariant. The result nests some code-blocks, and it might not look pretty (you can clean it up using `foolbox`

if you want), but it works.

f <- function(x, y) { a <- x + y 2 * a^2 + a } f %>% set_invariant(a, a > 0) %>% set_invariant(a, is.numeric(a))

As another example, imagine that you want to inline a function call.

I put some restrictions on the function in this example. I don't allow it to have assignments. This is for the same reasons that we had to make assumptions about the `<<-`

assignment above. We cannot, before we call the function, know what local variables will be set to. If we inline a function, we need to replace variables with values, and that gets tricky if there are assignments. For similar reasons, I will assume that default arguments can be computed from parameters that are explicitly provided. Lazy evaluation and the rules for when variables are evaluated, and in which context, makes it hard to know the values of these if I cannot assume this, and the extra analysis needed is too much for this example.

Anyway, with a simple mapping from a function call to its body, with variables replaced by the parameters in the call, can be implemented using two transformations. One, that replaces variables in the function body with the values they should get in the call, and another that then inserts this transformed body in the place where we have the function call.

I first check that the function, `f`

, doesn't have assignments. I don't know how to check the requirements on the default arguments, but I should probably also check that.

After that, I define a function that maps a symbol to a value, if the symbol is found in a table, `map`

. Then I use that in a function that rewrites an expression; it use the mapping function as a callback on symbols and rewrites an expression.

I then define a callback to inline function calls. This will be called on `call`

objects for the given function. I extract the arguments provided in the call and put them in a table. Then I substitute the values in the table into the variables in the default parameters and rewrite the expressions there, substituting the variables I now have there with the values they get in the function call. Finally, I take the function body, rewrite it using the symbol map, and return that. This will then be inserted as a replacement for the function call in the depth-first traversal we set up as the final expression in the function.

inline <- function(fn, f) { # only inline if `f` has no assignments... otherwise, too much # analysis is needed for this simple example. check_assignment <- function(expr, ...) { stop("Assignment! I told you not to!") } f %>% analyse() %>% analyse_with( analysis_callbacks() %>% add_topdown_callback(`<-`, check_assignment) %>% add_topdown_callback(`=`, check_assignment) ) defaults <- formals(f) remap_symbols <- function(expr, map, ...) { var_name <- as.character(expr) if (var_name %in% names(map)) { rlang::expr( ( !!map[[var_name]] ) ) } else { expr } } remap_expr <- function(expr, map) { expr %>% rewrite_expr() %>% rewrite_expr_with( rewrite_callbacks() %>% with_symbol_callback(remap_symbols), map = map ) } inline_callback <- function(expr, ...) { map <- defaults args <- as.list(match.call(f, expr)[-1]) vars <- names(args) for (var in vars) { map[[var]] <- args[[var]] } for (var in names(defaults)) { if (! var %in% vars) { expr_with_varsubst <- eval(substitute(defaults[[var]], map)) map[[var]] <- expr_with_varsubst %>% remap_expr(map) } } body(f) %>% remap_expr(map) } fn %>% rewrite() %>% rewrite_with( rewrite_callbacks() %>% add_call_callback(f, inline_callback) ) }

To see it in action, we can inline the calls to `f`

in the function `g`

:

f <- function(x, y = x) 2 * x + y g <- function(z) f(z - 3) + f(y = z + 3, x = 4) g %>% inline(f)

If we want to perform the inline-transformation while we define a new function we can use the `rewrites`

syntax, but here we need to change the inline transformation function a bit. The transformations given to `rewrites`

must take the function to be transformed as its first argument, so we need to "curry" the inline function, changing it from `function(f, fn) ...`

to `function(f) function(fn) ...`

so we can provide the function to inline in `rewrites`

and get the function to transform when the `rewrites`

rules are run.

g <- rewrites[inline(f)] < function(z) f(z - 3) + f(y = z + 3, x = 4) g

We can write `inline(f)`

here, although the `inline`

function takes two arguments, the first of which being the function we transform, because the `rewrites[...]`

syntax transform the functions in the same was as the `%>%`

operator. The input to the `rewrites[...]`

is automatically added as the first argument to the first transformation in `rewrites`

, the output of the first transformation will be inserted as the first argument to the next transformation, etc.

**Any scripts or data that you put into this service are public.**

Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.