15

私は基本的に、Rでこの Ruby スクリプトのバリエーションを実行する方法を探しています。互いに距離が等しくない数値 (この場合は回帰プロットのモデレーターのステップ) の
任意のリストがあります。これらの数値の範囲内にある値を、リスト内の最も近い数値に丸めます。範囲は重複しません。

arbitrary.numbers <- c(4,10,15) / 10
numbers <- c(16:1 / 10, 0.39, 1.45)
range <- 0.1

期待される出力:

numbers
## 1.6 1.5 1.4 1.3 1.2 1.1 1.0 0.9 0.8 0.7 0.6 0.5 0.4 0.3 0.2 0.1 0.39 1.45
round_to_nearest_neighbour_in_range(numbers,arbitrary.numbers,range)
## 1.5 1.5 1.5 1.3 1.2 1.0 1.0 1.0 0.8 0.7 0.6 0.4 0.4 0.4 0.2 0.1 0.4 1.5

特定の問題に対応できる小さなヘルパー関数がありますが、柔軟性が低く、ループが含まれています。ここに投稿できますが、実際のソリューションはまったく異なるように見えると思います。

速度に合わせたさまざまな回答 (100 万の数字)

> numbers = rep(numbers,length.out = 1000000)
> system.time({ mvg.round(numbers,arbitrary.numbers,range) })[3]
elapsed 
  0.067 
> system.time({ rinker.loop.round(numbers,arbitrary.numbers,range) })[3]
elapsed 
  0.289 
> system.time({ rinker.round(numbers,arbitrary.numbers,range) })[3]
elapsed 
  1.403 
> system.time({ nograpes.round(numbers,arbitrary.numbers,range) })[3]
elapsed 
  1.971 
> system.time({ january.round(numbers,arbitrary.numbers,range) })[3]
elapsed 
  16.12 
> system.time({ shariff.round(numbers,arbitrary.numbers,range) })[3]
elapsed 
15.833 
> system.time({ mplourde.round(numbers,arbitrary.numbers,range) })[3]
elapsed 
  9.613 
> system.time({ kohske.round(numbers,arbitrary.numbers,range) })[3]
elapsed 
 26.274

MvG の関数は最も高速で、Tyler Rinker の 2 番目の関数よりも約 5 倍高速です。

4

6 に答える 6

9

applyファミリ関数やループのないベクトル化されたソリューション:

キーはで、 の各要素が「間」findIntervalにある「スペース」を見つけます。が の 2 番目と 3 番目のインデックスの間にあるため、が返されます。arbitrary.numbersnumbersfindInterval(6,c(2,4,7,8))26c(2,4,7,8)

# arbitrary.numbers is assumed to be sorted.
# find the index of the number just below each number, and just above.
# So for 6 in c(2,4,7,8) we would find 2 and 3.
low<-findInterval(numbers,arbitrary.numbers) # find index of number just below
high<-low+1 # find the corresponding index just above.

# Find the actual absolute difference between the arbitrary number above and below.
# So for 6 in c(2,4,7,8) we would find 2 and 1. 
# (The absolute differences to 4 and 7).
low.diff<-numbers-arbitrary.numbers[ifelse(low==0,NA,low)]
high.diff<-arbitrary.numbers[ifelse(high==0,NA,high)]-numbers

# Find the minimum difference. 
# In the example we would find that 6 is closest to 7, 
# because the difference is 1.
mins<-pmin(low.diff,high.diff,na.rm=T) 
# For each number, pick the arbitrary number with the minimum difference.
# So for 6 pick out 7.
pick<-ifelse(!is.na(low.diff) & mins==low.diff,low,high)

# Compare the actual minimum difference to the range. 
ifelse(mins<=range+.Machine$double.eps,arbitrary.numbers[pick],numbers)
# [1] 1.5 1.5 1.5 1.3 1.2 1.0 1.0 1.0 0.8 0.7 0.6 0.4 0.4 0.4 0.2 0.1 0.4 1.5
于 2012-10-12T14:58:46.163 に答える
5

を使用したさらに別のソリューションfindInterval：

arbitrary.numbers<-sort(arbitrary.numbers)          # need them sorted
range <- range*1.000001                             # avoid rounding issues
nearest <- findInterval(numbers, arbitrary.numbers - range) # index of nearest
nearest <- c(-Inf, arbitrary.numbers)[nearest + 1]  # value of nearest
diff <- numbers - nearest                           # compute errors
snap <- diff <= range                               # only snap near numbers
numbers[snap] <- nearest[snap]                      # snap values to nearest
print(numbers)

