具有约束的R二次多维优化

Question

我试着解决以下函数的二次优化问题：

b<-4.7e-09
a<-(-2e-05)
M<-100
beta<-0.5
min<-fuction(x){
    x1=x[1]
    x2=x[2]
    x3=x[3]
    E=a*x1+b*x1^2+a*x2+b*x2^2+a*x3+b*x3^2
    V=(M-x1)+(M-x1-x2)+(M-x1-x2-x3)
    return (E+beta*V)
}

约束是

x1+x2+x3=M
x1>=0,x2>=0,x3>=0

有没有办法可以使用constrOptim或solve.QP来解决这个问题？

不一定，但整体优化会更好。

我感谢任何评论。

Answer 1

[注意：在下文中，我调用您的函数f(...)以避免与内置R函数min(...)混淆。此外，我假设您的代码中的x2=x[3]是错误的，并且您想要x2=x[2]。]

首先，在你求助于数值优化之前，你应该做一些基本的数学运算。如果x _i ≥0且sum(x) = M，则x _i ≤M。因此，我们在具有边（0，M）的立方体中操作。此外，如果sum(x) = M那么我们实际上只有2个自变量（比如x ₁ 和x ₂ ）和x ₃ = M - （x ₁ + x ₂ ）。我们可以通过这种方式相对容易地确定最小值：

x    <- seq(0,M,len=101)
df   <- expand.grid(x=x,y=x)
df$f <- mapply(function(x,y) f(c(x,y,M-(x+y))),df$x,df$y)
df$f <- ifelse(df$x+df$y>M,NA,df$f)
df[which.min(df$f),]
#       x y         f
# 101 100 0 -0.001953

因此f的最小值出现在x ₁ = M，x ₂ = x ₃ = 0。

由于函数f(...)是一个曲面，我们可以用这个来确认，如下所示（如果可能的话，绘制函数总是一个好主意!!）。

library(reshape2)     # for dcast(...)
library(rgl)          # for surface3d(...), etc.
z       <- dcast(df,x~y,value.var="f")[-1]
zlim    <- range(z[!is.na(zz)])
palette <- rev(heat.colors(10))
col     <- palette[9*(df$f-zlim[1])/diff(zlim) + 1] 
surface3d(x,x,as.matrix(zz),color=col)
axes3d()
title3d(xlab="X",ylab="Y",zlab="Z")

因此表面看起来是一个平面，最小值确实在（100,0,0）。

最后，我们当然可以使用数值优化器（IMO对这个问题来说太过分了 - 除非这当然是家庭作业？）。这里我们使用同名包中的nloptr(...)。 f(...)是要最小化的函数，g(...)是表示为不等式的约束abs(sum(x)-M) <= 0。 lb是x下界的向量。您还可以使用eval_g_eq=...将约束指定为相等。阅读文档以获取更多详细信息。

f <-function(x){                   # objective function
  x1=x[1]
  x2=x[2]
  x3=x[3]
  E=a*x1+b*x1^2+a*x2+b*x2^2+a*x3+b*x3^2
  V=(M-x1)+(M-x1-x2)+(M-x1-x2-x3)
  return (E+beta*V)
}
g <- function(x) {abs(sum(x)-M)}   # constraint function

library(nloptr)
result <-nloptr(c(0,0,0), f, lb=c(0,0,0), eval_g_ineq=g,
                opts = list(algorithm="NLOPT_LN_COBYLA"))
result$solution
# [1] 1.000000e+02 4.440892e-16 4.835780e-16