# ETL
library(tidyverse)
library(sparkline)
# for the tables
library(reactable)
library(reactablefmtr)
library(DT)
# for the charts
library(highcharter)
# for the Demand & Supply Planning calculations : the library planr
library(planr)
# Others
library(htmltools)portfolio
First, let’s load a few libraries :
We’re going to use the drp() function from the R package planr, and apply it on a portfolio of products.
This function is presented in : https://rpubs.com/nikonguyen/drp_demo
More info on : https://github.com/nguyennico/planr
1) Overview Demo dataset
1.1) Demo dataset
Let’s look at the demo dataset blueprint_drp.
The raw data look like this:
df1 <- blueprint_drp
glimpse(df1)Rows: 520
Columns: 9
$ DFU <chr> "Item 000001", "Item 000001", "Item 000001", "Item 000001", …
$ Period <date> 2022-07-03, 2022-07-10, 2022-07-17, 2022-07-24, 2022-07-31,…
$ Demand <dbl> 364, 364, 364, 260, 736, 859, 859, 859, 273, 349, 349, 349, …
$ Opening <dbl> 6570, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ Supply <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5000, 0, 0, 0, 0, …
$ FH <chr> "Frozen", "Frozen", "Free", "Free", "Free", "Free", "Free", …
$ SSCov <dbl> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, …
$ DRPCovDur <dbl> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, …
$ MOQ <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …1.2) Overview
Let’s have a summary view, using the reactable package:
#-----------------
# Get Summary of variables
#-----------------
# set a working df
df1 <- blueprint_drp
# aggregate
df1 <- df1 |> group_by(DFU) |>
summarise(Demand = sum(Demand),
Opening = sum(Opening),
Supply = sum(Supply),
SSCov = mean(SSCov),
DRPCovDur = mean(DRPCovDur),
MOQ = mean(MOQ)
)
# let's calculate the share of Demand
df1$Demand.pc <- df1$Demand / sum(df1$Demand)
# keep Results
Value_DB <- df1
#-----------------
# Get Sparklines Demand
#-----------------
# set a working df
df1 <- blueprint_drp
# replace missing values by zero
df1$Demand <- df1$Demand |> replace_na(0)
# aggregate
df1 <- df1 |> group_by(DFU, Period) |> summarise(Quantity = sum(Demand))
# generate Sparkline
df1 <- df1 |> group_by(DFU) |> summarise(Demand.Quantity = list(Quantity))
# keep Results
Demand_Sparklines_DB <- df1
#-----------------
# Get Sparklines Supply
#-----------------
# set a working df
df1 <- blueprint_drp
# replace missing values by zero
df1$Supply <- df1$Supply |> replace_na(0)
# aggregate
df1 <- df1 |> group_by(DFU, Period) |> summarise(Quantity = sum(Supply))
# generate Sparkline
df1 <- df1 |> group_by(DFU) |> summarise(Supply.Quantity = list(Quantity))
# keep Results
Supply_Sparklines_DB <- df1
#-----------------
# Merge dataframes
#-----------------
# merge
df1 <- left_join(Value_DB, Demand_Sparklines_DB)
df1 <- left_join(df1, Supply_Sparklines_DB)
# reorder columns
df1 <- df1 %>% select(DFU,
SSCov,
DRPCovDur,
#MOQ,
Demand, Demand.pc, Demand.Quantity, Opening,
Supply, Supply.Quantity)
# get results
Summary_DB <- df1
glimpse(Summary_DB)Rows: 10
Columns: 9
$ DFU <chr> "Item 000001", "Item 000002", "Item 000003", "Item 000…
$ SSCov <dbl> 3, 3, 2, 3, 2, 5, 8, 2, 8, 6
$ DRPCovDur <dbl> 3, 2, 2, 4, 4, 3, 4, 4, 8, 10
$ Demand <dbl> 20294, 60747, 5975, 68509, 119335, 101810, 13823, 2075…
$ Demand.pc <dbl> 0.032769097, 0.098089304, 0.009647943, 0.110622748, 0.…
$ Demand.Quantity <list> <364, 364, 364, 260, 736, 859, 859, 859, 273, 349, 349…
$ Opening <dbl> 6570, 5509, 2494, 7172, 17500, 9954, 2092, 17500, 1222…
$ Supply <dbl> 6187, 17927, 3000, 20000, 30000, 21660, 6347, 73000, …
$ Supply.Quantity <list> <0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5000, 0, 0,…Now let’s create the table, using the libraries reactable and reactablefmtr :
We can get an overview of the different DRP parameters per product (DFU)
and also visualize the current Supply Plan and Demand profile
reactable(df1,compact = TRUE,
defaultSortOrder = "desc",
defaultSorted = c("Demand"),
defaultPageSize = 20,
columns = list(
`DFU` = colDef(name = "DFU"),
`Demand`= colDef(
name = "Total Demand (units)",
aggregate = "sum", footer = function(values) formatC(sum(values),format="f", big.mark=",", digits=0),
format = colFormat(separators = TRUE, digits=0),
style = list(background = "yellow",fontWeight = "bold")
),
`Demand.pc`= colDef(
name = "Share of Demand (%)",
cell = data_bars(df1, text_position = "above", number_fmt = scales::percent)
#format = colFormat(percent = TRUE, digits = 1)
), # close %
`Supply`= colDef(
name = "Total Supply (units)",
aggregate = "sum", footer = function(values) formatC(sum(values),format="f", big.mark=",", digits=0),
format = colFormat(separators = TRUE, digits=0)
),
`Opening`= colDef(
name = "Opening Inventories (units)",
aggregate = "sum", footer = function(values) formatC(sum(values),format="f", big.mark=",", digits=0),
format = colFormat(separators = TRUE, digits=0)
),
Demand.Quantity = colDef(
name = "Projected Demand",
cell = function(value, index) {
sparkline(df1$Demand.Quantity[[index]])
}),
Supply.Quantity = colDef(
name = "Projected Supply",
cell = function(values) {
sparkline(values, type = "bar")
}),
`SSCov`= colDef(
name = "Safety Stock (Periods)",
cell = data_bars(df1,
text_position = "outside-base",
fill_color = "skyblue",
round_edges = TRUE)
),
`DRPCovDur`= colDef(
name = "Frequency of Supply (Periods)",
cell = data_bars(df1,
text_position = "outside-end",
fill_color = "salmon",
round_edges = TRUE)
)
), # close columns list
defaultColDef = colDef(footerStyle = list(fontWeight = "bold")),
columnGroups = list(
colGroup(name = "DRP parameters",
columns = c("SSCov", "DRPCovDur")),
colGroup(name = "Demand",
columns = c("Demand",
"Demand.pc",
"Demand.Quantity")),
colGroup(name = "Supply",
columns = c("Supply", "Supply.Quantity"))
)
) # close reactable1.3) Look at the Frozen Horizon
We have 2 values for the Frozen Horizon:
Frozen
Free
The DRP Calculation :
is only performed within the Free Horizon
takes into account the values of the Supply Plan which are within the Frozen Horizon
# keep only needed columns
df1 <- blueprint_drp |> select(DFU, Period, FH)
# spread
df1 <- df1 |> spread(Period, FH)
# create DT
datatable(df1,
options = list(
searching = FALSE,
pageLength = 20),rownames= FALSE) |>
formatStyle(
2:length(df1),
backgroundColor = styleEqual(
c('Frozen'), c('yellow')
)) 2) Calculate DRP
Let’s apply the drp() function :
# set a working df
df1 <- blueprint_drp
df1 <- as.data.frame(df1)
# calculate drp
calculated_drp <- planr::drp(data = df1,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening = Opening,
Supply = Supply,
SSCov = SSCov,
DRPCovDur = DRPCovDur,
MOQ = MOQ,
FH = FH
)
# formatting
calculated_drp <- as.data.frame(calculated_drp)
head(calculated_drp) DFU Period Demand Opening Supply SSCov DRPCovDur Stock.Max MOQ
1 Item 000001 2022-07-03 364 6570 0 3 3 6 1
2 Item 000001 2022-07-10 364 0 0 3 3 6 1
3 Item 000001 2022-07-17 364 0 0 3 3 6 1
4 Item 000001 2022-07-24 260 0 0 3 3 6 1
5 Item 000001 2022-07-31 736 0 0 3 3 6 1
6 Item 000001 2022-08-07 859 0 0 3 3 6 1
FH Safety.Stocks Maximum.Stocks DRP.Calculated.Coverage.in.Periods
1 Frozen 988 3442 16.8
2 Frozen 1360 3937 15.8
3 Free 1855 3846 14.8
4 Free 2454 3935 13.8
5 Free 2577 3548 12.8
6 Free 1991 3038 11.8
DRP.Projected.Inventories.Qty DRP.plan
1 6206 0
2 5842 0
3 5478 0
4 5218 0
5 4482 0
6 3623 03) Analysis
3.1) For one Item
Let’s look at the Item 000004 :
# filter data
Selected_DB <- filter(calculated_drp, calculated_drp$DFU == "Item 000004")
glimpse(Selected_DB)Rows: 52
Columns: 15
$ DFU <chr> "Item 000004", "Item 000004", "Item…
$ Period <date> 2022-07-03, 2022-07-10, 2022-07-17…
$ Demand <dbl> 1296, 1296, 1296, 926, 678, 791, 79…
$ Opening <dbl> 7172, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
$ Supply <dbl> 0, 0, 0, 0, 0, 0, 0, 10000, 0, 0, 0…
$ SSCov <dbl> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,…
$ DRPCovDur <dbl> 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,…
$ Stock.Max <dbl> 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,…
$ MOQ <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ FH <chr> "Frozen", "Frozen", "Frozen", "Froz…
$ Safety.Stocks <dbl> 3518, 2900, 2395, 2260, 2373, 2142,…
$ Maximum.Stocks <dbl> 6569, 5833, 5579, 5695, 6059, 6053,…
$ DRP.Calculated.Coverage.in.Periods <dbl> 6.1, 5.1, 4.1, 3.1, 2.1, 1.1, 0.1, …
$ DRP.Projected.Inventories.Qty <dbl> 5876, 4580, 3284, 2358, 1680, 889, …
$ DRP.plan <dbl> 0, 0, 0, 0, 0, 0, 0, 10000, 0, 0, 0…Let’s create a table using reactable and reactablefmtr :
# keep only the needed columns
df1 <- Selected_DB |> select(Period,
FH,
Demand,
DRP.Calculated.Coverage.in.Periods,
DRP.Projected.Inventories.Qty,
DRP.plan)
# replace missing values by zero
df1$DRP.Projected.Inventories.Qty <- df1$DRP.Projected.Inventories.Qty |> replace_na(0)
df1$DRP.plan <- df1$DRP.plan |> replace_na(0)
# create a f_colorpal field
df1 <- df1 |> mutate(f_colorpal = case_when(DRP.Calculated.Coverage.in.Periods > 6 ~ "#FFA500",
DRP.Calculated.Coverage.in.Periods > 2 ~ "#32CD32",
DRP.Calculated.Coverage.in.Periods > 0 ~ "#FFFF99",
TRUE ~ "#FF0000" ))
# create reactable
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"
)
),
DRP.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
`DRP.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"
)
}
),
DRP.plan = colDef(
name = "Calculated Supply (units)",
cell = data_bars(df1,
fill_color = "#3CB371",
text_position = "outside-end"
)
)
), # close columns lits
columnGroups = list(
colGroup(name = "Projected Inventories", columns = c("DRP.Calculated.Coverage.in.Periods", "DRP.Projected.Inventories.Qty"))
)
) # close reactable3.2) For multiple Items
We can create a simple table that we could call a “Supply Risks Alarm”, giving a quick overview of:
projected inventories
or the projected coverages
#------------------------------
# Get data
df1 <- calculated_drp
df1 <- as.data.frame(df1)
#------------------------------
# Filter
# filter Period based on those Starting and Ending Periods
df1 <- filter(df1,df1$Period >= "2022-07-03" & df1$Period <= "2022-09-25")
#--------
# Keep Initial data
#--------
# replace missing values by zero
df1$Demand <- df1$Demand |> replace_na(0)
Initial_DB <- df1
#------------------------------
# Transform
#--------
# Create a Summary database
#--------
# set a working df
df1 <- Initial_DB
# aggregate
df1 <- df1 |> group_by(DFU) |> summarise(Demand.Qty = sum(Demand))
# Get Results
Value_DB <- df1
#--------
# Create the SRA
#--------
# set a working df
df1 <- Initial_DB
#------------------------------
# keep only the needed columns
df1 <- df1 |> select(DFU, Period, DRP.Calculated.Coverage.in.Periods)
# format as numeric
df1$DRP.Calculated.Coverage.in.Periods <- as.numeric(df1$DRP.Calculated.Coverage.in.Periods)
# formatting 1 digit after comma
df1$DRP.Calculated.Coverage.in.Periods = round(df1$DRP.Calculated.Coverage.in.Periods, 1)
# spread data
df1 <- df1 |> spread(Period, DRP.Calculated.Coverage.in.Periods)
# replace missing values by zero
df1[is.na(df1)] <- 0
# Get Results
SRA_DB <- df1
#--------
# Merge both database
#--------
# merge both databases
df1 <- left_join(Value_DB, SRA_DB)
# Sort by Demand.Qty descending
df1 <- df1 |> arrange(desc(Demand.Qty))
# rename column
df1 <- df1 |> rename("Total Demand (units)" = Demand.Qty)
# Get Results
Interim_DB <- df1Let’s visualize through a DT table :
#------------------------------
# create DT
df1 <- Interim_DB
datatable(df1,
options = list(
searching = FALSE,
pageLength = 20,
columnDefs = list(list(width = '200px', targets = c(1,2)))
),rownames= FALSE) |>
formatRound(2:2, 1) |>
formatStyle(columns = c(1:100), fontSize = '85%') |>
formatStyle(
3:length(df1),
backgroundColor = styleInterval(c(-0.1,0.0,4.0), c('#FF6347', 'orange', 'yellow','lightblue'))
) |>
formatStyle(
2:2,
backgroundColor = 'mediumseagreen'
)