（预）向功能工厂和内部提供变量

Question

我正在阅读 Hadley 的 Advanced R 并尝试一些东西。我正在尝试创建一个lazy 闭包函数，该函数返回一个在其环境中提供data.frame 的函数，并使用with 并能够在以后提供其他函数参数。

lazy <- function(dataframe, x) {
    function(FUN, x, ...) {
        with(dataframe, FUN(x = x, ...))
    }
}

lz_factory <- lazy(mtcars, "mpg")

lz_factory(mean)
lz_factory(cor, y="hp")

所以我期待数据框是它所在的功能环境的一部分（browser 看看确认）。但是，变量名称 x 未提供，当我使用 cor 作为第一个 FUN 参数时，我无法提供新变量 y。这与向使用 non-standard evaluation (NSE) 的函数 (with) 提供字符有关。我希望哈德利叔叔为我感到骄傲，但我对eval、parse、substitute 的翻找都返回了错误。这意味着我不完全了解 R 是如何处理事情的。我知道为什么它不起作用（NSE），但不知道如何使它起作用。以下是错误：

> lz_factory(mean)
Error in FUN(x = x, ...) : argument "x" is missing, with no default

> lz_factory(cor, y="hp")
Error in is.data.frame(x) : argument "x" is missing, with no default

我想我可以使用替代品来解决它，就像 Hadley 在此处显示的 xyplot 一样，但这也是一个失败，如下所示：

lazy <- function(dataframe, default) {
    function(FUN, x, ...) {
        if (missing(x)) x <- default
        eval(substitute(with(dataframe, FUN(x, ...))))
    }
}

lz_factory <- lazy(mtcars, "mpg")

lz_factory(mean)
lz_factory(cor, y="hp")


> lz_factory(mean)
[1] NA
Warning message:
In mean.default("mpg") : argument is not numeric or logical: returning NA

> lz_factory(cor, y="hp")
Error in cor("mpg", y = "hp") : 'x' must be numeric

那么我怎样才能让这个惰性函数起作用呢：

1. 使用包含在环境中的数据框生成自己的函数
2. 允许我根据需要提供 x，如果不需要，则使用最初提供的默认值
3. 允许我将未知变量传递给lz_factory 创建的函数

最理想的情况是我想让这个函数与with 一起工作。如果那不可能，很高兴知道为什么。最后，如果无法使用with，我怎样才能使该功能正常运行？

Answer 1

这个功能怎么样

lazy <- function(dataframe, ...) {
    pdots <- substitute(list(...))
    if(is.null(names(pdots)) || names(pdots)[1]=="") {
        names(pdots)[2]<-"x"
    }
    function(FUN, ...) {
        dots <- substitute(list(...))[-1]
        if (is.null(dots$x)) {
            dots$x <- pdots$x
        }
        with(dataframe, do.call(FUN, as.list(dots)))
    }
}

这允许您在 mtcars 中使用不带引号的变量名称。例如

lz_factory <- lazy(mtcars, mpg)
lz_factory(mean)
# [1] 20.09062
lz_factory(mean, x=hp)
# [1] 146.6875
lz_factory(cor, y=hp)
# [1] -0.7761684

在这里，我们使用了一些额外的替换来确保我们得到惰性求值，并允许您使用不带引号的变量名。 with 将负责评估表达式。我猜可能有一种方法可以简化这一点，但至少它似乎有效。

Answer 2

这是@MrFlick 函数的略微简化版本：

lazy <- function(df, x_var = NULL) {
  x <- substitute(x_var)

  function(FUN, ...) {
    call <- substitute(FUN(...))
    if (is.null(call$x) && !is.null(x)) {
      call$x <- x
    }
    eval(call, df, parent.frame())
  }
}

关键是更好地利用substitute()的功能，并通过直接使用eval来避免with()。