按日期范围在 R 中滚动 window 函数（uniqueN）

Question

我有一个数据集，我想在其中执行一个日期范围内的滚动函数。

我目前通过一个循环来完成这项工作，我在其中对每个范围的主要数据进行子集化，然后进行计算并将其拼凑在一起。它运行良好，但实际数据集超过 200 万行，需要 15 分钟以上才能完成。

library(data.table)
start_date <- as.Date(fast_strptime("2021-03-04", "%Y-%m-%d"))
end_date <- start_date + 2
output <- data.table(NULL)
d = structure(list(date = structure(c(18690, 18690, 18692, 18692, 18692, 18693, 18693, 18694, 18695, 18695, 18695), class = "Date"),
                   id = c(1, 2, 1, 1, 2, 3, 1, 4, 4, 2, 1),
                   w = c(3, 1, 1, 1, 4, 2, 1, 2, 3, 4, 1)),
              row.names = c(NA, -16L), class = c("data.table", "data.frame"))

while (end_date < Sys.Date()) {
  
  
  x <- d[date >= start_date & date <= end_date, .(tw = sum(w)), 
         by = .(id)]
  
  
  
  setorder(x, -tw, id)
  x[, wprop := {x = sum(tw); y = cumsum(tw) / x}]
  x[, idprop := {x = uniqueN(id); y = 1:.N / x}]
  
  start_date <- end_date + 1
  end_date <- start_date + 2
  
  x[, start_date := start_date]
  x[, end_date := end_date]

  output <- rbindlist(list(output, x))
  
    
}

我更喜欢 data.table 解决方案，因为我将在不同的时间执行此操作 windows 所以我需要它尽可能快。

Answer 1

首先，迭代构建（增长）一个框架（或data.table）可能是个问题，所以我的第一个想法是将其包装在lapply 而不是 while 循环。这将生成一个 data.table 的列表，之后我们将执行单个 rbindlist。仅此一项就可以显着提高 2M 数据集的速度。

start_dates <- seq(as.Date(fast_strptime("2021-03-04", "%Y-%m-%d")), 
                   max(d$date) + 1, by = "3 days")
list_of_tables <- lapply(start_dates, function(start_date) {
  x <- d[date >= start_date & date <= start_date + 2L, .(tw = sum(w)), by = .(id)]
  setorder(x, -tw, id)
  x[, wprop := {x = sum(tw); y = cumsum(tw) / x}]
  x[, idprop := {x = uniqueN(id); y = 1:.N / x}]
  x[, start_date := start_date + 3L]
  x[, end_date := start_date + 5L]
  x
})
rbindlist(list_of_tables)
#       id    tw     wprop idprop start_date   end_date
#    <num> <num>     <num>  <num>     <Date>     <Date>
# 1:     1     5 0.5000000   0.50 2021-03-07 2021-03-12
# 2:     2     5 1.0000000   1.00 2021-03-07 2021-03-12
# 3:     4     5 0.3846154   0.25 2021-03-10 2021-03-15
# 4:     2     4 0.6923077   0.50 2021-03-10 2021-03-15
# 5:     1     2 0.8461538   0.75 2021-03-10 2021-03-15
# 6:     3     2 1.0000000   1.00 2021-03-10 2021-03-15

另一种方法是使用 data.table 的范围连接，更直接一些。

ranges <- data.table(start_date = seq(as.Date(fast_strptime("2021-03-04", "%Y-%m-%d")),
                                      max(d$date)+1, by="3 days"))
ranges[, end_date := start_date + 2L]
ranges
#    start_date   end_date
#        <Date>     <Date>
# 1: 2021-03-04 2021-03-06
# 2: 2021-03-07 2021-03-09
# 3: 2021-03-10 2021-03-12

从这里开始，

tmp <- d[ranges, on = .(date >= start_date, date <= end_date)
  ][, .(tw = sum(w)), by = .(date, id)
  ][!is.na(id),]
setorder(tmp, -tw, id)
tmp[, c("wprop", "idprop") := .(cumsum(tw)/sum(tw), seq_len(.N)/uniqueN(id)), by = .(date)
  ][, c("start_date", "end_date") := .(date + 3L, date + 5L)
  ][, date := NULL]
#       id    tw     wprop idprop start_date   end_date
#    <num> <num>     <num>  <num>     <Date>     <Date>
# 1:     1     5 0.5000000   0.50 2021-03-07 2021-03-09
# 2:     2     5 1.0000000   1.00 2021-03-07 2021-03-09
# 3:     4     5 0.3846154   0.25 2021-03-10 2021-03-12
# 4:     2     4 0.6923077   0.50 2021-03-10 2021-03-12
# 5:     1     2 0.8461538   0.75 2021-03-10 2021-03-12
# 6:     3     2 1.0000000   1.00 2021-03-10 2021-03-12

备注：

因为联接的 LHS 是 ranges，可能存在零数据的范围，导致其他字段中的 NA。这是连接和此示例数据的自然副作用；我不知道这是否会成为问题，但 [!is.na(id),] 就是为了做到这一点。我认为内部联接会感觉更自然，但是 data.table::[-join 语义仅支持左联接。
我将（wprop 和 idprop 的赋值组合成一个 [ 行，没有真正的原因，它可以是单独的计算。
范围连接破坏了连接的LHS（即内部框架，ranges）上table的连接键的列名，所以我们想引用为 start_date/end_date 然后被称为 date/date.1 立即 post-join。幸运的是，这次我们没有丢失任何数据，也不需要 date.1，所以这是一次优雅的恢复。（我可以将 date 重命名为 start_date 而不是新的赋值，它可能对 2M 行更有效，所以请随时查看它是否对您有帮助。）

仅供参考：使用 this 数据，基准测试表明，与帧列表方法相比，范围连接方法运行s 的时间不到一半多于。我怀疑当数据量显着增加时，该比率是否会保持不变。 请在对您的 2M 行数据尝试这两种方法并报告运行次后回来。谢谢！

按日期范围在 R 中滚动 window 函数（uniqueN）

Rolling window function (uniqueN) in R by date range

r

data.table

rolling-computation