r - 按组在多个列上执行多个函数，并创建信息丰富的列名称

Question

如何调整数据表操作，以便除了每个类别的几个列的 sum 之外，
它还会同时计算其他函数，例如 mean 和计数 (.N) 并自动创建列名:“sum c1”、“sum c2”、“sum c4”、“mean c1”、“mean c2”、“意思是 c4”，最好还有 1 列“计数”？

我的旧解决方案是写出

mean col1 = ....
mean col2 = ....

等等，在data.table命令里面

哪个有效，但我认为效率极低，如果在新的应用程序版本中进行预编码将不再起作用，计算取决于用户在 R Shiny 应用程序中的选择，为哪些列计算什么。

我已经阅读了大量帖子和博客文章，但还没有完全弄清楚如何最好地做到这一点。我读到在某些情况下，根据您使用的方法(.sdcols、get、lapply 和或 by =)，对大型数据表的操作可能会变得非常缓慢。因此我添加了一个“相当大”的虚拟数据集

我的真实数据大约是 100k 行，100 列和 1-100 组。

library(data.table)
n = 100000
dt  = data.table(index=1:100000,
                 category = sample(letters[1:25], n, replace = T),
                 c1=rnorm(n,10000),
                 c2=rnorm(n,1000),
                 c3=rnorm(n,100),
                 c4 = rnorm(n,10)
)

# add more columns to test for big data tables 
lapply(c(paste('c', 5:100, sep ='')),
       function(addcol) dt[[addcol]] <<- rnorm(n,1000) )

# Simulate columns selected by shiny app user 

Colchoice <- c("c1", "c4")
FunChoice <- c(".N", "mean", "sum")

# attempt which now does just one function and doesn't add names
dt[, lapply(.SD, sum, na.rm=TRUE), by=category, .SDcols=Colchoice ]

预期输出是每组一行，每个选定列的每个函数对应一列。

Category  Mean c1 Sum c1 Mean c4 ...
A
B
C
D
E
......

可能是重复的，但我还没有找到我需要的确切答案

Answer 1

如果我理解正确，这个问题由两部分组成:

如何在列列表上使用多个函数进行分组和聚合，并自动生成新的列名。

如何将函数名称作为字符向量传递。

对于第 1 部分 ，这几乎是 Apply multiple functions to multiple columns in data.table 的副本，但附加要求结果应使用 by = 进行分组。
因此，必须通过在对 recursive = FALSE 的调用中添加参数 unlist() 来修改 eddi's answer :

my.summary = function(x) list(N = length(x), mean = mean(x), median = median(x))
dt[, unlist(lapply(.SD, my.summary), recursive = FALSE), 
   .SDcols = ColChoice, by = category]

    category c1.N   c1.mean c1.median c4.N   c4.mean c4.median
 1:        f 3974  9999.987  9999.989 3974  9.994220  9.974125
 2:        w 4033 10000.008  9999.991 4033 10.004261  9.986771
 3:        n 4025  9999.981 10000.000 4025 10.003686  9.998259
 4:        x 3975 10000.035 10000.019 3975 10.010448  9.995268
 5:        k 3957 10000.019 10000.017 3957  9.991886 10.007873
 6:        j 4027 10000.026 10000.023 4027 10.015663  9.998103
...

对于第 2 部分 ，我们需要从函数名称的字符向量中创建 my.summary()。这可以通过“在语言上编程”来实现，即将表达式组装为字符串，最后对其进行解析和评估:

my.summary <- 
  sapply(FunChoice, function(f) paste0(f, "(x)")) %>% 
  paste(collapse = ", ") %>% 
  sprintf("function(x) setNames(list(%s), FunChoice)", .) %>% 
  parse(text = .) %>% 
  eval()

my.summary

function(x) setNames(list(length(x), mean(x), sum(x)), FunChoice)
<environment: 0xe376640>

或者，我们可以循环遍历类别和 rbind() 之后的结果:

library(magrittr)   # used only to improve readability
lapply(dt[, unique(category)],
       function(x) dt[category == x, 
                      c(.(category = x), unlist(lapply(.SD, my.summary))), 
                      .SDcols = ColChoice]) %>% 
  rbindlist()

基准
到目前为止，已经发布了 4 个 data.table 和一个 dplyr 解决方案。至少有一个答案声称“超快”。因此，我想通过具有不同行数的基准来验证:

