[英]Nonlinear discrete optimization in R
我有一個簡單的(確實是經濟學標准)非線性約束離散最大化問題,在R中解決並且遇到了麻煩。 我找到了部分問題的解決方案(非線性最大化;離散最大化),但沒有找到所有問題的聯合。
這是問題所在。 消費者想要購買三種產品(鳳梨,香蕉,餅干),知道價格並且預算為20歐元。 他喜歡多樣性(即,如果可能的話,他希望擁有所有三種產品)並且他的滿意度在消耗量上減少(他喜歡他的第一個餅干方式超過他的第100個)。
他希望最大化的功能是
當然,由於每個人都有一個價格,並且他的預算有限,他在這個約束條件下最大化了這個功能
我想要做的是找到滿足約束條件的最佳購買清單(N ananas,M香蕉,K餅干)。
如果問題是線性的,我會簡單地使用linprog :: solveLP()。 但目標函數是非線性的。 如果問題具有連續性,那么它將是一個簡單的分析解決方案。
問題是離散和非線性的,我不知道如何繼續。
這是一些玩具數據。
df <- data.frame(rbind(c("ananas",2.17),c("banana",0.75),c("cookie",1.34)))
names(df) <- c("product","price")
我想要一個優化程序,給我一個(N,M,K)的最佳購買清單。
任何提示?
如果您不介意使用“手動”解決方案:
uf=function(x)prod(x)^.5
bf=function(x,pr){
if(!is.null(dim(x)))apply(x,1,bf,pr) else x%*%pr
}
budget=20
df <- data.frame(product=c("ananas","banana","cookie"),
price=c(2.17,0.75,1.34),stringsAsFactors = F)
an=0:(budget/df$price[1]) #include 0 for all possibilities
bn=0:(budget/df$price[2])
co=0:(budget/df$price[3])
X=expand.grid(an,bn,co)
colnames(X)=df$product
EX=apply(X,1,bf,pr=df$price)
psX=X[which(EX<=budget),] #1st restrict
psX=psX[apply(psX,1,function(z)sum(z==0))==0,] #2nd restrict
Ux=apply(psX,1,uf)
cbind(psX,Ux)
(sol=psX[which.max(Ux),])
uf(sol) # utility
bf(sol,df$price) #budget
> (sol=psX[which.max(Ux),]) ananas banana cookie 1444 3 9 5 > uf(sol) # utility [1] 11.61895 > bf(sol,df$price) #budget 1444 19.96
1)沒有包這可以通過蠻力來完成。 使用問題中的df
作為輸入確保price
是數字(它是問題的df
中的一個因子)並計算每個變量的最大數量mx
。 然后創建可變計數的網格g
並計算每個的total
價格以及給出gg
的相關objective
。 現在按照目標的降序對gg
進行排序,並使這些解決方案滿足約束條件。 head
將展示前幾個解決方案。
price <- as.numeric(as.character(df$price))
mx <- ceiling(20/price)
g <- expand.grid(ana = 0:mx[1], ban = 0:mx[2], cook = 0:mx[3])
gg <- transform(g, total = as.matrix(g) %*% price, objective = sqrt(ana * ban * cook))
best <- subset(gg[order(-gg$objective), ], total <= 20)
贈送:
> head(best) # 1st row is best soln, 2nd row is next best, etc.
ana ban cook total objective
1643 3 9 5 19.96 11.61895
1929 3 7 6 19.80 11.22497
1346 3 10 4 19.37 10.95445
1611 4 6 5 19.88 10.95445
1632 3 8 5 19.21 10.95445
1961 2 10 6 19.88 10.95445
2)dplyr這也可以使用dplyr包很好地表達。 使用上面的g
和price
:
library(dplyr)
g %>%
mutate(total = c(as.matrix(g) %*% price), objective = sqrt(ana * ban * cook)) %>%
filter(total <= 20) %>%
arrange(desc(objective)) %>%
top_n(6)
贈送:
Selecting by objective
ana ban cook total objective
1 3 9 5 19.96 11.61895
2 3 7 6 19.80 11.22497
3 3 10 4 19.37 10.95445
4 4 6 5 19.88 10.95445
5 3 8 5 19.21 10.95445
6 2 10 6 19.88 10.95445
我認為這個問題在本質上與這個問題非常相似( 在R中求解不確定方程系統 )。 Richie Cotton的答案是這種可能解決方案的基礎:
df <- data.frame(product=c("ananas","banana","cookie"),
price=c(2.17,0.75,1.34),stringsAsFactors = F)
FUN <- function(w, price=df$price){
total <- sum(price * w)
errs <- c((total-20)^2, -(sqrt(w[1]) * sqrt(w[2]) * sqrt(w[3])))
sum(errs)
}
init_w <- rep(10,3)
res <- optim(init_w, FUN, lower=rep(0,3), method="L-BFGS-B")
res
res$par # 3.140093 9.085182 5.085095
sum(res$par*df$price) # 20.44192
請注意,解決方案的總成本(即價格)為20.44美元。 為了解決這個問題,我們可以對誤差項進行加權,以便更加強調第一項,即與總成本相關:
### weighting of error terms
FUN2 <- function(w, price=df$price){
total <- sum(price * w)
errs <- c(100*(total-20)^2, -(sqrt(w[1]) * sqrt(w[2]) * sqrt(w[3]))) # 1st term weighted by 100
sum(errs)
}
init_w <- rep(10,3)
res <- optim(init_w, FUN2, lower=rep(0,3), method="L-BFGS-B")
res
res$par # 3.072868 8.890832 4.976212
sum(res$par*df$price) # 20.00437
正如LyzandeR所說,R中沒有非線性整數規划求解器。相反,您可以使用R包rneos將數據發送到NEOS求解器之一並將結果返回到R過程。
在NEOS Solvers頁面上選擇“Mixed Integer Nonlinearly Constrained Optimization”的解算器之一 ,例如Bonmin或Couenne。 對於上面的示例,請將AMPL建模語言中的以下文件發送給以下解算器之一:
[請注意,最大化乘積x1 * x2 * x3
與最大化乘積sqrt(x1) * sort(x2) * sqrt(x3)
。
型號文件:
param p{i in 1..3};
var x{i in 1..3} integer >= 1;
maximize profit: x[1] * x[2] * x[3];
subject to restr: sum{i in 1..3} p[i] * x[i] <= 20;
數據文件:
param p:= 1 2.17 2 0.75 3 1.34 ;
命令文件:
solve;
display x;
您將收到以下解決方案:
x [*] :=
1 3
2 9
3 5
;
這種方法適用於更多擴展示例,“手動”解決方案不合理,而且舍入optim
解決方案不正確。
為了看一個更苛刻的例子,讓我提出以下問題:
求整數向量x =(x_i),i = 1,...,10,最大化x1 * ... * x10,使得p1 * x1 + ... + p10 * x10 <= 10,其中p = (p_i),i = 1,...,10,是以下價格向量
p <- c(0.85, 0.22, 0.65, 0.73, 0.91, 0.11, 0.31, 0.47, 0.93, 0.71)
使用constrOptim
來解決這個帶有線性不等式約束的非線性優化問題,我得到了900不同起點的解,但從來沒有960的最優解!
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.