data.table 高效回收

Question

我经常在 data.table 中使用回收，例如当我需要预测未来几年时。 我在以后的每一年重复我的原始数据。

这可能会导致类似的事情：

library(data.table)
dt <- data.table(cbind(1:500000, 500000:1))
dt2 <- dt[, c(.SD, .(year = 1:10)), by = 1:nrow(dt) ]

但我经常需要处理数百万行，列数远远超过这个玩具示例。 时间增加.. 试试这个：

library(data.table)
dt <- data.table(cbind(1:50000000, 50000000:1))
dt2 <- dt[, c(.SD, .(year = 1:10)), by = 1:nrow(dt) ]

我的问题是：有没有更有效的方法来达到这个目的？

感谢您的帮助！

编辑： 对于这个问题的表述，接受的答案是最完整的（直到现在），但我意识到我的问题有点棘手。 我会问另一个问题以显示它：data.table efficient recycling V2

Answer 1

我认为这个问题是交叉连接。没有内置方法可以在两个数据表之间进行交叉连接（CJ 函数适用于向量），但从讨论 on this issue 来看，此函数运行良好：

CJDT <- function(...) {
    Reduce(function(DT1, DT2) cbind(DT1, DT2[rep(1:.N, each=nrow(DT1))]), list(...))
}

使用你的大例子，这对我有用：

years = data.table(year = 1:10, key = "year")
setkey(dt)
dt3 = CJDT(dt, years)

您的方法在内存不足之前需要更长的时间。

Answer 2

正如 cmets 中提到的，我怀疑问题的前提可能是有问题的。无论如何，这里有一个稍微快一点的替代方案：

setkey(dt)
dt[CJ(V1, year = 1:10)]

基准测试：

dt <- data.table(cbind(1:50000000, 50000000:1))
microbenchmark::microbenchmark(
  op = dt[, c(.SD, .(year = 1:10)), by = 1:nrow(dt) ],
  sb = {setkey(dt); dt[CJ(V1, year = 1:10)]},
  gr = {setkey(dt); CJDT(dt, data.table(year = 1:10, key = "year"))},
  times = 1
)

单位：秒

 expr       min        lq      mean    median        uq       max neval
   op 171.67241 171.67241 171.67241 171.67241 171.67241 171.67241     1
   sb 136.00782 136.00782 136.00782 136.00782 136.00782 136.00782     1
   gr  45.14151  45.14151  45.14151  45.14151  45.14151  45.14151     1

Answer 3

我将迄今为止给出的解决方案与我自己的解决方案（仅使用lapply 和rbindlist）进行基准测试。由于内存不足，我无法运行整个任务。这就是我选择较小 dt 的原因：

library(data.table)

dt <- data.table(cbind(1:5000000, 5000000:1))

original <- function() {
  dt2 <- dt[, c(.SD, .(year = 1:10)), by = 1:nrow(dt) ]
  dt2
}

sb <- function() {
  dt2 <- dt[CJ(V1, year = 1:10), on = "V1"]
}

gregor <- function() {
  CJDT <- function(...) {
    Reduce(function(DT1, DT2) cbind(DT1, DT2[rep(1:.N, each=nrow(DT1))]), list(...))
  }
  years = data.table(year = 1:10, key = "year")
  setkey(dt)
  dt3 = CJDT(dt, years)
  dt3
}

bindlist <- function() {
  dt3 <- rbindlist(lapply(1:10, function(x) {
    dt$year <- x
    dt
  }))
  # dt3 <- setcolorder(dt3, c("nrow", "V1", "V2", "year")) # to get exactly same dt
  # dt3 <- dt3[order(nrow)]
  dt3
}

基准测试

library(bench)
res <- mark(
  original = original(),
  sb = sb(),
  gregor = gregor(),
  bindlist = bindlist(),
  iterations = 1,
  check = FALSE
)
#> Warning: Some expressions had a GC in every iteration; so filtering is
#> disabled.
res
#> # A tibble: 4 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 original      5.88s    5.88s     0.170    1.72GB   16.0  
#> 2 sb            1.76s    1.76s     0.570    1.73GB    0.570
#> 3 gregor        1.87s    1.87s     0.536  972.86MB    0    
#> 4 bindlist   558.69ms 558.69ms     1.79     1.12GB    0

summary(res, relative = TRUE)
#> Warning: Some expressions had a GC in every iteration; so filtering is
#> disabled.
#> # A tibble: 4 x 6
#>   expression   min median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <dbl>  <dbl>     <dbl>     <dbl>    <dbl>
#> 1 original   10.5   10.5       1         1.81      Inf
#> 2 sb          3.14   3.14      3.35      1.82      Inf
#> 3 gregor      3.34   3.34      3.15      1         NaN
#> 4 bindlist    1      1        10.5       1.18      NaN

^{由reprex package (v0.3.0) 于 2019-12-03 创建}

现在结果并不完全相同（请参阅我的解决方案中的注释代码以进行更正），但与您尝试执行的操作相同。我的 lapply 加上 rbindlist 解决方案令人惊讶地快了 3 倍以上。这可能会在整个任务中发生变化，但我对此表示怀疑。