使用 data.table 快速取消嵌套

问题描述

我目前正在使用 tidyr 包来取消嵌套列表列。但是，我正在寻找一种更快的方法并转向 data.table （我是一个菜鸟）。考虑以下示例：

dt1 <- data.table::data.table(
    a = c("a1","a2"),df1 = list(data.frame(
        b = c("b1","b2")
    ))
)

tidyr::unnest(dt1,df1)
#> # A tibble: 4 x 2
#>   a     b    
#>   <chr> <chr>
#> 1 a1    b1   
#> 2 a1    b2   
#> 3 a2    b1   
#> 4 a2    b2

dt1[,data.table::rbindlist(df1),by = .(a)]
#>     a  b
#> 1: a1 b1
#> 2: a1 b2
#> 3: a2 b1
#> 4: a2 b2
Created on 2021-06-22 by the reprex package (v1.0.0)

我得到了相同的结果，但是如果我有一个很大的 data.table 并且 by 中有更多的列，这种方法使用 data.table 比使用 {tidyr 的性能更差 {1}}。可以缓解吗？

一个后续问题是如何使用 data.table 取消嵌套多个列。考虑这个例子：

dt2 <- data.table::data.table(
    a = c("a1","b2")
    )),df2 = list(data.frame(
        c = c("c1","c2")
    ))
)

tidyr::unnest(dt2,c(df1,df2))
#> # A tibble: 4 x 3
#>   a     b     c    
#>   <chr> <chr> <chr>
#> 1 a1    b1    c1   
#> 2 a1    b2    c2   
#> 3 a2    b1    c1   
#> 4 a2    b2    c2
Created on 2021-06-22 by the reprex package (v1.0.0)

在 data.table::rbindlist 中使用多个参数似乎不起作用。

更新：在制作了一个大（r）示例来证明我对执行时间的声明后，结果证明 tidyr 对列表列是否包含 data.frame 非常敏感s 或 data.tables:

n_inner <- 300
inner_df <- data.frame(
    d1 = seq.POSIXt(as.POSIXct("2020-01-01"),as.POSIXct("2021-01-01"),length.out = n_inner),d2 = seq.POSIXt(as.POSIXct("2020-01-01"),d3 = rnorm(n_inner)
)

n_outer <- 400

dt <- data.table::data.table(
    a = sample(10,n_outer,replace = TRUE),b = seq.POSIXt(as.POSIXct("2020-01-01"),length.out = n_outer),c = seq.POSIXt(as.POSIXct("2019-01-01"),as.POSIXct("2020-01-01"),d = rep(list(inner_df),n_outer)
)

bench::mark(check = FALSE,tidyr = tidyr::unnest(dt,d),datatable = dt[,data.table::rbindlist(d),by = .(a,b,c)]
)
#> # A tibble: 2 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 tidyr          14ms   18.7ms      53.2      18MB     26.6
#> 2 datatable    56.2ms   56.2ms      17.8    25.5MB    178.

inner_dt <- data.table::as.data.table(inner_df)
dt$d <- rep(list(inner_dt),n_outer)

bench::mark(check = FALSE,c)]
)
#> Warning: Some expressions had a GC in every iteration; so filtering is disabled.
#> # A tibble: 2 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 tidyr       202.2ms  209.3ms      4.40    28.4MB     19.1
#> 2 datatable    43.5ms   49.9ms     18.3     25.4MB     22.0

^{由 reprex package (v1.0.0) 于 2021 年 6 月 22 日创建}

在我的实际用例中，我嵌套了 data.frame，因为它来自使用 RcppSimdJson 解析的 JSON，这里 tidyr 更快。

解决方法

只是制作一个基准，显示与 data.table 和 tidyr 的解决方案的差异，以另一种方式为 data.table 和 base 解决方案提供。

DT <- data.table::data.table(
    a = c("a1","a2"),df1 = list(data.frame(
        b = c("b1","b2")
    ))
)
n <- 1e5
set.seed(42)
dt1 <- DT[sample(seq_len(nrow(DT)),n,TRUE),]

