capturing an expression as a function body in R

Question

I'm trying to write a program that takes an expression as an input and returns a function with that expression bound as its body.

caller <- function (expr, params) {

    Function <- function (params, body, env = parent.frame()) {
        # returns a function

    }

    Function(params, body = expr)
}

func <- caller (a + b, c('a', 'b'))

func(1, 2)
[1] 3

I can bind the parameters quite easily, by using something like

params <- c('a', 'b')
f <- function() {} 
formals(f) <- structure(
    replicate(length(params), NULL),
    names = params
)

I'm having trouble coming up with a way of dynamically adding the expression as the body. I've tried use substitute(), and adapting make_function from the pryr library, but I can't quite get things to work. My best attempt is

    body(f, parent.frame()) <- as.list( match.call() )[-1]$body

I couldn't get this to work with substitute either. Any thoughts on how to bind the body in so that the topmost program works as expected?

I've seen similar questions on SO, but the solutions don't seem to satistfy this problem.

Answer 1

Here is a solution to allow parameters with no default value. It's also easier to pass parameters names, as they don't have to be enclosed with quotes.

Please check the comments in the code below:

g <- function(...)
{
    # Get the arguments as unevaluated expressions:

    L <- as.list(substitute(list(...)))[-1]

    # The first argument is the body expression (technically a call object):

    expr <- L[[1]]

    # If the expression is not enclosed in curly braces, let's force it:

    if( as.character(expr[[1]]) != "{" ) expr <- call("{", expr)

    # Drop the first argument:

    L <- L[-1]

    # Mark symbols to be used as names for missing parameters:

    filter <- vapply(L, is.symbol, logical(1))

    params <- L

    # The obscure expression "formals(function(x){})$x" returns a missing value, something really arcane ;-) :

    params[filter] <- list(formals(function(x){})$x)

    # Here the symbols are used as names:

    names(params)[filter] <- vapply(L[filter], as.character, character(1))

    # Now the result:

    f <- function(){}

    formals(f) <- params

    body(f) <- expr

    # Just to make it nicier, let's define the enclosing environment as if the function were created outside g:

    environment(f) <- parent.frame()

    f
}

Some tests:

> g(a+b, a, b=1)
function (a, b = 1) 
{
    a + b
}


> f <- g({x <- a+b; x^2}, a, b)
> f
function (a, b) 
{
    x <- a + b
    x^2
}
> f(2,3)
[1] 25
> f(1)
Error in a + b : 'b' is missing

> g(a+b, a=2, b=2)()
[1] 4

Answer 2

How about simply:

caller <- function(expr, params) {
  f <- function() NULL
  formals(f) <- structure(replicate(length(params), NULL), names=params)
  body(f, envir=parent.frame()) <- substitute(expr)
  f
}

It doesn't use an inner function, which may have been causing your problems with substitute.

Note that I'm not certain if this is setting the environment of the returned function the way that you want. This sets it to the environment from which you call caller.