在R语言中使用mapply函数时针对子集参数的非标准评估

Question

我无法在使用 mapply 时使用 xtabs 或 aggregate 的 subset 参数（或我测试过的任何函数，包括 ftable 和 lm）。以下调用在使用 subset 参数时失败，但不使用该参数时可以正常工作：

mapply(FUN = xtabs,
       formula = list(~ wool,
                      ~ wool + tension),
       subset = list(breaks < 15,
                     breaks < 20),
       MoreArgs = list(data = warpbreaks))

# Error in mapply(FUN = xtabs, formula = list(~wool, ~wool + tension), subset = list(breaks <  : 
#   object 'breaks' not found
# 
# expected result 1/2:
# wool
# A B 
# 2 2
# 
# expected result 2/2:
#     tension
# wool L M H
#    A 0 4 3
#    B 2 2 5

mapply(FUN = aggregate,
       formula = list(breaks ~ wool,
                      breaks ~ wool + tension),
       subset = list(breaks < 15,
                     breaks < 20),
       MoreArgs = list(data = warpbreaks,
                       FUN = length))

# Error in mapply(FUN = aggregate, formula = list(breaks ~ wool, breaks ~  : 
#   object 'breaks' not found
# 
# expected result 1/2:
#   wool breaks
# 1    A      2
# 2    B      2
# 
# expected result 2/2:
#   wool tension breaks
# 1    B       L      2
# 2    A       M      4
# 3    B       M      2
# 4    A       H      3
# 5    B       H      5

错误似乎是由于 subset 参数在错误的环境中未被评估。我知道可以使用 data = warpbreaks[warpbreaks$breaks < 20, ] 这个方法来在 data 参数中进行子集操作，但我正在努力提高我的R语言技能。

我的问题是：

• 如何在 mapply 中使用 subset 参数？我尝试使用 match.call 和 eval.parent，但目前没有成功（更多细节请参见我的以前的问题）。
• 为什么在 data = warpbreaks 中评估了 formula 参数，但没有评估 subset 参数呢？

- Thomas

---

记录一下，这不仅限于mapply，也适用于例如lapply：(i) 这个可以运行：lapply(X = list(warpbreaks, warpbreaks), FUN = xtabs, formula = ~ wool)；但是 (ii) 这个会失败：lapply(X = list(warpbreaks, warpbreaks), FUN = xtabs, formula = ~ wool, subset = breaks < 15)。 - Thomas

Answer 1

简而言之，当您创建一个列表以作为函数参数传递时，它会在创建时进行评估。您遇到的错误是因为R试图在调用环境中创建您想要传递的列表。

更清楚地了解这一点，假设您尝试在调用mapply之前创建要传递的参数：

f_list <- list(~ wool, ~ wool + tension)
d_list <- list(data = warpbreaks)
mapply(FUN = xtabs, formula = f_list, MoreArgs = d_list)
#> [[1]]
#> wool
#>  A  B 
#> 27 27 
#> 
#> [[2]]
#>     tension
#> wool L M H
#>    A 9 9 9
#>    B 9 9 9

创建公式列表没有问题，因为只有在需要时才会进行计算，而且当然可以从全局环境中访问warpbreaks，因此这个mapply的调用有效。

当然，如果在mapply调用之前尝试创建以下列表：

subset_list <- list(breaks < 15, breaks < 20)

接着R会告诉你找不到 breaks。

然而，如果你在搜索路径中创建了使用 warpbreaks 的列表，那么问题就解决了：

subset_list <- with(warpbreaks, list(breaks < 15, breaks < 20))
subset_list
#> [[1]]
#>  [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [14]  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE
#> [27] FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#> [40] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE
#> [53] FALSE FALSE
#> 
#> [[2]]
#>  [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE  TRUE
#> [14]  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE FALSE FALSE  TRUE
#> [27] FALSE FALSE  TRUE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE
#> [40]  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE  TRUE
#> [53]  TRUE FALSE

因此您可能认为我们可以将其传递给mapply，然后一切都很好，但现在我们会得到一个新错误：

mapply(FUN = xtabs, formula = f_list, subset = subset_list, MoreArgs = d_list)
#> Error in eval(substitute(subset), data, env) : object 'dots' not found

那我们为什么会遇到这个问题呢？

问题出在传递给 mapply 的任何函数中使用了eval，或者调用使用eval的函数。

如果你查看 mapply 的源代码，你会发现它接收你传递的额外参数，并将它们放在一个名为dots的列表中，然后将该列表传递给内部的mapply调用:

