我在下面寫了一個我想優化的函式
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
有人可以告訴我如何實作這一目標嗎？
uj5u.com熱心網友回復：
您可以嘗試暴力網格搜索：
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
uj5u.com熱心網友回復：
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"
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/336866.html
上一篇：從資料幀創建多級.json檔案