上記nearestのコードの は、実際には数学的に最も近い数値ではありません。nearest[i] - range <= numbers[i]代わりに、 、または同等の のような最大の任意の数nearest[i] <= numbers[i] + rangeです。したがって、指定された入力数値のスナップ範囲内にあるか、またはスナップ範囲にはまだ小さすぎる最大の任意の数値を一度に見つけます。このため、チェックする必要があるのは の 1 つの方法だけですsnap。絶対値は必要ありません。また、この投稿の以前のリビジョンからの 2 乗も必要ありませんでした。

のポインターのデータフレームでの間隔検索のおかげで、 nograpes による回答findIntervalでそれを認識する前にそこに見つかりました。

元の質問とは対照的に、範囲が重複している場合は、次のように書くことができます。

arbitrary.numbers<-sort(arbitrary.numbers)        # need them sorted
range <- range*1.000001                           # avoid rounding issues
nearest <- findInterval(numbers, arbitrary.numbers) + 1 # index of interval
hi <- c(arbitrary.numbers, Inf)[nearest]          # next larger
nearest <- c(-Inf, arbitrary.numbers)[nearest]    # next smaller
takehi <- (hi - numbers) < (numbers - nearest)    # larger better than smaller
nearest[takehi] <- hi[takehi]                     # now nearest is really nearest
snap <- abs(nearest - numbers) <= range           # only snap near numbers
numbers[snap] <- nearest[snap]                    # snap values to nearest
print(numbers)

このコードでは、nearestが実際に最も近い数値になります。これは、すべての間隔の両方のエンドポイントを考慮することによって実現されます。精神的には、これはnograpes によるバージョンと非常によく似ていますが、 ifelseandの使用を避けていNAます。これにより、分岐命令の数が減るため、パフォーマンスが向上するはずです。

于 2012-10-12T16:44:49.293 に答える
3

これは、あなたの望むことですか？

> idx <- abs(outer(arbitrary.numbers, numbers, `-`)) <= (range+.Machine$double.eps)
> rounded <- arbitrary.numbers[apply(rbind(idx, colSums(idx) == 0), 2, which)]
> ifelse(is.na(rounded), numbers, rounded)
 [1] 1.5 1.5 1.5 1.3 1.2 1.0 1.0 1.0 0.8 0.7 0.6 0.4 0.4 0.4 0.2 0.1 0.4 1.5
于 2012-10-12T14:42:49.427 に答える
2

丸め誤差 (ほとんどの場合) のため、予想される効果を得るために range = 0.1000001 を使用することに注意してください。

range <- range + 0.0000001

blah <- rbind( numbers, sapply( numbers, function( x ) abs( x - arbitrary.numbers ) ) )
ff <- function( y ) { if( min( y[-1] ) <= range + 0.000001 ) arbitrary.numbers[ which.min( y[ -1 ] ) ] else  y[1]  }
apply( blah, 2, ff )
于 2012-10-12T14:43:12.150 に答える
2

これはさらに短いです:

sapply(numbers, function(x) ifelse(min(abs(arbitrary.numbers - x)) > 
range + .Machine$double.eps, x, arbitrary.numbers[which.min
(abs(arbitrary.numbers - x))] ))

ありがとう@MvG

于 2012-10-12T14:53:40.453 に答える
1

別のオプション：

arb.round <- function(numbers, arbitrary.numbers, range) {
    arrnd <- function(x, ns, r){ 
        ifelse(abs(x - ns) <= range +.00000001, ns, x)
    }
    lapply(1:length(arbitrary.numbers), function(i){
            numbers <<- arrnd(numbers, arbitrary.numbers[i], range)
        }
    )
    numbers
}

arb.round(numbers, arbitrary.numbers, range)

収量:

> arb.round(numbers, arbitrary.numbers, range)
[1] 1.5 1.5 1.5 1.3 1.2 1.0 1.0 1.0 0.8 0.7 0.6 0.4 0.4 0.4 0.2 0.1 0.4 1.5

編集:必要ではなく、時間を消費できるため、関数の最後にある return 呼び出しを削除しました。

編集:ここではループがさらに高速になると思います:

loop.round <- function(numbers, arbitrary.numbers, range) {
    arrnd <- function(x, ns, r){ 
        ifelse(abs(x - ns) <= range +.00000001, ns, x)
    }
    for(i in seq_along(arbitrary.numbers)){
            numbers <- arrnd(numbers, arbitrary.numbers[i], range)
    }
    numbers
}
于 2012-10-12T14:51:03.027 に答える