Question

我基本上是在寻找一种方法来在R.中做this Ruby script的变体我有一个任意数字列表（在这种情况下为回归图的主持人的步骤），它们彼此之间的距离不等，我想要围绕这些数值范围内的值进行舍入数字到列表中最近的数字。范围不重叠。

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的功能最快，比Tyler Rinker的第二个功能快5倍。

Answer 1

矢量化解决方案，没有任何apply族函数或循环：

密钥是findInterval，它在arbitrary.numbers中找到numbers中每个元素都在“之间”的“空格”。因此，findInterval(6,c(2,4,7,8))会返回2，因为6介于c(2,4,7,8)的第2和第3个索引之间。

# 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

Answer 2

使用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的一种方式。不需要绝对值，甚至从这篇文章的前一版本开始的平方也是不必要的。

感谢Interval search on a data frame指向findInterval处的指针，因为我在answer by 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最终成为最接近的数字。这是通过考虑每个间隔的两个端点来实现的。从本质上讲，这与version by nograpes非常相似，但它避免使用ifelse和NA，这样可以提高性能，因为它可以减少分支指令的数量。

Answer 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

Answer 4

请注意，由于舍入错误（最有可能），我使用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 )

Answer 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

Answer 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

编辑：我在功能结束时删除了回复电话，因为它没有必要，并且可以燃烧时间。

编辑：我认为这里的循环会更快：

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
}

从列表舍入到最接近的任意数字

不同的答案为速度计时（百万数字）

6 个答案: