R中的非线性离散优化答案

【问题标题】：Nonlinear discrete optimization in RR中的非线性离散优化
【发布时间】：2016-01-12 08:57:00
【问题描述】：

我有一个简单的（实际上是经济学标准）非线性约束离散最大化问题要在 R 中解决，但遇到了麻烦。我找到了问题的部分的解决方案（非线性最大化；离散最大化），但不是所有问题的联合。

这就是问题所在。一位消费者想要购买三种产品（凤梨、香蕉、饼干），知道价格并且有 20 欧元的预算。他喜欢多样化（即，如果可能，他想拥有所有三种产品）并且他的满意度正在下降（他喜欢他的第一个饼干超过他的第 100 个）。

他希望最大化的函数是

当然，由于每个人都有价格，而且他的预算有限，他会在以下约束条件下最大化此功能

我要做的是找到满足约束条件的最优购买清单（N ananas, M banans, 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) 的最佳购买清单。

有什么提示吗？

【问题讨论】：

基本上你需要的是一个非线性、不等式约束的离散优化器，我不相信它存在于 R 中（目前）。您可以使用Rsolnp，它提供了除离散案例之外的所有内容，然后测试估计值的向上和向下舍入的所有组合。如果参数太多，那么您可以通过取舍入的值来妥协。在大多数情况下，这仍然是一个可以接受的解决方案。
我想知道现在R中是否存在这样的包？

标签： r optimization constraints discrete-mathematics

【解决方案1】：

1) 没有包 这可以通过蛮力来完成。使用问题中的df 作为输入确保price 是数字（它是问题df 中的一个因素）并计算每个变量的最大数mx。然后创建变量计数的网格g 并计算每个的total 价格和相关的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)

给予：

> 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

【讨论】：

谢谢。这非常好（我没有严格的计算时间限制，所以蛮力似乎还可以）。我批准了它，因为它可以很容易地变成给定任何 df 的函数。谢谢！

【解决方案2】：

如果您不介意使用“手动”解决方案：

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

【讨论】：

我认为您的 3 个凤梨、9 个香蕉和 5 个饼干的解决方案总和为 28 美元？
@Marcinthebox 嗯，不，它看起来正确地总和为 19.96。我也想知道你为什么会有如此不同的结果......
@PaoloCrosetto - 对我而言，数据框加载不好 - 你修复了价格到因子的转换，而我搞砸了。我现在得到和你一样的结果。干杯，马克

【解决方案3】：

我认为这个问题本质上与这个问题 (Solve indeterminate equation system in 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

【讨论】：

谢谢，但我宁愿不采用四舍五入 -> 这不是一件无辜的事情，四舍五入后的结果毕竟可能不是最佳的......
我现在已经去掉了示例中的舍入效果。

【解决方案4】：

正如 LyzanderR 所说，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

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的最优解！

【讨论】：