rdo.call

Look up local variable in function called by do.call


I have a function that is supposed to use a value based on the environment it is called in:

Foo <- function(a) {
  return(a + b)
}

In the global environment I can now simply do

b <- 1
Foo(2)
# 3

The real function will take a list of arguments so I'm using do call, easy enough:

do.call(Foo, list(a = 2)
# 3

Running this in local blocks (or test_that blocks for that matter) this doesn't work the way I want it to (either way).

local({
  b <- 3
  print(Foo(2))
  print(do.call(Foo, list(a = 2)))
})
# [1] 3
# [1] 3

This returns 3, I want 5. Had i not defined or deleted the global b the function would fail because it cannot find the symbol.

I tried supplying different environments to the do.call approach (environment(), parent.env(),...) using quote = TRUE and without but to no avail.

Is there a way for force Foo to look up variables in the local block by passing it as an environment?


Solution

  • 1) Since b is not defined in Foo, Foo will look for b in the environment in which Foo was defined, not the environment in which it was called.

    You can redefine Foo's environment. This will make a copy of Foo such that free variables in it will be looked up in the local environment. No packages are used.

    local({
        b <- 3
        environment(Foo) <- environment()
        print(Foo(2))
        print(do.call(Foo, list(a = 2)))
        
    })
    ## [1] 5
    ## [1] 5
    

    2) If it is ok to modify Foo then other possibilities are to modify it by passing b as an additional argument or passing an environment as an additional argument and have Foo evaluate b in that environment.

    Foo2 <- function(a, b) {
      return(a + b)
    }
    local({
        b <- 3
        print(Foo2(2, b))
        print(do.call(Foo2, list(a = 2, b = b)))
    })
    ## [1] 5
    ## [1] 5
    

    3) or

    Foo3 <- function(a, envir = parent.frame()) {
      return(a + envir$b)
    }
    local({
        b <- 3
        print(Foo3(2))
        print(do.call(Foo3, list(a = 2)))
        
      })
    ## [1] 5
    ## [1] 5
    

    4) A variation of the above that only involves modifying the signature of Foo but not its body is the following (or use get("b", parent.frame()) if you want to allow it to look into the ancestors of the parent frame as well).

    Foo4 <- function(a, b = parent.frame()$b) {
      return(a + b)
    }
    local({
        b <- 3
        print(Foo4(2))
        print(do.call(Foo4, list(a = 2)))
      })
    ## [1] 5
    ## [1] 5
    

    5) Another approach is to inject a statement into Foo using trace and then remove it afterwards.

    local({
      b <- 3
      on.exit(untrace(Foo))
      trace(Foo, bquote(b <- .(b)), print = FALSE)
      print(Foo(2))
      print(do.call(Foo, list(a = 2)))
    })
    ## [1] 5
    ## [1] 5
    

    6) If we wrap the body of Foo in eval.parent(substitute({...})) that will effectively inject it into the caller giving it access to b. Also see Thomas Lumley article starting on page 11 of R News 1/3 .

    Foo6 <- function(a) eval.parent(substitute({
      return(a + b)
    }))
    local({
      b <- 3
      print(Foo6(2))
      print(do.call(Foo6, list(a = 2)))
    })
    ## [1] 5
    ## [1] 5
    

    7) This is really the same as (6) under the hood except it wraps it nicely. This is the only one here that uses a package.

    library(gtools)
    
    Foo7 <- defmacro(a, expr = {
      return(a + b)
    })
    local({
      b <- 3
      print(Foo7(2))
      print(do.call(Foo7, list(a = 2)))
    })
    ## [1] 5
    ## [1] 5