Question

我正在使用R中的nls求解器来计算系数。我难以实现一种优化过程，以使系数正确地适应不等式约束。

目标是

最小化拟合曲线的残差
函数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

用不等式约束优化nls结果

0 个答案: