逐行加速data.frame的子集，避免循环（dplyr，R）答案

【问题标题】：Speeding subsetting of data.frame by row based conditions avoiding loops (dplyr, R)逐行加速data.frame的子集，避免循环（dplyr，R）
【发布时间】：2018-11-25 17:16:28
【问题描述】：

我是 dplyr 的新手，我正在努力解决我认为是一个简单的功能。我有一个类似于的数据集：

require(dplyr)
dat <- data.frame(t = rep(seq(1, 5, 1),4), id = rep(c(rep("A",5), rep("B",5), rep("C",5), rep("D",5)), 1),
                  x = 1:20, y = 51:70, h = c(rep(1,10), rep(0,10) ) )
dat <- arrange(dat, t)
dat <- data.frame(dat, group = c("B", "A", "A", "A", "A", "B", "C", "D", "A", "B", "D", "C", "A", "D", "C", "A", "A", "C", "C", "B") )
dat

我想将一个新列附加到数据集dat，其中包含以下操作：

对于每一行，例如带有 id == C 的第 3 行，取其余行，使其在 group 中的值不同于起始 id，在这种情况下为 C
按时间分组观察t
如果id（在这种情况下，第3行中的id C）在列h中具有值1，则执行以下操作：将所有值相加（来自基于t的组）在x 中除以y 和x 中的值的标准差（来自基于t 的组）。如果id 在列h 中的值为0，则放置一个0。如果没有观察到，代码应该放置一个零。

例如，对于idA 行中的1，代码应生成0，因为在时间t == 1 的所有观察都具有group == A。对于id B 行中的2，代码应生成(11 + 16) / sd(c(11, 16, 61, 66))。

如何在dplyr 或不包括looping 的任何其他方式上执行此操作？谢谢。

数据看起来像

dat
#    t id  x  y h group
# 1  1  A  1 51 1     B
# 2  1  B  6 56 1     A
# 3  1  C 11 61 0     A
# 4  1  D 16 66 0     A
# 5  2  A  2 52 1     A
# 6  2  B  7 57 1     B
# 7  2  C 12 62 0     C
# 8  2  D 17 67 0     D
# 9  3  A  3 53 1     A
# 10 3  B  8 58 1     B
# 11 3  C 13 63 0     D
# 12 3  D 18 68 0     C
# 13 4  A  4 54 1     A
# 14 4  B  9 59 1     D
# 15 4  C 14 64 0     C
# 16 4  D 19 69 0     A
# 17 5  A  5 55 1     A
# 18 5  B 10 60 1     C
# 19 5  C 15 65 0     C
# 20 5  D 20 70 0     B

我尝试了以下方法，但没有产生正确的结果。

dat %>% 
  group_by(t) %>% 
  mutate(new = ifelse(id != group, h * (sum(x) /map_dbl(row_number(), ~ 
      sd(c(x[-.x], y[-.x]) ))) , 0) )

【问题讨论】：

如果您追求速度，我建议您使用data.table 包。
我需要在一个非常大的数据集上多次执行这种类型的操作。另外，我想引导整个估计过程，所以速度很重要。不幸的是，我对dplyr 知之甚少（这似乎比apply 或for-loop 快得多），但我对data.table 知之甚少。你会如何在data.table 上设置这个？

标签： r for-loop dplyr tidyverse

【解决方案1】：

这应该只是说明data.tables 与dplyr 的速度性能。我只是把变异的整个 ifelse 打包到一个 data.table 操作中并与 (by = t) 分组。所以结果不会是想要的结果，但是对于 dplyr 和 data.tables 的结果至少是一样的。

library(data.table)
library(dplyr)

datDT <- data.table(dat)

DTF <- function(){
  d <- datDT[ , new := ifelse(  id != group, h * (sum(x) /
                      map_dbl(row_number(x), ~ 
                                sd(c(x[-.x], y[-.x])))) , 0) , by = t]
  d
}
DPF <- function(){
  d <- dat %>% 
    group_by(t) %>% 
    mutate(new = ifelse(id != group, h * (sum(x) /map_dbl(row_number(x), ~ 
                                                            sd(c(x[-.x], y[-.x]) ))) , 0) )
  d
}

dtres = DTF()
dplres = DPF()

all.equal(dtres, data.table(dplres))


library(microbenchmark)
mc <- microbenchmark(times = 100,
                     DT =  DTF(),
                     DPLYR = DPF()
)

mc

Unit: milliseconds
  expr       min        lq      mean    median        uq      max neval cld
    DT  7.428605  7.821919  8.324179  8.056762  8.429851 15.39028   100  a 
 DPLYR 11.154076 11.439025 11.895716 11.720050 12.139022 16.40934   100   b

收益不是很大，但仍然很明显，我确信仍然可以通过设置键、摆脱 ifelse 等来完成一些优化，但我将其留给真正的 data.table 专家 :) .

因此，如果您对两者都不熟悉，不妨深入研究 data.tables，因为您也可以将 dplyr-verbs 与它们一起使用（如下所示），并且比使用 tbl 结构稍微快一点.

dtres %>% 
  group_by(t) %>% 
  summarise(mN = mean(new))

【讨论】：