我有以下功能，并希望优化参数x和y，以便最大化输出。我正在尝试使用optimise。
感谢此处的评论，我可以使用Rsolnp::solnp进行优化。
但是现在我在添加上限和下限时会出错。
见下面的例子
目标功能：
my_fn <- function(x) {
z <- ifelse(x[1] < 1000000, 0,
ifelse(x[1] < 19500000, x[1] * 0.0175,
ifelse(x[1] < 20500000, x[1] * 0.0190,
ifelse(x[1] < 21500000, x[1] * 0.0220,
ifelse(x[1] < 22500000, x[1] * 0.0270,
x[1] * 0.0340))))) +
ifelse(x[2] < 750000, 0,
ifelse(x[2] < 15750000, x[2] * 0.0100,
ifelse(x[2] < 16500000, x[2] * 0.0150,
ifelse(x[2] < 17250000, x[2] * 0.0275,
ifelse(x[2] < 18000000, x[2] * 0.0375,
ifelse(x[2] < 18750000, x[2] * 0.0450,
x[2] * 0.0550)))))) +
return(-z) # because I want to maximise
}
平等功能：
my_fn_equal <- function(x) {
z1 = x[1] + x[2]
return(z1)
}
我使用以下内容：
library(Rsolnp)
solnp(pars = c(1000000, 750000), # initial values
fun = my_fn, # objective function
eqfun = my_fn_equal, # equality function
eqB = c(17000000) # euqlity constraint
)
它工作正常。 但是一旦我添加下限和上限，我就会开始出错：
solnp(pars = c(1000000, 750000), # initial values
fun = my_fn, # objective function
eqfun = my_fn_equal, # equality function
eqB = c(17000000), # euqlity constraint
LB = c(1000000, 750000), # lower bound for parameters
UB = c(16000000, 16000000) # upper bound for parameters (I chose 16M randomly)
)
问题反转Hessian的结果：
solnp-->The linearized problem has no feasible
solnp-->solution. The problem may not be feasible.
Iter: 1 fn: -25000.0000 Pars: 1000000.00000 750000.00000
solnp--> Solution not reliable....Problem Inverting Hessian.
$pars
[1] 1000000 750000
$convergence
[1] 2
$values
[1] -25000 -25000
$lagrange
[1] 0
$hessian
[,1] [,2]
[1,] 1 0
[2,] 0 1
$ineqx0
NULL
$nfuneval
[1] 7
$outer.iter
[1] 1
$elapsed
Time difference of 0.1664431 secs
$vscale
[1] 25000 15250000 1 1
约束是：
# x[1] >= 1000000
# x[2] >= 750000
# x[1] + x[2] = 17000000
为什么选择边界时会出现这些错误？ 他们是什么意思？
此外，似乎每当我更改初始值时，优化值都会发生变化。为什么我没有获得每次最大化输出的相同参数？
谢谢！
答案 0 :(得分：0)
这是作为MIP（混合整数程序）解决问题的方法。
假设我们有两个供应商A和B。每个供应商都会根据我们给他们的金额（支出）提供现金金额作为奖励。允许的最高支出为3000万美元，我们希望将总奖金最大化。每个供应商都有最低和最高支出限制。
在实际情况下，有7个供应商具有不同的约束条件和奖励规则。但为简单起见，我仅使用2个供应商。
library(tidyverse)
# run spend & bonus for A
A_value <- data.frame()
for (i in seq(0, 35000000, 100000)) {
A_value_temp <- data.frame(vendor = 'A',
spend = i,
bonus = ifelse(i < 1000000, 0,
ifelse(i < 19500000, i * 0.0175,
ifelse(i < 20500000, i * 0.0190,
ifelse(i < 21500000, i * 0.0220,
ifelse(i < 22500000, i * 0.0270,
i * 0.0340)))))
)
A_value <- rbind(A_value, A_value_temp)
}
# run spend & bonus for B
B_value <- data.frame()
for (i in seq(0, 35000000, 100000)) {
B_value_temp <- data.frame(vendor = 'B',
spend = i,
bonus = ifelse(i < 750000, 0,
ifelse(i < 15750000, i * 0.0100,
ifelse(i < 16500000, i * 0.0150,
ifelse(i < 17250000, i * 0.0275,
ifelse(i < 18000000, i * 0.0375,
ifelse(i < 18750000, i * 0.0450,
i * 0.0550))))))
)
B_value <- rbind(B_value, B_value_temp)
}
# create control data frame
control <- rbind.data.frame(A_value, B_value)
# Build spend matrices
spend_matrix <- as.matrix(cbind(control %>%
filter(vendor == "A") %>%
mutate(A = spend) %>%
select(A) ,
control %>%
filter(vendor == "B") %>%
mutate(B = spend) %>%
select(B)
)
)
# Build bonus matrices
bonus_matrix <- as.matrix(cbind(control %>%
filter(vendor == "A") %>%
mutate(A = bonus) %>%
select(A) ,
control %>%
filter(vendor == "B") %>%
mutate(B = bonus) %>%
select(B)
)
)
# Check spend and bonus matrices
> tail(spend_matrix)
A B
[346,] 34500000 34500000
[347,] 34600000 34600000
[348,] 34700000 34700000
[349,] 34800000 34800000
[350,] 34900000 34900000
[351,] 35000000 35000000
> tail(bonus_matrix)
A B
[346,] 1173000 1897500
[347,] 1176400 1903000
[348,] 1179800 1908500
[349,] 1183200 1914000
[350,] 1186600 1919500
[351,] 1190000 1925000
# Optimisation
library(ompr)
library(ROI)
library(ROI.plugin.glpk)
library(ompr.roi)
# Spend constraint: max spend allowed
max_spend <- 30000000
# Number of scenarios (different scenarios of spend)
scenarios <- nrow(spend_matrix)
# Number of vendors
vendors <- unique(control$vendor)
# MIP model
MIP_sol <- MIPModel() %>%
add_variable(x[i,j], i=1:scenarios , j=1:length(vendors), type="binary") %>%
# Every vendor must have spend constraint
add_constraint(sum_expr(x[i,j], i=1:scenarios) == 1, j=1:length(vendors)) %>%
# Minimun spend constraints
add_constraint(sum_expr(spend_matrix[i,j] * x[i,j], i=1:scenarios, j=1) >= 2500000) %>% # Vendor A
add_constraint(sum_expr(spend_matrix[i,j] * x[i,j], i=1:scenarios, j=2) >= 3500000) %>% # Vendor B
# Maximum spend constraints
add_constraint(sum_expr(spend_matrix[i,j] * x[i,j], i=1:scenarios, j=1) <= 26000000) %>% # Vendor A
add_constraint(sum_expr(spend_matrix[i,j] * x[i,j], i=1:scenarios, j=2) <= 19000000) %>% # Vendor B
# Equality sum constraint
add_constraint(sum_expr(spend_matrix[i,j] * x[i,j], i=1:scenarios, j=1:length(vendors)) <= max_spend) %>%
# Set objective: max bonus
set_objective(sum_expr(bonus_matrix[i,j] * x[i,j], i=1:scenarios, j=1:length(vendors)), "max") %>%
# solve model
solve_model(with_ROI(solver = "glpk", verbose = TRUE))
> print(MIP_sol)
Status: optimal
Objective value: 1237500
# Solution
cat("Status:",solver_status(MIP_sol),"\n")
cat("Objective:",objective_value(MIP_sol),"\n")
optim_solution <- get_solution(MIP_sol, x[i, j]) %>%
filter(value > 0) %>%
mutate(vendor = vendors[j],
scenario = i,
spend = diag(spend_matrix[i,j]),
bonus = diag(bonus_matrix[i,j])) %>%
select(scenario, vendor, spend, bonus)
> print(optim_solution)
scenario vendor spend bonus
1 111 A 11000000 192500
2 191 B 19000000 1045000