[英]constrained optimization R: another example
我試圖在R中執行約束優化。我看了這些帖子以及其他幾篇文章:
上面的第一篇文章很有幫助,但是我仍然無法獲得正確的答案。
我的職能是:
Fd <- 224 * d1 + 84 * d2 + d1 * d2 - 2 * d1^2 - d2^2
我的約束是: 3 * d1 + d2 = 280
首先,我先使用無約束窮舉搜索找到正確的答案,然后再進行無約束窮舉搜索:
my.data <- expand.grid(x1 = seq(0, 200, 1), x2 = seq(0, 200, 1))
head(my.data)
dim(my.data)
d1 <- my.data[,1]
d2 <- my.data[,2]
Fd <- 224 * d1 + 84 * d2 + d1 * d2 - 2 * d1^2 - d2^2
new.data <- data.frame(Fd = Fd, d1 = d1, d2 = d2)
head(new.data)
# identify values of d1 and d2 that maximize Fd without the constraint
new.data[new.data$Fd == max(new.data$Fd),]
# **This is the correct answer**
# Fd d1 d2
# 6157 11872 76 80
# Impose constraint
new.data <- new.data[(3 * new.data$d1 + new.data$d2) == 280, ]
# identify values of d1 and d2 that maximize Fd with the constraint
new.data[new.data$Fd == max(new.data$Fd),]
# **This is the correct answer**
# Fd d1 d2
# 14743 11774 69 73
現在使用optim
找到不受約束的最大值。 這可行。
Fd <- function(betas) {
b1 = betas[1]
b2 = betas[2]
(224 * b1 + 84 * b2 + b1 * b2 - 2 * b1^2 - b2^2)
}
# unconstrained
optim(c(60, 100), Fd, control=list(fnscale=-1), method = "BFGS", hessian = TRUE)
# $par
# [1] 75.99999 79.99995
現在使用constrOptim
查找約束極大constrOptim
。 這是行不通的。
b1.lower.bound <- c(0, 280)
b1.upper.bound <- c(93.33333, 0)
b2.lower.bound <- c(93.33333, 0)
b2.upper.bound <- c(0, 280)
theta = c(60,100) # starting values
ui = rbind(c(280,0), c(0,93.33333)) # range of allowable values
theta %*% ui # obtain ci as -1 * theta %*% ui
# [,1] [,2]
# [1,] 16800 9333.333
constrOptim(c(60,100), Fd, NULL, ui = rbind(c(280,0), c(0,93.33333)), ci = c(-16800, -9333.333), control=list(fnscale=-1))
# $par
# [1] 75.99951 80.00798
我曾嘗試過使用ui
和ci
,但是無論我使用什么值,我總是得到與不受約束的optim
相同的答案。
感謝您的任何建議。
在這里,我已經實施了格羅騰迪克(G. Grothendieck)的建議,似乎返回了正確的答案。 雖然,理想情況下,我想學習如何使用約束優化來獲取正確答案。 我在這里使用了Brent方法,因為只有一個變量。 請注意,我必須在optim
語句中提供上限和下限。
# Find maxima using optim and substitution. First remove b2
#
# 3 * b1 + b2 = 280
#
# b2 = (280 - 3 * b1)
Fd <- function(betas) {
b1 = betas[1]
(224 * b1 + 84 * (280 - 3 * b1) + b1 * (280 - 3 * b1) - 2 * b1^2 - (280 - 3 * b1)^2)
}
optim(c(60), Fd, method = "Brent", lower = 0, upper = 93.33333, control=list(fnscale=-1))
# $par
# [1] 69
# Now remove b1
#
# 3 * b1 + b2 = 280
#
# b1 = ((280 - b2) / 3)
Fd <- function(betas) {
b2 = betas[1]
(224 * ((280 - b2) / 3) + 84 * b2 + ((280 - b2) / 3) * b2 - 2 * ((280 - b2) / 3)^2 - b2^2)
}
optim(c(100), Fd, method = "Brent", lower = 0, upper = 280, control=list(fnscale=-1))
# $par
# [1] 73
constrOptim()
使用線性不等式約束,並通過ui %*% param - ci >= 0
定義可行區域。 如果約束為3 * d1 + d2 <= 280
,則ui
為c(-3, -1)
, ci
為-280
。
Fd <- function(betas) { b1 = betas[1] b2 = betas[2] (224 * b1 + 84 * b2 + b1 * b2 - 2 * b1^2 - b2^2) } theta = c(59.999,100) # because of needing " ui %*% inital_par - ci > 0 " ui = c(-3, -1) ci = -280 # those ui & ci mean " -3*par[1] + -1*par[2] + 280 >= 0 " constrOptim(theta, Fd, NULL, ui = ui, ci = ci, control=list(fnscale=-1)) # $par # [1] 69.00002 72.99993
如果您不希望不平等而是平等約束,那么最好使用Rsolnp
或alabama
軟件包。 他們可以使用不等式和/或等式約束( 有關等式和不等式約束,請參見約束優化庫 )。
library(Rsolnp); library(alabama); Fd2 <- function(betas) { # -1 * Fd b1 = betas[1] b2 = betas[2] -1 * (224 * b1 + 84 * b2 + b1 * b2 - 2 * b1^2 - b2^2) } eqFd <- function(betas) { # the equality constraint b1 = betas[1] b2 = betas[2] (3 * b1 + b2 -280) } solnp(pars = c(60, 100), fun = Fd2, eqfun = eqFd, eqB = 0) auglag(par = c(60, 100), fn = Fd2, heq = eqFd)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.