在 R 中使用 mapply 对子集参数进行非标准评估
Non-standard evaluation of subset argument with mapply in R
我无法将 xtabs 或 aggregate 的 subset 参数（或我测试过的任何函数，包括 ftable 和 lm）与 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，但到目前为止没有成功（更多细节在我的 ）。
- 为什么
formula 参数在 data = warpbreaks 中求值，但是
subset 参数不是？
简短的回答是，当您创建一个列表作为参数传递给函数时，它会在创建时进行评估。您收到的错误是因为 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，它不会' t 存在于调用 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
@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 ("parallel map")，它可以接受任意数量的参数，所有参数都包含在一个列表中。在这种情况下，我们使用 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 和 return 数据框。例如：
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
这是 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 来避免调用操作和临时 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
我无法将 xtabs 或 aggregate 的 subset 参数（或我测试过的任何函数，包括 ftable 和 lm）与 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，但到目前为止没有成功（更多细节在我的 - 为什么
formula参数在data = warpbreaks中求值，但是subset参数不是？
简短的回答是，当您创建一个列表作为参数传递给函数时，它会在创建时进行评估。您收到的错误是因为 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，它不会' t 存在于调用 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
@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("parallel map")，它可以接受任意数量的参数，所有参数都包含在一个列表中。在这种情况下，我们使用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 和 return 数据框。例如：
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
这是 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 来避免调用操作和临时 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