如果我理解正确的话，这个问题由两部分组成：
- 如何使用多个函数对列列表进行分组和聚合，并自动生成新的列名。
- 如何将函数名称作为字符向量传递。
对于第 1 部分，这几乎与 Apply multiple functions to multiple columns in data.table 重复，但附加要求应使用 by = 对结果进行分组。
因此，eddi's answer 必须通过在对unlist() 的调用中添加参数recursive = FALSE 来修改：
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：计算语言，第 3 次基准测试
受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”方法几乎总是最快或第二：