R中的非线性离散优化
Nonlinear discrete optimization in R
我有一个简单的（实际上是经济学标准）非线性约束 离散 最大化问题要在 R 中解决，但遇到了麻烦。我找到了问题 部分 的解决方案（非线性最大化；离散最大化），但没有找到所有问题的联合。
问题来了。一位消费者想要购买三种产品（菠萝、香蕉、饼干），知道价格并且预算为 20 欧元。他喜欢多样性（即，如果可能的话，他希望拥有所有三种产品）并且他的满意度随着消费量的增加而降低（他喜欢他的第一个饼干的方式超过了他的第 100 个）。
他希望最大化的函数是
当然，因为每个人都有价格，而且他的预算有限，所以他在
的约束下最大化这个函数
我想做的是找到满足约束条件的最优购买清单（N个凤梨，M个香蕉，K个饼干）
如果问题是线性的，我会简单地使用 linprog::solveLP()。但是 objective 函数是非线性的。
如果问题是连续性的，那将是一个简单的解析解。
这个问题是离散的和非线性的，我不知道如何进行。
这里有一些可以玩的玩具数据。
df <- data.frame(rbind(c("ananas",2.17),c("banana",0.75),c("cookie",1.34)))
names(df) <- c("product","price")
我想要一个优化程序，为我提供 (N,M,K) 的最佳购买清单。
有什么提示吗？
如果您不介意使用 "by hand" 解决方案：
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
我认为这个问题在本质上与这个问题（）非常相似。 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 求解器之一，并且 returns 结果进入你的 R 过程。
Select 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
;
如果解决方案 "by hand" 不合理且四舍五入 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 的最佳解决方案!
1) no packages 这可以通过暴力破解。使用问题中的 df 作为输入确保 price 是数字（它是问题 df 中的一个因素）并计算每个变量的最大数字 mx。然后创建变量计数的网格 g 并计算每个变量的 total 价格和相关的 objective 给出 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 中解决，但遇到了麻烦。我找到了问题 部分 的解决方案（非线性最大化；离散最大化），但没有找到所有问题的联合。
问题来了。一位消费者想要购买三种产品（菠萝、香蕉、饼干），知道价格并且预算为 20 欧元。他喜欢多样性（即，如果可能的话，他希望拥有所有三种产品）并且他的满意度随着消费量的增加而降低（他喜欢他的第一个饼干的方式超过了他的第 100 个）。
他希望最大化的函数是
当然，因为每个人都有价格，而且他的预算有限，所以他在
的约束下最大化这个函数我想做的是找到满足约束条件的最优购买清单（N个凤梨，M个香蕉，K个饼干）
如果问题是线性的，我会简单地使用 linprog::solveLP()。但是 objective 函数是非线性的。 如果问题是连续性的，那将是一个简单的解析解。
这个问题是离散的和非线性的，我不知道如何进行。
这里有一些可以玩的玩具数据。
df <- data.frame(rbind(c("ananas",2.17),c("banana",0.75),c("cookie",1.34)))
names(df) <- c("product","price")
我想要一个优化程序，为我提供 (N,M,K) 的最佳购买清单。
有什么提示吗？
如果您不介意使用 "by hand" 解决方案：
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
我认为这个问题在本质上与这个问题（
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 求解器之一，并且 returns 结果进入你的 R 过程。
Select 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
;
如果解决方案 "by hand" 不合理且四舍五入 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 的最佳解决方案!
1) no packages 这可以通过暴力破解。使用问题中的 df 作为输入确保 price 是数字（它是问题 df 中的一个因素）并计算每个变量的最大数字 mx。然后创建变量计数的网格 g 并计算每个变量的 total 价格和相关的 objective 给出 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