mapply
#> function (FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES = TRUE) 
#> {
#>     FUN <- match.fun(FUN)
#>     dots <- list(...)
#>     answer <- .Internal(mapply(FUN, dots, MoreArgs))
#> ...

如果您的FUN本身调用另一个函数，该函数对其任何参数调用eval，则它将尝试对对象dots进行eval，但在调用eval的环境中，该对象不存在。通过对match.call包装器执行mapply可以轻松看到这一点：

mapply(function(x) match.call(), x = list(1))
[[1]]
(function(x) match.call())(x = dots[[1L]][[1L]])

因此，我们错误的最小可重现示例为：

mapply(function(x) eval(substitute(x)), x = list(1))
#> Error in eval(substitute(x)) : object 'dots' not found

那么，解决方案是什么？看起来你已经找到了一个完美的解决方案，也就是手动对要传递的数据框进行子集转换。其他人可能建议你尝试使用purrr::map来获得更优雅的解决方案。

然而，你确实可以让mapply做你想要的事情，秘密就在于修改FUN，将其变成xtabs的匿名包装器，在运行时进行子集转换。

mapply(FUN = function(formula, subset, data) xtabs(formula, data[subset,]), 
       formula = list(~ wool, ~ wool + tension),
       subset = with(warpbreaks, list(breaks < 15, breaks < 20)),
       MoreArgs = list(data = warpbreaks))
#> [[1]]
#> wool
#> A B 
#> 2 2 
#> 
#> [[2]]
#>     tension
#> wool L M H
#>    A 0 4 3
#>    B 2 2 5

- Allan Cameron

---

真是美好的一天！在你今早给出的出色答案之后，我又有了另一个问题。感谢您的教学，我很高兴学到了更多关于R语言的知识。我已经为您的回答点了赞，但我会等到截止日期再验证并授予奖金，以保持问题具有吸引力。 - Thomas

@Moody_Mudskipper 是的，这似乎是 xtabs 调用 model.frame 的方式所导致的问题。它不是手动列出从 xtabs 调用中要传递的所有参数，而是执行了一个 match.call 并将调用对象中的函数更改为 model.frame，同时保留了所有参数。聪明，但懒惰，最终会有错误：由于 model.frame 使用 eval，如果通过 mapply 调用，则此方法无法工作，原因如上所述。 - Allan Cameron

@Moody_Mudskipper，感谢您的报告！记录一下，R devel 上的线程在这里：https://stat.ethz.ch/pipermail/r-devel/2020-May/079421.html - Thomas

@Moody_Mudskipper eipi10，我接受并奖励了Allan Cameron的答案，因为他是第一个提供基于R语言、详细回答我的问题的人。希望你不介意！无论如何，你的回答也非常有帮助！ - Thomas

这是一个很好的答案，而且我有足够的积分：）。问题也很好。 - moodymudskipper

Answer 2

@AllanCameron提到了使用purrr::map的可能性。以下是几个选项：

1. 由于我们知道我们想要通过breaks列进行子集化，因此我们只需要提供截止值，因此无需担心延迟表达式的评估。在这里和其他示例中，我们为breaks列表的元素命名，以便输出还会告诉我们使用了什么breaks截止值。此外，在所有示例中，我们利用dplyr::filter函数过滤data参数中的数据，而不是subset参数：

library(tidyverse)

map2(list(breaks.lt.15=15,
          breaks.lt.20=20),
     list(~ wool,
          ~ wool + tension),
     ~ xtabs(.y, data=filter(warpbreaks, breaks < .x))
)
#> $breaks.lt.15
#> wool
#> A B 
#> 2 2 
#> 
#> $breaks.lt.20
#>     tension
#> wool L M H
#>    A 0 4 3
#>    B 2 2 5

与上面类似，但我们提供整个过滤表达式，并用 quos 包装过滤表达式以延迟评估。在 xtabs 中过滤 warpbreaks 数据框时，!!.x 将在该点评估这些表达式。

map2(quos(breaks.lt.15=breaks < 15,
          breaks.lt.20=breaks < 20),
     list(~ wool,
          ~ wool + tension),
     ~ xtabs(.y, data=filter(warpbreaks, !!.x))
)
#> $breaks.lt.15
#> wool
#> A B 
#> 2 2 
#> 
#> $breaks.lt.20
#>     tension
#> wool L M H
#>    A 0 4 3
#>    B 2 2 5