library(data.table)
library(magrittr)
bm <- bench::press(
  n = 10L^(2:6),
  {
    set.seed(12212018)
    dt <- data.table(
      index = 1:n,
      category = sample(letters[1:25], n, replace = T),
      c1 = rnorm(n, 10000),
      c2 = rnorm(n, 1000),
      c3 = rnorm(n, 100),
      c4 = rnorm(n, 10)
    )
    # use set() instead of <<- for appending additional columns
    for (i in 5:100) set(dt, , paste0("c", i), rnorm(n, 1000))
    tables()

    ColChoice <- c("c1", "c4")
    FunChoice <- c("length", "mean", "sum")
    my.summary <- function(x) list(length = length(x), mean = mean(x), sum = sum(x))
    
    bench::mark(
      unlist = {
        dt[, unlist(lapply(.SD, my.summary), recursive = FALSE),
           .SDcols = ColChoice, by = category]
      },
      loop_category = {
        lapply(dt[, unique(category)],
               function(x) dt[category == x, 
                              c(.(category = x), unlist(lapply(.SD, my.summary))), 
                              .SDcols = ColChoice]) %>% 
          rbindlist()
        },
      dcast = {
        dcast(dt, category ~ 1, fun = list(length, mean, sum), value.var = ColChoice)
        },
      loop_col = {
        lapply(ColChoice, function(col)
          dt[, setNames(lapply(FunChoice, function(f) get(f)(get(col))), 
                        paste0(col, "_", FunChoice)), 
             by=category]
        ) %>% 
          Reduce(function(x, y) merge(x, y, by="category"), .)
      },
      dplyr = {
        dt %>% 
          dplyr::group_by(category) %>% 
          dplyr::summarise_at(dplyr::vars(ColChoice), .funs = setNames(FunChoice, FunChoice))
      },
      check = function(x, y) 
        all.equal(setDT(x)[order(category)], 
                  setDT(y)[order(category)] %>%  
                    setnames(stringr::str_replace(names(.), "_", ".")),
                  ignore.col.order = TRUE,
                  check.attributes = FALSE
                  )
    )  
  }
)

绘制时更容易比较结果:

library(ggplot2)
autoplot(bm)

请注意对数时间刻度。
对于这个测试用例，unlist 方法总是最快的方法，其次是 dcast。 dplyr 正在追赶更大的问题大小 n 。 lapply/loop 两种方法的性能都较低。特别是， Parfait's approach 循环遍历列并随后合并子结果似乎对问题大小 n 相当敏感。
编辑:第二个基准
正如 jangorecki 所建议的，我用更多的行和不同数量的组重复了基准测试。
由于内存限制，最大的问题大小是 10 M 行乘以 102 列，占用 7.7 GB 内存。
因此，基准代码的第一部分修改为

bm <- bench::press(
  n_grp = 10^(1:3),
  n_row = 10L^seq(3, 7, by = 2),
  {
    set.seed(12212018)
    dt <- data.table(
      index = 1:n_row,
      category = sample(n_grp, n_row, replace = TRUE),
      c1 = rnorm(n_row),
      c2 = rnorm(n_row),
      c3 = rnorm(n_row),
      c4 = rnorm(n_row, 10)
    )
    for (i in 5:100) set(dt, , paste0("c", i), rnorm(n_row, 1000))
    tables()
    ...

正如 jangorecki 预期的那样，一些解决方案对组的数量比其他解决方案更敏感。特别是，loop_category 的性能随着组数的增加而下降得更厉害，而 dcast 似乎受到的影响较小。对于较少的组，unlist 方法总是比 dcast 快，而对于许多组， dcast 更快。但是，对于较大的问题， unlist 似乎领先于 dcast。
编辑 2019-03-12:计算语言，第三个基准
受 this follow-up question 的启发，我在语言方法上添加了一个计算，其中将整个表达式创建为字符串、解析和评估。
该表达式是由

library(magrittr)
ColChoice <- c("c1", "c4")
FunChoice <- c("length", "mean", "sum")
my.expression <- CJ(ColChoice, FunChoice, sorted = FALSE)[
  , sprintf("%s.%s = %s(%s)", V1, V2, V2, V1)] %>% 
  paste(collapse = ", ") %>% 
  sprintf("dt[, .(%s), by = category]", .) %>% 
  parse(text = .)
my.expression

expression(dt[, .(c1.length = length(c1), c1.mean = mean(c1), c1.sum = sum(c1), 
                  c4.length = length(c4), c4.mean = mean(c4), c4.sum = sum(c4)), by = category])

然后通过以下方式评估

eval(my.expression)

这产生

    category c1.length   c1.mean   c1.sum c4.length   c4.mean   c4.sum
 1:        f      3974  9999.987 39739947      3974  9.994220 39717.03
 2:        w      4033 10000.008 40330032      4033 10.004261 40347.19
 3:        n      4025  9999.981 40249924      4025 10.003686 40264.84
 4:        x      3975 10000.035 39750141      3975 10.010448 39791.53
 5:        k      3957 10000.019 39570074      3957  9.991886 39537.89
 6:        j      4027 10000.026 40270106      4027 10.015663 40333.07
 ...

我修改了第二个基准测试的代码以包含这种方法，但不得不将额外的列从 100 减少到 25，以应对更小的 PC 的内存限制。图表显示“eval”方法几乎总是最快或第二: