これは、sapply がループよりも効率が悪い場合の良い例です。sapply を使用するとコードが見やすくなりますが、時間の経過とともにその見栄えの代償を払うことになります。
代わりに、while ループを for ループの内側にラップして、素敵できちんとした関数にすることができます。
以下は、入れ子になった適用ループと入れ子になった for-while ループ (および適切な測定のために混合された適用-while ループ) を比較するベンチマークです。更新：vapply..match..コメントに記載されているものを追加しました。sapply よりも高速ですが、while ループよりもはるかに低速です。
基準：
test elapsed relative
1 for.while 0.069 1.000
2 sapply.while 0.080 1.159
3 vapply.match 0.101 1.464
4 nested.sapply 0.104 1.507
3 分の 1 の時間を節約できることに注意してください。シーケンスを A に追加し始めると、節約できる金額が大きくなる可能性があります。
あなたの質問の2番目の部分について：
これがすべて素敵な関数にまとめられている場合、 A に seq を追加するのは簡単です
# Sample data
A <- c(10, 5, 3, 4, 7, 100, 2)
B <- c(4, 8, 11, 1, 5, 18, 20)
# Sample sequence
S <- seq(1, 12, 3)
# marix with all index values (with names cleaned up)
indexesOfB <- t(sapply(S, function(s) findIndx(A+s, B)))
dimnames(indexesOfB) <- list(S, A)
最後に、代わりに Aより小さいB の値を見つけたい場合は、関数内の演算を交換するだけです。
(関数に if 句を含めて、単一の関数のみを使用することもできます。2 つの別個の関数を使用する方が効率的だと思います)
findIndx.gt(A, B) # [1] 3 3 5 5 6 NA 8 NA NA
findIndx.lt(A, B) # [1] 2 4 4 NA 8 7 NA NA NA
その後、1 つの素敵なパッケージにまとめることができます。
rangeFindIndx(A, B, S)
# A S indxB.gt indxB.lt
# 10 1 3 2
# 5 1 3 4
# 3 1 5 4
# 4 1 5 NA
# 7 1 6 NA
# 100 1 NA NA
# 2 1 NA NA
# 10 4 6 4
# 5 4 3 4
# ...
機能
(依存していることに注意してくださいreshape2)
rangeFindIndx <- function(A, B, S) {
# For each s in S, and for each a in A,
# find the first value of B, which is higher than a+s, or lower than a-s
require(reshape2)
# Create gt & lt matricies; add dimnames for melting function
indexesOfB.gt <- sapply(S, function(s) findIndx.gt(A+s, B))
indexesOfB.lt <- sapply(S, function(s) findIndx.lt(A-s, B))
dimnames(indexesOfB.gt) <- dimnames(indexesOfB.gt) <- list(A, S)
# melt the matricies and combine into one
gtltMatrix <- cbind(melt(indexesOfB.gt), melt(indexesOfB.lt)$value)
# clean up their names
names(gtltMatrix) <- c("A", "S", "indxB.gt", "indxB.lt")
return(gtltMatrix)
}
findIndx.gt <- function(A, B) {
lng <- length(A)
ret <- integer(0)
b <- NULL
for (j in seq(lng-1)) {
i <- j + 1
while (i <= lng && ((b <- B[[i]]) < A[[j]]) ) {
i <- i + 1
}
ret <- c(ret, ifelse(i<lng, i, NA))
}
c(ret, NA)
}
findIndx.lt <- function(A, B) {
lng <- length(A)
ret <- integer(0)
b <- NULL
for (j in seq(lng-1)) {
i <- j + 1
while (i <= lng && ((b <- B[[i]]) > A[[j]]) ) { # this line contains the only difference from findIndx.gt
i <- i + 1
}
ret <- c(ret, ifelse(i<lng, i, NA))
}
c(ret, NA)
}