Редактирование массива для обеспечения строго возрастающих значений

Рассмотрим отсортированный вектор 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 ", чтобы гарантировать, что никакие два значения в 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.

Ответ 1

Я сомневаюсь, что это возможно без итерации, потому что смещение некоторых точек от ближайших соседей слишком близко может привести к тому, что перемещенные точки будут ближе к другим соседям. Вот одно решение, которое только изменяет те значения, которые необходимы для достижения решения, и перемещает их на минимальное расстояние, чтобы обеспечить минимальный разрыв эпсилона.

Он использует функцию, которая назначает силу каждой точке в зависимости от того, нужно ли ее перемещать от ближайшего соседа. Направление (знак) силы указывает, нужно ли нам увеличивать или уменьшать значение этой точки. Точки, которые зажаты между соседними соседями, не двигаются, но их внешние соседи отодвигаются от центральной точки (это поведение позволяет как можно меньше как можно меньше). Сила, назначенная конечным точкам, всегда равна нулю, потому что мы не хотим, чтобы общий диапазон х изменялся

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)
}

Далее, нам нужна функция для переключения точек, в зависимости от силы, действующей на них. Положительные силы заставляют их двигаться на эпсилон выше, чем предыдущая точка. Отрицательные силы сдвигают их вниз.

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

Ответ 2

Это был интересный вызов, и я думаю, что я разработал решение. Это немного уродливое и запутанное и может сделать с некоторой рационализацией, но, похоже, возвращает то, о чем просил Реми.

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

EDIT: я включил его в простую функцию. tr устанавливает пороговое значение для того, что считается близким, в десятичных точках.

Ответ 3

Предполагая, что значения отсортированы в порядке возрастания, проще всего сделать это с помощью двух for-loops. Первый для цикла наблюдает за каждым числом, а второй (внутренний) для цикла сравнивается со всеми числами перед каждым номером. Если ApproxEqual истинно, во внутреннем for-loop добавляется 1e-5 к значению, проанализированному внешним циклом.

Здесь код, который выполняет трюк:

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

Ответ 4

Не всегда возможно изменить значения переменных, чтобы гарантировать, что два значения не будут приблизительно равны и все еще ограничены между min и max без изменения min или max. E. g. min=0, max=epsilon/2.
Вы можете итеративно находить ближайших соседей и изменять их значения (при необходимости и, если возможно), чтобы сделать их примерно одинаковыми. Алгоритмы поиска ближайших соседей хорошо известны. https://en.wikipedia.org/wiki/Nearest_neighbor_search