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

Question

考虑一个排序的 vector 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)具有完全相同的值(达到 float 的准确度)。其他一些条目差异很大，而另一些条目差异很小。我想考虑一个近似相等测试

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

，其中 epsilon可能是 1e-5例如。

目标

我想修改变量 x 的值“尽可能少”以确保 x 中没有两个值是“近似相等”和x仍然在 min 之间和 max .

我很高兴让您决定“尽可能少”的真正含义。例如，可以最小化原始 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

我怀疑在不迭代的情况下这是可能的，因为将一些点从太近的邻居中移开可能会导致移动的点聚集在更靠近其他邻居的地方。这是一种解决方案，它仅更改获得解决方案所需的那些值，并将它们移动尽可能小的距离，以确保 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) 传递给函数的 vector 长度 < 3

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

B) 传递的 vector 在边界处有多个值

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