R中具有mapply的子集参数的非标准评估

时间:2019-06-29 13:36:11

标签: r scope subset evaluation mapply

我不能将任何函数的subset参数与mapply一起使用。以下调用失败,并带有subset参数,但它们不能在以下情况下工作:

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

# Error in mapply(ftable, formula = list(wool ~ breaks, wool + tension ~  : 
#   object 'breaks' not found

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

# Error in mapply(xtabs, formula = list(~wool, ~wool + tension), subset = list(breaks <  : 
#   object 'breaks' not found

Map(lm,
    formula = list(breaks ~ wool,
                   breaks ~ tension),
    subset = list(breaks < 15,
                  breaks < 20),
    MoreArgs = list(data = warpbreaks))

# Error in mapply(FUN = f, ..., SIMPLIFY = FALSE) : 
#   object 'breaks' not found

该错误似乎是由于未在正确的环境中评估subset自变量引起的。我知道我可以使用data作为data = warpbreaks[warpbreaks$breaks < 20, ]参数的子集,但是我希望提高对R的了解。

我的问题是:

  • 为什么在formula中评估data = warpbreaks参数,但是 subset参数不是吗?
  • 我为ftable编写了一个包装器,因为我需要针对许多变量使用频率和百分比来计算平面表(更多详细信息,请参见previous questions)。我可以修改包装器以使用subsetftable的{​​{1}}参数吗?

mapply

3 个答案:

答案 0 :(得分:8)

简短的答案是,当您创建要作为参数传递给函数的列表时,将在创建时对其进行评估。您收到的错误是因为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的列表中,然后它将传递给内部{ {1}}通话:

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的环境中。通过在eval包装器上进行mapply可以很容易地看到这一点:

match.call

因此,我们的错误的最小可重现示例是

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使其变成{{ 1}}是动态的子集:

FUN

答案 1 :(得分:4)

@AllanCameron暗示了purrr::map解决方案的可能性。以下是一些选项:

  1. 因为我们知道我们想按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
  1. 与上述类似,但我们提供了整个过滤器表达式,并将过滤器表达式包装在quos中以延迟求值。 !!.x在我们过滤warpbreaks内的xtabs数据帧的时刻评估表达式。
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
  1. 如果需要过滤器和xtabs公式的所有组合,则可以使用crossing函数来生成组合,然后将其传递给pmap(“并行映射”),该组合可以采用任何参数的数量,所有参数都包含在一个列表中。在这种情况下,我们使用rlang::exprs而不是quos来延迟评估。 rlang::exprs在上面也可以使用,但是quos在这里不起作用。我不确定我是否真正理解为什么,但是它与捕获表达式及其环境(quos)和仅捕获表达式(exprs)有关,如所讨论的{{3} }。
# 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 :(得分: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循环来避免调用操作和即席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