R中的非線性離散優化

我有一個簡單的（確實是經濟學中的標準）非線性約束離散在R中解決最大化問題並且遇到了麻煩。我發現問題的解決方案部分（非線性最大化;離散最大化），但不是所有問題的聯合。R中的非線性離散優化

這是問題所在。消費者想購買三種產品（鳳梨，香蕉，曲奇），瞭解價格並且有20歐元的預算。他喜歡多種多樣（即如果可能的話，他希望擁有所有三種產品），並且他的滿意度在消費量上下降（他喜歡他的第一個餅乾方式超過他的第100個）。

他希望發揮最大的功用是

當然，因爲每個人都有一個價格，他有一個預算有限，他的約束下最大化這個功能

我想要做的是找到滿足約束條件的最佳購買清單（N ananas，M香蕉，K cookies）。

如果問題是線性的，我會簡單地使用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）。

任何提示？

來源

2015-10-14 PaoloCrosetto

從本質上講，你需要的是一個非線性的，不等式約束，離散優化，這我不相信它存在於R（還）。您可以使用'Rsolnp'來提供除了離散情況以外的所有內容，然後測試所有估計值向上舍入和向下的組合。如果參數太多，則可以通過取整向下的值來妥協。在大多數情況下，它仍然是一個可接受的解決方案 – LyzandeR

1）no packages這可以通過蠻力來完成。使用問題中的df作爲輸入確保price是數字（這是問題的df中的一個因子），並計算每個變量的最大數字mx。然後創建可變計數的網格g並計算每個的價格以及相關聯的objective給出gg。按目標的降序排序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)

，並提供：使用dplyr包

> 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這也可以是很好地表達。使用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

來源

2015-10-21 14:28:50

謝謝。這非常好（我沒有嚴格的計算時間限制，所以蠻力似乎沒問題）。我批准它，因爲它可以很容易地變成任何DF的功能。謝謝！ – PaoloCrosetto

如果不使用「手動」解決方案介意：

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

來源

2015-10-14 13:34:53 Robert

我認爲你的3個菠蘿，9個香蕉和5個餅乾的解決方案總和爲28美元？ –

@Marcinthebox mmm nope，它看起來正確的總和爲19.96。我也想知道爲什麼你有這樣一個不同的結果... – PaoloCrosetto

@PaoloCrosetto - 是我的一個不良的數據框加載 - 你固定價格轉換因子，而我搞砸了這樣做。我現在得到和你一樣的結果。乾杯，馬克 –

我覺得這個問題在本質上是對這個問題（Solve indeterminate equation system in R）非常相似。由任賢齊棉花答案是基礎，這個可能的解決方案：

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

來源

2015-10-14 14:43:34

謝謝，但我寧願不求助於四捨五入 - >這不是一個無辜的事情，舍入後的結果可能不是最佳的... – PaoloCrosetto

我已經刪除了示例中的舍入效應現在。 –

由於LyzandeR指出存在R.沒有可用的非線性整數規劃求解相反，您可以使用R包rneos將數據發送到NEOS解算器之一，並將結果返回到您的R過程。

在NEOS Solvers頁面上選擇「混合整數非線性約束優化」的解算器之一，例如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！

來源

2015-10-18 19:06:25

R中的非線性離散優化

回答

相關問題