# 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 light_proj_inv() from the R package planr, and apply it on a portfolio of products.
This function is presented in : https://rpubs.com/nikonguyen/light_proj_inv_simple_demo
More info on : https://github.com/nguyennico/planr
1) Overview Demo dataset
Let’s look at the demo dataset blueprint_light.
We are going to :
apply the light_proj_inv() on this portfolio template
create some nice visuals of tables and charts, using the R packages reactable, reactablefmtr and highcharter.
The raw data look like this:
df1 <- blueprint_light
head(df1)# A tibble: 6 × 5
DFU Period Demand Opening Supply
<chr> <date> <dbl> <dbl> <dbl>
1 Item 000001 2022-07-03 364 6570 0
2 Item 000001 2022-07-10 364 0 0
3 Item 000001 2022-07-17 364 0 0
4 Item 000001 2022-07-24 260 0 0
5 Item 000001 2022-07-31 736 0 0
6 Item 000001 2022-08-07 859 0 0Let’s have a summary view, using the reactable package:
#-----------------
# Get Summary of variables
#-----------------
# set a working df
df1 <- blueprint_light
# aggregate
df1 <- df1 |> group_by(DFU) |>
summarise(Demand = sum(Demand),
Opening = sum(Opening),
Supply = sum(Supply)
)
# 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_light
# replace missing values by zero
df1$Demand[is.na(df1$Demand)] <- 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_light
# replace missing values by zero
df1$Supply[is.na(df1$Supply)] <- 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, Demand, Demand.pc, Demand.Quantity, Opening,
Supply, Supply.Quantity)
# get results
Summary_DB <- df1
glimpse(Summary_DB)Rows: 10
Columns: 7
$ DFU <chr> "Item 000001", "Item 000002", "Item 000003", "Item 000…
$ 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, 34…
$ Opening <dbl> 6570, 5509, 2494, 7172, 17500, 9954, 2092, 17500, 1222…
$ Supply <dbl> 6187, 17927, 3000, 20000, 30000, 21660, 6347, 73000, 7…
$ Supply.Quantity <list> <0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5000, 0, 0…and now let’s create the reactable :
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 (%)",
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"
#chartRangeMin = 0, chartRangeMax = max(chickwts$weight)
)
})
), # close columns list
defaultColDef = colDef(footerStyle = list(fontWeight = "bold")),
columnGroups = list(
colGroup(name = "Demand",
columns = c("Demand",
"Demand.pc",
"Demand.Quantity")),
colGroup(name = "Supply",
columns = c("Supply", "Supply.Quantity"))
)
) # close reactable2) Calculate Projected Inventories & Coverages
# set a working df
df1 <- blueprint_light
df1 <- as.data.frame(df1)
# calculate
calculated_projection <- light_proj_inv(dataset = df1,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening = Opening,
Supply = Supply)
# formatting
calculated_projection <- as.data.frame(calculated_projection)
# see results
head(calculated_projection) DFU Period Demand Opening Calculated.Coverage.in.Periods
1 Item 000001 2022-07-03 364 6570 16.8
2 Item 000001 2022-07-10 364 0 15.8
3 Item 000001 2022-07-17 364 0 14.8
4 Item 000001 2022-07-24 260 0 13.8
5 Item 000001 2022-07-31 736 0 12.8
6 Item 000001 2022-08-07 859 0 11.8
Projected.Inventories.Qty Supply
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 000001 :
# filter data
Selected_DB <- filter(calculated_projection, calculated_projection$DFU == "Item 000001")
glimpse(Selected_DB)Rows: 52
Columns: 7
$ DFU <chr> "Item 000001", "Item 000001", "Item 000…
$ Period <date> 2022-07-03, 2022-07-10, 2022-07-17, 20…
$ Demand <dbl> 364, 364, 364, 260, 736, 859, 859, 859,…
$ Opening <dbl> 6570, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ Calculated.Coverage.in.Periods <dbl> 16.8, 15.8, 14.8, 13.8, 12.8, 11.8, 10.…
$ Projected.Inventories.Qty <dbl> 6206, 5842, 5478, 5218, 4482, 3623, 276…
$ Supply <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …Let’s create a table using reactable :
# keep only the needed columns
df1 <- Selected_DB |> select(Period,
Demand,
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" ))
# 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"
)
),
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"
)
}
),
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 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
projected coverages
#------------------------------
# Get data
df1 <- calculated_projection
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[is.na(df1$Demand)] <- 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, Calculated.Coverage.in.Periods)
# format as numeric
df1$Calculated.Coverage.in.Periods <- as.numeric(df1$Calculated.Coverage.in.Periods)
# formatting 1 digit after comma
df1$Calculated.Coverage.in.Periods = round(df1$Calculated.Coverage.in.Periods, 1)
# spread data
df1 <- df1 |> spread(Period, 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,
#filter = list(position = 'top', clear = FALSE),
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:20,
backgroundColor = styleInterval(c(-0.1,0.0,1.0), c('#FF6347', 'orange', 'yellow','lightblue'))
) |>
formatStyle(
2:2,
backgroundColor = 'mediumseagreen'
) 3.3) Add Delay Analysis Check
We can imagine creating a tag to inform us when the projected inventories are negative, which means we have a risk of delay.
It’s somehow like “screening” all the projected inventories (in a pretty simple way!).
#--------
# Create a Delay.Analysis check
#--------
# set a working df
df1 <- Initial_DB
# aggregate
df1 <- df1 |> group_by(DFU) |>
summarise(min.Projected.Inventories.Qty = min(Projected.Inventories.Qty),
max.Projected.Inventories.Qty = max(Projected.Inventories.Qty)
)
#-----------------
# Identify where we are late to supply
#-----------------
# Add a character info to analyze whether there is an identified delay or not
df1$Delay.Analysis <- if_else(df1$min.Projected.Inventories.Qty <= 0, "Delay", "OK")
# Get Results
Check_DB <- df1
head(Check_DB)# A tibble: 6 × 4
DFU min.Projected.Inventories.…¹ max.Projected.Invent…² Delay.Analysis
<chr> <dbl> <dbl> <chr>
1 Item 000001 385 6206 OK
2 Item 000002 1252 10954 OK
3 Item 000003 1180 2229 OK
4 Item 000004 98 9307 OK
5 Item 000005 3100 28600 OK
6 Item 000006 6531 15730 OK
# ℹ abbreviated names: ¹min.Projected.Inventories.Qty,
# ²max.Projected.Inventories.QtyNow let’s add this Check_DB to the previous dataframe :
#--------
# Merge
#--------
# merge
df1 <- left_join(Check_DB, Interim_DB)
df1 <- as.data.frame(df1)
# Note : we could use a filter to keep only those rows, in a shiny app for example
# filter on Delay.Analysis
# df1 <- filter(df1, df1$Delay.Analysis %in% input$Selected.Delay.Analysis)
# needed variables
df1 <- df1 |> select(-min.Projected.Inventories.Qty,
-max.Projected.Inventories.Qty)
#------------------------------
# create DT
datatable(df1,
#filter = list(position = 'top', clear = FALSE),
options = list(
searching = FALSE,
pageLength = 20,
columnDefs = list(list(width = '200px', targets = c(1,2)))
),rownames= FALSE) %>%
formatRound(3:3, 1) %>%
formatStyle(columns = c(1:100), fontSize = '85%') %>%
formatStyle(
4:20,
backgroundColor = styleInterval(c(-0.1,0.0,1.0), c('#FF6347', 'orange', 'yellow','lightblue'))
) %>%
formatStyle(
3:3,
backgroundColor = 'mediumseagreen'
) 4) Cockpit
We can also use another way, more compact, to get :
an overview of the projected inventories
an analysis of the projected values
4.1) Create Dataframe
#------------------------------
# Get data
df1 <- calculated_projection
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 this initial dataset
Initial_DB <- df1
#-----------------
# Get Summary of variables
#-----------------
# set a working df
df1 <- Initial_DB
# aggregate
df1 <- df1 |> group_by(DFU) |>
summarise(Demand = sum(Demand),
Opening = sum(Opening),
Supply = sum(Supply)
)
# 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 <- Initial_DB
# replace missing values by zero
df1$Demand[is.na(df1$Demand)] <- 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 <- Initial_DB
# replace missing values by zero
df1$Supply[is.na(df1$Supply)] <- 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
#-----------------
# Get Sparklines Projected Inventories
#-----------------
# set a working df
df1 <- Initial_DB
# replace missing values by zero
df1$Projected.Inventories.Qty[is.na(df1$Projected.Inventories.Qty)] <- 0
# aggregate
df1 <- df1 |> group_by(DFU,Period) |>
summarise(
Quantity = sum(Projected.Inventories.Qty)
)
# generate Sparkline
df1 <- df1 |> group_by(DFU) |> summarise(PI.Quantity = list(Quantity))
# keep Results
PI_Sparklines_DB <- df1
#--------
# Create a Delay.Analysis check
#--------
# set a working df
df1 <- Initial_DB
# aggregate
df1 <- df1 |> group_by(DFU) |>
summarise(min.Projected.Inventories.Qty = min(Projected.Inventories.Qty),
max.Projected.Inventories.Qty = max(Projected.Inventories.Qty)
)
#-----------------
# Identify where we are late to supply
#-----------------
# Add a character info to analyze whether there is an identified delay or not
df1$Delay.Analysis <- if_else(df1$min.Projected.Inventories.Qty <= 0, "Delay", "OK")
# Get Results
Check_DB <- df1
#-----------------
# Merge dataframes
#-----------------
# merge
df1 <- left_join(Value_DB, Demand_Sparklines_DB)
df1 <- left_join(df1, Supply_Sparklines_DB)
df1 <- left_join(df1, PI_Sparklines_DB)
df1 <- left_join(df1, Check_DB)
# reorder columns
df1 <- df1 |> select(DFU, Demand, Demand.pc, Demand.Quantity,
Supply, Supply.Quantity,
Opening,
PI.Quantity,
Delay.Analysis)
# get results
Summary_DB <- df1
glimpse(Summary_DB)Rows: 10
Columns: 9
$ DFU <chr> "Item 000001", "Item 000002", "Item 000003", "Item 000…
$ Demand <dbl> 6185, 18458, 1314, 12336, 29700, 17846, 3870, 49416, 9…
$ Demand.pc <dbl> 0.042589379, 0.127100204, 0.009048091, 0.084944637, 0.…
$ Demand.Quantity <list> <364, 364, 364, 260, 736, 859, 859, 859, 273, 349, 34…
$ Supply <dbl> 0, 15120, 0, 10000, 30000, 17556, 2593, 27000, 0, 2520
$ Supply.Quantity <list> <0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0>, <0, 0, 0, 103…
$ Opening <dbl> 6570, 5509, 2494, 7172, 17500, 9954, 2092, 17500, 122…
$ PI.Quantity <list> <6206, 5842, 5478, 5218, 4482, 3623, 2764, 1905, 1632,…
$ Delay.Analysis <chr> "OK", "OK", "OK", "OK", "OK", "OK", "OK", "Delay", "O…4.2) Display 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 a reactable :
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 (%)",
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"
#chartRangeMin = 0, chartRangeMax = max(chickwts$weight)
)
}),
PI.Quantity = colDef(
name = "Projected Inventories",
cell = function(values) {
sparkline(values, type = "bar"
#chartRangeMin = 0, chartRangeMax = max(chickwts$weight)
)
}),
Delay.Analysis = colDef(
name = "Delay Analysis",
cell = function(value) {
color <- switch(
value,
OK = "hsl(120,61%,50%)",
Delay = "hsl(39,100%,50%)"
)
badge <- status_badge(color = color)
tagList(badge, value)
})
), # close columns list
defaultColDef = colDef(footerStyle = list(fontWeight = "bold")),
columnGroups = list(
colGroup(name = "Demand",
columns = c("Demand",
"Demand.pc",
"Demand.Quantity")),
colGroup(name = "Supply",
columns = c("Supply", "Supply.Quantity")),
colGroup(name = "Inventories",
columns = c("Opening", "PI.Quantity", "Delay.Analysis"))
)
) # close reactableThis cockpit gives us a quick overview about the risks of delays (negative projected inventories). However, we don’t know:
about the possible overstocks
whether those delays, or overstocks, are significant versus some targets.
We can then introduce 2 new parameters :
Min.Cov : Minimum Coverage target, expressed in Period
Max.Cov : Maximum Coverage target, expressed in Periods
And calculate the projected inventories and coverages using the proj_inv() function.
Then, we’ll be able to compare the projected coverages versus those 2 target levels.
Et voilà! :)