Question

我是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，p为0.75需要相当长的时间......

即。代码行

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

似乎永远......

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

也许是将xts对象转换为data.table对象以便以加速方式执行该函数然后在最后重新转换回xts的例程？

提前致谢

hlm

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

p.p.s快速使用数据帧的另一个例子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

Answer 1

数据表在这里是无关紧要的 - 你基本上在向量上运行sapply，这是你可以获得的最快的操作（除了转到C）。数据帧和数据表总是比矢量慢。您可以通过使用直接向量（没有xts dispatch）获得一点，但是快速完成此操作的唯一简单方法是并行化：

> 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倍的加速，如果你这样做 - 但你必须自己编码（所以只有你经常使用它才有价值......）。

Answer 2

data.table可以通过按键拆分数据来快速完成。我认为data.table目前不支持滚动键，或者by或i参数中的表达式。

您可以使用data.table的子集化速度比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更快。我无法测试并行解决方案。

使用data.table来加速rollapply

2 个答案:

编辑---基准测试