bench::mark(check = FALSE,tidyr = tidyr::unnest(dt1,df1),dt = dt1[,data.table::rbindlist(df1),by = .(a)],dt2 = dt1[,unlist(df1,TRUE,FALSE),.(a)],base = data.frame(a=rep(dt1$a,lapply(dt1$df1,nrow)),do.call(rbind,dt1$df1)),base2 = data.frame(a=rep(dt1$a,b=unlist(dt1$df1,FALSE))
      )
#  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc
#  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>
#1 tidyr         1.03s    1.03s     0.971   22.59MB     7.76     1     8
#2 dt           46.9ms  50.15ms    17.1     15.01MB     9.47     9     5
#3 dt2         11.66ms  13.66ms    70.8     14.03MB    35.4     36    18
#4 base          3.47s    3.47s     0.288   43.23MB    12.1      1    42
#5 base2       353.9ms 363.41ms     2.75     4.58MB    11.0      2     8

所以 data.table 是两种方式，最快，然后是一个 base 解决方案，然后是 tidyr，然后是另一个 base 解决方案。

也许您可以结合使用 base 和 data.table，因为使用 data.table::rbindlist 似乎比使用 do.call 的 rbind 更快。也看看：How to speed up rbind?

对于更新中的给定数据，它看起来像：

data.frame(dt[rep(seq_len(nrow(dt)),vapply(dt$d,nrow,0L)),1:3],data.table::rbindlist(dt$d)

基于问题中给出的示例进行基准测试：

f <- alist(tidyr = tidyr::unnest(dt,d),datatable = dt[,data.table::rbindlist(d),by = .(a,b,c)],base=do.call(rbind,lapply(seq_len(nrow(dt)),function(i) do.call(data.frame,dt[i,]))),base2=data.frame(dt[rep(seq_len(nrow(dt)),dt$d)),dtBase=data.frame(dt[rep(seq_len(nrow(dt)),data.table::rbindlist(dt$d)))

set.seed(42)
n_inner <- 300
inner_df <- data.frame(
    d1 = seq.POSIXt(as.POSIXct("2020-01-01"),as.POSIXct("2021-01-01"),length.out = n_inner),d2 = seq.POSIXt(as.POSIXct("2020-01-01"),d3 = rnorm(n_inner)
)

n_outer <- 400

dt <- data.table::data.table(
    a = sample(10,n_outer,replace = TRUE),b = seq.POSIXt(as.POSIXct("2020-01-01"),length.out = n_outer),c = seq.POSIXt(as.POSIXct("2019-01-01"),as.POSIXct("2020-01-01"),d = rep(list(inner_df),n_outer)
)

inner_dt <- as.data.frame(inner_df) #Having data.frames in the dt
dt$d <- rep(list(inner_dt),n_outer)
do.call(bench::mark,c(f,check = FALSE))
#  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc
#  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>
#1 tidyr        17.5ms  17.93ms     53.4    22.09MB     19.8    27    10
#2 datatable   45.52ms  50.54ms     17.2    25.59MB     27.5    10    16
#3 base       809.87ms 809.87ms      1.23    2.22GB    115.      1    93
#4 base2      290.01ms 294.97ms      3.39    1.12GB    173.      2   102
#5 dtBase       4.71ms   5.06ms    159.      10.6MB     69.4    80    35

inner_dt <- data.table::as.data.table(inner_df) #Having data.tables in the dt
dt$d <- rep(list(inner_dt),check = FALSE))
#  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc
#  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>
#1 tidyr      285.56ms 285.94ms      3.50   28.32MB     15.7     2     9
#2 datatable   45.73ms  48.67ms     16.7     25.3MB     18.5     9    10
#3 base       784.33ms 784.33ms      1.27    2.23GB    105.      1    82
#4 base2        4.61ms   4.83ms    166.     10.62MB     50.0    83    25
#5 dtBase       4.75ms   5.02ms    158.      10.6MB     49.9    79    25

目前看来，如果必须与 base 或 data.table 一起使用，使用 data.frame 和 data.table 的组合是最快的。

data.table data.table r r unnest