为什么包装函数不能按预期工作？

Question

Here are four functions, the latter ones wraps the former ones.

a <- 0

f1 <- function(expr) {
  a1 <- 1
  eval(expr)
}

f2 <- function(expr) {
  a2 <- 2
  f1(expr)
}

f3 <- function(expr) {
  a3 <- 3
  f2(expr)
}

f4 <- function(expr) {
  a4 <- 4
  f3(expr)
}

Do the following experienments:

> f4(a)
0

which works as expected. But if we call

f4(a4) Error in eval(expr) : object 'a4' not found

> f4(a3)
Error in eval(expr) : object 'a3' not found

...

> f2(a2)
Error in eval(expr) : object 'a2' not found

> f2(a1)
Error in eval(expr) : object 'a1' not found

> f1(a1)
Error in eval(expr) : object 'a1' not found

I inspect the local environment and parent environment of each function body f3 's parent frame is f4 's local environment, ... , f1 's parent is f2 's body. Is it a clear explanation why this happens? And how can I get rid of this problem to make the code work for the purpose that the function call should allow subsequent functions (like f3 ) to find the defined symbols (eg a4 )?

Answer 1

I strongly recommend you spend some time reading Advanced R: Environments .

First of all, when I run f1(a1) I get "object 'a1' not found" as well; not "1" as you get above.

The issue is that by default R resolves variables using the enclosing environment of a function. The enclosing environment of a function is determined when the function is defined, not when the function is called. Therefore it doesn't go up the call chain to resolve variable names. You can explicitly look in a calling parent with the parent.frame() environment, but these environments do not chain together in nested function calls.

In the same way that get() will loop up a variable by walking up the enclosing parent environments, you can make your own function to walk up the calling environments and see which variables are available.

call.get <- function(val) {
    for(i in 1:sys.nframe()) {
        if (exists(val, envir=sys.frame(i), inherits=F)) {
            return(get(val, envir=sys.frame(i)))
        }
    }
    return(NULL)
}

call.ls <- function(val) {
    vars<-lapply(1:sys.nframe(), function(i) ls(envir=parent.frame(i)))
    return(sort(unique(unlist(vars))))
}

Then if you do something like

f1 <- function(expr) {
  a1 <- 1
  call.ls()
}

f2 <- function(expr) {
  a2 <- 2
  f1(expr)
}

f3 <- function(expr) {
  a3 <- 3
  f2(expr)
}

f4 <- function(expr) {
  a4 <- 4
  f3(expr)
}

f4(1)

You will get

"a1"   "a2"   "a3"   "expr" "FUN"  "val"  "X"  

and you can use

call.get("a3")

to get one of those variables from a parent calling frame.

But another problem you have is you are triggering evaluation of the expr argument when you call the sub-function. When you do

f2 <- function(expr) {
  a2 <- 2
  f1(expr)
}

That evaluates expr in the f2 environment and passes the result to f1 . You are losing the evaluation at that point. The easiest way to pass through a lazy-evaluation is to use "...". Something like

f1 <- function(...) {
    a1 <- 1
    expr<-deparse(substitute(...))
    call.get(expr)
}
f2 <- function(...) {
    a2 <- 2
    f1(...)
}
f2(a1)
# [1] 1
f2(a2)
# [1] 2

Otherwise you need to more explicitly pass the expression with a do.call

f1 <- function(expr) {
    a1 <- 1
    expr<-deparse(substitute(expr))
    call.get(expr)
}
f2 <- function(expr) {
    expr<-substitute(expr)
    a2 <- 2
    do.call(f1, list(expr))
}

f2(a1)
# [1] 1
f2(a2)
# [1] 2