r - dplyr 将 NULL 传递给 group_by

Question

这可能已经在某个地方得到了回答，但我找不到答案...标记为重复并随意投反对票，但请有人帮助我:)

简短的问题

如何在函数内将 NULL 传递给 dplyr::group_by？

library(dplyr)

dt <- data.frame(a = sample(LETTERS[1:2], 100, replace = TRUE), b = sample(LETTERS[3:4], 100, replace = TRUE), value = rnorm(100,5,1))

f1 <- function(dt, a, b, c) {
  dt %>% group_by(a, b, c) %>% summarise(mean = mean(value))
}

f1(dt, a = "a", b = "b", c = NULL)

# Error in grouped_df_impl(data, unname(vars), drop) : 
#  Column `c` is unknown 

详细解释

我正在编写一个函数，其中“b”列可以作为 NULL 给出，这意味着该函数应该忽略该列。如果“b”列作为字符给出，函数应使用该列来汇总数据。像这样:

f2 <- function(dt, a, b) {
  if(is.null(b)) {
    dt %>% group_by(a) %>% summarize(mean = mean(value))
  } else {
    dt %>% group_by(a, b) %>% summarize(mean = mean(value))
  }
}

实际函数比较长和复杂，使用dplyr pipes让所有的总结代码都变短了。我有多个条件导致不同的输出和总结备选方案，因此我通过首先分组并在单独的步骤中总结来缩短 if else 语句:

f3 <- function(dt, a, b, type = "mean") {
  if(is.null(b)) {
    tmp <- dt %>% group_by(a) 
  } else {
    tmp <- dt %>% group_by(a, b)
  }

  if(type == "mean") {
    tmp %>% summarize(mean = mean(value))
  } else {
    tmp %>% summarise(sum = sum(value))
  }
}

如果可以将 NULL 传递给 group_by 函数，我可以大大缩短我的代码(无论如何，NULL 应该是空的并且这种传递适用于许多函数，例如来自同一作者的 reshape2::melt。

Answer 1

我不确定这是否涵盖了您的所有用例，但是使用整洁评估的函数(请参阅 programming with dplyr vignette)会更加灵活，因为您不必担心有多少分组变量你可以传递一个任意的函数向量来总结。希望这样可以避免跟踪 NULL 列或使用 ifelse 选择汇总函数的需要。

例如，在下面的代码中，... 是任意数量的分组列，包括根本没有分组列。 type 参数允许您通过一个或多个任意函数进行总结:

library(tidyverse)
library(rlang)

set.seed(2)
dt <- data.frame(a = sample(LETTERS[1:2], 100, replace = TRUE), 
                 b = sample(LETTERS[3:4], 100, replace = TRUE), 
                 value = rnorm(100,5,1))

f1 = function(data, value.var, ...,  type="mean") {

  groups = enquos(...)
  value.var = enquo(value.var)

  names(type) = paste0(type, "_", quo_text(value.var))
  type = syms(type)

  data %>% group_by(!!!groups) %>% 
    summarise_at(vars(!!value.var), funs(!!!type))
}

f1(dt, value, a, b)

  a     b     mean_value
  <fct> <fct>      <dbl>
1 A     C           5.01
2 A     D           5.05
3 B     C           4.95
4 B     D           5.13

f1(dt, value)

  mean_value
       <dbl>
1       5.03

weird_func = function(x) {
  paste(round(cos(x),1)[1:3], collapse="/")
}

f1(dt, value, a, b, type=c("mean", "min", "median", "max", "weird_func"))

  a     b     mean_value min_value median_value max_value weird_func_value
  <fct> <fct>      <dbl>     <dbl>        <dbl>     <dbl> <chr>           
1 A     C           5.01      3.26         5.07      7.08 1/-0.1/1        
2 A     D           5.05      2.90         5.33      6.36 -0.4/0.9/0      
3 B     C           4.95      3.66         4.73      7.11 0.5/-0.5/0.7    
4 B     D           5.13      2.98         5.46      7.05 0/0.7/0.7

f1(mtcars, mpg, cyl, type=c("mean", "median"))

    cyl mean_mpg median_mpg
  <dbl>    <dbl>      <dbl>
1     4     26.7       26  
2     6     19.7       19.7
3     8     15.1       15.2