R编程：使用先前计算的行更新每一行

Question

R编程：使用先前计算的行更新每一行

rloopsdata.tabletime-seriesvectorization

8

我有一个非常大的时间序列，需要基于开始时的某个任意值和当前时间段中的变化来创建不同的时间序列。在实际数据集中，这种变化取决于数据框的其他变量，但为了演示，我将其重新创建如下：

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
    } 
  }
}

然而，循环遍历（数百万次）观测非常缓慢。是否有可能对其进行向量化或者更高效地运行该进程？

- Radek Janhuba

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- GoGonzo · Accepted Answer

我建议你在处理简单循环时使用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子集，这是在R中处理数据的一种高度低效的方式。该函数只是一个预计在所有基准测试中都会失败的弱者。在循环时，应始终向量化（向量和矩阵）计算。以下函数与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

享受吧！