【问题标题】:R - Faster Way to Calculate Rolling Statistics Over a Variable IntervalR - 计算可变区间滚动统计的更快方法
【发布时间】:2013-12-06 17:46:45
【问题描述】:

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

也就是说,假设给定一个随机定时的观察值(即不是每天或每周的数据,观察结果只是有一个时间戳,就像在刻度数据中一样),并且假设您想查看中心和离散统计数据能够扩大和收紧计算这些统计数据的时间间隔。

我做了一个简单的 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")

示例函数(运行速度非常慢,有很多观察结果

SummaryStats <- function(dataframe, interval){
  # Returns daily simple summary stats, 
  # at varying intervals
  # dataframe is the data frame in question, with Date and Price obs
  # interval is the width of time to be treated as a day

  firstDay <- min(dataframe$Date)
  lastDay  <- max(dataframe$Date)
  result <- data.frame(Date = NULL,
                       Average = NULL,  Median = NULL,
                       Count = NULL,
                       Percentile25 = NULL, Percentile75 = NULL)

  for (Day in firstDay:lastDay){

    dataframe.sub = subset(dataframe,
                Date > (Day - (interval/2))
                & Date < (Day + (interval/2)))

    nu = data.frame(Date = Day, 
                    Average = mean(dataframe.sub$Price),
                    Median = median(dataframe.sub$Price),
                    Count = length(dataframe.sub$Price),
                    P25 = quantile(dataframe.sub$Price, 0.25),
                    P75 = quantile(dataframe.sub$Price, 0.75))

    result = rbind(result,nu)

  }

  return(result)

}

欢迎您的建议!

【问题讨论】:

  • 我也遇到过类似的问题。请参阅以下问题:Q1Q2Q3。我发现 Rcpp 函数很容易编写,并且可能有很大的加速。

标签: r asynchronous plyr intervals windowing


【解决方案1】:

让我们看看...你正在做一个循环(在 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)

【讨论】:

    【解决方案2】:

    Rcpp 是您最关心速度的好方法。我将使用滚动平均统计来举例说明。

    基准测试: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)
    }
    

    现在解释rollmean_cppxy 是数据。 xout 是请求滚动统计的点向量。 width 是滚动窗口的宽度*2。请注意,滑动窗口末端的索引存储在ledgeredge 中。这些本质上是指向xy 中各自元素的指针。这些索引对于调用其他将向量以及开始和结束索引作为输入的 C++ 函数(例如,中位数等)非常有用。

    对于那些想要“详细”版本的 rollmean_cpp 进行调试(冗长)的人:

    cppFunction('
      NumericVector rollmean_cpp( NumericVector x, NumericVector y, 
                                  NumericVector xout, double width) {
    
        double total=0, oldtotal=0;
        unsigned int n=x.size(), nout=xout.size(), i, ledge=0, redge=0;
        NumericVector out(nout);
    
    
        for( i=0; i<nout; i++ ) {
          Rcout << "Finding window "<< i << " for x=" << xout[i] << "..." << std::endl;
          total = 0;
    
          // numbers to push into window
          while( x[ redge ] - xout[i] <= width && redge<n ) {
            Rcout << "Adding (x,y) = (" << x[redge] << "," << y[redge] << ")" ;
            Rcout << "; edges=[" << ledge << "," << redge << "]" << std::endl;
            total += y[redge++];
          }
    
          // numbers to pop off window
          while( xout[i] - x[ ledge ] > width && ledge<n ) {
            Rcout << "Removing (x,y) = (" << x[ledge] << "," << y[ledge] << ")";
            Rcout << "; edges=[" << ledge+1 << "," << redge-1 << "]" << std::endl;
            total -= y[ledge++];
          }
          if(ledge==n) Rcout << " OVER ";
          if( ledge==redge ) {
           Rcout<<" NO DATA IN INTERVAL " << std::endl << std::endl;
           oldtotal=total=0; out[i]=NAN; continue;}
    
          Rcout << "For interval [" << xout[i]-width << "," <<
                   xout[i]+width << "], all points in interval [" << x[ledge] <<
                   ", " << x[redge-1] << "]" << std::endl ;
          Rcout << std::endl;
    
          out[i] = ( oldtotal + total ) / (redge-ledge);
          oldtotal=total+oldtotal;
        }
        return out;
      }')
    
    x = c(1,2,3,6,90,91)
    y = c(9,8,7,5.2,2,1)
    xout = c(1,2,2,3,6,6.1,13,90,100)
    a = rollmean_cpp(x,y,xout=xout,2)
    # Finding window 0 for x=1...
    # Adding (x,y) = (1,9); edges=[0,0]
    # Adding (x,y) = (2,8); edges=[0,1]
    # Adding (x,y) = (3,7); edges=[0,2]
    # For interval [-1,3], all points in interval [1, 3]
    # 
    # Finding window 1 for x=2...
    # For interval [0,4], all points in interval [1, 3]
    # 
    # Finding window 2 for x=2...
    # For interval [0,4], all points in interval [1, 3]
    # 
    # Finding window 3 for x=3...
    # For interval [1,5], all points in interval [1, 3]
    # 
    # Finding window 4 for x=6...
    # Adding (x,y) = (6,5.2); edges=[0,3]
    # Removing (x,y) = (1,9); edges=[1,3]
    # Removing (x,y) = (2,8); edges=[2,3]
    # Removing (x,y) = (3,7); edges=[3,3]
    # For interval [4,8], all points in interval [6, 6]
    # 
    # Finding window 5 for x=6.1...
    # For interval [4.1,8.1], all points in interval [6, 6]
    # 
    # Finding window 6 for x=13...
    # Removing (x,y) = (6,5.2); edges=[4,3]
    # NO DATA IN INTERVAL 
    # 
    # Finding window 7 for x=90...
    # Adding (x,y) = (90,2); edges=[4,4]
    # Adding (x,y) = (91,1); edges=[4,5]
    # For interval [88,92], all points in interval [90, 91]
    # 
    # Finding window 8 for x=100...
    # Removing (x,y) = (90,2); edges=[5,5]
    # Removing (x,y) = (91,1); edges=[6,5]
    # OVER  NO DATA IN INTERVAL 
    
    print(a)
    # [1] 8.0 8.0 8.0 8.0 5.2 5.2 NaN 1.5 NaN
    

    【讨论】:

    • 您好。如果我错了,请纠正我(我正在努力遵循你的 c++ 代码,我对 R 很好,对 python 还好,其他的就不多),但我认为这个函数需要 x 轴变量是连续的(均匀间隔)或者至少它会创建一个与输入向量等长的向量。因此,我很好奇是否; 1)这是真的吗?和 2) 对于观察结果彼此随机间隔的任何建议? 3)再次,给定随机间隔的观察(即有时一天观察二十次,另一次观察零次)我如何处理这个问题。
    • 我实际上有一两个关于设置类似函数来计算异步价格观察的可变长度窗口滚动 MEDIAN 的问题,但我没有时间制定一个示例 Rcpp 函数来显示你(另外,这样的问题可能最好在另一篇stackoverflow帖子中提出)。但感谢您的所有反馈。我当然已经合并了很多 apply() 系列函数来加速我的计算,你的建议是让我合并 Rcpp 函数来加快速度!
    • 合并滚动中位数应该只是修改上面的滚动平均函数的问题。看起来有一种相当简单的方法可以计算this question 答案中的中位数。特别是,std::nth_element 函数应该非常易于使用,因为它将向量和要计算中位数的向量部分的索引作为输入。 rollmean_cpp 函数已经提供了这些索引,向量是您的输入 (y)。
    【解决方案3】:

    在回答我上面对“Kevin”的问题时,我想我在下面找到了一些东西。

    此函数获取刻度数据(时间观察以随机间隔出现,并由时间戳指示)并计算间隔内的平均值。

    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)
    

    【讨论】:

      【解决方案4】:

      将所有连接的点视为一条链。将此链视为一个图,其中每个数据点都是一个节点。然后,对于每个节点,我们希望找到距离 w 或更小的所有其他节点。为此,我首先生成一个给出成对距离的矩阵。 nth 行给出了节点 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
      }
      

      然后我使用矩阵来确定每个窗口的边缘。对于这个例子,我设置了w=2

      # How many data points to look left or right at each data point
      lookr = colSums( rarray <= w )
      lookl = colSums( larray <= w )
      
      # convert these "look" variables to indeces of the input vector
      ri = 1:length(x) + lookr
      li = 1:length(x) - lookl
      

      定义好窗口后,使用*apply 函数来获得最终答案非常简单。

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

      以上所有代码在我的计算机上花费了大约 50 秒。这比我其他答案中的 rollmean_r 函数快一点。但是,这里特别好的是提供了索引。然后,您可以将任何您喜欢的 R 函数与 *apply 函数一起使用。例如,

      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 函数。祝你好运
      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2022-01-22
      • 1970-01-01
      • 1970-01-01
      • 2016-01-15
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多