R-计算可变时间间隔内滚动统计信息的更快方法

我很好奇是否有人能想出一种（更快的）方法来计算可变时间间隔（窗口）内的滚动统计数据（滚动平均值、中值、百分位数等）

也就是说，假设有一个随机定时的观测值（即不是每日或每周的数据，观测值只有一个时间戳，如滴答数数据），并且假设您希望查看中心和分散统计数据，您可以扩大和缩短计算这些统计数据的时间间隔

我做了一个简单的for循环来实现这一点。但它显然运行得非常慢（事实上，我认为我的循环仍然在运行一个小样本的数据，我设置它来测试它的速度）。我一直在尝试像ddply这样的东西来做这件事——这看起来很难获得每日统计数据——但我似乎无法摆脱它

例如：

样本设置：

df <- data.frame(Date = runif(1000,0,30))
df$Price <- I((df$Date)^0.5 * (rnorm(1000,30,4)))
df$Date <- as.Date(df$Date, origin = "1970-01-01")

---

df让我们看看。。。您正在执行一个循环（R中的速度非常慢），在创建子集时创建不必要的数据副本，并使用
rbind
累积数据集。如果你避免这些，事情会大大加快。试试这个

Summary_Stats <- function(Day, dataframe, interval){
    c1 <- dataframe$Date > Day - interval/2 & 
        dataframe$Date < Day + interval/2
    c(
        as.numeric(Day),
        mean(dataframe$Price[c1]),
        median(dataframe$Price[c1]),
        sum(c1),
        quantile(dataframe$Price[c1], 0.25),
        quantile(dataframe$Price[c1], 0.75)
      )
}
Summary_Stats(df$Date[2],dataframe=df, interval=20)
firstDay <- min(df$Date)
lastDay  <- max(df$Date)
system.time({
    x <- sapply(firstDay:lastDay, Summary_Stats, dataframe=df, interval=20)
    x <- as.data.frame(t(x))
    names(x) <- c("Date","Average","Median","Count","P25","P75")
    x$Date <- as.Date(x$Date)
})
dim(x)
head(x)

如果速度是您最关心的问题，那么
Summary\u Stats是一个很好的方法。我将使用滚动平均统计来举例说明

基准：Rcpp与R

x = sort(runif(25000,0,4*pi))
y = sin(x) + rnorm(length(x),0.5,0.5)
system.time( rollmean_r(x,y,xout=x,width=1.1) )   # ~60 seconds
system.time( rollmean_cpp(x,y,xout=x,width=1.1) ) # ~0.0007 seconds

Rcpp和R功能的代码

