Question

---来自rstudio community forum的交叉发布，以寻找tidyverse之外的潜在解决方案。

基本情况是，各组之间的计算是独立的，但是每个组都需要提供一些根据自身计算得出的参数。一个简单的例子是找到小于列最大值的一半的第一个元素的索引。唯一的问题是，一列X需要使用通过其他A, B, C计算出的最大值。

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

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-04-05创建}

有什么想法可以改善效果？似乎大多数功能都是基于列的，我还没有找到有效地完成此简单任务的解决方案。

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

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

1 个答案: