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 <profjcn...@gmail.com>
To: r-help@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@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.
______________________________________________
R-help@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.
