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

正如评论中提到的，我怀疑问题的前提可能是“有问题的”。无论如何，这是一种更快的替代方法：

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倍。这可能会在整个任务上发生变化，但我对此表示怀疑。

数据表高效回收

3 个答案:

基准