我正在尝试使用nloptr包优化R中的一个函数。这是代码：
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)
在运行此代码时，我得到以下错误：
nloptr中的错误(x0=x0，eval_f=eval_f，eval__g_ineq=eval_g_ineq，eval_g_q=eval__g_eq，：STRING_ELT((只能应用于"字符向量"，而不能应用于"NULL"呼叫：。。。使用CallingHandlers->带有可见->eval->eval->nlotr执行已停止
奇怪的是，如果我在opts中使用"algorithm"="NLOPT_LN_COBYLA"，并在nloptr调用中删除相等约束eval_g_eq，它运行良好，我得到了一个解决方案。然而，我的工作需要平等的约束。
我应该如何解决问题？
这仍然是一个猜测，但是：我能想到的唯一可能性是，在为全局解决方案使用无导数优化器的同时，为本地优化器使用基于导数的优化器(即，NLopt文档澄清了NLOPT_LN_AUGLAG中的LN表示"本地，无导数"，而_LD_表示"本地、基于导数"(是造成问题的原因吗？我通过使用"；NLOT_ LN_；与local_opts中的算法一样：与代码中的其他一切一样，
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 ))
返回
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
据我所见，这已经完成了一个合理的解决方案，尊重限制：
- 停止的原因("达到ftol_rel或ftol_abs…"(是合理的
- 它使用了合理数量(102(的迭代来达到目的(而不是
maxeval( eval_g_eq(res$solution)确实给出了0(我们也可以通过检查看到，因为条件是x[1]+x[2]-1==0(- 不等式条件为
-x1-x2和x1+x2-1；我不确定这些不等式的符号是如何定义/确定的？与x0相同，即假设初始条件可行？(如果x1+x2被约束为等于1，我不确定为什么这里的不等式约束可以做任何事情？( - CCD_ 16比CCD_ 17大得多