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