cppFunction('
  NumericVector rollmean_cpp( NumericVector x, NumericVector y, 
                              NumericVector xout, double width) {
    double total=0;
    unsigned int n=x.size(), nout=xout.size(), i, ledge=0, redge=0;
    NumericVector out(nout);

    for( i=0; i<nout; i++ ) {
      while( x[ redge ] - xout[i] <= width && redge<n ) 
        total += y[redge++];
      while( xout[i] - x[ ledge ] > width && ledge<n ) 
        total -= y[ledge++];
      if( ledge==redge ) { out[i]=NAN; total=0; continue; }
      out[i] = total / (redge-ledge);
    }
    return out;
  }')

rollmean_r = function(x,y,xout,width) {
  out = numeric(length(xout))
  for( i in seq_along(xout) ) {
    window = x >= (xout[i]-width) & x <= (xout[i]+width)
    out[i] = .Internal(mean( y[window] ))
  }
  return(out)
}

在回答我对“凯文”的问题时，我想我在下面找到了答案

此函数获取滴答声数据（以随机间隔出现的时间观测值由时间戳表示），并计算间隔内的平均值

library(Rcpp)

cppFunction('
  NumericVector rollmean_c2( NumericVector x, NumericVector y, double width,
                              double Min, double Max) {

double total = 0, redge,center;
unsigned int n = (Max - Min) + 1,
                  i, j=0, k, ledge=0, redgeIndex;
NumericVector out(n);


for (i = 0; i < n; i++){
  center = Min + i + 0.5;
  redge = center - width / 2;
  redgeIndex = 0;
  total = 0;

  while (x[redgeIndex] < redge){
    redgeIndex++;
  }
  j = redgeIndex;

  while (x[j] < redge + width){
    total += y[j++];

  }

  out[i] = total / (j - redgeIndex);
}
return out;

  }')

# Set up example data
x = seq(0,4*pi,length.out=2500)
y = sin(x) + rnorm(length(x),0.5,0.5)
plot(x,y,pch=20,col="black",
     main="Sliding window mean; width=1",
     sub="rollmean_c in red      rollmean_r overlaid in white.")


c.out = rollmean_c2(x,y,width=1,Min = min(x), Max = max(x)) 
lines(0.5:12.5,c.out,col="red",lwd=3)

库（Rcpp）
CPP函数（'
数值向量rollmean_c2（数值向量x，数值向量y，双宽度，
双最小值，双最大值）{
双倍合计=0，红色，中间；
无符号整数n=（最大-最小）+1，
i、 j=0，k，壁架=0，红指数；
数字矢量输出（n）；
对于（i=0；i

将所有连接点视为一条链。将此链视为一个图，其中每个数据点都是一个节点。然后，对于每个节点，我们希望找到距离
w
或更小的所有其他节点。为此，我首先生成一个矩阵，给出两两距离。第
n
行给出了节点
n
节点之间的距离

# First, some data
x = sort(runif(25000,0,4*pi))
y = sin(x) + rnorm(length(x),0,0.5)

# calculate the rows of the matrix one by one
# until the distance between the two closest nodes is greater than w
# This algorithm is actually faster than `dist` because it usually stops
# much sooner
dl = list()
dl[[1]] = diff(x)
i = 1
while( min(dl[[i]]) <= w ) {
  pdl = dl[[i]]
  dl[[i+1]] = pdl[-length(pdl)] + dl[[1]][-(1:i)]
  i = i+1
}

# turn the list of the rows into matrices
rarray = do.call( rbind, lapply(dl,inf.pad,length(x)) )
larray = do.call( rbind, lapply(dl,inf.pad,length(x),"right") )

# extra function
inf.pad = function(x,size,side="left") {
  if(side=="left") {
    x = c( x, rep(Inf, size-length(x) ) )
  } else {
    x = c( rep(Inf, size-length(x) ), x )
  }
  x
}

定义了窗口后，使用
*apply
函数获得最终答案非常简单

rolling.mean = vapply( mapply(':',li,ri), function(i) .Internal(mean(y[i])), 1 )

上面所有的代码在我的电脑上花了大约50秒。这比我另一个答案中的
rollmean\r
函数快一点。然而，这里特别好的是提供了索引。然后，您可以在
*apply
函数中使用您喜欢的任何R函数。比如说,

rolling.mean = vapply( mapply(':',li,ri), 
                                        function(i) .Internal(mean(y[i])), 1 )

大约需要5秒钟。以及

rolling.median = vapply( mapply(':',li,ri), 
                                        function(i) median(y[i]), 1 )

大约需要14秒。如果您愿意，您可以在我的另一个答案中使用Rcpp函数来获取索引。
我也遇到过类似的问题。见以下问题：。我发现Rcpp函数非常容易编写，并且可能有很大的加速。您好。纠正我，如果我错了（我正在努力遵循你的C++代码，我很好用R，好的Python，而不是这么多其他），但我认为这个函数需要X轴变量是顺序（均匀间隔），或至少它会创建一个向量长度相等的输入向量。因此，我很好奇；1） 这是真的吗？2）当观测值彼此随机间隔时，有什么建议吗？3）同样，考虑到随机间隔的观察（例如，有时一天20次观察，另一天0次观察），我如何处理这个问题。我实际上有一个或两个问题，关于设置一个类似的函数来计算异步价格观察的可变长度窗口滚动中值，但我还没来得及编写一个Rcpp函数示例来向您展示（另外，这样的问题最好在另一篇stackoverflow文章中提出）。但是谢谢你的反馈。我确实加入了很多apply（）函数家族来加速我的计算，你的建议让我加入Rcpp函数来加速更多！合并滚动中值只需修改上述滚动平均值函数即可。看起来有一个相当简单的方法来计算答案的中位数。特别是，
std:：nth_element
函数应该使用起来非常简单，因为它将向量和要计算中值的向量部分的索引作为输入。
rollmean\u cpp
函数已经提供了这些索引，向量就是您的输入（
y
）。如果有人知道生成成对距离矩阵的更快方法，那就太好了！这就是上面的代码最慢的地方。真的很酷，你还在考虑这个问题！很抱歉，我没有具体回复你的帖子，但是：关于可变区间长度中位数的计算有什么建议吗？（我处理的是异步时间序列价格观察，它存在较大的异常值问题，因此平均值实际上不是中心趋势的适当度量）。我对中值计算的建议是使用此答案中的代码，或修改另一个答案中的Rcpp函数。最好的
rolling.mean = vapply( mapply(':',li,ri), function(i) .Internal(mean(y[i])), 1 )

rolling.mean = vapply( mapply(':',li,ri), 
                                        function(i) .Internal(mean(y[i])), 1 )

rolling.median = vapply( mapply(':',li,ri), 
                                        function(i) median(y[i]), 1 )