按组将不同的功能应用于不同的列集

Posted 2023-03-24

【中文标题】按组将不同的功能应用于不同的列集

【英文标题】：Apply different functions to different sets of columns by group

【发布时间】：2014-04-11 22:57:55

【问题描述】：

我有一个data.table，具有以下功能：

bycols：将数据分组的列 nonvaryingcols：每组中的列是不变的（这样从每组中取出第一项并进行就足够了） datacols：要聚合/汇总的列（例如在组内求和）

我很好奇什么最有效的方法来做你可能称之为混合崩溃的事情，将上述所有三个输入作为字符向量。它不一定是绝对最快的，但足够快且语法合理是理想的。

示例数据，其中不同的列集存储在字符向量中。

require(data.table)
set.seed(1)
bycols <- c("g1","g2")
datacols <- c("dat1","dat2")
nonvaryingcols <- c("nv1","nv2")
test <- data.table(
  g1 = rep( letters, 10 ),
  g2 = rep( c(LETTERS,LETTERS), each = 5 ),
  dat1 = runif( 260 ),
  dat2 = runif( 260 ),
  nv1 = rep( seq(130), 2),
  nv2 = rep( seq(130), 2) 
)

最终数据应如下所示：

   g1 g2      dat1      dat2 nv1 nv2
1:  a  A 0.8403809 0.6713090   1   1
2:  b  A 0.4491883 0.4607716   2   2
3:  c  A 0.6083939 1.2031960   3   3
4:  d  A 1.5510033 1.2945761   4   4
5:  e  A 1.1302971 0.8573135   5   5
6:  f  B 1.4964821 0.5133297   6   6

我已经制定了两种不同的方法，但一种非常不灵活和笨拙，另一种非常缓慢。如果到那时还没有人想出更好的东西，明天会发布。

【参考方案1】：

与[.data.table 的这种编程用法一样，一般策略是构造一个表达式e，它可以在j 参数中进行计算。一旦你理解了这一点（我相信你也明白了），它就变成了 computing on the language 的游戏，得到一个看起来像你在命令行中写的 j-slot 表达式。

例如，在这里，给定示例中的特定值，您希望调用如下所示：

test[, list(dat1=sum(dat1), dat2=sum(dat2), nv1=nv1[1], nv2=nv2[1]),
       by=c("g1", "g2")]

所以你想在j-slot 中求值的表达式是

list(dat1=sum(dat1), dat2=sum(dat2), nv1=nv1[1], nv2=nv2[1])

以下大部分函数都用于构建该表达式：

f <- function(dt, bycols, datacols, nvcols) 
    e <- c(sapply(datacols, function(x) call("sum", as.symbol(x))),
           sapply(nvcols, function(x) call("[", as.symbol(x), 1)))
    e<- as.call(c(as.symbol("list"), e))
    dt[,eval(e), by=bycols]


f(test, bycols=bycols, datacols=datacols, nvcols=nonvaryingcols)
##      g1 g2      dat1      dat2 nv1 nv2
##   1:  a  A 0.8403809 0.6713090   1   1
##   2:  b  A 0.4491883 0.4607716   2   2
##   3:  c  A 0.6083939 1.2031960   3   3
##   4:  d  A 1.5510033 1.2945761   4   4
##   5:  e  A 1.1302971 0.8573135   5   5
##  ---                                  
## 126:  v  Z 0.5627018 0.4282380 126 126
## 127:  w  Z 0.7588966 1.4429034 127 127
## 128:  x  Z 0.7060596 1.3736510 128 128
## 129:  y  Z 0.6015249 0.4488285 129 129
## 130:  z  Z 1.5304034 1.6012207 130 130

【讨论】：

谢谢@JoshOBrien。很有意义。在一分钟内发布我的带有基准的慢速解决方案。

@eddi 感谢您进行修复。

【参考方案2】：

这就是我想出的。它可以工作，但速度很慢。

test[, 
  cbind(
    as.data.frame( t( sapply( .SD[, ..datacols], sum ) ) ),
    .SD[, ..nonvaryingcols][1]
  )
, by = bycols ]

基准测试

FunJosh <- function() 
  f(test, bycols=bycols, datacols=datacols, nvcols=nonvaryingcols)

FunAri <- function() 
  test[, 
    cbind(
      as.data.frame( t( sapply( .SD[, ..datacols], sum ) ) ),
      .SD[, ..nonvaryingcols][1]
    )
  , by = bycols ]

FunEddi <- function() 
  cbind(
    test[, lapply(.SD, sum), by = bycols, .SDcols = datacols], 
    test[, lapply(.SD, "[", 1), by = bycols, .SDcols = nonvaryingcols][, ..nonvaryingcols]
  ) 


library(microbenchmark)
identical(FunJosh(), FunAri())
# [1] TRUE

microbenchmark(FunJosh(), FunAri(), FunEddi())
#Unit: milliseconds
#      expr        min         lq     median         uq        max neval
# FunJosh()   2.749164   2.958478   3.098998   3.470937   6.863933   100
#  FunAri() 246.082760 255.273839 284.485654 360.471469 509.740240   100
# FunEddi()   5.877494   6.229739   6.528205   7.375939 112.895573   100

至少比@joshobrien 的解决方案慢两个数量级。 编辑 @Eddi 的解决方案也快得多，并表明 cbind 不是最佳的，但在右手中可能相当快。可能是我正在做的所有转换和sapplying，而不仅仅是直接使用lapply。

【讨论】：

如果您要走cbind 路线，最好改用cbind(test[, lapply(.SD, sum), by = bycols, .SDcols = datacols], test[, lapply(.SD, "[", 1), by = bycols, .SDcols = nonvaryingcols][, nonvaryingcols, with = F])。

【参考方案3】：

只是为了多样化，这里是@Josh O'brien 解决方案的一个变体，它使用bquote 运算符而不是call。我确实尝试用 bquote 替换最终的 as.call，但由于 bquote 不支持列表拼接（例如，请参阅 this question），我无法让它工作。

f <- function(dt, bycols, datacols, nvcols) 
        datacols = sapply(datacols, as.symbol)
        nvcols = sapply(nvcols, as.symbol)
        e = c(lapply(datacols, function(x) bquote(sum(.(x)))),
              lapply(nvcols, function(x) bquote(.(x)[1])))
        e = as.call(c(as.symbol("list"), e))
        dt[,eval(e), by=bycols]



>   f(test, bycols=bycols, datacols=datacols, nvcols=nonvaryingcols)
     g1 g2   dat1   dat2 nv1 nv2
  1:  a  A 0.8404 0.6713   1   1
  2:  b  A 0.4492 0.4608   2   2
  3:  c  A 0.6084 1.2032   3   3
  4:  d  A 1.5510 1.2946   4   4
  5:  e  A 1.1303 0.8573   5   5
 ---                            
126:  v  Z 0.5627 0.4282 126 126
127:  w  Z 0.7589 1.4429 127 127
128:  x  Z 0.7061 1.3737 128 128
129:  y  Z 0.6015 0.4488 129 129
130:  z  Z 1.5304 1.6012 130 130
>