代码之家  ›  专栏  ›  技术社区  ›  slhck

将参数列表传递给具有准旋转的函数

  •  3
  • slhck  · 技术社区  · 6 年前

    我试图在R中编写一个函数,根据分组变量总结数据帧。分组变量以列表形式给出并传递给 group_by_at ,我想参数化它们。

    library(tidyverse)
    
    d = tribble(
      ~foo, ~bar, ~baz,
      1, 2, 3,
      1, 3, 5
      4, 5, 6,
      4, 5, 1
    )
    
    sum_fun <- function(df, group_vars, sum_var) {
      sum_var = enquo(sum_var)
      return(
        df %>% 
          group_by_at(.vars = group_vars) %>% 
          summarize(sum(!! sum_var))
      )
    }
    
    d %>% sum_fun(group_vars = c("foo", "bar"), baz)
    

    但是,我想这样调用函数:

    d %>% sum_fun(group_vars = c(foo, bar), baz)
    

    我试过使用 enquo 就像summary变量一样,然后替换 group_vars 具有 !! group_vars

    Error in !group_vars : invalid argument type
    

    使用 group_by(!!!group_vars) 产量:

    Column `c(foo, bar)` must be length 2 (the number of rows) or one, not 4 
    

    重写函数的正确方法是什么?

    2 回复  |  直到 6 年前
        1
  •  9
  •   Tung    6 年前

    我只想用 vars 做引用。下面是一个使用 mtcars

    library(tidyverse)
    
    sum_fun <- function(.data, .summary_var, .group_vars) {
      summary_var <- enquo(.summary_var)
    
      .data %>%
        group_by_at(.group_vars) %>%
        summarise(mean = mean(!!summary_var))
    }
    
    sum_fun(mtcars, disp, .group_vars = vars(cyl, am))
    #> # A tibble: 6 x 3
    #> # Groups:   cyl [?]
    #>     cyl    am  mean
    #>   <dbl> <dbl> <dbl>
    #> 1     4     0 136. 
    #> 2     4     1  93.6
    #> 3     6     0 205. 
    #> 4     6     1 155  
    #> 5     8     0 358. 
    #> 6     8     1 326
    

    您也可以替换 .group_vars 具有 ... (点-点)

    sum_fun2 <- function(.data, .summary_var, ...) {
      summary_var <- enquo(.summary_var)
    
      .data %>%
        group_by_at(...) %>%  # Forward `...`
        summarise(mean = mean(!!summary_var))
    }
    
    sum_fun2(mtcars, disp, vars(cyl, am))
    #> # A tibble: 6 x 3
    #> # Groups:   cyl [?]
    #>     cyl    am  mean
    #>   <dbl> <dbl> <dbl>
    #> 1     4     0 136. 
    #> 2     4     1  93.6
    #> 3     6     0 205. 
    #> 4     6     1 155  
    #> 5     8     0 358. 
    #> 6     8     1 326
    

    enquos 对于

    sum_fun3 <- function(.data, .summary_var, ...) {
      summary_var <- enquo(.summary_var)
    
      group_var <- enquos(...)
      print(group_var)
    
      .data %>%
          group_by_at(group_var) %>% 
          summarise(mean = mean(!!summary_var))
    }
    
    sum_fun3(mtcars, disp, c(cyl, am))
    #> [[1]]
    #> <quosure>
    #>   expr: ^c(cyl, am)
    #>   env:  global
    #> 
    #> # A tibble: 6 x 3
    #> # Groups:   cyl [?]
    #>     cyl    am  mean
    #>   <dbl> <dbl> <dbl>
    #> 1     4     0 136. 
    #> 2     4     1  93.6
    #> 3     6     0 205. 
    #> 4     6     1 155  
    #> 5     8     0 358. 
    #> 6     8     1 326
    

    .addi_var ... .group_var .

    sum_fun4 <- function(.data, .summary_var, .addi_var, .group_vars) {
      summary_var <- enquo(.summary_var)
    
      .data %>%
        group_by_at(c(.group_vars, .addi_var)) %>%
        summarise(mean = mean(!!summary_var))
    }
    
    sum_fun4(mtcars, disp, .addi_var = vars(gear), .group_vars = vars(cyl, am))
    #> # A tibble: 10 x 4
    #> # Groups:   cyl, am [?]
    #>      cyl    am  gear  mean
    #>    <dbl> <dbl> <dbl> <dbl>
    #>  1     4     0     3 120. 
    #>  2     4     0     4 144. 
    #>  3     4     1     4  88.9
    #>  4     4     1     5 108. 
    #>  5     6     0     3 242. 
    #>  6     6     0     4 168. 
    #>  7     6     1     4 160  
    #>  8     6     1     5 145  
    #>  9     8     0     3 358. 
    #> 10     8     1     5 326
    

    group_by_at()

    sum_fun5 <- function(.data, .summary_var, .addi_var, ...) {
    
      summary_var <- enquo(.summary_var)
      addi_var    <- enquo(.addi_var)
      group_var   <- enquos(...)
    
      ### convert quosures to strings for `group_by_at`
      all_group <- purrr::map_chr(c(addi_var, group_var), quo_name)
    
      .data %>%
        group_by_at(all_group) %>% 
        summarise(mean = mean(!!summary_var))
    }
    
    sum_fun5(mtcars, disp, gear, cyl, am)
    #> # A tibble: 10 x 4
    #> # Groups:   gear, cyl [?]
    #>     gear   cyl    am  mean
    #>    <dbl> <dbl> <dbl> <dbl>
    #>  1     3     4     0 120. 
    #>  2     3     6     0 242. 
    #>  3     3     8     0 358. 
    #>  4     4     4     0 144. 
    #>  5     4     4     1  88.9
    #>  6     4     6     0 168. 
    #>  7     4     6     1 160  
    #>  8     5     4     1 108. 
    #>  9     5     6     1 145  
    #> 10     5     8     1 326
    

    创建日期:2018-10-09 reprex package (v0.2.1.9000)

        2
  •  3
  •   Martin Schmelzer    6 年前

    你可以利用椭圆 ...

    sum_fun <- function(df, sum_var, ...) {
      sum_var <- substitute(sum_var)
      grps    <- substitute(list(...))[-1L]
      return(
        df %>% 
          group_by_at(.vars = as.character(grps)) %>% 
          summarize(sum(!! sum_var))
      )
    }
    
    d %>% sum_fun(baz, foo, bar)
    

    我们获取附加参数并从中创建一个列表。然后采用非标准评价法( substitute )获取变量名并阻止R对其求值。自 group_by_at 需要character或numeric类型的对象,我们只需将名称向量转换为字符向量,函数将按预期进行求值。

    > d %>% sum_fun(baz, foo, bar)
    # A tibble: 3 x 3
    # Groups:   foo [?]
        foo   bar `sum(baz)`
      <dbl> <dbl>      <dbl>
    1     1     2          3
    2     1     3          5
    3     4     5          7
    

    如果不想将分组变量作为任意数量的附加参数提供,则当然可以使用命名参数:

    sum_fun <- function(df, sum_var, grps) {
      sum_var <- enquo(sum_var)
      grps    <- as.list(substitute(grps))[-1L]
      return(
        df %>% 
          group_by_at(.vars = as.character(grps)) %>% 
          summarize(sum(!! sum_var))
      )
    }
    
    sum_fun(mtcars, sum_var = hp, grps = c(cyl, gear))
    

    list(cyl, gear) 在它的组成部分。也许有办法 rlang 但到目前为止,我还没有深入研究这个包裹。