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＆＃34;的值＆＃34;确保x中没有两个值＆＃34;近似相等＆＃34;并且x仍然位于min和max之间。

我很高兴让你尽可能少地决定什么＆＃34;＆＃34;实际意思。例如，可以最小化原始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）传递给函数的向量的长度为＆lt; 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 2

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

public void updateDatabase(Context context, SQLiteDatabase database) {

    InputStream inputStream = context.getResources().openRawResource(R.raw.teamlist);
    try {
        BufferedReader buffer = new BufferedReader(new InputStreamReader(inputStream, "UTF-8"));
    } catch (UnsupportedEncodingException ioe) {
        Log.e("ERROR", "Could not load " + ioe);
    }

    String line = "";

    database.beginTransaction();
    try {
        while ((line = buffer.readLine()) != null) {
            // read each line from CSV file into a database

        }
    } catch (IOException ioe){
        Log.e("ERROR", "Could not load " + ioe);
    }
    database.setTransactionSuccessful();
    database.endTransaction();
}

编辑：我把它包装成一个简单的函数。

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

设置被认为是近似匹配的阈值，以小数点表示。

Answer 3

假设值按升序排序，使用两个for循环似乎最简单。第一个for循环观察每个数字，第二个（内部）for循环与每个数字之前的所有数字进行比较。如果ApproxEqual为true，则在内部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 4

并不总是可以修改变量的值以确保没有两个值大致相等且仍然在min和max之间限制而不修改min或max。 E. g。 min=0，max=epsilon/2。
您可以迭代地找到最近的邻居并更改它们的值（如果需要，如果可能的话）以使它们大致相等。用于搜索最近邻居的算法是众所周知的。 https://en.wikipedia.org/wiki/Nearest_neighbor_search

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

4 个答案: