有效地解压缩不同长度的数据帧列表

Question

我有一个列表，其中包含涵盖不同年份的大量时间序列数据帧。我正在使用 lapply 成功解压缩列表，但我想要更快的东西。一个复杂的问题是一些数据帧是空的，但我想保留它们的记录，以便在解包后我可以 cbind 正确的数据标签。

我正在使用微基准测试对示例数据进行当前尝试。

library("plyr")
library("microbenchmark")

# Create some example dataframes of varying length.
ts1 <- data.frame(year=2004:2019, value=14:29)
ts2 <- data.frame(year=2006:2018, value=18:6)
ts3 <- NULL
ts4 <- data.frame(year=2005:2017, value=25:37)
ts5 <- NULL

# Combine the example dataframes into a list.
ts_data <- list(ts1, ts2, ts3, ts4, ts5)

# Function to unpack time series data if not empty and return a dataframe.
fn_unpack_ts <- function(ts) {
  if (!plyr::empty(ts)) {  
    df <- t(ts$value)
    colnames(df) <- ts$year
  } else {
    df <- NA
  }
  return(as.data.frame(df))
}

# Use lapply to run through each dataframe.
microbenchmark::microbenchmark(
l_ts <- Reduce(plyr::rbind.fill, lapply(ts_data, fn_unpack_ts)), times=100
)

# Tidy up the final dataframe.
l_ts$df <- NULL

所需的输出数据框如下所示：

> l_ts
   2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019
 1   14   15   16   17   18   19   20   21   22   23   24   25   26   27   28   29
 2   NA   NA   18   17   16   15   14   13   12   11   10    9    8    7    6   NA
 3   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA
 4   NA   25   26   27   28   29   30   31   32   33   34   35   36   37   NA   NA
 5   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA

我个人以毫秒为单位重复 100 次的时间是：

           min       lq     mean   median       uq     max neval
l_ts  2.844698 3.024238 3.283312 3.093525 3.357831 9.21223   100

我想知道是否有更有效的方法来解压缩我的示例数据。我怀疑每次都不需要返回数据帧，但这是我在使用 rbind.fill 处理不同年数时让它工作的唯一方法。

更新

#A 提出的非常好的解决方案。苏里曼和#Uwe。我对包含 1,098 行和 10 次重复的真实数据进行的测试显示：

expr                                                               mean (ms)     
Reduce(rbind.fill, lapply(ts_data, fn_unpack_ts))                  1326.2   
purrr::map_dfr(ts_data, fn_unpack_ts)                               133.7 
dcast(rbindlist(ts_data, idcol="id")[CJ(id=seq_along(ts_data),
  year, unique=TRUE), on=.(id, year)], id~year)                      15.0

...所以我宣布 rbindlist 方法获胜。

Answer 1

这是一个使用 purrr::map_dfr

的选项

microbenchmark::microbenchmark(
  l_ts <- purrr::map_dfr(ts_data, fn_unpack_ts), unit = "ms",times=100
)

Unit: milliseconds
                                  expr      min        lq      mean    median       uq      max neval
l_ts <- map_dfr(ts_data, fn_unpack_ts) 0.367476 0.3829495 0.4368147 0.3925645 0.417654 1.181447   100

Answer 2

这是另一种方法，它使用 rbindlist() 组合数据帧，使用交叉连接 CJ() 来完成缺失时间序列的 ID，并使用 dcast() 将 long 重塑为宽幅面：

library(data.table)
dcast(rbindlist(ts_data, idcol = "id")[CJ(id = seq_along(ts_data), year, unique = TRUE), on = .(id, year)], id ~ year)

   id 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019
1:  1   14   15   16   17   18   19   20   21   22   23   24   25   26   27   28   29
2:  2   NA   NA   18   17   16   15   14   13   12   11   10    9    8    7    6   NA
3:  3   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA
4:  4   NA   25   26   27   28   29   30   31   32   33   34   35   36   37   NA   NA
5:  5   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA   NA

我没有包括给定的非常小的样本数据集的基准计时，因为这只会衡量函数调用的开销。一个有意义的基准需要研究 all 解决方案在 one 计算机上不同（小和大）问题大小的时间。

有效地解压缩不同长度的数据帧列表

Efficiently unpack a list of varying length dataframes

r

list

unpack