代码之家 › 专栏 › 技术社区 › Jakub MaÅecki

如何处理R中函数列表的求值

tidy evaluation dplyr r

Jakub MaÅecki · 技术社区 · 5 年前

我试图弄清楚如何处理自定义聚合函数,它将与dplyr的评估原则一起工作。我想创建一个形状函数:

custom_aggregation <- function (data, stat_funs = list(mean, median), agg_col, ...)

哪里 data 这是一个数据。框架 stat_funs 是要应用的函数列表, agg_col 指示将在哪个列上应用函数, ... 正在对列进行分组。

对于单个攻击函数,我使用如下代码:

custom_aggregation <- function (data, stat_fun, agg_col, ...) {

  groups <- enquos(...) 
  agg_col <- enquo(agg_col) 
  stat_fun_enq <- enquo(stat_fun) 
  agg_name <- paste0(quo_name(agg_col), '', quo_name(stat_fun_enq))

  data %>% 
    group_by(!!!groups) %>% 
    summarise(!!agg_name := stat_fun(!!agg_col)) 
}

# I can try to call the function on mtcars data.frame:
custom_aggregation(mtcars, stat_fun = mean, agg_col = qsec, cyl, am)

我不知道如何处理函数列表( stat_fun (论点)。

我试过:

map(stat_fun, enquo) # and the basic lapply equivalent with variants

lapply(stat_fun, function(i) {
  stat_fun_enq <- enquo(i)
})


lapply(seq_along(stat_fun), function(i) {
  stat_fun_enq <- enquo(stat_fun[[i]])
})

有人能告诉我我做错了什么吗?

0 回复 | 直到 5 年前

akrun 5 年前

一个选项是将函数作为一个quosure列表传递,然后 map 通过 list ,评估( !! )应用函数

library(tidyverse)
custom_aggregation <- function (data, stat_fun, agg_col, ...) {

  groups <- enquos(...) 
  agg_col <- enquo(agg_col) 
  agg_name <- rlang::as_name(stat_fun)
  data %>%
        group_by(!!! groups) %>%
         summarise((!!agg_name) := (!!stat_fun)(!!agg_col))



}

不清楚预期的输出格式

quos(mean, median)  %>%
      map(~ custom_aggregation(mtcars, stat_fun = .x, agg_col = qsec, cyl, am))
#[[1]]
# A tibble: 6 x 3
# Groups:   cyl [3]
#    cyl    am  mean
#  <dbl> <dbl> <dbl>
#1     4     0  21.0
#2     4     1  18.4
#3     6     0  19.2
#4     6     1  16.3
#5     8     0  17.1
#6     8     1  14.6

#[[2]]
# A tibble: 6 x 3
# Groups:   cyl [3]
#    cyl    am median
#  <dbl> <dbl>  <dbl>
#1     4     0   20.0
#2     4     1   18.6
#3     6     0   19.2
#4     6     1   16.5
#5     8     0   17.4
#6     8     1   14.6

使现代化

如果我们需要一个数据集

library(rlang)
custom_aggregation <- function (data, stat_fun, agg_col, ...) {

  groups <- enquos(...) 
  agg_col <- enquo(agg_col) 

  nm1 <- str_c(rlang::as_name(agg_col),
       map_chr(rlang::call_args(rlang::enexpr(stat_fun)),
             rlang::as_name), sep="_") 

  data %>%
         group_by(!!! groups) %>%
         summarise_at(vars(rlang::as_name(agg_col)), stat_fun) %>%
         rename_at(vars(starts_with('fn')), ~ nm1)





}

-测试

custom_aggregation(mtcars, stat_fun = list(sum), agg_col = qsec, cyl, am)    # A tibble: 6 x 3
# Groups:   cyl [3]
#    cyl    am  qsec
#  <dbl> <dbl> <dbl>
#1     4     0  62.9
#2     4     1 148. 
#3     6     0  76.9
#4     6     1  49.0
#5     8     0 206. 
#6     8     1  29.1




custom_aggregation(mtcars, stat_fun = list(sum, max), agg_col = qsec, cyl, am)
# A tibble: 6 x 4
# Groups:   cyl [3]
#    cyl    am qsec_sum qsec_max
#  <dbl> <dbl>    <dbl>    <dbl>
#1     4     0     62.9     22.9
#2     4     1    148.      19.9
#3     6     0     76.9     20.2
#4     6     1     49.0     17.0
#5     8     0    206.      18  
#6     8     1     29.1     14.6


custom_aggregation(mtcars, stat_fun = list(sum, min, max), agg_col = qsec, cyl, am)
# A tibble: 6 x 5
# Groups:   cyl [3]
#    cyl    am qsec_sum qsec_min qsec_max
#  <dbl> <dbl>    <dbl>    <dbl>    <dbl>
#1     4     0     62.9     20       22.9
#2     4     1    148.      16.7     19.9
#3     6     0     76.9     18.3     20.2
#4     6     1     49.0     15.5     17.0
#5     8     0    206.      15.4     18  
#6     8     1     29.1     14.5     14.6