R - 矢量化条件替换

Question

您好，我正在尝试操作一个数字列表，我想在没有 for 循环的情况下使用 R 中的快速 native 操作来这样做。操作的伪代码是:

By default the starting total is 100 (for every block within zeros)

From the first zero to next zero, the moment the cumulative total falls by more than 2% replace all subsequent numbers with zero.

Do this far all blocks of numbers within zeros

The cumulative sums resets to 100 every time

例如，如果以下是我的数据:

d <- c(0,0,0,1,3,4,5,-1,2,3,-5,8,0,0,-2,-3,3,5,0,0,0,-1,-1,-1,-1);

结果将是:

0 0 0 1 3 4 5 -1 2 3 -5 0 0 0 -2 -3 0 0 0 0 0 -1 -1 -1 0

目前我有一个带有 for 循环的实现，但由于我的向量非常长，性能很差。

提前致谢。

这是一个运行示例代码:

d <- c(0,0,0,1,3,4,5,-1,2,3,-5,8,0,0,-2,-3,3,5,0,0,0,-1,-1,-1,-1);
ans <- d;
running_total <- 100;
count <- 1;
max <- 100;
toggle <- FALSE;
processing <- FALSE;

for(i in d){
  if( i != 0 ){  
       processing <- TRUE; 
       if(toggle == TRUE){
          ans[count] = 0;  
       }
       else{
         running_total = running_total + i;
  
          if( running_total > max ){ max = running_total;}
          else if ( 0.98*max > running_total){
              toggle <- TRUE;  
          }
      }
   }

   if( i == 0 && processing == TRUE )
   { 
       running_total = 100; 
       max = 100;
       toggle <- FALSE;
   }
   count <- count + 1;
}
cat(ans)

Answer 1

我不确定如何将您的循环转换为矢量化操作。但是，有两个相当简单的选项可以提高性能。第一种是简单地将循环放入 R 函数中，并使用 compiler 包对其进行预编译。第二个稍微复杂一些的选项是将 R 循环转换为 c++ 循环，并使用 Rcpp 包将其链接到 R函数。然后调用 R 函数，将其传递给快速的 c++ 代码。我展示了这些选项和时间。我非常感谢来自 Rcpp listserv 的 Alexandre Bujard 的帮助，他帮助我解决了一个我不明白的指针问题。

首先，这是作为函数的 R 循环，foo.r。

## Your R loop as a function
foo.r <- function(d) {
  ans <- d
  running_total <- 100
  count <- 1
  max <- 100
  toggle <- FALSE
  processing <- FALSE

  for(i in d){
    if(i != 0 ){
      processing <- TRUE
      if(toggle == TRUE){
        ans[count] <- 0
      } else {
        running_total = running_total + i;
        if (running_total > max) {
          max <- running_total
        } else if (0.98*max > running_total) {
          toggle <- TRUE
        }
      }
    }
    if(i == 0 && processing == TRUE) {
      running_total <- 100
      max <- 100
      toggle <- FALSE
    }
    count <- count + 1
  }
  return(ans)
}

现在我们可以加载compiler包并编译函数并将其命名为foo.rcomp。

## load compiler package and compile your R loop
require(compiler)
foo.rcomp <- cmpfun(foo.r)

这就是编译路线所需的全部内容。这都是 R 并且显然非常简单。现在对于 c++ 方法，我们使用 Rcpp 包以及 inline 包，它允许我们“内联” c++ 代码。也就是说，我们不必制作源文件并编译它，我们只需将它包含在 R 代码中，编译就会为我们处理。

## load Rcpp package and inline for ease of linking
require(Rcpp)
require(inline)

## Rcpp version
src <- '
  const NumericVector xx(x);
  int n = xx.size();
  NumericVector res = clone(xx);
  int toggle = 0;
  int processing = 0;
  int tot = 100;
  int max = 100;

  typedef NumericVector::iterator vec_iterator;
  vec_iterator ixx = xx.begin();
  vec_iterator ires = res.begin();
  for (int i = 0; i < n; i++) {
    if (ixx[i] != 0) {
      processing = 1;
      if (toggle == 1) {
        ires[i] = 0;
      } else {
        tot += ixx[i];
        if (tot > max) {
          max = tot;
        } else if (.98 * max > tot) {
            toggle = 1;
          }
      }
    }

   if (ixx[i] == 0 && processing == 1) {
     tot = 100;
     max = 100;
     toggle = 0;
   }
  }
  return res;
'

foo.rcpp <- cxxfunction(signature(x = "numeric"), src, plugin = "Rcpp")

现在我们可以测试我们是否得到了预期的结果:

## demonstrate equivalence
d <- c(0,0,0,1,3,4,5,-1,2,3,-5,8,0,0,-2,-3,3,5,0,0,0,-1,-1,-1,-1)
all.equal(foo.r(d), foo.rcpp(d))

最后，通过重复 10e4 次来创建一个更大版本的 d。然后我们可以运行三个不同的函数，纯 R 代码，编译后的 R 代码，以及链接到 c++ 的 R 函数> 代码。

## make larger vector to test performance
dbig <- rep(d, 10^5)

system.time(res.r <- foo.r(dbig))
system.time(res.rcomp <- foo.rcomp(dbig))
system.time(res.rcpp <- foo.rcpp(dbig))

在我的系统上，给出:

> system.time(res.r <- foo.r(dbig))
   user  system elapsed 
  12.55    0.02   12.61 
> system.time(res.rcomp <- foo.rcomp(dbig))
   user  system elapsed 
   2.17    0.01    2.19 
> system.time(res.rcpp <- foo.rcpp(dbig))
   user  system elapsed 
   0.01    0.00    0.02 

已编译的 R 代码在 250 万向量上运行时所用时间约为未编译 R 代码的 1/6，仅需 2 秒。 c++ 代码比编​​译后的 R 代码快几个数量级，只需 0.02 秒即可完成。除了初始设置之外，基本循环的语法在 R 和 c++ 中几乎相同，因此您甚至不会失去清晰度。我怀疑即使您的部分或全部循环可以在 R 中进行矢量化，您也很难超越链接到 c++ 的 R 函数的性能。最后，只是为了证明:

> all.equal(res.r, res.rcomp)
[1] TRUE
> all.equal(res.r, res.rcpp)
[1] TRUE

不同的函数返回相同的结果。