如果你想得到所有筛选器和交叉表公式的组合，可以使用crossing函数生成所有的组合，并将组合传递给pmap（"parallel map"），它可以接收任意数量的参数，所有参数都包含在一个列表中。在这种情况下，我们使用rlang::exprs代替quos来延迟评估。在上面的例子中，rlang::exprs也可以工作，但是quos在这里不起作用。我不确定我真正理解为什么会这样，但这与捕获表达式和其环境（quos）以及仅捕获表达式（exprs）有关，详情请参见此处。

# map over all four combinations of breaks and xtabs formulas
crossing(
  rlang::exprs(breaks.lt.15=breaks < 15,
               breaks.lt.20=breaks < 20),
  list(~ wool,
       ~ wool + tension)
) %>% 
  pmap(~ xtabs(.y, data=filter(warpbreaks, !!.x)))
#> $breaks.lt.15
#> wool
#> A B 
#> 2 2 
#> 
#> $breaks.lt.15
#>     tension
#> wool L M H
#>    A 0 1 1
#>    B 1 0 1
#> 
#> $breaks.lt.20
#> wool
#> A B 
#> 7 9 
#> 
#> $breaks.lt.20
#>     tension
#> wool L M H
#>    A 0 4 3
#>    B 2 2 5

您也可以使用tidyverse函数来汇总数据，而不是使用 xtabs 函数，并返回一个数据框。例如:

map2_df(c(15,20),
        list("wool",
             c("wool", "tension")),
        ~ warpbreaks %>% 
            filter(breaks < .x) %>% 
            group_by_at(.y) %>% 
            tally() %>% 
            bind_cols(max.breaks=.x - 1)
) %>% 
  mutate_if(is.factor, ~replace_na(fct_expand(., "All"), "All")) %>% 
  select(is.factor, everything())   # Using select this way requires development version of dplyr, soon to be released on CRAN as version 1.0.0
#> # A tibble: 7 x 4
#>   wool  tension     n max.breaks
#>   <fct> <fct>   <int>      <dbl>
#> 1 A     All         2         14
#> 2 B     All         2         14
#> 3 A     M           4         19
#> 4 A     H           3         19
#> 5 B     L           2         19
#> 6 B     M           2         19
#> 7 B     H           5         19

如果您想包括边际计数，可以这样做:

crossing(
  c(Inf,15,20),
  list(NULL, "wool", "tension", c("wool", "tension"))
) %>% 
  pmap_df(
    ~ warpbreaks %>% 
        filter(breaks < .x) %>% 
        group_by_at(.y) %>% 
        tally() %>% 
        bind_cols(max.breaks=.x - 1)
  ) %>% 
  mutate_if(is.factor, ~replace_na(fct_expand(., "All"), "All")) %>% 
  select(is.factor, everything()) 

#>    wool tension  n max.breaks
#> 1   All     All  4         14
#> 2     A     All  2         14
#> 3     B     All  2         14
#> 4   All       L  1         14
#> 5   All       M  1         14
#> 6   All       H  2         14
#> 7     A       M  1         14
#> 8     A       H  1         14
#> 9     B       L  1         14
#> 10    B       H  1         14
#> 11  All     All 16         19
#> 12    A     All  7         19
#> 13    B     All  9         19
#> 14  All       L  2         19
#> 15  All       M  6         19
#> 16  All       H  8         19
#> 17    A       M  4         19
#> 18    A       H  3         19
#> 19    B       L  2         19
#> 20    B       M  2         19
#> 21    B       H  5         19
#> 22  All     All 54        Inf
#> 23    A     All 27        Inf
#> 24    B     All 27        Inf
#> 25  All       L 18        Inf
#> 26  All       M 18        Inf
#> 27  All       H 18        Inf
#> 28    A       L  9        Inf
#> 29    A       M  9        Inf
#> 30    A       H  9        Inf
#> 31    B       L  9        Inf
#> 32    B       M  9        Inf
#> 33    B       H  9        Inf

如果我们在先前的链式操作中添加pivot_wider，就可以得到：

pivot_wider(names_from=max.breaks, values_from=n, 
            names_prefix="breaks<=", values_fill=list(n=0))

   wool  tension `breaks<=14` `breaks<=19` `breaks<=Inf`
 1 All   All                4           16            54
 2 A     All                2            7            27
 3 B     All                2            9            27
 4 All   L                  1            2            18
 5 All   M                  1            6            18
 6 All   H                  2            8            18
 7 A     M                  1            4             9
 8 A     H                  1            3             9
 9 B     L                  1            2             9
10 B     H                  1            5             9
11 B     M                  0            2             9
12 A     L                  0            0             9

- eipi10

---

感谢您详细的回答！ - Thomas

