列列表上具有多种功能，并使用data.table
如何调整数据表操作，以便除每个列的sum外，
它还会同时计算其他函数，例如mean和计数（.N）并自动创建列名称：“ sum c1”，“ sum c2”，“ sum c4”，“ mean c1 ”，“均值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
......
可能是重复的，但我没有找到我需要的确切答案
5 个答案:
答案 0 :(得分：6)
这是一个数据表答案：
funs_list <- lapply(FunChoice, as.symbol)
dcast(dt, category~1, fun=eval(funs_list), value.var = Colchoice)
它超级快，可以做您想要的。
答案 1 :(得分：3)
如果我理解正确，那么这个问题包括两个部分：
- 如何在列列表中使用多种功能进行分组和聚合，并自动生成新的列名称。
- 如何将函数名称作为字符向量传递。
对于第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的建议，我用更多的行和不同数量的组重复了基准测试。 由于内存的限制，最大的问题大小是1000万行乘以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 ...
我修改了第二个基准测试的代码以包括这种方法，但是为了应付一台小得多的PC的内存限制，不得不将额外的列从100减少到25。图表显示，“评估”方法几乎总是最快或第二：
答案 2 :(得分：1)
考虑构建一个数据表列表，在其中循环访问每个 ColChoice 并应用 FuncChoice 的每个功能（相应地设置名称）。然后，要将所有数据表合并在一起，请在merge调用中运行Reduce。另外，使用get检索环境对象（函数/列）。
注意： ColChoice 已重命名为驼峰式大小写，并且length函数将.N替换为计数形式的函数形式：
set.seed(12212018) # RUN BEFORE data.table() BUILD TO REPRODUCE OUTPUT
...
ColChoice <- c("c1", "c4")
FunChoice <- c("length", "mean", "sum")
output <- lapply(ColChoice, function(col)
dt[, setNames(lapply(FunChoice, function(f) get(f)(get(col))),
paste0(col, "_", FunChoice)),
by=category]
)
final_dt <- Reduce(function(x, y) merge(x, y, by="category"), output)
head(final_dt)
# category c1_length c1_mean c1_sum c4_length c4_mean c4_sum
# 1: a 3893 10000.001 38930003 3893 9.990517 38893.08
# 2: b 4021 10000.028 40210113 4021 9.977178 40118.23
# 3: c 3931 10000.008 39310030 3931 9.996538 39296.39
# 4: d 3954 10000.010 39540038 3954 10.004578 39558.10
# 5: e 4016 9999.998 40159992 4016 10.002131 40168.56
# 6: f 3974 9999.987 39739947 3974 9.994220 39717.03
答案 3 :(得分：0)
似乎没有使用data.table的简单答案，因为还没有人回答。因此，我将提出一个基于dplyr的答案，该答案应该可以满足您的要求。我以内置的虹膜数据集为例：
library(dplyr)
iris %>%
group_by(Species) %>%
summarise_at(vars(Sepal.Length, Sepal.Width), .funs = c(sum=sum,mean= mean), na.rm=TRUE)
## A tibble: 3 x 5
# Species Sepal.Length_sum Sepal.Width_sum Sepal.Length_mean Sepal.Width_mean
# <fct> <dbl> <dbl> <dbl> <dbl>
#1 setosa 245. 171. 5.00 3.43
#2 versicolor 297. 138. 5.94 2.77
#3 virginica 323. 149. 6.60 2.97
或将字符向量输入用于列和函数：
Colchoice <- c("Sepal.Length", "Sepal.Width")
FunChoice <- c("mean", "sum")
iris %>%
group_by(Species) %>%
summarise_at(vars(Colchoice), .funs = setNames(FunChoice, FunChoice), na.rm=TRUE)
## A tibble: 3 x 5
# Species Sepal.Length_mean Sepal.Width_mean Sepal.Length_sum Sepal.Width_sum
# <fct> <dbl> <dbl> <dbl> <dbl>
#1 setosa 5.00 3.43 245. 171.
#2 versicolor 5.94 2.77 297. 138.
#3 virginica 6.60 2.97 323. 149.
答案 4 :(得分：0)
如果您需要计算的摘要统计信息是mean和{也许是.N的事物，median将data.table优化为整个by的C代码，如果将表转换为长格式，则可能会具有更快的性能，从而可以以数据表可以优化它们的方式进行计算：
> 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)
)
> {lapply(c(paste('c', 5:100, sep ='')), function(addcol) dt[[addcol]] <<- rnorm(n,1000) ); dt}
> Colchoice <- c("c1", "c4")
> dt[, .SD
][, c('index', 'category', Colchoice), with=F
][, melt(.SD, id.vars=c('index', 'category'))
][, mean := mean(value), .(category, variable)
][, median := median(value), .(category, variable)
][, N := .N, .(category, variable)
][, value := NULL
][, index := NULL
][, unique(.SD)
][, dcast(.SD, category ~ variable, value.var=c('mean', 'median', 'N')
]
category mean_c1 mean_c4 median_c1 median_c4 N_c1 N_c4
1: a 10000 10.021 10000 10.041 4128 4128
2: b 10000 10.012 10000 10.003 3942 3942
3: c 10000 10.005 10000 9.999 3926 3926
4: d 10000 10.002 10000 10.007 4046 4046
5: e 10000 9.974 10000 9.993 4037 4037
6: f 10000 10.025 10000 10.015 4009 4009
7: g 10000 9.994 10000 9.998 4012 4012
8: h 10000 10.007 10000 9.986 3950 3950
...
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？