R 编程 : Using previously calculated row to update each row

Question

我有一个非常大的时间序列，我需要根据开始时的一些任意值和当前时间段的变化创建一个不同的时间序列。在真实数据集中，此更改取决于数据框的其他变量，但出于 MWE 的目的，我按如下方式重新创建它:

initial_value <- 100
set.seed(123)
library(data.table)
df <- as.data.table(data.frame(num = c(1:10),change = rnorm(10)))

新变量 value 定义为它自己在上一周期的值加上当前周期的 change。第一次观察中的值由任意选择的 initial_value 确定。如果对 value 没有限制，它可以简单地创建为

df <- df[, value0 := initial_value + cumsum(change)]

使用 data.table 速度非常快。但是，不幸的是， change 也可能取决于前一时期的实际 value。具体来说，我们假设每当达到 102 时，该系列需要在下一个周期到达 initial_value 并在那里停留 3 个周期。因此，在以下数据框中，我需要创建变量 value 而上面的代码生成 value0 :

    num      change    value0     value
 1:   1 -0.56047565  99.43952  99.43952
 2:   2 -0.23017749  99.20935  99.20935
 3:   3  1.55870831 100.76806 100.76806
 4:   4  0.07050839 100.83856 100.83856
 5:   5  0.12928774 100.96785 100.96785
 6:   6  1.71506499 102.68292 102.68292
 7:   7  0.46091621 103.14383 100.00000
 8:   8 -1.26506123 101.87877 100.00000
 9:   9 -0.68685285 101.19192 100.00000
10:  10 -0.44566197 100.74626  99.55434

到目前为止，我设法产生此结果的唯一方法是使用循环:

df$value <- NA 
df$value[1] <- initial_value + df$change[1]
for (i in 2:nrow(df)) {
  if (is.na(df$value[i])) {
    if (df$value[i-1] < 102) {
      df$value[i] <- df$value[i-1] + df$change[i]
    } else {
      df$value[i:(i+2)] <- initial_value
    } 
  }
}

然而，循环(数十)数百万次观察非常缓慢。有没有办法可以将其矢量化或更有效地运行该过程？

Answer 1

我建议您将 Rcpp 用于简单循环。复制请求的逻辑很容易。
你的功能:

fun_r <- function(){
  df$value <- NA 
  df$value[1] <- initial_value + df$change[1]
  for (i in 2:nrow(df)) {
    if (is.na(df$value[i])) {
      if (df$value[i-1] < 102) {
        df$value[i] <- df$value[i-1] + df$change[i]
      } else {
        df$value[i:(i+2)] <- initial_value
      } 
    }
  }
  df
}

C++中的相同功能

library(Rcpp)
cppFunction({'
  NumericVector fun_c(NumericVector change, double init, double thr){
  int n = change.size();
  int end;
  NumericVector out(n);
  out[ 0 ] = init + change[ 0 ];

  for(int i = 1; i < n; i++){

    if( out[ i - 1 ] < thr ){

      out[i] = out[ i - 1 ] + change[ i ];

    } else {

      end = std::min( i + 2 , n - 1);
      for(int j = i; j <= end; j++) {
        out[ j ] = init;
        i = j;
      }
    }

  }
  return out;
}
'})

更新:
第一次写的R函数(上)基于 data.frame subsetting，这是在 R 中处理数据的非常无效的方式。 Function 只是一个失败者，预计会在所有基准测试中失败。在循环时，应该始终对(向量和矩阵)计算进行矢量化。下面的函数与 Rcpp 示例更具竞争力:

fun_r2 <- function(change, initial_value, thr ){
  n <- length(change)
  value <- numeric(n) 
  value[1] <- initial_value + change[1]

  for (i in 2:n) {
    if ( value[i]==0 ) {
      if (value[i-1] < thr) {
        value[i] <- value[i-1] + change[i]
      } else {
        value[i:(i+2)] <- initial_value
      } 
    }
  }
  value
}

三个函数产生相同的结果， fun_c是最快的，但矢量化 fun_r2功能可以认为是可以接受的。

df$value <- fun_r()
df$value_r2 <- fun_r2(as.vector(df$change), init=100, thr=102)
df$value_rcpp <- fun_c(df$change, init=100, thr=102)

all.equal(df$value, df$value_rcpp)
all.equal(df$value, df$value_r2)
# TRUE

mb <- microbenchmark::microbenchmark(
  fun_r(),
  fun_r2(as.vector(df$change), init=100, thr=102),
  fun_c(df$change, init=100, thr=102),
  times=100L
)

#    expr       mean
# 1 fun_r()   6650.72481
# 2 fun_r2()  42.28442
# 3 fun_c()   18.24121

享受!