Question

简单的问题。我想检查两点（i，j）的差异是否大于阈值（diff）。如果点之间的差异超过阈值，则应返回索引并测量下一个距离，但是从新数据点开始。它是一个简单的cutofffilter，其中过滤了预定义阈值下的所有数据点。唯一的诀窍是，测量始终是从最后一次＆＃34;点（那是＆＃34;远远超过＆＃34;从之前的点）。

我首先把它写成两个嵌套循环，如：

x <- sample(1:100)
for(i in 1:(length(x)-1)){
      for(j in (i+1):length(x)){
        if(abs(x[i] - x[j]) >= cutoff) { 
          print(j)
          i <- j  # set the index to the current datapoint
          break }
      }}

这种解决方案很直观。但是不正常。我认为i和j的分配无效。第一个循环只是忽略跳转并遍历所有数据点。

好吧，我不想浪费时间进行调试，只是觉得我可以用递归函数做同样的事情。所以我写得像：

checkCutOff.f <- function(x,cutoff,i = 1) {
  options(expressions=500000)
  # Loops through the data and comperes the temporally fixed point 'i with the looping points 'j
  for(j in (i+1):length(x)){
    if( abs(x[i] - x[j]) >= cutoff ){
      break
    }
  }

  # Recursive function to update the new 'i - stops at the end of the dataset
  if( j<length(x) ) return(c(j,checkCutOff.f(x,cutoff,j))) 
  else return(j)
}
 x<-sample(1:100000)
 checkCutOff.f(x,1)

此代码有效。但是我得到了大数据集的堆栈溢出。这就是我问自己这段代码是否有效的原因。对我来说，增加限制等等总是暗示效率低下的代码......

所以我的问题是： 什么样的解决方案真正有效？谢谢！的

Answer 1

您应该避免使用c增加返回值。那效率很低。最终分配到最大尺寸和子集到所需的大小。

请注意，您的功能在结果中始终包含length(x)，这是错误的：

set.seed(42)
x<-sample(1:10)
checkCutOff.f(x, 100)
#[1] 10

这是一个带循环的R解决方案：

checkCutOff.f1 <- function(x,cutoff) {
  i <- 1
  j <- 1
  k <- 1

  result <- integer(length(x))

  while(j < length(x)) {
    j <- j + 1
    if (abs(x[i] - x[j]) >= cutoff) {
      result[k] <- j
      k <- k + 1
      i <- j
    }
  }
  result[seq_len(k - 1)]
}

all.equal(checkCutOff.f(x, 4), checkCutOff.f1(x, 4))
#[1] TRUE
#the correct solution includes length(x)  here (by chance)

很容易翻译成Rcpp：

#include <Rcpp.h>
using namespace Rcpp;


// [[Rcpp::export]]
IntegerVector checkCutOff_f1cpp(NumericVector x, double cutoff) {
  int i = 0; 
  int j = 1; 
  int k = 0;
  IntegerVector result(x.size());  
  while(j < x.size()) {
    if (std::abs(x[i] - x[j]) >= cutoff) {
      result[k] = j + 1;
      k++;
      i = j;
    }
    j++;
  }
  result = result[seq_len(k)-1];
  return result;
}

然后在R：

all.equal(checkCutOff.f(x, 4), checkCutOff_f1cpp(x, 4))
#[1] TRUE

基准：

library(microbenchmark)
y <- sample(1:1000)

microbenchmark(
  checkCutOff.f(y, 4),
  checkCutOff.f1(y, 4),
  checkCutOff_f1cpp(y, 4)
  )

#Unit: microseconds
#                    expr      min        lq       mean   median        uq       max neval cld
#     checkCutOff.f(y, 4) 3665.105 4681.6005 7798.41776 5323.068 6635.9205 41028.930   100   c
#    checkCutOff.f1(y, 4) 1384.524 1507.2635 1831.43236 1769.031 2070.7225  3012.279   100  b 
# checkCutOff_f1cpp(y, 4)    8.765   10.7035   26.40709   14.240   18.0005   587.958   100 a

我确信这可以进一步改进，并且应该进行更多的测试。

循环中的R递归函数或循环

1 个答案: