GRG нелинейный R

Question

Я хочу преобразовать мою модель Excel Solver в модель в R. Мне нужно найти 3 набора координат, который минимизирует расстояние до 5 других заданных координат. Я сделал программу, которая вычисляет матрицу расстояний, которая выводит минимальное расстояние от каждого входа до заданных координат. Я хочу минимизировать эту функцию, изменив вход. То есть я хочу найти координаты такие, чтобы сумма минимальных расстояний была минимизирована. Я попробовал несколько способов сделать это, см. Код ниже (Да, моя матричная функция расстояния может быть несколько неуклюжей, но это потому, что мне пришлось уменьшить входную переменную до 1, чтобы запустить некоторые алгоритмы, такие как nloprt (в противном случае я получил бы предупреждения) Я также видел некоторые другие вопросы (такие как нелинейные наименьшие квадраты GRG (оптимизация)), но они не изменили / не улучшили решение.

# First half of p describes x coordinates, second half the y coordinates # yes thats cluncky
p<-c(2,4,6,5,3,2) # initial points

x_given <- c(2,2.5,4,4,5)
y_given <- c(9,5,7,1,2)

f <- function(Coordinates){ 

# Predining
Term_1                       <-     NULL
Term_2                       <-     NULL
x                            <-     NULL
Distance                     <-     NULL
min_prob                     <-     NULL
l                            <-     length(Coordinates)
l2                           <-     length(x_given)
half_length                  <-     l/2
s                            <-     l2*half_length
Distance_Matrix              <-     matrix(c(rep(1,s)), nrow=half_length)

# Creating the distance matrix
for (k in 1:half_length){
  for (i in 1:l2){
    Term_1[i]                <-     (Coordinates[k]-x_given[i])^2
    Term_2[i]                <-     (Coordinates[k+half_length]-y_given[i])^2
    Distance[i]              <-     sqrt(Term_1[i]+Term_2[i])
    Distance_Matrix[k,i]     <-     Distance[i]
  }
}
d                            <-     Distance_Matrix

# Find the minimum in each row, thats what we want to obtain ánd minimize
for (l in 1:nrow(d)){
  min_prob[l] <- min(d[l,])
}
som<-sum(min_prob)
return(som)
}

# Minimise
sol<-optim(p,f)
x<-sol$par[1:3]
y<-sol$par[4:6]
plot(x_given,y_given)
points(x,y,pch=19)

Решение, однако, явно не такое оптимальное. Я пытался использовать функцию nloptr, но я не уверен, какой алгоритм использовать. Какой алгоритм я могу использовать или я могу использовать / запрограммировать другую функцию, которая решает эту проблему? Заранее спасибо (и извините за подробный длинный вопрос)

Answer 1

Посмотрите на вывод optim, Он достиг предела итерации и еще не сходился.

> optim(p, f)
$`par`
[1] 2.501441 5.002441 5.003209 5.001237 1.995857 2.000265

$value
[1] 0.009927249

$counts
function gradient 
     501       NA 

$convergence
[1] 1

$message
NULL

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

> optim(p, f, control = list(maxit = 1000))
$`par`
[1] 2.502806 4.999866 5.000000 5.003009 1.999112 2.000000

$value
[1] 0.005012449

$counts
function gradient 
     755       NA 

$convergence
[1] 0

$message
NULL