[R] Non linear optimization with nloptr package fail to produce true optimal result
J C Nash
pro|jcn@@h @end|ng |rom gm@||@com
Fri Dec 13 20:42:51 CET 2024
Setting penalty scales si, se at 1e+4 gets results somewhat near the alabama results.
The problem seems quite sensitive to the constraint.
JN
-------- Forwarded Message --------
Subject: Re: [R] Non linear optimization with nloptr package fail to produce true optimal result
Date: Fri, 13 Dec 2024 14:30:03 -0500
From: J C Nash <profjcnash using gmail.com>
To: r-help using r-project.org
The following may or may not be relevant, but definitely getting somewhat different results.
As this was a quick and dirty try while having a snack, it may have bugs.
# Lobo2412.R -- from R Help 20241213
#Original artificial data
library(optimx)
library(nloptr)
library(alabama)
set.seed(1)
A <- 1.34
B <- 0.5673
C <- 6.356
D <- -1.234
x <- seq(0.5, 20, length.out = 500)
y <- A + B * x + C * x^2 + D * log(x) + runif(500, 0, 3)
#Objective function
X <- cbind(1, x, x^2, log(x))
flobo <- function(theta) {
sum(abs(X %*% theta - y))
}
#Constraint
eps <- 1e-4
hinlobo <- function(theta) {
abs(sum(X %*% theta) - sum(y)) - 1e-3 + eps # ?? weird! (1e-4 - 1e-3)
}
Hxlobo <- function(theta) {
X[100, , drop = FALSE] %*% theta - (120 - eps) # ditto -- also constant
}
conobj<-function(tt){
ob <- flobo(tt)
ci <- hinlobo(tt)
if (ci > 0) {ci <- 0}
ce <- Hxlobo(tt)
si<-1; se<-1
val<-ob+si*ci^2+se*ce^2
cat("f, ci, ce,ob,val:"," ",ci," ",ce," ",ob," ",val," at "); print(tt)
val
}
t0<-rep(0,4)
conobj(t0)
t1 <- c(2.02, 6.764, 6.186, -20.095)
conobj(t1)
t2 <- c( -0.2186159, -0.5032066, 6.4458823, -0.4125948)
conobj(t2)
solo<-optimr(t0, conobj, gr="grcentral", method="anms", control=list(trace=1))
solo
conobj(solo$par)
#Optimization with nloptr
# Sol = nloptr::auglag(t0, flobo, eval_g_ineq = hinlobo, eval_g_eq = Hxlobo, opts =
# list("algorithm" = "NLOPT_LN_COBYLA", "xtol_rel" = 1.0e-8, print_level=1))
# -0.2186159 -0.5032066 6.4458823 -0.4125948
sol <- auglag(par=t0, fn=flobo, hin=hinlobo, heq=Hxlobo, control.outer=list(trace=TRUE))
sol
#==================================
J Nash
On 2024-12-13 13:45, Duncan Murdoch wrote:
> You posted a version of this question on StackOverflow, and were given advice there that you ignored.
>
> nloptr() clearly indicates that it is quitting without reaching an optimum, but you are hiding that message. Don't do
> that.
>
> Duncan Murdoch
>
> On 2024-12-13 12:52 p.m., Daniel Lobo wrote:
>> library(nloptr)
>>
>> set.seed(1)
>> A <- 1.34
>> B <- 0.5673
>> C <- 6.356
>> D <- -1.234
>> x <- seq(0.5, 20, length.out = 500)
>> y <- A + B * x + C * x^2 + D * log(x) + runif(500, 0, 3)
>>
>> #Objective function
>>
>> X <- cbind(1, x, x^2, log(x))
>> f <- function(theta) {
>> sum(abs(X %*% theta - y))
>> }
>>
>> #Constraint
>>
>> eps <- 1e-4
>>
>> hin <- function(theta) {
>> abs(sum(X %*% theta) - sum(y)) - 1e-3 + eps
>> }
>>
>> Hx <- function(theta) {
>> X[100, , drop = FALSE] %*% theta - (120 - eps)
>> }
>>
>> #Optimization with nloptr
>>
>> Sol = nloptr(rep(0, 4), f, eval_g_ineq = hin, eval_g_eq = Hx, opts =
>> list("algorithm" = "NLOPT_LN_COBYLA", "xtol_rel" = 1.0e-8))$solution
>> # -0.2186159 -0.5032066 6.4458823 -0.4125948
>
> ______________________________________________
> R-help using r-project.org mailing list -- To UNSUBSCRIBE and more, see
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide https://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
More information about the R-help
mailing list