[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