R滾動匯總，帶有多個窗口，按組

Question

給出下表：

library(data.table)
df <- data.table(value = c(3,1,5,6,2,5,12,6), grp = c(1,1,1,2,2,3,3,3))

   value grp
1:     3   1
2:     1   1
3:     5   1
4:     6   2
5:     2   2
6:     5   3
7:    12   3
8:     6   3

我想添加3個新列，以便每個都是列“值”的滾動總和，並按列“ grp”分組。 這是配置表，其中包含以下每個新列的窗口長度和名稱：

rolling_conf <- data.table(name=c("2d", "4d", "7d"), window = c(1,2,2))

   name window
1:   2d      1
2:   4d      2
3:   7d      2

我能夠使用for循環實現此任務：

library(RcppRoll)
for(i in 1:nrow(rolling_conf)){
  df[ , rolling_conf$name[i] := roll_sumr(value, rolling_conf$window[i], na.rm=T), grp]
}

這是我得到的輸出（這是理想的輸出）：

   value grp 2d 4d 7d
1:     3   1  3 NA NA
2:     1   1  1  4  4
3:     5   1  5  6  6
4:     6   2  6 NA NA
5:     2   2  2  8  8
6:     5   3  5 NA NA
7:    12   3 12 17 17
8:     6   3  6 18 18

我正在尋找一種更快的實現方式（使其並行而不是順序運行）。 我不想使用foreach。 我想應聘者是必經之路，但我沒有寫出這樣的代碼。

感謝您的幫助！

Answer 1

這是我使用lapply的解決方案：

library(data.table)
library(RcppRoll)
df <- data.table(value = c(3,1,5,6,2,5,12,6), grp = c(1,1,1,2,2,3,3,3))
rolling_conf <- list("2d" = 1, "4d"= 2, "7d" = 2)
dff <- split(df$value, df$grp)

dfl <- lapply(dff, function(y) sapply(rolling_conf, function(x) roll_sumr(y, x, na.rm=T)))


dfl <- do.call(rbind, dfl)
dfl
#      2d 4d 7d
# [1,]  3 NA NA
# [2,]  1  4  4
# [3,]  5  6  6
# [4,]  6 NA NA
# [5,]  2  8  8
# [6,]  5 NA NA
# [7,] 12 17 17
# [8,]  6 18 18


cbind(df,dfl)
#    value grp 2d 4d 7d
# 1:     3   1  3 NA NA
# 2:     1   1  1  4  4
# 3:     5   1  5  6  6
# 4:     6   2  6 NA NA
# 5:     2   2  2  8  8
# 6:     5   3  5 NA NA
# 7:    12   3 12 17 17
# 8:     6   3  6 18 18

Answer 2

使用sapply()避免手動循環的一個版本：

library(data.table)
library(RcppRoll)

# create datasets
dt <- data.table(value=c(3,1,5,6,2,5,12,6), grp=c(1,1,1,2,2,3,3,3))
rc <- data.table(name=c("2d", "4d", "7d"), window=c(1,2,2))

# implement rolling sum according various window lengths
result <- sapply(as.list(rc$window), function(x) dt[ , roll_sumr(value, x, na.rm=T), by=grp][[2]])

# add back to dataset with correct column names
colnames(result) <- rc$name
cbind(dt, result)