Оптимизация справедливости округления в R

Question

У меня есть проблема, которая проста в формулировке и хотела бы знать, есть ли интеллектуальное решение, а не грубое вычисление.

Учитывая следующий вектор A <- c(30,20,150,50,30,70) который суммирует до 350, мне нужно распределить (добавить) Всего 5 дополнительных блоков к элементам, в результате чего получает сумму 355.

Я ограничивается только к целочисленной корректировке. Я хочу распределить эти 5 единиц, чтобы свести к минимуму максимальное процентное изменение элемента после корректировки. Я хочу, чтобы корректировки каждого элемента были «справедливыми» в этом смысле. Например, добавление вектора

c(0,0,3,0,0,2) дает "новый" A (A.New) от: 30 20 153 50 30 72

Процентное изменение в каждом элементе (идущей от А до A.New) является : 0,000000 0,000000 2,000000 0,000000 0,000000 2,857143 с максимальным изменением 2.857143

оценки снова с регулировкой c(0,0,4,0,0,1) дает A.New 30 20 154 50 30 71
и процент изменения 0.000000 0.000000 2.666667 0.000000 0.000000 1.428571
с максимальным процентное изменение 2.666667

Поэтому c(0,0,4,0,0,1) было бы предпочтительным (но не оптимальными.)

Корректировка c(0,0,3,1,0,1) дает минимум максимального процентного изменения элементы, 2.000000. Это кажется оптимальным решением.

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

Я рассматриваю использование lpSolve в качестве потенциального решения, но объективная функция как «минимальная величина значений» проблематична.

Я мог бы создать собственный и, вероятно, сложный алгоритм для этого, но, возможно, я пропустил более простые способы приблизиться к этому?

(Обратите внимание, что в действительности, вектор корректируется может иметь много сотен элементов, потенциально.)

Answer 1

Вот подход, использующий матрицу увеличения в процентах. Я поместил его в функцию, берущую вектор «x» и количество целых чисел «N», которые вы хотите добавить (пояснения см. В комментариях).

Allocate_Int <- function (x,N) { # x is vector, N = Number of Integers 
    p <- 100/x # Percentage increase by 1 
    m <- p %o% c(1:N) # create a matrix of increased percentage 
    m1 <- m <= m[order(m)][N] # find the N-th lowest numbers in T/F matrix 
    return(rowSums(m1)) # and return the nr of TRUE values per item. 
    } 

И это работает на примере из вашего вопроса:

A <- c(30,20,150,50,30,70) 
Allocate_Int(A,5) 
[1] 0 0 3 1 0 1 

Если есть связи, возвращающийся вектор имеет многие значения:

Allocate_Int(c(1,1),3) 
[1] 2 2 

Если вы хотите найти связи, использование:

vec1 <- c(10,20,20,50,100) 
N <- 10 
Allocate_Int(vec1,N)-Allocate_Int(vec1,N-1) 
[1] 0 0 0 1 1