编辑数组以确保严格增加值

Question

考虑一个排序向量 x，它位于 min 和 max 之间。下面是这样的 x 的示例，其中 min 可以是 0 而 max 可以是 12:

x = c(0.012, 1, exp(1), exp(1)+1e-55, exp(1)+1e-10,
       exp(1)+1e-3, 3.3, 3.33333, 3.333333333333333, 3+1/3, 5, 5, 10, 12)

5 和 5 以及 exp(1) 和 exp(1)+10^(-55) 具有完全相同的值（达到浮点数的精度级别）。其他一些条目差异很大，而另一些条目差异很小。我想考虑等式测试的近似值

ApproxEqual = function(a,b) abs(a-b) < epsilon

，例如 epsilon 可以是 1e-5。

目标

我想修改变量 x 的值 "as little as possible" 以确保 x 中没有两个值是 "approximatively equal" 和 x仍然在 min 和 max 之间。

我很高兴让您决定 "as little as possible" 的真正含义。例如，可以最小化原始 x 和预期变量输出之间的平方差之和。

示例 1

x_input = c(5, 5.1, 5.1, 5.1, 5.2)
min=1
max=100

x_output = c(5, 5.1-epsilon, 5.1, 5.1+epsilon, 5.2)

示例 2

x_input = c(2,2,2,3,3)
min=2
max=3

x_output = c(2, 2+epsilon, 2+2*epsilon, 2+3*epsilon, 3-epsilon,3)

当然，在上面的例子中，如果(3-epsilon) - (2+3*epsilon) < epsilon是TRUE，那么函数应该抛出一个错误，因为这个问题没有解决方案。

旁注

如果解决方案非常高效，我会很高兴。例如，答案可以使用 Rcpp。

Answer 1

假设值按升序排序，使用两个 for 循环似乎最容易做到这一点。第一个 for 循环观察每个数字，第二个（内部）for 循环与每个数字之前的所有数字进行比较。如果 ApproxEqual 为真，则在内部 for 循环中将 1e-5 添加到外部 for 循环解析的值。

下面是解决问题的代码：

x = c(5, 5.1, 5.1, 5.1, 5.2)

epsilon <-1e-5
ApproxEqual = function(a,b) abs(a-b) < epsilon

for (i in 1:length(x)){
  if (i>1){
    for (j in 1:(i-1)){
      if (ApproxEqual(x[i],x[j])){
        x[i]=x[i]+epsilon
      }
    }
  }
}

print(x)

这给出了

> print(x)
[1] 5.00000 5.10000 5.10001 5.10002 5.20000

Answer 2

这是一个有趣的挑战，我想我已经找到了解决方案。它有点丑陋和复杂，可以做一些精简，但它似乎 return Remi 所要求的。

library(magrittr)

xin <- c(0.012, 1, exp(1), exp(1)+10^(-55), exp(1)+10^(-10),
    exp(1)+10^(-3), 3.3, 3.33333, 3.333333333333333, 3+1/3, 5, 5, 10, 12)

tiebreaker <- function(x, t=3) {
    dif <- diff(x) %>% round(t)
    x[dif==0] <- x[dif==0] + 
        seq(-10^-t, -10^-(t+0.99), 
        length.out=length(x[dif==0])) %>% sort
    x
}

xout <- tiebreaker(xin)

diff(xin) > 0.0001
# TRUE TRUE FALSE FALSE TRUE TRUE TRUE FALSE FALSE TRUE FALSE TRUE TRUE

diff(xout) > 0.0001  #it makes close matches less close
# TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE

xin == xout  #but leaves already less close matches as they were
# TRUE TRUE FALSE FALSE TRUE TRUE TRUE FALSE FALSE TRUE FALSE TRUE TRUE TRUE

编辑：我把它包装成一个简单的函数。 tr 设置接近匹配的阈值（以小数点表示）。

Answer 3

我怀疑如果不进行迭代这是可能的，因为将一些点从太近的邻居移开可能会导致移动的点聚集到更靠近其他邻居的地方。这是一个解决方案，它只更改到达解决方案所需的那些值，并将它们移动尽可能小的距离以确保最小间隙 epsilon。

