R中的优化，对优化参数的和和类型有约束

Question

我在下面写了一个函数，我想优化

my_function = function(param, q, m){
out = sum(-param*q + param*m)
return(-out)
}

我能够运行函数并获得优化结果

> init = c(0,0,0)
> q = c(0.6, 0.14, 0.18)
> m = c(0, 2.5 , 4.2)
>
> nlminb(init, my_function, q=q, m=m, lower=c(0,0,0), upper=c(3,3,3))
$par
[1] 0 3 3
$objective
[1] -19.14
$convergence
[1] 0
$iterations
[1] 3
$evaluations
function gradient 
4        9 
$message
[1] "both X-convergence and relative convergence (5)"

我想引入以下约束，但我不确定如何做到这一点

• 输出参数应为非负整数
• 各参数之和为k

有人能告诉我如何才能做到这一点吗?

Answer 1

1)定义一个函数proj，对于任意输入向量x输出向量y满足sum(y) = k，则有如下:

注意，这是原始问题的松弛，我们没有应用整数约束;然而，如果松弛问题满足约束，那么它也一定是原始问题的解。

proj <- function(x, k = 3) k * x / sum(x)
obj <- function(x, ...) my_function(proj(x), ...)
out <- nlminb(c(1, 1, 1), obj, q = q, m = m, lower = 0)
str(out)
## List of 6
##  $ par        : num [1:3] 0 0 5.05
##  $ objective  : num -12.1
##  $ convergence: int 0
##  $ iterations : int 4
##  $ evaluations: Named int [1:2] 5 12
##   ..- attr(*, "names")= chr [1:2] "function" "gradient"
##  $ message    : chr "both X-convergence and relative convergence (5)"
proj(out$par) # solution
## [1] 0 0 3

2)另一种方法是使用整数规划。这一个显式地施加整数约束。

library(lpSolve)
res <- lp("min", q-m, t(rep(1, 3)), "=", 3, all.int = TRUE)
str(res)

给出如下(res$solution是解决方案)

List of 28
$ direction       : int 0
$ x.count         : int 3
$ objective       : num [1:3] 0.6 -2.36 -4.02
$ const.count     : int 1
$ constraints     : num [1:5, 1] 1 1 1 3 3
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:5] "" "" "" "const.dir.num" ...
.. ..$ : NULL
$ int.count       : int 3
$ int.vec         : int [1:3] 1 2 3
$ bin.count       : int 0
$ binary.vec      : int 0
$ num.bin.solns   : int 1
$ objval          : num -12.1
$ solution        : num [1:3] 0 0 3
$ presolve        : int 0
$ compute.sens    : int 0
$ sens.coef.from  : num 0
$ sens.coef.to    : num 0
$ duals           : num 0
$ duals.from      : num 0
$ duals.to        : num 0
$ scale           : int 196
$ use.dense       : int 0
$ dense.col       : int 0
$ dense.val       : num 0
$ dense.const.nrow: int 0
$ dense.ctr       : num 0
$ use.rw          : int 0
$ tmp             : chr "Nobody will ever look at this"
$ status          : int 0
- attr(*, "class")= chr "lp"

Answer 2

您可以尝试强力网格搜索:

my_function <- function(param, q, m){
out <- sum(-param*q + param*m)
-out
}
q <- c(0.6, 0.14, 0.18)
m <- c(0, 2.5 , 4.2)
library("NMOF")
ans <- gridSearch(fun = my_function,
lower = c(0, 0, 0),
upper = c(3, 3, 3),
n = 4,  ## 4 levels from lower to upper: 0,1,2,3
q = q, m = m)

答案是所有可能的组合及其目标函数值的列表:

ans
## $minfun
## [1] -19.14
## 
## $minlevels
## [1] 0 3 3
## 
## $values
##  [1]   0.00   0.60   1.20   1.80  -2.36  -1.76  -1.16  -0.56  -4.72  -4.12
## [11]  -3.52  -2.92  -7.08  -6.48  -5.88  -5.28  -4.02  -3.42  -2.82  -2.22
## [21]  -6.38  -5.78  -5.18  -4.58  -8.74  -8.14  -7.54  -6.94 -11.10 -10.50
## [31]  -9.90  -9.30  -8.04  -7.44  -6.84  -6.24 -10.40  -9.80  -9.20  -8.60
## [41] -12.76 -12.16 -11.56 -10.96 -15.12 -14.52 -13.92 -13.32 -12.06 -11.46
## [51] -10.86 -10.26 -14.42 -13.82 -13.22 -12.62 -16.78 -16.18 -15.58 -14.98
## [61] -19.14 -18.54 -17.94 -17.34
## 
## $levels
## $levels[[1]]
## [1] 0 0 0
## 
## $levels[[2]]
## [1] 1 0 0
## 
## $levels[[3]]
## [1] 2 0 0
## 
## .....
## 
## $levels[[64]]
## [1] 3 3 3

水平是非负整数，但它们的和是不受约束的。要添加求和约束，要么检查目标函数，并在特定解决方案违反约束时返回一个大值(即解决方案被标记为坏)。或过滤结果;例如，假设总和应为2:

valid <- sapply(ans$levels, sum) == 2
ans$values[valid]
## [1]  1.20 -1.76 -4.72 -3.42 -6.38 -8.04
ans$levels[valid]
## [[1]]
## [1] 2 0 0
## 
## [[2]]
## [1] 1 1 0
## 
## [[3]]
## [1] 0 2 0
## 
## [[4]]
## [1] 1 0 1
## 
## [[5]]
## [1] 0 1 1
## 
## [[6]]
## [1] 0 0 2

然后只保留最好的有效解。

best <- which.min(ans$values[valid])
ans$values[valid][best]
## [1] -8.04
ans$levels[valid][best]
## [[1]]
## [1] 0 0 2