在 nloptr 中使用“算法”=“NLOPT_LN_AUGLAG”时出现 STRING_ELT 错误

Question

I am trying to optimize a function in R using the nloptr package. Here is the code:

library('nloptr')

hn <- function(x, n)
{
    hret <- 0
    if (n == 0)
    {
        hret <- 1
        return (hret)
    }
    else if (n == 1)
    {
        hret <- 2*x
        return (hret)
    }
    else
    {
        
        hn2 <- 1
        hn1 <- 2*x
        all_n <- seq(from = 2, to = n, by = 1)
        for (ni in all_n)
        {
            
            hn = (2*x*hn1/sqrt(ni)) + (2*sqrt( (ni-1)/ni)*hn2)
            #print(hn)
            hn2 = hn1
            hn1 = hn
        }
        hret <- hn
        return (hret)
    }
}

term <- function(alpha, r, theta, n)
{
    beta = alpha*cosh(r) - Conj(alpha)*exp(1i*theta)*(sinh(r))
    
    
    
    hnterm <- beta/(sqrt(exp(1i*theta)*sinh(2*r)))
    term4 <- hn(hnterm, n)
    
    logterm1 <- (1/2)*log(cosh(r))
    logterm2 <- -((1/2)*(abs(alpha)^2)) + ((1/2)* (Conj(alpha)^2))*exp(1i*theta)*tanh(r)
    logterm3  <- (n/2)*( log (((1/2)*exp(1i*theta)*tanh(r)) ))
    logterm4 <- log ( term4)
    logA <- logterm1 + logterm2 + logterm3 + logterm4
    A <- exp(logA)
    
    
    retval <- c(A)
    
    return (A)
    
}


PESQ <- function(x, alpha)
{
    p0 <- x[1]
    p1 <- x[2]
    beta <- x[3]
    r <- x[4]
    theta <- x[5]
    
    N <- 30
    
    NI <- seq(from = 0, to = N, by = 1)
    
    elements <- rep(0+1i*0, length(NI))
    elements_abs_sqr <- rep(0, length(NI))
    pr <- rep(0, length(NI))
    total <- 0 + 1i*0
    for (n in NI)
    {
        w <-term(2*alpha + beta, r, theta, n)
        elements[n+1] <- w
        elements_abs_sqr[n+1] <-(abs(w)^2)
    }
    total <- sum(elements_abs_sqr)
    for (n in NI)
    {
        pr[n+1] <- Re(elements[n+1]/sqrt(total))
        pr[n+1] <- pr[n+1]^2
        
    }
    p_off_given_on <- pr[1]
    
    elements <- rep(0+1i*0, length(NI))
    elements_abs_sqr <- rep(0, length(NI))
    pr <- rep(0, length(NI))
    total <- 0 + 1i*0
    for (n in NI)
    {
        w <-term(beta, r, theta, n)
        elements[n+1] <- w
        elements_abs_sqr[n+1] <-(abs(w)^2)
    }
    total <- sum(elements_abs_sqr)
    for (n in NI)
    {
        pr[n+1] <- Re(elements[n+1]/sqrt(total))
        pr[n+1] <- pr[n+1]^2
        
    }
    
    p_on_given_off = 1 - pr[1]
    
    P_e = p0*p_off_given_on + p1*p_on_given_off
    
    return(P_e)
}

eval_g_eq <- function(x)
{
    return ( x[1] + x[2] - 1)
}

lb <- c(0, 0, -Inf, 0.001, -pi)
ub <- c(1, 1, Inf, Inf, pi)

local_opts <- list("algorithm" = "NLOPT_LD_MMA", 
                   "xtol_rel"=1.0e-18)

# Set optimization options.
opts <- list("algorithm" = "NLOPT_LN_AUGLAG",
             "xtol_rel" = 1.0e-18, "local_opts" = local_opts, "maxeval" = 10000)


x0 <- c(0.1,0.9, 0.1, 0.01, 0.7853982)


alpha <- 0.65

eval_g_ineq <- function(x)
{
    return (c (- x[1] - x[2], 
               x[1] + x[2] - 1)
    )
}

eval_f <- function(x)
{
    ret = PESQ(x, alpha)
    return(ret)
}

res <- nloptr ( x0 = x0, 
                eval_f = eval_f,
                eval_g_eq = eval_g_eq,
                eval_g_ineq = eval_g_ineq,
                lb = lb,
                ub = ub,
                opts = opts )
print(res)

Upon running this code, I get the following error:

Error in nloptr(x0 = x0, eval_f = eval_f, eval_g_ineq = eval_g_ineq, eval_g_eq = eval_g_eq, : STRING_ELT() can only be applied to a 'character vector', not a 'NULL' Calls: ... withCallingHandlers -> withVisible -> eval -> eval -> nloptr Execution halted

The weird thing, if I use "algorithm"="NLOPT_LN_COBYLA" in opts and I remove the equality constraint eval_g_eq in nloptr call, it runs fine and I get a solution. However, I need equality constraints for my work.

How should I fix the issue?

Answer 1

This is still a bit of a guess, but: the only possibility I can come up with is that using a derivative-based optimizer for your local optimizer at the same time as you use a derivative-free optimizer for the global solution (ie, the NLopt docs clarify that LN in NLOPT_LN_AUGLAG denotes "local, derivative-free" whereas _LD_ would denote "local, derivative-based") is causing the problem? I got an answer (not sure if it's correct though!) by using "NLOPT_LN_COBYLA" as the algorithm in local_opts : with everything else as in your code,

local_opts <- list("algorithm" = "NLOPT_LN_COBYLA", 
                   "xtol_rel"=1.0e-18)

# Set optimization options.
opts <- list("algorithm" = "NLOPT_LN_AUGLAG",
             "xtol_rel" = 1.0e-18, "local_opts" = local_opts, "maxeval" = 10000)

print(res <- nloptr ( x0 = x0, 
                eval_f = eval_f,
                eval_g_eq = eval_g_eq,
                eval_g_ineq = eval_g_ineq,
                lb = lb,
                ub = ub,
               opts = opts ))

Returns

Call:

nloptr(x0 = x0, eval_f = eval_f, lb = lb, ub = ub, eval_g_ineq = eval_g_ineq, 
    eval_g_eq = eval_g_eq, opts = opts)


Minimization using NLopt version 2.4.2 

NLopt solver status: 3 ( NLOPT_FTOL_REACHED: Optimization stopped because 
ftol_rel or ftol_abs (above) was reached. )

Number of Iterations....: 102 
Termination conditions:  xtol_rel: 1e-18    maxeval: 10000 
Number of inequality constraints:  2 
Number of equality constraints:    1 
Optimal value of objective function:  2.13836819774604e-05 
Optimal value of controls: 0 1 -0.0003556752 0.006520304 2.037835

As far as I can see this has done a plausible solution respecting the constraints:

• the reason for stopping ("ftol_rel or ftol_abs... was reached") is sensible
• it used a reasonable number (102) of iterations to get there (and not maxeval )
• eval_g_eq(res$solution) does give 0 (which we can also see by inspection, as the condition is x[1]+x[2]-1==0 ).
• The inequality conditions are -x1-x2 and x1+x2-1 ; I'm not sure how the sign of these inequalities is defined/determined? The same as x0 , ie assuming the initial conditions are feasible? (If x1+x2 is constrained to equal 1, I'm not sure why the inequality constraints here can ever do anything?)
• eval_f(x0) is considerably larger than eval_f(res$solution) ...