6

我是 data.tables 的新手，如果这是一个非常基本的问题，我深表歉意。

我听说 data.tables 在处理大量数据时显着提高了计算时间，因此想看看 data.table 是否能够帮助加快 rollapply 功能。

如果我们有一些单变量数据

xts.obj <- xts(rnorm(1e6), order.by=as.POSIXct(Sys.time()-1e6:1), tz="GMT") 
colnames(xts.obj) <- "rtns"

宽度为 100 且 ap 为 0.75 的简单滚动分位数需要非常长的时间...

即代码行

xts.obj$quant.75 <- rollapply(xts.obj$rtns,width=100, FUN='quantile', p=0.75)

似乎需要永远...

data.table 有什么可以加快速度的吗？即是否有可以应用的通用滚动功能？

也许是将 xts 对象转换为 data.table 对象以加速执行功能然后在最后重新转换回 xts 的例程？

提前致谢

hlm

ps 我似乎没有在 data.table 邮件列表上得到太多回复，所以我在这里发帖，看看我是否能得到更好的回复。

pps 快速了解另一个使用数据帧的示例，data.table 解决方案似乎比 rollapply 函数花费的时间更长，即如下所示：

> x <- data.frame(x=rnorm(10000))
> x.dt <- data.table(x)
> system.time(l1 <- as.numeric(rollapply(x,width=10,FUN=quantile,p=0.75)))   
   user  system elapsed 
   2.69    0.00    2.68 
> system.time(l <- as.numeric(unlist(x.dt[,lapply(1:((nrow(x.dt))-10+1), function(i){ x.dt[i:(i+10-1),quantile(x,p=0.75)]})])))
   user  system elapsed 
  11.22    0.00   11.51 
> identical(l,l1)
[1] TRUE
4

2 回答 2

8

datatable 在这里无关紧要-您实际上是sapply在向量上运行，这几乎是您可以获得的最快的操作（除了转到 C 之外）。数据框和数据表总是比向量慢。您可以通过使用直向量（没有 xts 分派）获得一点好处，但快速完成此操作的唯一简单方法是并行化：

> x = as.vector(xts.obj$rtns)
> system.time(unclass(mclapply(1:(length(x) - 99),
                      function(i) quantile(x[i:(i + 99)], p=0.75), mc.cores=32)))
   user  system elapsed 
325.481  15.533  11.221

如果您需要更快，那么您可能需要编写一个专门的函数：天真的应用方法重新排序每个明显浪费的块 - 您需要做的就是删除一个元素并在下一个元素中排序以获得分位数，所以如果你这样做，你可以预期大约 50 倍的加速 - 但你必须自己编写代码（所以只有更频繁地使用它才值得......）。

于 2012-08-28T03:26:32.820 回答
5

data.table通过按键拆分数据来快速工作。我认为data.table目前不支持滚动键，或者在byori参数中会执行此操作的表达式。

data.table您可以使用子集比 a更快的事实data.frame

DT <- as.data.table(x)
.x <- 1:(nrow(DT)-9)
system.time(.xl <- unlist(lapply(.x, function(.i) DT[.i:(.i+10),quantile(x,0.75, na.rm = T)])))
   user  system elapsed 
   8.77    0.00    8.77

或者，您可以构建唯一标识滚动 ID 的关键变量。宽度 = 10，因此我们需要 10 列（用 填充NA_real_）

library(plyr) # for as.quoted
.j <- paste0('x',1:10, ':= c(rep(NA_real_,',0:9,'),rep(seq(',1:10,',9991,by=10),each=10), rep(NA_real_,',c(0,9:1),'))')


 datatable <- function(){
   invisible(lapply(.j, function(.jc) x.dt[,eval(as.quoted(.jc)[[1]])]))
x_roll <- rbind(x.dt[!is.na(x1),quantile(x,0.75),by=x1],
  x.dt[!is.na(x2),quantile(x,0.75),by=x2],
  x.dt[!is.na(x3),quantile(x,0.75),by=x3],
  x.dt[!is.na(x4),quantile(x,0.75),by=x4],
      x.dt[!is.na(x5),quantile(x,0.75),by=x5],
      x.dt[!is.na(x6),quantile(x,0.75),by=x6],
      x.dt[!is.na(x7),quantile(x,0.75),by=x7],
      x.dt[!is.na(x8),quantile(x,0.75),by=x8],
      x.dt[!is.na(x9),quantile(x,0.75),by=x9],
      x.dt[!is.na(x10),quantile(x,0.75),by=x10],use.names =F)


setkeyv(x_roll,'x1')

invisible(x.dt[,x1:= 1:10000])
setkeyv(x.dt,'x1')
x_roll[x.dt][, list(x,V1)]}

l1 <- function()as.numeric(rollapply(x,width=10,FUN=quantile,p=0.75))
lapply_only <- function() unclass(lapply(1:(nrow(x) - 9), function(i) quantile(x[['x']][i:(i + 9)], p=0.75)))


benchmark(datatable(),l1(),lapply_only(), replications = 5)
##            test replications elapsed relative user.self 
## 1   datatable()            5    9.41 1.000000      9.40      
## 2          l1()            5   10.97 1.165781     10.85        
## 3 lapply_only()            5   10.39 1.104145     10.35

编辑---基准测试

data.table比 rollapply 和 raw lapply 更快。我无法测试并行解决方案。

于 2012-08-28T04:09:25.000 回答