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

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) eval(expr) 中的错误：找不到对象“a4”

> 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的body。是否清楚地解释了为什么会发生这种情况？我怎样才能摆脱这个问题以使代码工作，以便函数调用应该允许后续函数（如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