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()从长格式更改为宽格式：

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 解决方案的时间安排。

有效地解压缩可变长度数据帧的列表

2 个答案: