如何加快分组数据框中的跨列计算

Question

--- 从rstudio community forum 交叉发布tidyverse 之外的潜在解决方案。

基本情况是组之间的计算是独立的，但是每个组都需要输入一些从自己计算出来的参数。一个简单的例子是找到小于列最大值一半的第一个元素的索引。唯一的变化是一列X 需要使用通过其他列A, B, C 计算的最大值。

我有一个使用group_map（类似于do）的解决方案来解决我在grouped calculation 上的问题。但性能似乎不是最佳的。与group_map 一起使用时，summarise_at 似乎需要更长的时间（与没有它的时间相比）

library(tidyverse)

times <- 1e5
cols <- 4
df3 <- as.data.frame(x = matrix(rnorm(times * cols, mean = 5), ncol = cols)) %>% 
   rename(A = V1, B = V2, C = V3, X = V4)

df3 <- cbind(grp = rep(seq_len(1e3), each = 100), df3) %>% 
   group_by(grp)

system.time(
  df3 %>% 
    group_map(~
    { 
      all_max <- summarise_at(., vars(A:C), max) %>% mutate(X = rowMeans(.))
      map2_df(., all_max, ~match(TRUE, .x < 0.5 * .y))
    }
    )
)
#>    user  system elapsed 
#>    3.87    0.00    3.98

system.time(
  df3 %>% summarise_at(vars(A:C), max) %>% mutate(X = rowMeans(.))
)
#>    user  system elapsed 
#>    0.02    0.00    0.01

system.time(
  df3 %>% summarise_at(vars(A:X), ~match(TRUE, . < 0.5 * max(.)))
)  
#>    user  system elapsed 
#>    0.25    0.02    0.26

^{由reprex package (v0.2.1) 于 2019 年 4 月 5 日创建}

有提高性能的想法吗？似乎大多数函数都是基于列的，我还没有找到有效地完成这个简单任务的解决方案。

Answer 1

据我所知，这在我的机器上不到半秒就完成了与您的代码相同的工作：

library(data.table)
DT = as.data.table(matrix(rnorm(times * cols, mean = 5), times, cols))
setnames(DT, c('A', 'B', 'C', 'X'))
DT[ , grp := rep(seq_len(1e3), each = 100)]

setkey(DT, grp)

DT[DT[ , lapply(.SD, max), keyby = grp, .SDcols = !'X'
       ][ , X := Reduce(`+`, .SD)/ncol(.SD), .SDcols = !'grp'], {
  i.A; i.B; i.C; i.X
  lapply(names(.SD), function(j) 
    which.max(eval(as.name(j)) < .5 * eval(as.name(paste0('i.', j)))))
}, on = 'grp', by = .EACHI, .SDcols = !'grp']
#        grp V1 V2 V3 V4
#    1:    1  3 30  1  4
#    2:    2  6 15  4 10
#    3:    3  2  5  7  2
#    4:    4  8 16  5  8
#    5:    5 10  3  1  7
#   ---                 
#  996:  996 11  5  3 13
#  997:  997  3  3  3 11
#  998:  998 14 21  2 10
#  999:  999 18  2  1 41
# 1000: 1000  8  7  3  3

本质上，您正在创建相关上限的查找表并重新加入。

你可以这样分开：

lookup = 
  DT[ , lapply(.SD, max), keyby = grp, .SDcols = !'X'
     ][ , X := Reduce(`+`, .SD)/ncol(.SD), .SDcols = !'grp']
DT[lookup, on = 'grp', {
  i.A; i.B; i.C; i.X
  lapply(names(.SD), function(j) 
    which.max(eval(as.name(j)) < .5 * eval(as.name(paste0('i.', j)))))
}, by = .EACHI, .SDcols = !'grp']

一旦分离，您还可以获得获取get 的灵活性（根据我的经验，它比eval(as.name()) 慢）：

DT[lookup, on = 'grp', {
  lapply(names(.SD), function(j) 
    which.max(eval(as.name(j)) < .5 * get(paste0('i.', j))))
}, by = .EACHI, .SDcols = !'grp']
#        grp V1 V2 V3 V4
#    1:    1  1  5 26  3
#    2:    2  6  7  3  4
#    3:    3  2  6  1 13
#    4:    4  5  2 12  5
#    5:    5  9 12  2  4
#   ---                 
#  996:  996  1  3  4  1
#  997:  997  1  6  3 13
#  998:  998 10 13  9  8
#  999:  999  2  4 13  4
# 1000: 1000  7 30 19 14