它使用一个函数为每个点分配一个力，这取决于我们是否需要将它移离太近的邻居。力的方向（符号）表示我们是否需要增加或减少该点的值。夹在其他太近邻居之间的点不会移动，但它们的外部邻居都会远离中心点（这种行为是尽可能少地移动尽可能少的点）。分配给端点的力始终为零，因为我们不希望 x 的整体范围发生变化

force <- function(x, epsilon){
 c(0, sapply(2:(length(x)-1), function(i){ (x[i] < (x[i-1]+epsilon)) - (x[i] > (x[i+1]-epsilon)) }), 0)
}

接下来，我们需要一个函数来移动点，具体取决于作用在点上的力。正力使它们移动到比前一点更高的 epsilon。负面力量使他们向下移动。

move <- function(x, epsilon, f){
  x[which(f==-1)] <- x[which(f==-1)+1] - epsilon 
  x[which(f==1)]  <- x[which(f==1)-1] + epsilon
  # Next line deals with boundary condition, and prevents points from bunching up at the edges of the range
  # I doubt this is necessary, but included out of abundance of caution. Could try deleting this line if performance is an issue.
  x <- sapply(1:(length(x)), function(i){x[i] <- max(x[i], head(x,1)+(i-1)*epsilon); x[i] <- min(x[i], tail(x,1)-(length(x)-i)*epsilon)})
  x
}

最后，函数separate用于迭代计算力和移动点，直到找到解决方案。它还会在迭代之前检查一些边缘情况。

separate <- function(x,epsilon) {
  if (epsilon > (range(x)[2] - range(x)[1]) / (length(x) - 1)) stop("no solution possible")
  if (!(all(diff(x)>=0))) stop ("vector must be sorted, ascending")

  initial.x <- x
  solved <- FALSE

  ##################################
  # A couple of edge cases to catch
  ##################################
  # 1. catch cases when vector length < 3 (nothing to do, as there are no points to move)
  if (length(x)<3) solved <- TRUE
  # 2. catch cases where initial vector has values too close to the boundaries 
  x <- sapply(1:(length(x)), function(i){
    x[i] <- max(x[i], head(x,1)+(i-1)*epsilon)
    x[i] <- min(x[i], tail(x,1)-(length(x)-i)*epsilon)
  })

  # Now iterate to find solution
  it <- 0
  while (!solved) {
    it <-  it+1
    f <- force(x, epsilon)
    if (sum(abs(f)) == 0) solved <- TRUE
    else x <- move(x, epsilon, f)
  }
  list(xhat=x, iterations=it, SSR=sum(abs(x-initial.x)^2))
}

在 OP 提供的示例上对此进行测试：

x = c(0.012, 1, exp(1), exp(1)+1e-55, exp(1)+1e-10, exp(1)+1e-3, 3.3, 3.33333, 3.333333333333333, 3+1/3, 5, 5, 10, 12)
epsilon <- 1e-5

separate(x, epsilon)
# $xhat
# [1]  0.012000  1.000000  2.718272  2.718282  2.718292  2.719282  3.300000  3.333323  3.333333  3.333343
# [11]  4.999990  5.000000 10.000000 12.000000
#
# $iterations
# [1] 2
#
# $SSR
# [1] 4.444424e-10

编辑 1

函数 separate 添加了一些行以响应评论以捕获一些边缘情况 -

A) 传递给函数的向量长度 < 3

separate(c(0,1), 1e-5)
# $xhat
# [1] 0 1
# 
# $iterations
# [1] 0
# 
# $SSR
# [1] 0

B) 其中传递的向量在边界处有多个值

separate(c(0,0,0,1), 1e-5)
# [1] "it = 1, SSR = 5e-10"
# $xhat
# [1] 0e+00 1e-05 2e-05 1e+00
# 
# $iterations
# [1] 1
#
# $SSR
# [1] 5e-10

Answer 4

在不修改最小值或最大值的情况下，并不总是可以修改变量的值来确保没有两个值近似相等并且仍然在最小值和最大值之间。例如min=0, max=epsilon/2.
您可能会反复查找最近的邻居并更改它们的值（如果需要且可能的话）以使它们不近似相等。搜索最近邻居的算法是众所周知的。 https://en.wikipedia.org/wiki/Nearest_neighbor_search

编辑数组以确保严格增加值

Editing array to ensure strictly increasing values

c

c++

optimization

r

rcpp