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

Question

这里有四个函数，后面的函数包裹了前面的函数。

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)
}

做以下实验:

> f4(a)
0

它按预期工作。但如果我们打电话

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

我检查每个函数体的本地环境和父环境 f3 的父框架是 f4 的本地环境，... , f1 的父级是 f2 的主体。是否有一个明确的解释为什么会发生这种情况？我怎样才能摆脱这个问题，使代码工作的目的是函数调用应该允许后续函数(如f3)找到定义的符号(例如a4) >)?

Answer 1

我强烈建议您花一些时间阅读Advanced R: Environments .

首先，当我运行 f1(a1) 时，我也得到“object 'a1' not found”；不是上面得到的“1”。

问题是默认情况下 R 使用函数的封闭环境解析变量。函数的封闭环境是在定义函数时确定的，而不是在调用函数时确定的。因此，它不会沿着调用链向上解析变量名称。您可以使用 parent.frame() 环境显式查看调用父级，但这些环境不会在嵌套函数调用中链接在一起。

与 get() 通过遍历封闭父环境来循环变量的方式相同，您可以创建自己的函数来遍历调用环境并查看哪些变量可用。

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))))
}

然后如果你做类似的事情

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)

你会得到

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

你可以使用

call.get("a3")

从父调用框架获取这些变量之一。

但是您遇到的另一个问题是，当您调用子函数时，您会触发对 expr 参数的求值。当你这样做时

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

在 f2 环境中计算 expr 并将结果传递给 f1。那时你就失去了评价。通过惰性求值的最简单方法是使用“...”。类似的东西

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

否则，您需要使用 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