От округленного до ближайшего произвольного числа из списка

В основном я ищу способ сделать вариант этого Ruby script в R.
У меня есть произвольный список чисел (шаги модератора для графика регрессии в этом случае), которые имеют неравные расстояния друг от друга, и я хотел бы округлять значения, которые находятся в пределах диапазона вокруг этих номера до ближайшего номера в списке. Диапазоны не перекрываются.

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

У меня есть небольшая вспомогательная функция, которая может сделать для моей конкретной проблемы, но она не очень гибкая и содержит цикл. Я могу опубликовать его здесь, но я думаю, что реальное решение будет выглядеть совершенно иначе.

Различные ответы, рассчитанные на скорость (на миллион номеров)

> 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 является самой быстрой, примерно в 5 раз быстрее, чем вторая функция Тайлера Ринкера.

Ответ 1

Еще одно решение, использующее 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. Поэтому за один раз мы находим наибольшее произвольное число, которое находится либо в диапазоне привязки для заданного входного числа, либо слишком мало для этого. По этой причине нам нужно всего лишь проверить один способ для snap. Абсолютное значение не требуется, и даже квадрат из предыдущей ревизии этого сообщения был ненужным.

Благодаря Интервальный поиск в кадре данных для указателя в findInterval, так как я нашел его там, прежде чем распознать его в ответ на nograpes.

Если, в отличие от вашего первоначального вопроса, у вас были перекрывающиеся диапазоны, вы могли бы написать такие вещи:

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 действительно заканчивается как ближайшее число. Это достигается за счет рассмотрения обеих конечных точек каждого интервала. По духу это очень похоже на версию с помощью nocses, но он избегает использования ifelse и NA, что должно принести пользу производительности, поскольку оно уменьшает количество ветвлений инструкции.

Ответ 2

Векторное решение без каких-либо apply семейных функций или циклов:

Ключ findInterval, который находит "пробел" в arbitrary.numbers, где каждый элемент в numbers находится "между". Итак, findInterval(6,c(2,4,7,8)) возвращает 2, потому что 6 находится между 2-м и 3-м индексами c(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

Ответ 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

Ответ 4

Обратите внимание, что из-за ошибок округления (скорее всего) я использую диапазон = 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 )

Ответ 5

Это еще меньше:

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

Спасибо @MvG

Ответ 6

Другая опция:

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

EDIT: я удалил обратный вызов в конце функции, так как он не нужен, и может записывать время.

EDIT: Я думаю, что цикл будет еще быстрее:

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
}