R优化买入卖出
我需要找到优化问题的解决方案。在我的简化示例中，我对明年的价格进行了预测。我的库存最多可以包含25种产品。我每个月可以买卖。我每月不能购买超过4种产品或出售超过8种产品。我通过以低于出售的价格购买来寻找利润。是否有包装/功能可以指示何时购买和何时出售？目的是在维持设定条件的同时，使期末利润最大化（请参见下面的示例）。还提供了可能的手动解决方案。在实际应用中，还会有其他条件，例如，我需要在冬季保持一定的库存水平，或者最大买/卖取决于库存水平。例如。如果库存很高，那么您可以出售更多等等。
library(tidyverse)
library(lubridate)
df <- tibble(
date = ymd("2020-06-01") + months(0:11),
price = c(12, 11, 12, 13, 16, 17, 18, 17, 18, 16, 17, 13),
total_capacity = 25,
max_units_buy = 4,
max_units_sell = 8)
# date price total_capacity max_units_buy max_units_sell
# 1 2020-06-01 12 25 4 8
# 2 2020-07-01 11 25 4 8
# 3 2020-08-01 12 25 4 8
# 4 2020-09-01 13 25 4 8
# 5 2020-10-01 16 25 4 8
# 6 2020-11-01 17 25 4 8
# 7 2020-12-01 18 25 4 8
# 8 2021-01-01 17 25 4 8
# 9 2021-02-01 18 25 4 8
# 10 2021-03-01 16 25 4 8
# 11 2021-04-01 17 25 4 8
# 12 2021-05-01 13 25 4 8
df_manual_solution <- tibble(
date = ymd("2020-06-01") + months(0:11),
price = c(12, 11, 12, 13, 16, 17, 18, 17, 18, 16, 17, 13),
total_capacity = 25,
max_units_buy = 4,
max_units_sell = 8,
real_buy = c(4, 4, 4, 4, 4, 4, 0, 0, 0, 4, 0, 0),
real_sell = c(0, 0, 0, 0, 0, 0, 8, 8, 8, 0, 4, 0),
inventory_level = cumsum(real_buy) - cumsum(real_sell),
profit_loss = cumsum(real_sell*price) - cumsum(real_buy*price))
# date price total_capacity max_units_buy max_units_sell real_buy real_sell inventory_level profit_loss
# 1 2020-06-01 12 25 4 8 4 0 4 -48
# 2 2020-07-01 11 25 4 8 4 0 8 -92
# 3 2020-08-01 12 25 4 8 4 0 12 -140
# 4 2020-09-01 13 25 4 8 4 0 16 -192
# 5 2020-10-01 16 25 4 8 4 0 20 -256
# 6 2020-11-01 17 25 4 8 4 0 24 -324
# 7 2020-12-01 18 25 4 8 0 8 16 -180
# 8 2021-01-01 17 25 4 8 0 8 8 -44
# 9 2021-02-01 18 25 4 8 0 8 0 100
# 10 2021-03-01 16 25 4 8 4 0 4 36
# 11 2021-04-01 17 25 4 8 0 4 0 104
# 12 2021-05-01 13 25 4 8 0 0 0 104
2 个答案:
答案 0 :(得分：1)
我相信可以将其建模为小型混合整数编程（MIP）模型。
这是使用CVXR的实现：
> library(CVXR)
>
> # data
> price = c(12, 11, 12, 13, 16, 17, 18, 17, 18, 16, 17, 13)
> capacity = 25
> max_units_buy = 4
> max_units_sell = 8
>
> # number of time periods
> NT <- length(price)
>
> # Decision variables
> inv = Variable(NT,integer=T)
> buy = Variable(NT,integer=T)
> sell = Variable(NT,integer=T)
>
> # Lag operator
> L = cbind(rbind(0,diag(NT-1)),0)
>
> # optimization model
> problem <- Problem(Maximize(sum(price*(sell-buy))),
+ list(inv == L %*% inv + buy - sell,
+ inv >= 0, inv <= capacity,
+ buy >= 0, buy <= max_units_buy,
+ sell >= 0, sell <= max_units_sell))
> result <- solve(problem,verbose=T)
GLPK Simplex Optimizer, v4.47
84 rows, 36 columns, 119 non-zeros
* 0: obj = 0.000000000e+000 infeas = 0.000e+000 (12)
* 35: obj = -1.040000000e+002 infeas = 0.000e+000 (0)
OPTIMAL SOLUTION FOUND
GLPK Integer Optimizer, v4.47
84 rows, 36 columns, 119 non-zeros
36 integer variables, none of which are binary
Integer optimization begins...
+ 35: mip = not found yet >= -inf (1; 0)
+ 35: >>>>> -1.040000000e+002 >= -1.040000000e+002 0.0% (1; 0)
+ 35: mip = -1.040000000e+002 >= tree is empty 0.0% (0; 1)
INTEGER OPTIMAL SOLUTION FOUND
> cat("status:",result$status)
status: optimal
> cat("objective:",result$value)
objective: 104
> print(result$getValue(buy))
[,1]
[1,] 4
[2,] 4
[3,] 4
[4,] 4
[5,] 4
[6,] 0
[7,] 0
[8,] 4
[9,] 0
[10,] 4
[11,] 0
[12,] 0
> print(result$getValue(sell))
[,1]
[1,] 0
[2,] 0
[3,] 0
[4,] 0
[5,] 0
[6,] 8
[7,] 8
[8,] 0
[9,] 8
[10,] 0
[11,] 4
[12,] 0
> print(result$getValue(inv))
[,1]
[1,] 4
[2,] 8
[3,] 12
[4,] 16
[5,] 20
[6,] 12
[7,] 4
[8,] 8
[9,] 0
[10,] 4
[11,] 0
[12,] 0
>
答案 1 :(得分：0)
增加了拥有初始库存的可能性，并创建了一个功能来逐步优化以考虑与存货水平有关的买/卖。
library(tidyverse)
library(lubridate)
library(CVXR)
init_fce <- function(.df_storage, .df_bounds, .type = "max"){
if(.type == "max"){
.df_storage$max_buy <- max(.df_bounds$max_buy)
.df_storage$max_sell <- max(.df_bounds$max_sell)
} else if(.type == "min"){
.df_storage$max_buy <- min(.df_bounds$max_buy)
.df_storage$max_sell <- min(.df_bounds$max_sell)
} else if(.type == "mean"){
.df_storage$max_buy <- mean(.df_bounds$max_buy)
.df_storage$max_sell <- mean(.df_bounds$max_sell)
}
.df_storage
}
optim_fce <- function(.df){
# Decision variables
m_inv_tot = Variable(nrow(.df), integer = T)
m_buy = Variable(nrow(.df), integer = T)
m_sell = Variable(nrow(.df), integer = T)
# Lag operator
m_L = cbind(rbind(0, diag(nrow(.df) - 1)), 0)
objetive <- Maximize(sum(.df$price*(m_sell-m_buy)))
constraints <- list(
m_inv_tot == m_L %*% m_inv_tot + .df$inv_init + m_buy - m_sell, # L %*% result$getValue(inv) + result$getValue(buy) - result$getValue(sell)
m_inv_tot >= 0, m_inv_tot <= .df$capacity,
m_buy >= 0, m_buy <= .df$max_buy,
m_sell >= 0, m_sell <= .df$max_sell
)
problem <- Problem(objetive, constraints)
result <- solve(problem) # , verbose=T
.df <- .df %>%
mutate(
buy = (result$getValue(m_buy) %>% as.vector()),
sell = (result$getValue(m_sell) %>% as.vector()),
inventory_real = (result$getValue(m_inv_tot) %>% as.vector())
)
.df
}
set_limits_fce <- function(.df_storage, .df_bounds){
.df_storage <- .df_storage %>%
select(-max_buy, -max_sell) %>%
mutate(capacity_usage_pct_prec = lag(inventory_real, default = inv_init[1])/capacity) %>%
crossing(.df_bounds %>% select(-segment)) %>%
filter(capacity_usage_pct_prec >= lbound, capacity_usage_pct_prec < ubound) %>%
mutate(
within_bounds = (buy <= max_buy) & (sell <= max_sell)
) %>%
select(-lbound, -ubound)
.df_storage
}
get_results <- function(.df_storage){
if( any(!.df_storage$within_bounds) ){
print("result not within bounds")
} else{
.df_storage$profit <- .df_storage$sell * .df_storage$price - .df_storage$buy * .df_storage$price
print(sum(.df_storage$profit))
}
.df_storage
}
A1_storage <- tibble(
date = ymd("2020-06-01") + months(0:11),
price = c(12, 11, 12, 13, 16, 17, 18, 17, 18, 16, 17, 13),
inv_init = c(3, rep(0, 11)),
capacity = 25
)
A2_bounds <- tibble(
segment = c("0%-30%", "30%-65%", "65%-70%", "70%-100%"),
lbound = c(0, 0.3, 0.65, 0.7),
ubound = c(0.3, 0.65, 0.7, 1),
max_buy = c(4,3,2,2),
max_sell = c(4,6,6,8)
)
B1_max <- init_fce(A1_storage, A2_bounds, .type = "max") %>%
optim_fce() %>%
set_limits_fce(.df_bounds = A2_bounds) %>%
get_results() %>%
optim_fce() %>%
set_limits_fce(.df_bounds = A2_bounds) %>%
get_results() %>%
optim_fce() %>%
set_limits_fce(.df_bounds = A2_bounds) %>%
get_results() %>%
optim_fce() %>%
set_limits_fce(.df_bounds = A2_bounds) %>%
get_results()
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？