Passing a list of arguments to a function with quasiquotation

后端 未结 2 2106
不知归路
不知归路 2020-12-06 14:36

I am trying to write a function in R that summarizes a data frame according to grouping variables. The grouping variables are given as a list and passed to group_by_at

2条回答
  •  青春惊慌失措
    2020-12-06 15:37

    I'd just use vars to do the quoting. Here is an example using mtcars dataset

    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
    #>     
    #> 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
    

    You can also replace .group_vars with ... (dot-dot-dot)

    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
    #>     
    #> 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
    

    If you prefer to supply inputs as a list of columns, you will need to use enquos for the ...

    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]]
    #> 
    #>   expr: ^c(cyl, am)
    #>   env:  global
    #> 
    #> # A tibble: 6 x 3
    #> # Groups:   cyl [?]
    #>     cyl    am  mean
    #>     
    #> 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
    

    Edit: append an .addi_var to .../.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
    #>       
    #>  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() can also take input as a character vector of column names

    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
    #>       
    #>  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
    

    Created on 2018-10-09 by the reprex package (v0.2.1.9000)

提交回复
热议问题