使用lapply或在R中的用户定义函数中的非标准评估

Question

我在ftable周围写了一个包装器，因为我需要为许多变量计算频率和百分比的平面表。由于类“公式”的ftable方法使用非标准评估，包装器依赖于do.call和match.call以允许使用subset的ftable参数（my previous question中的更多细节）。

mytable <- function(...) {
    do.call(what = ftable,
            args = as.list(x = match.call()[-1]))
    # etc
}

但是，我不能使用lapply和with这个包装器：

# example 1: error with "lapply"
lapply(X = warpbreaks[c("breaks",
                        "wool",
                        "tension")],
       FUN = mytable,
       row.vars = 1)

Error in (function (x, ...)  : object 'X' not found

# example 2: error with "with"
with(data = warpbreaks[warpbreaks$tension == "L", ],
     expr = mytable(wool))

Error in (function (x, ...)  : object 'wool' not found

这些错误似乎是由于match.call未在适当的环境中进行评估。

由于这个问题与my previous one密切相关，这里是我的问题的总结：

• do.call和match.call的包装不能与lapply或with一起使用。
• 没有do.call和match.call的包装器不能使用subset的ftable参数。

并总结了我的问题：

• 我怎样才能编写一个包装器，它允许使用subset的ftable参数并与lapply和with一起使用？我有想法避免使用lapply和with，但我希望了解并纠正这些错误，以提高我对R的认识。
• lapply的错误与?lapply的以下注释有关吗？ 由于历史原因，lapply创建的调用未被评估，并且编写了依赖于此的代码（例如，bquote）。这意味着记录的调用始终为FUN（X [[i]]，...）形式，其中i由当前（整数或双精度）索引替换。这通常不是问题，但是如果FUN使用sys.call或match.call，或者它是一个使用该调用的原始函数。这意味着用包装器调用原始函数通常更安全，因此例如lapply（ll，function（x）is.numeric（x））是确保正确发生is.numeric的方法分派所必需的。

Answer 1

使用match.call和lapply的问题是match.call返回传入它的文字调用，没有任何解释。为了看看发生了什么，让我们创建一个更简单的函数，它可以准确地显示函数如何解释传递给它的参数：

match_call_fun <- function(...) {
    call = as.list(match.call()[-1])
    print(call)
}

当我们直接调用它时，match.call正确获取参数并将它们放在我们可以与do.call一起使用的列表中：

match_call_fun(iris['Species'], 9)

[[1]]
iris["Species"]

[[2]]
[1] 9

但是看看当我们使用lapply时会发生什么（我只包括内部print语句的输出）：

lapply('Species', function(x) match_call_fun(iris[x], 9))

[[1]]
iris[x]

[[2]]
[1] 9

由于match.call获得传递给它的文字参数，它接收iris[x]，而不是我们想要的正确解释的iris['Species']。当我们用ftable将这些参数传递给do.call时，它会在当前环境中查找对象x，然后在找不到它时返回错误。我们需要解释

正如您所见，添加envir = parent.frame()可以解决问题。这是因为，添加该参数告诉do.call评估父框架中的iris[x]，这是lapply中的匿名函数，其中x具有正确的含义。为了看到这一点，让我们制作另一个简单的函数，使用do.call从3个不同的环境级别打印ls：

z <- function(...) {
    print(do.call(ls, list()))
    print(do.call(ls, list(), envir = parent.frame()))
    print(do.call(ls, list(), envir = parent.frame(2)))
}

当我们从全局环境调用z()时，我们看到函数内部的空环境，然后是全局环境：

z()

character(0)                                  # Interior function environment
[1] "match_call_fun" "y"              "z"     # GlobalEnv
[1] "match_call_fun" "y"              "z"     # GlobalEnv

但是当我们从lapply内部调用时，我们看到parent.frame的一个级别是lapply中的匿名函数：

lapply(1, z)

character(0)                                  # Interior function environment
[1] "FUN" "i"   "X"                           # lapply
[1] "match_call_fun" "y"              "z"     # GlobalEnv

因此，通过添加envir = parent.frame()，do.call知道在iris[x]环境中评估lapply，它知道x实际上是'Species'，并且它正确评估。

mytable_envir <- function(...) {
    tab <- do.call(what = ftable,
                   args = as.list(match.call()[-1]),
                   envir = parent.frame())
    prop <- prop.table(x = tab,
                       margin = 2) * 100
    bind <- cbind(as.matrix(x = tab),
                  as.matrix(x = prop))
    margin <- addmargins(A = bind,
                         margin = 1)
    round(x = margin,
          digits = 1)
}



# This works!
lapply(X = c("breaks","wool","tension"),
       FUN = function(x) mytable_envir(warpbreaks[x],row.vars = 1))

---

至于为什么添加envir = parent.frame()有所不同，因为这似乎是默认选项。我不是100％肯定，但我的猜测是，当使用默认参数时，parent.frame在do.call函数内部进行评估，返回运行do.call的环境。然而，我们正在做的是在parent.frame之外调用do.call，这意味着它返回比默认版本高一级。

这是一个测试函数，它将parent.frame()作为默认值：

fun <- function(y=parent.frame()) {
    print(y)
    print(parent.frame())
    print(parent.frame(2))
    print(parent.frame(3))
}

现在看看当我们在lapply中调用它时会发生什么，无论是否传递parent.frame()作为参数：

lapply(1, function(y) fun())
<environment: 0x12c5bc1b0>     # y argument
<environment: 0x12c5bc1b0>     # parent.frame called inside
<environment: 0x12c5bc760>     # 1 level up = lapply
<environment: R_GlobalEnv>     # 2 levels up = globalEnv

lapply(1, function(y) fun(y = parent.frame()))
<environment: 0x104931358>     # y argument
<environment: 0x104930da8>     # parent.frame called inside
<environment: 0x104931358>     # 1 level up = lapply
<environment: R_GlobalEnv>     # 2 levels up = globalEnv

在第一个示例中，y的值与在函数内调用parent.frame()时获得的值相同。在第二个例子中，y的值与一个级别的环境相同（在lapply内）。所以，虽然它们看起来一样，但它们实际上做了不同的事情：在第一个例子中，当parent.frame看到没有y=参数时，在函数内部被评估，在第二个例子中，parent.frame在lapply匿名函数中被评估首先，在调用fun之前，然后传递给它。

Answer 2

因为你只想传递传递给ftable的所有参数，所以不需要do.call（）。

mytable <- function(...) {
  tab <- ftable(...)
  prop <- prop.table(x = tab,
                     margin = 2) * 100
  bind <- cbind(as.matrix(x = tab),
                as.matrix(x = prop))
  margin <- addmargins(A = bind,
                       margin = 1)
  return(round(x = margin,
               digits = 1))
}

以下lapply为每个变量分别创建一个表，我不知道这是否是你想要的。

lapply(X = c("breaks",
             "wool",
             "tension"),
       FUN = function(x) mytable(warpbreaks[x],
                                 row.vars = 1))

如果你想要1个表中的所有3个变量

warpbreaks$newVar <- LETTERS[3:4]

lapply(X = cbind("c(\"breaks\", \"wool\", \"tension\")",
             "c(\"newVar\", \"tension\",\"wool\")"),
       FUN = function(X)
        eval(parse(text=paste("mytable(warpbreaks[,",X,"],
                                 row.vars = 1)")))
)

Answer 3

感谢this issue，包装成了：

# function 1
mytable <- function(...) {
    do.call(what = ftable,
            args = as.list(x = match.call()[-1]),
            envir = parent.frame())
    # etc
}

要么：

# function 2
mytable <- function(...) {
    mc <- match.call()
    mc[[1]] <- quote(expr = ftable)
    eval.parent(expr = mc)
    # etc
}

我现在可以使用subset的ftable参数，并使用lapply中的包装器：

lapply(X = warpbreaks[c("wool",
                        "tension")],
       FUN = function(x) mytable(formula = x ~ breaks,
                                 data = warpbreaks,
                                 subset = breaks < 15))

但是我不明白为什么我必须向envir = parent.frame()提供do.call，因为它是默认参数。

更重要的是，这些方法无法解决另一个问题：I can not use the subset argument of ftable with mapply。