dplyr将NULL传递给group_by

时间:2018-10-16 07:12:29

标签: r if-statement dplyr

这可能已经在某处得到了回答,但是我找不到答案...标记为重复项并随意投票,但是有人可以帮助我:)

简短问题

如何在函数内将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管道使所有汇总代码更短。我有多个条件导致不同的输出并汇总其他选择,因此我通过首先分组并在单独的步骤中进行汇总来缩短了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来自同一作者)。

2 个答案:

答案 0 :(得分:1)

我认为您需要首先将其从NULL转换为NA(因为从您的答案中,您只需要传递值即可,而不必将其包含在计算中)

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 %>% 
    mutate(c = ifelse(is_empty(c)==TRUE,NA,c)) %>% 
    group_by(a, b,c) %>% 
    summarise(mean = mean(value))
}

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

结果:

# A tibble: 4 x 4
# Groups:   a, b [?]
  a     b     c      mean
  <fct> <fct> <lgl> <dbl>
1 A     C     NA     5.27
2 A     D     NA     5.18
3 B     C     NA     5.27
4 B     D     NA     5.49

答案 1 :(得分: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