R рекурсивная функция или петля в петле

Question

простой проблема. Я хочу проверить, превышает ли разность двух точек (i, j) порог (diff). Если разница между точками превышает порог, индекс должен быть возвращен, а следующее расстояние измерено, но из нового дататота. Это простой фильтр отсечки, в котором все параметры данных с заданным предопределенным порогом фильтруются. Единственный трюк в том, что измерение выполняется всегда из «последней» точки (которая была «достаточно далеко от точки раньше»).

я первый написал как два вложенных циклов, как:

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 

Я уверен, что это может быть улучшено в дальнейшем и более тестирование должно быть сделано.