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) ]

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

感谢您的帮助！

编辑：对于这个问题的表述，公认的答案是最完整的（到目前为止），但我意识到我的问题有点棘手。我会问另一个问题来展示它：

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

data.table高效回收

data.table efficient recycling

r

data.table

recycle

基准