Jakub.Novotny
Reputation: 3047
R optimisation buy sell
I need to find a solution to an optimisation problem. In my simplified example, I have a prediction of prices for the next year. I have inventory that can contain max 25 products. I can either sell or buy each month. I cannot buy more than 4 products or sell more than 8 products per month. I am looking for profit by buying for lower price than selling. Is there a package/function that can indicate when to buy and when to sell? The objective is to maximise the profit at the end of the period whilst maintaining set conditions (see the example below). A possible manual solution is provided as well. In the real application, there will be additional conditions such as that I need to maintain a certain level of inventory in winter or that the max buy/sell is dependent on the inventory level. E.g. if the inventory is high then you can sell more etc.
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
Upvotes: 0
Views: 327
Answers (2)
Jakub.Novotny
Reputation: 3047
Added the possibility to have an initial inventory and created a function to do the optimisation step-wise to account stock-level dependent buy/sell.
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()
Upvotes: 0
Erwin Kalvelagen
Reputation: 16724
I believe this can be modeled as a small Mixed Integer Programming (MIP) model.
Here is an implementation using 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
>
Upvotes: 1
Related Questions
- Linear Programs using R
- R optimisation max buy/sell dependent on stock level
- Optimization with three variables
- R for solving linear programming marketing problem
- Linear Optimization R
- Mixed Integer Linear Programming in R
- Optimizing using R
- Non Linear Integer Programming
- R Optimisation - Integer Programming
- Optimization in R