# ETL
library(tidyverse)
library(htmltools)
# for the tables
library(reactable)
library(reactablefmtr)
# for the charts
library(highcharter)
# for the Demand & Supply Planning calculations : the library planr
library(planr)const_dmd
First, let’s load a few libraries :
We’re going to present here how to use the const_dmd() function from the R package planr.
More info on : https://github.com/nguyennico/planr
1) Create a demo dataset
Let’s create a demo dataset with 5 variables, for 2 products (Product A and Product B) :
a Period of time : for example monthly or weekly buckets
a Demand : could be some sales forecasts, expressed in units, and here in weekly bucket
an Opening Inventory : what we hold as available inventories at the beginning of the horizon, expressed in units
a Supply Plan : the supplies that we plan to receive, expressed in units
a Product : it’s an item, a SKU (Storage Keeping Unit), or a SKU at a location, also called a DFU (Demand Forecast Unit)
#------------------------
# Let's create the different variables for the Product A
#------------------------
# create dataset for the test
Period <- c("2023-08-20", "2023-08-27", "2023-09-03", "2023-09-10", "2023-09-17", "2023-09-24", "2023-10-01", "2023-10-08", "2023-10-15", "2023-10-22", "2023-10-29",
"2023-11-05", "2023-11-12", "2023-11-19", "2023-11-26", "2023-12-03", "2023-12-10", "2023-12-17", "2023-12-24","2023-12-31", "2024-01-07", "2024-01-14",
"2024-01-21", "2024-01-28", "2024-02-04", "2024-02-11", "2024-02-18", "2024-02-25", "2024-03-03", "2024-03-10", "2024-03-17", "2024-03-24", "2024-03-31",
"2024-04-07", "2024-04-14", "2024-04-21", "2024-04-28", "2024-05-05", "2024-05-12", "2024-05-19", "2024-05-26", "2024-06-02", "2024-06-09", "2024-06-16",
"2024-06-23", "2024-06-30", "2024-07-07", "2024-07-14", "2024-07-21", "2024-07-28", "2024-08-04", "2024-08-11", "2024-08-18", "2024-08-25", "2024-09-01",
"2024-09-08", "2024-09-15", "2024-09-22", "2024-09-29", "2024-10-06", "2024-10-13", "2024-10-20", "2024-10-27", "2024-11-03", "2024-11-10", "2024-11-17",
"2024-11-24", "2024-12-01", "2024-12-08", "2024-12-15", "2024-12-22", "2024-12-29")
Demand <- c(9240, 6600, 0, 22440, 1320, 6600, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4000, 0, 0, 0, 4000, 0, 0, 0, 1362, 0,
1385, 0, 1403, 0, 0, 4552, 4325, 5085, 5811, 5080, 5459, 5610, 5406, 0, 6155, 0, 1351, 2684, 1394, 0, 1395, 1341, 1341, 1328, 1498,
2983, 4769, 4829, 5334, 7574, 5879, 0, 5073, 0, 0, 1535, 1614, 1362, 0, 1342, 0, 0, 1363, 0, 0, 0, 0)
Opening <- c(8000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
Supply <- c(0, 0, 9330, 21780, 0, 0, 9000, 0, 3540, 0, 0, 0, 0, 1500, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 5280, 0, 0, 0, 0, 20100, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,0)
#------------------------
# Now let's assemble in a single dataset
#------------------------
# assemble
inputA <- data.frame(Period,
Demand,
Opening,
Supply)
# let's add a Product
inputA$DFU <- "Product A"
#------------------------
# Let's create the different variables for the Product B
#------------------------
# We just change the Opening Inventories and the Supply plan
# create dataset for the test
Period <- c("2023-08-20", "2023-08-27", "2023-09-03", "2023-09-10", "2023-09-17", "2023-09-24", "2023-10-01", "2023-10-08", "2023-10-15", "2023-10-22", "2023-10-29",
"2023-11-05", "2023-11-12", "2023-11-19", "2023-11-26", "2023-12-03", "2023-12-10", "2023-12-17", "2023-12-24","2023-12-31", "2024-01-07", "2024-01-14",
"2024-01-21", "2024-01-28", "2024-02-04", "2024-02-11", "2024-02-18", "2024-02-25", "2024-03-03", "2024-03-10", "2024-03-17", "2024-03-24", "2024-03-31",
"2024-04-07", "2024-04-14", "2024-04-21", "2024-04-28", "2024-05-05", "2024-05-12", "2024-05-19", "2024-05-26", "2024-06-02", "2024-06-09", "2024-06-16",
"2024-06-23", "2024-06-30", "2024-07-07", "2024-07-14", "2024-07-21", "2024-07-28", "2024-08-04", "2024-08-11", "2024-08-18", "2024-08-25", "2024-09-01",
"2024-09-08", "2024-09-15", "2024-09-22", "2024-09-29", "2024-10-06", "2024-10-13", "2024-10-20", "2024-10-27", "2024-11-03", "2024-11-10", "2024-11-17",
"2024-11-24", "2024-12-01", "2024-12-08", "2024-12-15", "2024-12-22", "2024-12-29")
Demand <- c(9240, 6600, 0, 22440, 1320, 6600, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4000, 0, 0, 0, 4000, 0, 0, 0, 1362, 0,
1385, 0, 1403, 0, 0, 4552, 4325, 5085, 5811, 5080, 5459, 5610, 5406, 0, 6155, 0, 1351, 2684, 1394, 0, 1395, 1341, 1341, 1328, 1498,
2983, 4769, 4829, 5334, 7574, 5879, 0, 5073, 0, 0, 1535, 1614, 1362, 0, 1342, 0, 0, 1363, 0, 0, 0, 0)
Opening <- c(18000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
Supply <- c(0, 0, 0, 0, 15000, 0, 9000, 0, 10000, 0, 0, 0, 0, 1500, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 5280, 0, 0, 0, 0, 20100, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,0)
#------------------------
# Now let's assemble in a single dataset
#------------------------
# assemble
inputB <- data.frame(Period,
Demand,
Opening,
Supply)
# let's add a Product
inputB$DFU <- "Product B"
#------------------------
# Stack both datasets
#------------------------
# stack
input <- rbind(inputA, inputB)
# format the Period as a date
input$Period <- as.Date(as.character(input$Period), format = '%Y-%m-%d')
glimpse(input)Rows: 144
Columns: 5
$ Period <date> 2023-08-20, 2023-08-27, 2023-09-03, 2023-09-10, 2023-09-17, 2…
$ Demand <dbl> 9240, 6600, 0, 22440, 1320, 6600, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4…
$ Opening <dbl> 8000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
$ Supply <dbl> 0, 0, 9330, 21780, 0, 0, 9000, 0, 3540, 0, 0, 0, 0, 1500, 0, 0…
$ DFU <chr> "Product A", "Product A", "Product A", "Product A", "Product A…2) Calculate the Constrained Demand
Let’s calculate the Constrained Demand, using the function const_dmd() .
This function actually calculates 2 things :
the projected inventories and coverages, just like the function light_proj_inv()
and also, based on those projections : the actual (possible) Demand
- which is then the constrained Demand
When we look at the projected inventories, we can see that we will be late (negative projected inventories) to supply some Demand.
The idea through this function is then to know the constrained Demand : how much Demand can be supplied (answered) and when, based on the projected inventories.
calculated_projection <- planr::const_dmd(dataset = input,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening = Opening,
Supply = Supply)
# formatting
calculated_projection <- as.data.frame(calculated_projection)
glimpse(calculated_projection)Rows: 144
Columns: 9
$ DFU <chr> "Product A", "Product A", "Product A", …
$ Period <date> 2023-08-20, 2023-08-27, 2023-09-03, 20…
$ Demand <dbl> 9240, 6600, 0, 22440, 1320, 6600, 0, 0,…
$ Opening <dbl> 8000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ Calculated.Coverage.in.Periods <dbl> 0.0, 0.0, 0.1, 0.6, 0.0, 0.0, 8.5, 7.5,…
$ Projected.Inventories.Qty <dbl> -1240, -7840, 1490, 830, -490, -7090, 1…
$ Supply <dbl> 0, 0, 9330, 21780, 0, 0, 9000, 0, 3540,…
$ Constrained.Demand <dbl> 8000, 0, 7840, 22440, 830, 0, 7090, 0, …
$ Current.Stock.Available.Tag <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …3) Table
Let’s create a function to display a badge :
#--------------------------------------------------------------------------------------
# A Function to define a Badge Status in the reactable
#--------------------------------------------------------------------------------------
status_badge <- function(color = "#aaa", width = "9px", height = width) {
span(style = list(
display = "inline-block",
marginRight = "8px",
width = width,
height = height,
backgroundColor = color,
borderRadius = "50%"
))
}Now let’s create the table, using the libraries reactable and reactablefmtr :
# set a working df
df1 <- calculated_projection
# let's select one item
df1 <- filter(df1, df1$DFU == "Product B")
#----------------
# Create the table
#----------------
# remove not needed column
df1 <- df1 |> select(-DFU)
# reorder variables
df1 <- df1 |> select(Period, Demand, Constrained.Demand, Current.Stock.Available.Tag,
Calculated.Coverage.in.Periods, Projected.Inventories.Qty, Supply
)
# create a f_colorpal field
df1 <- df1 |> mutate(f_colorpal = case_when(Calculated.Coverage.in.Periods > 6 ~ "#FFA500",
Calculated.Coverage.in.Periods > 2 ~ "#32CD32",
Calculated.Coverage.in.Periods > 0 ~ "#FFFF99",
TRUE ~ "#FF0000" ))
# adjust Current.Stock.Available.Tag
df1$Current.Stock.Available.Tag <- if_else(df1$Current.Stock.Available.Tag == 1, "Available", "")
#-------------------------
# Create Table
reactable(df1, resizable = TRUE, showPageSizeOptions = TRUE,
striped = TRUE, highlight = TRUE, compact = TRUE,
defaultPageSize = 20,
columns = list(
Demand = colDef(
name = "Demand (units)",
cell = data_bars(df1,
fill_color = "#3fc1c9",
text_position = "outside-end")
),
Constrained.Demand = colDef(
name = "Constrained Demand (units)",
cell = data_bars(df1,
fill_color = "gold",
text_position = "outside-end")
),
Calculated.Coverage.in.Periods = colDef(
name = "Coverage (Periods)",
maxWidth = 90,
cell= color_tiles(df1, color_ref = "f_colorpal")
),
f_colorpal = colDef(show = FALSE), # hidden, just used for the coverages
`Projected.Inventories.Qty`= colDef(
name = "Projected Inventories (units)",
format = colFormat(separators = TRUE, digits=0),
style = function(value) {
if (value > 0) {
color <- "#008000"
} else if (value < 0) {
color <- "#e00000"
} else {
color <- "#777"
}
list(color = color
#fontWeight = "bold"
)
}
),
Current.Stock.Available.Tag = colDef(
name = "Current Stock Available Tag",
cell = function(value) {
color <- switch(
value,
No = "hsl(120,61%,50%)",
Available = "rgb(135,206,250)"
)
badge <- status_badge(color = color)
tagList(badge, value)
}),
Supply = colDef(
name = "Supply (units)",
cell = data_bars(df1,
fill_color = "#3CB371",
text_position = "outside-end"
)
)
), # close columns lits
columnGroups = list(
colGroup(name = "Projected Inventories", columns = c("Calculated.Coverage.in.Periods",
"Projected.Inventories.Qty"))
)
) # close reactableWe can see that the [Constrained Demand] is different from the original, unconstrained Demand :) (obviously!)
It’s calculated based on the actual projected inventories.
The idea is to get the figures of the original unconstrained Demand which can be delivered (when and how much).
There is also another useful insight : [Current Stock Available Tag]
it informs the quantity of the original unconstrained Demand which can be supplied, considering the current stocks available (i.e the Opening)
the Opening Inventories are here of 18.000 units, which are enough stocks to supply the Demand of the 2 first weeks