Answer 3

这是一个关于NSE的问题。一种方法是直接在调用中注入子集条件，以便在相关上下文（数据中存在breaks的位置）应用它们。

可以使用alist()而不是list()，以获得引用表达式的列表，然后构建正确的调用（使用bquote()是最简单的方法），并对其进行评估。

mapply(
  FUN = function(formula, data, subset) 
    eval(bquote(xtabs(formula, data, .(subset)))),
  formula = list(~ wool,
                 ~ wool + tension),
  subset = alist(breaks < 15,
                 breaks < 20),
  MoreArgs = list(data = warpbreaks))
#> [[1]]
#> wool
#> A B 
#> 2 2 
#> 
#> [[2]]
#>     tension
#> wool L M H
#>    A 0 4 3
#>    B 2 2 5

mapply(FUN = function(formula, data, FUN, subset)
  eval(bquote(aggregate(formula, data, FUN, subset = .(subset)))),
  formula = list(breaks ~ wool,
                 breaks ~ wool + tension),
  subset = alist(breaks < 15,
                 breaks < 20),
  MoreArgs = list(data = warpbreaks,
                  FUN = length))
#> [[1]]
#>   wool breaks
#> 1    A      2
#> 2    B      2
#> 
#> [[2]]
#>   wool tension breaks
#> 1    B       L      2
#> 2    A       M      4
#> 3    B       M      2
#> 4    A       H      3
#> 5    B       H      5

现在您可以直接在调用中使用参数，因此您实际上不再需要 MoreArgs ，因此您可能希望将其简化如下：

mapply(
  FUN = function(formula, subset) 
    eval(bquote(xtabs(formula, warpbreaks, subset = .(subset)))),
  formula = list(~ wool,
                 ~ wool + tension),
  subset = alist(breaks < 15,
                 breaks < 20))
#> [[1]]
#> wool
#> A B 
#> 2 2 
#> 
#> [[2]]
#>     tension
#> wool L M H
#>    A 0 4 3
#>    B 2 2 5

mapply(FUN = function(formula, subset)
  eval(bquote(aggregate(formula, warpbreaks, length, subset = .(subset)))),
  formula = list(breaks ~ wool,
                 breaks ~ wool + tension),
  subset = alist(breaks < 15,
                 breaks < 20))
#> [[1]]
#>   wool breaks
#> 1    A      2
#> 2    B      2
#> 
#> [[2]]
#>   wool tension breaks
#> 1    B       L      2
#> 2    A       M      4
#> 3    B       M      2
#> 4    A       H      3
#> 5    B       H      5

您可以通过创建数据集并使用lapply进行循环来避免调用操纵和adhoc FUN参数：

mapply(
  FUN =  xtabs,
  formula = list(~ wool,
                 ~ wool + tension),
  data =  lapply(c(15, 20), function(x) subset(warpbreaks, breaks < x)))
#> [[1]]
#> wool
#> A B 
#> 2 2 
#> 
#> [[2]]
#>     tension
#> wool L M H
#>    A 0 4 3
#>    B 2 2 5

mapply(
  FUN =  aggregate,
  formula = list(breaks ~ wool,
                 breaks ~ wool + tension),
  data =  lapply(c(15, 20), function(x) subset(warpbreaks, breaks < x)),
  MoreArgs = list(FUN = length))
#> [[1]]
#>   wool breaks
#> 1    A      2
#> 2    B      2
#> 
#> [[2]]
#>   wool tension breaks
#> 1    B       L      2
#> 2    A       M      4
#> 3    B       M      2
#> 4    A       H      3
#> 5    B       H      5

- moodymudskipper

---

非常感谢您的回答！但是，我不确定我是否理解正确。您能否确认.()避免了bquote重新引用子集参数，因为它已经从alist中引用了？附注：对于像我这样需要背景信息的读者，建议阅读：http://adv-r.had.co.nz/Computing-on-the-language.html - Thomas

我认为你的理解基本正确。换句话说，在bquote()内部，.()的作用是评估其输入并将结果插入引用表达式中。以下代码：x <- 1; y <- 2; z <- quote(ZZZ); bquote(x + .(y) + .(z))，将返回quote(x + 2 + ZZZ)。任何可以使用substitute()完成的操作都可以使用bquote()完成，但在可以使用时，bquote()更加简洁。 - moodymudskipper

你可以尝试将eval(bquote(xtabs(formula, data, .(subset))))替换为eval(print(bquote(xtabs(formula, data, .(subset))))),这样在执行前它会打印出调用。 - moodymudskipper