在 R 中使用 mapply 对子集参数进行非标准评估答案

【问题标题】：Non-standard evaluation of subset argument with mapply in R在 R 中使用 mapply 对子集参数进行非标准评估
【发布时间】：2019-11-11 01:34:10
【问题描述】：

我不能将xtabs 或aggregate（或我测试的任何函数，包括ftable 和lm）的subset 参数与mapply 一起使用。以下调用因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 参数中使用 data = warpbreaks[warpbreaks$breaks < 20, ] 作为解决方法，但我希望提高我对 R 的了解。

我的问题是：

如何将subset 参数与mapply 一起使用？我尝试使用match.call 和eval.parent，但到目前为止没有成功（更多详细信息请参阅我的previous questions）。
为什么在data = warpbreaks 中评估formula 参数，但是 subset 参数不是？

【问题讨论】：

标签： r scope subset evaluation mapply

【解决方案1】：

@AllanCameron 暗示了purrr::map 解决方案的可能性。这里有几个选项：

既然我们知道我们想通过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 中以延迟评估。 !!.x 在我们过滤 xtabs 内的 warpbreaks 数据框时计算表达式。

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

如果您想要过滤器和 xtabs 公式的所有组合，您可以使用 crossing 函数生成组合，然后将其传递给 pmap（“平行映射”），它可以采用任意数量的参数，全部包含在一个列表中。在这种情况下，我们使用rlang::exprs 而不是quos 来延迟评估。 rlang::exprs 也可以在上面工作，但quos 在这里不起作用。我不确定我是否真的理解为什么，但这与捕获表达式及其环境 (quos) 与仅捕获表达式 (exprs) 有关，正如 here 所讨论的那样。

# 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

【讨论】：

感谢您详细的回答！

【解决方案2】：

这是 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

【讨论】：

非常感谢您的回答！但是，我不确定我是否理解正确。您能否确认.() 避免bquote “重新引用”子集参数，因为它已经从alist 引用？附言推荐给像我这样需要背景信息的读者阅读：adv-r.had.co.nz/Computing-on-the-language.html
我认为你说得对。换句话说，.() 在bquote() 内部所做的（并且只有在那里）是评估其输入并将结果插入到引用的表达式中。以下：x <- 1; y <- 2; z <- quote(ZZZ); bquote(x + .(y) + .(z)) ，将返回 quote(x + 2 + ZZZ)。可以用bquote() 做的任何事情都可以用substitute() 做，但是bquote() 在可以使用的时候更紧凑。
你可以尝试用eval(print(bquote(xtabs(formula, data, .(subset)))))替换eval(bquote(xtabs(formula, data, .(subset))))，它会在评估前打印调用

【解决方案3】：

简短的回答是，当您创建一个列表以作为参数传递给函数时，它会在创建时进行评估。您收到的错误是因为 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，它会因此尝试eval 对象dots，该对象在@987654344 所在的环境中不存在@ 叫做。这很容易通过在 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

【讨论】：

多么美好的一天！在您今天早上的出色回答之后，这是另一个。感谢您的教学法，我很高兴我对 R 有了更多的了解。我已经对您的答案投了赞成票，但我等到截止日期才验证它并奖励赏金以保持问题的吸引力。
@Moody_Mudskipper 是的，这似乎是xtabs 调用model.frame 的方式的产物。它不是手动列出要从xtabs 调用传递的所有参数，而是执行match.call 并将调用对象中的函数更改为model.frame，同时保留所有参数。聪明，但懒惰，最终还是有问题：由于model.frame 使用eval，如果通过mapply 调用，由于上述原因，此方法不起作用。
@Moody_Mudskipper 感谢您的报告！作为记录，R devel 上的线程在这里：stat.ethz.ch/pipermail/r-devel/2020-May/079421.html
@Moody_Mudskipper eipi10 我接受并授予了 Allan Cameron 的答案，因为他是第一个回答的人，提供了一个详细的答案，专门用 base R 回答了我的问题。我希望你不介意！不管怎样，你的回答也很有帮助！
这是一个很好的答案，我有足够的积分:)。问题也很好。