Оптимизировать результат nls с ограничением неравенства - PullRequest
Новая
       14

Оптимизировать результат nls с ограничением неравенства

0 голосов
/ 14 мая 2019

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

Цель

  • свести к минимуму остатки подобранной кривой
  • Выход функции innerSolve при заданном значении mySetpoints[1] = 100 равен или меньше mySetpoints[2] = 8,2e-05. 
library(tidyverse)
library(plotly)
library(NlcOptim)
library(Rsolnp)

## define set curve function ----
outerSolve <- function(x, a1, a2, a3){

  a1 * (1 - innerSolve(x, a2, a3) * (x - 1))

}

# part of the curve function
innerSolve <- function(x, a2, a3){

  a2 * x ^ a3

}

# define set coefficents
setCoef <- c(80, 0.0002, -0.18)

# define setpoints
mySetpoints <- c(100, 0.000082)

# create sample curve with some noise
myDF <- (function(){
  # define x
  x = seq(50, 800, 5)
  set.seed(123)
  tibble(x = x,
         y = outerSolve(x, setCoef[1], setCoef[2], setCoef[3]) +
             rnorm(length(x), 0, 0.02)
  )


})()

# start values for target coefficents
startCoef <- c(max(myDF$y), 0.0001, -0.1)

# data list with results of nls
myModel <-  nls(
  y ~ outerSolve(x, find.a1, find.a2, find.a3),
  data = myDF,
  start = c(
    find.a1 = startCoef[1],
    find.a2 = startCoef[2],
    find.a3 = startCoef[3]
  ),
  trace = TRUE,
  control = nls.control(maxiter = 100)
)

При текущих коэффициентах выходной сигнал при заданном значении равен 

innerSolve(mySetpoints[1], coef(myModel)[2], coef(myModel)[3])

     find.a2 
8.679169e-05

Есть идеи, как к этому подойти?

Редактировать

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

# minimize this function
minFunction <- function(giveCoef){

  myDF %>%
    mutate(predicted.y = outerSolve(x, giveCoef[1], giveCoef[2], giveCoef[3]),
      squaredRes = (y - predicted.y) ^ 2
      ) %>%
    summarise(sum.squaredRes = sum(squaredRes)) %>%
    pull(sum.squaredRes)


}

# consider this non linear inequality constrain
constrainFunction = function(x){

  mySetpoints[2] - innerSolve(mySetpoints[1], a2 = x[2], a3 = x[3])

}

# save optimized coefficients
optimResult <- solnp(startCoef, minFunction, ineqfun = constrainFunction, 
      ineqUB = 100, ineqLB = 0,
      LB = c(0, 0, -1), UB = c(150, 1, 0))$par

innerSolve(mySetpoints[1], optimResult[2], optimResult[3])

Таким образом, вывод функции innerSolve на заданном значении в порядке (6.811625e-05), но коэффициенты 2 и 3 действительно далеки от массива setCoef. 

optimResult
[1]  7.980713e+01  9.741321e-05 -7.768357e-02

Редактировать 2 С пакетом NlcOptim и равными ограничениями я получаю довольно хорошие результаты. 

# constraint function for NlcOptim package
confun1 = function(x){

  f <- mySetpoints[2] - x[2] * mySetpoints[1] ^ x[3]
  return(list(ceq = f, c = NULL))

}
# save optimized coefficients
optimResult1 <- solnl(X = startCoef, objfun = minFunction, confun = confun1)$par

# output
innerSolve(mySetpoints[1], optimResult1[2], optimResult1[3])
[1] 8.200001e-05

optimResult1
             [,1]
[1,] 80.005610025
[2,]  0.000154733
[3,] -0.137884531
...