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

Posted 2023-02-16

【中文标题】有效地解包不同长度的数据帧列表

【英文标题】：Efficiently unpack a list of varying length dataframes

【发布时间】：2019-06-11 05:23:36

【问题描述】：

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

我正在使用 microbenchmark 使用示例数据来计时我当前的尝试。

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 接近获胜者。

【参考方案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

【参考方案2】：

这是一种替代方法，它使用rbindlist() 组合数据帧，交叉连接CJ() 来完成缺失时间序列的 id，并使用dcast() 从长格式重塑为宽格式：

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

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