考虑一个排序 vector x,它的边界在 min 和 max 之间。下面是这样的 x 的示例,其中 min 可能是 0 和 max 可能是 0x2518122413: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)12 和 5 以及 5 和 exp(1) 具有完全相同的值(达到浮点数的精度水平)。其他一些条目差异很大,而另一些条目仅相差很小。我想考虑对等式测试的近似ApproxEqual = function(a,b) abs(a-b) < epsilon,例如,exp(1)+10^(-55) 可以是 epsilon。 目标 我想“尽可能少地”修改变量 1e-5 的值,以确保 x 中没有两个值“近似相等”,并且 x 仍然在 0x223131 和 0x2313131 之间有界。我很高兴让您决定“尽可能少”的真正含义。例如,可以最小化原始 x 和预期变量输出之间的平方偏差总和。 示例 1 x_input = c(5, 5.1, 5.1, 5.1, 5.2)min=1max=100x_output = c(5, 5.1-epsilon, 5.1, 5.1+epsilon, 5.2) 示例 2 x_input = c(2,2,2,3,3)min=2max=3x_output = c(2, 2+epsilon, 2+2*epsilon, 2+3*epsilon, 3-epsilon,3)当然,在上面的情况下,如果 min 是 max ,那么该函数应该会抛出错误,因为问题没有解决方案。 旁注 如果解决方案非常高效,我会很高兴。例如,答案可以使用 x。 最佳答案 我怀疑这在不迭代的情况下是可能的,因为将一些点从太近的邻居移开可能会导致移动的点与其他邻居聚集在一起。这是一种解决方案,它只更改那些需要达到解决方案的值,并将它们移动到尽可能小的距离以确保 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-5separate(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 长度 separate(c(0,1), 1e-5)# $xhat# [1] 0 1## $iterations# [1] 0## $SSR# [1] 0B)其中传递的 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关于c++ - 编辑数组以确保严格递增值,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/37534412/
10-12 17:11