これはもう少し遅いですが、役に立つ場合もあります。
私は@alexis_lazに、必要以上に多くの比較が計算されていることに同意します。 anyをローリング方式で適用すると、不要な計算が行われるため、アイデアをさらに進化させることができます。
キーは、特定の行が常に別の特定の行と比較されることです（この例では3つ下にあります）。その行に等価性が保持されているかどうかがわかると、指定されたウィンドウ内にその行を含む他の行には1（TRUE）の値を与える必要があります。
ここで便利なショートカットは同値が行jのために保持し、それが行iがTRUEになり、行j行i+1のウィンドウ内にある場合、i+1は状況を知らなくても（もTRUEであるということですウィンドウ内の他の点）。私が得意なのは、各行のウィンドウに対してanyを決定する必要がないということです。行番号iの行にいくつのTRUEがあるかを知っていれば、行i+1に対して、そのウィンドウを離れるポイントがTRUEであるかどうか、およびそのウィンドウに入るポイントがTRUEであるかどうかを判断するだけで済みます。基本的には、Window -widthのボックスでベクトルをフィルタリングしています。そして、ウィンドウに少なくとも1つのTRUE値を持つエントリをチェックします（これはすべて1回のパスで行うことができますが、余分な時間は有意ではない）。
ローリング・サムを使用すると、ランニング・タリーを持ち、ウィンドウを出入りするポイントを追加/削除するだけで効率的に計算できます。これは、@ alexis_lazの観測が来る場所です：出入りするポイントのステータスは、事前に計算できます。
具体的にするために、ここにいくつかのコードがあります。まず最初のループ@Richard Telfordの答えと@ alexis_lazの答えをコピーして関数にラップさせます（主に個人的な利便性のために出力形式が一致し、うまくいけばバグは追加されません）：
f_G <- function(x, window, idiff, valdiff){
base_rows = 1:(NROW(x) - idiff - 1) # can't check more than this
candidate_max = pmin(base_rows + window, NROW(x) - idiff) # maximum row to start checking against
out = rep(0, NROW(x)) #pre-allocate variable
for (i in seq_along(base_rows)) {
out[i] = as.numeric(any(x[(i + 1):candidate_max[i]]
- x[((i + 1):candidate_max[i]) + idiff] > valdiff))}
return(out)
}
f_RT <- function(x, window, idiff, valdiff){
x0 <- cbind(x[-(1)][1:NROW(x)], sapply(2:window,
function(i)x[-(1:i)][1:NROW(x)]))
x1 <- sapply((idiff+1):(idiff+window),
function(i)x[-(1:i)][1:NROW(x)])
out <- as.numeric(apply((x0 - x1) > valdiff, 1, any, na.rm = TRUE))
return(out)
}
f_AL <- function(x, window, idiff, valdiff){
check = (x[2:(NROW(x) - idiff)] - x[(2 + idiff):NROW(x)]) > valdiff
check <- c(check, rep(FALSE, idiff+1))
out <- as.integer(sapply(seq_along(check),
function(i) any(check[i:min(length(check), (i + (window - 1)))])))
return(out)
}
は次にここに（@alexis_lazが提案のように）私は事前に計算違いで、ベクター上で、上記のローリング合計を計算するための2つの機能があります。最初のものはfilter関数を使用し、2番目のものはRcppRollパッケージのroll_sumを使用します。
f_filt <- function(x, window, idiff, valdiff){
## calculate idiff differences once
check = as.integer((x[2:(NROW(x) - idiff)] - x[(2 + idiff):NROW(x)]) > valdiff)
## extend series to filter
check <- c(check, rep(0, window+idiff))
## reverse series due to filter using "past" values
ffilt <- rev(filter(rev(check), rep(1, window), sides=1))
## check if at least one
out <- ifelse(na.omit(ffilt) > 0, 1, 0)
return(out)
}
library(RcppRoll)
f_roll <- function(x, window, idiff, valdiff){
## calculate idiff differences once
check = as.integer((x[2:(NROW(x) - idiff)] - x[(2 + idiff):NROW(x)]) > valdiff)
## extend series to filter
check <- c(check, rep(0, window+idiff))
## rolling window sum
froll <- roll_sum(check, n=window, align="right")
out <- ifelse(froll > 0, 1, 0)
return(out)
}
簡単にチェックするように、我々はすべての機能が同じ答えを与えることをテストすることができます。
f_G(df$Price, Window, IndexDifference, ValueDifference)
# 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0
f_RT(df$Price, Window, IndexDifference, ValueDifference)
# 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0
f_AL(df$Price, Window, IndexDifference, ValueDifference)
# 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0
f_filt(df$Price, Window, IndexDifference, ValueDifference)
# 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0
f_roll(df$Price, Window, IndexDifference, ValueDifference)
# 1 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0
今すぐベンチマークにのそれらを聞かせて。また、テストする行の数を増やします。
library(microbenchmark)
w <- Window
idiff <- IndexDifference
vdiff <- ValueDifference
df2 <- rep(df$Price, 5000) #100,000 entries
microbenchmark(f_G(df2, w, idiff, vdiff),
f_RT(df2, w, idiff, vdiff),
f_AL(df2, w, idiff, vdiff),
f_filt(df2, w, idiff, vdiff),
f_roll(df2, w, idiff, vdiff)
)
Unit: milliseconds
expr min lq mean median uq max neval cld
f_G(df2, w, idiff, vdiff) 395.80227 412.05120 419.88554 413.55551 417.84907 479.47306 100 e
f_RT(df2, w, idiff, vdiff) 154.43919 192.99473 193.10029 195.61031 197.95933 236.27244 100 c
f_AL(df2, w, idiff, vdiff) 233.30237 244.01664 249.75449 245.07001 248.51249 319.04956 100 d
f_filt(df2, w, idiff, vdiff) 21.53997 22.51582 25.38218 22.59477 23.56873 63.48320 100 b
f_roll(df2, w, idiff, vdiff) 14.26333 14.35543 16.99302 15.24879 15.45127 55.49886 100 a
最後に、我々はこれをやってかなりいいスピードブーストを取得していることがわかります。このように近づくことについてのもう一つのすてきな点は、ウィンドウサイズに関係なく効率的なままであることです（特にローリング・サムを直接実行すると、filterは少し遅くなりますが、かなり速いです）。
w <- 25 #Window
df3 <- rep(df$Price, 5000) #100,000 entries
microbenchmark(f_G(df3, w, idiff, vdiff),
f_RT(df3, w, idiff, vdiff),
f_AL(df3, w, idiff, vdiff),
f_filt(df3, w, idiff, vdiff),
f_roll(df3, w, idiff, vdiff)
)
Unit: milliseconds
expr min lq mean median uq max neval cld
f_G(df3, w, idiff, vdiff) 487.65798 516.67700 537.54019 541.34459 551.52128 592.05720 100 e
f_RT(df3, w, idiff, vdiff) 328.44934 366.76176 389.08534 401.39053 409.49376 518.94535 100 d
f_AL(df3, w, idiff, vdiff) 240.99006 258.66045 263.21317 260.09258 263.75917 319.02493 100 c
f_filt(df3, w, idiff, vdiff) 37.32291 37.41098 38.97167 37.47234 38.40989 79.51684 100 b
f_roll(df3, w, idiff, vdiff) 15.49264 15.52950 15.86283 15.55252 15.62852 19.77415 100 a
"Signal"と "Price"ベクトルがあれば、[.data.frame'と '[< - 。data.frame'は避ける方が効率的です。例えば。単純なベクトルとは対照的に、単一の列 "data.frame"への代入を比較する： 'x1 = data.frame（col1 = integer（1e5））; x2 =整数（1e5）。 system.time（seq_len（nrow（x1））内のi）x1 $ col1 [i] = 1L）; system.time（for i in seq_along（x2））x2 [i] = 1L） ' –
Alexisさん、ありがとうございます。私は数十の列を持っています。これは簡単な例です。 – Krug