許容値と一致する値

Question

私はプロットする前にデータセットをサブセット化していますが、キーは数字ですmatch()または%in%の厳密な等価性テストを使用することはできません。 私は次のような代替案を書いていますが、この問題は十分に共通していると思います。 all.equalは、複数のテスト値に対して設計されていないようです。

select_in <- function(x, ref, tol=1e-10){ 
    testone <- function(value) abs(x - value) < tol 
    as.logical(rowSums(sapply(ref, testone))) 
} 

x = c(1.0, 1+1e-13, 1.01, 2, 2+1e-9, 2-1e-11) 
x %in% c(1,2,3) 
#[1] TRUE FALSE FALSE TRUE FALSE FALSE 
select_in(x, c(1, 2, 3)) 
#[1] TRUE TRUE FALSE TRUE FALSE TRUE 

Answer 1

これは（ない非常に寛容とはいえ）の目標を達成するためのようだ：

fselect_in <- function(x, ref, d = 10){ 
    round(x, digits=d) %in% round(ref, digits=d) 
} 

fselect_in(x, c(1,2,3)) 
# TRUE TRUE FALSE TRUE FALSE TRUE 

Answer 2

ないことがあるが、動作します寛容引数をall.equal持ってどれだけ良くしてください：

`%~%` <- function(x,y) sapply(x, function(.x) { 
any(sapply(y, function(.y) isTRUE(all.equal(.x, .y, tolerance=tol)))) 
}) 

x %~% c(1,2,3) 
[1] TRUE TRUE FALSE TRUE FALSE TRUE 

私は2つが機能を適用した好きではありません。私はそれを短縮しようとします。

更新

速くall.equalを使用しないかもしれないもう一つの方法。それは最初のソリューションよりもはるかに高速であることが判明：

`%~%` <- function(x,y) { 
out <- logical(length(x)) 
for(i in 1:length(x)) out[i] <- any(abs(x[i] - y) <= tol) 
out 
} 

x %~% c(1,2,3) 
[1] TRUE TRUE FALSE TRUE FALSE TRUE 

ベンチマーク

big.x <- rep(x, 1e3) 
big.y <- rep(y, 100) 

all.equal(select_in(big.x, big.y), big.x %~% big.y) 
[1] TRUE 

library(microbenchmark) 
microbenchmark(
    baptiste = select_in(big.x, big.y), 
    plafort2 = big.x %~% big.y, 
    times=50L) 
Unit: milliseconds 
    expr  min  lq  mean median  uq  max 
baptiste 185.86828 199.57517 231.28246 244.81980 261.7451 271.3426 
plafort2 49.03265 54.30729 84.88076 66.10971 118.3270 123.1074 
neval cld 
    50 b 
    50 a 

Answer 3

避ける別の考え方length(x) * length(ref)検索：

ff = function(x, ref, tol = 1e-10) 
{ 
    sref = sort(ref) 
    i = findInterval(x, sref, all.inside = TRUE) 
    dif1 = abs(x - sref[i]) 
    dif2 = abs(x - sref[i + 1]) 
    dif = dif1 > dif2 
    dif1[dif] = dif2[dif] 
    dif1 <= tol 
} 
ff(c(1.0, 1+1e-13, 1.01, 2, 2+1e-9, 2-1e-11), c(1, 2, 3)) 
#[1] TRUE TRUE FALSE TRUE FALSE TRUE 

と比較する：

set.seed(911) 
X = sample(1e2, 5e5, TRUE) + (sample(c(1e-8, 1e-9, 1e-10, 1e-12, 1e-13), 5e5, TRUE) * sample(c(-1, 1), 5e5, TRUE)) 
REF = as.double(1:1e2) 

all.equal(ff(X, REF), select_in(X, REF)) 
#[1] TRUE 
tol = 1e-10 #set this for Pierre's function 
microbenchmark::microbenchmark(select_in(X, REF), fselect_in(X, REF), X %~% REF, ff(X, REF), { round(X, 10); round(REF, 10) }, times = 35) 
#Unit: milliseconds 
#         expr  min   lq  median   uq  max neval 
#      select_in(X, REF) 1259.95876 1324.52371 1380.10492 1428.78677 1495.61810 35 
#      fselect_in(X, REF) 121.47241 123.72678 125.28932 128.56770 142.15676 35 
#        X %~% REF 2023.78159 2088.97226 2161.66973 2219.46164 2547.89849 35 
#        ff(X, REF) 67.35003 69.39804 71.20871 73.22626 94.04477 35 
# {  round(X, 10)  round(REF, 10) } 96.20344 96.88344 99.10093 102.66328 117.75189 35 

フランクのmatchがfindIntervalよりも速く、そして確かに、roundで過ごしたほとんどの時間を持つ必要があります。