时间戳

首页 > 解决方案 > 使用 dplyr 高效汇总具有不同功能的不同列

r - 使用 dplyr 高效汇总具有不同功能的不同列

问题描述

下面的代码完全符合我的要求。采用具有多个分组约束（即 id 和日期）的数据框，并为每个返回 1 行，并将不同的函数应用于不同的列。在这种情况下，折叠到字符并通过分组获取列的最大值。

问题是将这种方法扩展到具有 100k 行和组的更大数据帧。我怎样才能以更有效的方式得出相同的结论？如果这在 tidyverse 结构中是可能的，这是首选（虽然不是首选，但 data.table 解决方案也将被接受）。我想保持灵活性，以指定要包含在函数调用中的不同列，以及添加额外的汇总调用（例如 summarise_at（值总和））。

data <- tibble(id = c(1,1,1,2,3,4,5,5,6,6,6), date = dmy("01/01/2020"), var1 =  1:11, var2 = 12:22, var3 = 1:11)

data %>% 
group_by(id, date) %>%
    {data.frame(
            summarise_at(., vars(var1, var2), list(~ paste(unique(.), collapse = " AND "))), # return character string
            summarise_at(., vars(var3), list(~ max(., na.rm = T))),#, # return max in group
            summarise(., count = n(), .groups = "keep") # return count of cases in group
        )} %>% 
    select(-matches("[.]1$|[.]2$|[.]3$")) %>% # remove unwanted columns
    as_tibble()

# A tibble: 6 x 6
     id date       var1            var2              var3 count
  <dbl> <date>     <chr>           <chr>            <int> <int>
1     1 2020-01-01 1 AND 2 AND 3   12 AND 13 AND 14     3     3
2     2 2020-01-01 4               15                   4     1
3     3 2020-01-01 5               16                   5     1
4     4 2020-01-01 6               17                   6     1
5     5 2020-01-01 7 AND 8         18 AND 19            8     2
6     6 2020-01-01 9 AND 10 AND 11 20 AND 21 AND 22    11     3

这个问题的链接也是如此。 如何使用 summarise_at 将不同的函数应用于不同的列？

标签： rdplyrdata.tableaggregate

解决方案

这是tidyverse改编自@MichaelDewar's answer的方法，它更整洁，但我认为效率没有任何真正的提高。此外，在我看来，一个有 100k 行的数据框并不是什么大不了的事。我认为tidyverse解决方案很好。

library(dplyr)

data %>% 
  group_by(id, date) %>% 
  summarise(
    across(c(var1, var2), ~paste(unique(.), collapse = " AND ")), 
    across(var3, max, na.rm = T), 
    count = n(), .groups = "keep"
  )

但是如果你真的想提高效率，也许可以试试这个 data.table 解决方案

library(data.table)

setDT(data)[, c(
  lapply(c(var1 = "var1", var2 = "var2"), function(x) paste(unique(.SD[[x]]), collapse = " AND ")), 
  list(var3 = max(var3, na.rm = T), count = .N)
), by = c("id", "date")]

基准

set.seed(2020)
data2 <- data[sample.int(nrow(data), 1e5, T), ]
data22 <- data.table::copy(data2)

f1 <- 
  . %>% 
  group_by(id, date) %>%
  {data.frame(
    summarise_at(., vars(var1, var2), list(~ paste(unique(.), collapse = " AND "))), # return character string
    summarise_at(., vars(var3), list(~ max(., na.rm = T))),#, # return max in group
    summarise(., count = n(), .groups = "keep") # return count of cases in group
  )} %>% 
  select(-matches("[.]1$|[.]2$|[.]3$")) %>% # remove unwanted columns
  as_tibble()

f2 <- 
  . %>% 
  group_by(id, date) %>% 
  summarise(
    across(c(var1, var2), ~paste(unique(.), collapse = " AND ")), 
    across(var3, max, na.rm = T), 
    count = n(), 
    .groups = "keep"
  )

f3 <- function(dt) {
  setDT(dt)[, c(
    lapply(c(var1 = "var1", var2 = "var2"), function(x) paste(unique(.SD[[x]]), collapse = " AND ")), 
    list(var3 = max(var3, na.rm = T), count = .N)
  ), by = c("id", "date")]
}

microbenchmark::microbenchmark(f1(data2), f2(data2), f3(data22))

结果

Unit: milliseconds
       expr     min       lq      mean   median       uq     max neval cld
  f1(data2) 19.6730 20.27990 20.841344 20.50850 20.85045 29.2799   100   c
  f2(data2) 13.5455 14.09240 14.705967 14.34585 14.64625 20.5914   100  b 
 f3(data22)  6.9186  7.80615  8.598227  8.32035  8.68040 15.8358   100 a

推荐阅读