library(tidyverse)
library(dplyr)
library(lubridate)
library(tidyverse)
library(shiny)
# for the tables
library(reactable)
library(reactablefmtr)
library(sparkline)
library(DT)
# for the charts
library(highcharter)
# the library planr
library(planr)Some examples to apply the planr functions for portfolios
Let’s look at the demo dataset blueprint_light.
The raw data look like this:
df1 <- blueprint_light
glimpse(df1)
#> Rows: 520
#> Columns: 5
#> $ DFU <chr> "Item 000001", "Item 000001", "Item 000001", "Item 000001", "I…
#> $ Period <date> 2022-07-03, 2022-07-10, 2022-07-17, 2022-07-24, 2022-07-31, 2…
#> $ Demand <dbl> 364, 364, 364, 260, 736, 859, 859, 859, 273, 349, 349, 349, 20…
#> $ Opening <dbl> 6570, 0, 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, 0,…Let’s have a summary view, using the reactable package:
#-----------------
# Get Summary of variables
#-----------------
# set a working df
df1 <- blueprint_light
# aggregate
df1 <- df1 %>% select(DFU,
Demand,
Opening,
Supply) %>%
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)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Supply_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
# 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 reactable
# set a working df
df1 <- blueprint_light
df1 <- as.data.frame(df1)
glimpse(df1)
#> Rows: 520
#> Columns: 5
#> $ DFU <chr> "Item 000001", "Item 000001", "Item 000001", "Item 000001", "I…
#> $ Period <date> 2022-07-03, 2022-07-10, 2022-07-17, 2022-07-24, 2022-07-31, 2…
#> $ Demand <dbl> 364, 364, 364, 260, 736, 859, 859, 859, 273, 349, 349, 349, 20…
#> $ Opening <dbl> 6570, 0, 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, 0,…
# calculate
calculated_projection <- light_proj_inv(dataset = df1,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening = Opening,
Supply = Supply)
#> Joining with `by = join_by(DFU, Period)`
# 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 0Let’s look at the Item 000001 :
calculated_projection <-as.data.frame(calculated_projection)
# 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 reactableWe 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
# subset Period based on those Starting and Ending Periods
df1 <- subset(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 %>% select(
DFU,
Demand) %>%
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[,c("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)
#> Joining with `by = join_by(DFU)`
# Sort by Demand.Qty descending
df1 <- df1[order(-df1$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'
) 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 somehowe 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 %>% select(DFU, Period,Projected.Inventories.Qty) %>%
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 dataframes :
#--------
# Merge
#--------
# merge
df1 <- left_join(Check_DB, Interim_DB)
#> Joining with `by = join_by(DFU)`
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)
# remove not needed columns
df1 <- df1[ , -which(names(df1) %in% c("min.Projected.Inventories.Qty",
"max.Projected.Inventories.Qty"
#"Delay.Analysis"
))]
#------------------------------
# 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'
) We can also use another way, more compact, to get : - an overview of the projected inventories - an analysis of the projected values
#------------------------------
# Get data
df1 <- calculated_projection
df1 <- as.data.frame(df1)
#------------------------------
# Filter
# subset Period based on those Starting and Ending Periods
df1 <- subset(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 %>% select(DFU,
Demand,
Opening,
Supply) %>%
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)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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 %>% select(DFU, Period,Projected.Inventories.Qty) %>%
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)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Supply_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, PI_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Check_DB)
#> Joining with `by = join_by(DFU)`
# 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…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.
Let’s look at the demo dataset blueprint_light.
The raw data look like this:
df1 <- blueprint
glimpse(df1)
#> Rows: 520
#> Columns: 7
#> $ DFU <chr> "Item 000001", "Item 000001", "Item 000001", "Item 000001", "I…
#> $ Period <date> 2022-07-03, 2022-07-10, 2022-07-17, 2022-07-24, 2022-07-31, 2…
#> $ Demand <dbl> 364, 364, 364, 260, 736, 859, 859, 859, 273, 349, 349, 349, 20…
#> $ Opening <dbl> 6570, 0, 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, 0,…
#> $ Min.Cov <dbl> 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,…
#> $ Max.Cov <dbl> 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12…Let’s have a summary view, using the reactable package:
#-----------------
# Get Summary of variables
#-----------------
# set a working df
df1 <- blueprint
# aggregate
df1 <- df1 %>% select(DFU,
Demand,
Opening,
Supply,
Min.Cov,
Max.Cov) %>%
group_by(DFU) %>%
summarise(Demand = sum(Demand),
Opening = sum(Opening),
Supply = sum(Supply),
Min.Cov = mean(Min.Cov),
Max.Cov = mean(Max.Cov)
)
# 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)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Supply_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
# reorder columns
df1 <- df1 %>% select(DFU,
Min.Cov, Max.Cov,
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…
#> $ Min.Cov <dbl> 4, 8, 4, 2, 4, 6, 6, 4, 4, 4
#> $ Max.Cov <dbl> 12, 16, 12, 6, 12, 16, 12, 12, 12, 12
#> $ 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,…Let’s create a function bar_style() to be used within the reactable:
#--------------------------------------------------------------------------------------
# A Function for a bar chart in the background of the cell
#--------------------------------------------------------------------------------------
# Render a bar chart in the background of the cell
bar_style <- function(width = 1, fill = "#e6e6e6", height = "75%", align = c("left", "right"), color = NULL) {
align <- match.arg(align)
if (align == "left") {
position <- paste0(width * 100, "%")
image <- sprintf("linear-gradient(90deg, %1$s %2$s, transparent %2$s)", fill, position)
} else {
position <- paste0(100 - width * 100, "%")
image <- sprintf("linear-gradient(90deg, transparent %1$s, %2$s %1$s)", position, fill)
}
list(
backgroundImage = image,
backgroundSize = paste("100%", height),
backgroundRepeat = "no-repeat",
backgroundPosition = "center",
color = color
)
}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)
)
}),
`Min.Cov`= colDef(
name = "Min Coverage (Periods)",
style = function(value) {
bar_style(width = value / max(df1$Min.Cov), fill = "hsl(208, 70%, 90%)")
}
),
`Max.Cov`= colDef(
name = "Max Coverage (Periods)",
style = function(value) {
bar_style(width = value / max(df1$Max.Cov), fill = "hsl(0,79%,72%)")
}
)
), # 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 reactableLet’s apply the proj_inv() function :
# set a working df
df1 <- blueprint
df1 <- as.data.frame(df1)
# calculate
calculated_projection_and_analysis <- proj_inv(data = df1,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening = Opening,
Supply = Supply,
Min.Cov = Min.Cov,
Max.Cov = Max.Cov)
#> Joining with `by = join_by(DFU, Period)`
#> Joining with `by = join_by(DFU, Period)`
head(calculated_projection_and_analysis)
#> 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 Min.Cov Max.Cov Safety.Stocks Maximum.Stocks
#> 1 6206 0 4 12 1724 5821
#> 2 5842 0 4 12 2219 5471
#> 3 5478 0 4 12 2714 5132
#> 4 5218 0 4 12 3313 4904
#> 5 4482 0 4 12 2850 4185
#> 6 3623 0 4 12 2340 3693
#> PI.Index Ratio.PI.vs.min Ratio.PI.vs.Max
#> 1 OverStock 3.60 1.07
#> 2 OverStock 2.63 1.07
#> 3 OverStock 2.02 1.07
#> 4 OverStock 1.58 1.06
#> 5 OverStock 1.57 1.07
#> 6 OK 1.55 0.98Let’s look at the Item 000001 :
calculated_projection_and_analysis <-as.data.frame(calculated_projection_and_analysis)
# filter data
Selected_DB <- filter(calculated_projection_and_analysis, calculated_projection_and_analysis$DFU == "Item 000001")
glimpse(Selected_DB)
#> Rows: 52
#> Columns: 14
#> $ 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, …
#> $ Min.Cov <dbl> 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, …
#> $ Max.Cov <dbl> 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,…
#> $ Safety.Stocks <dbl> 1724, 2219, 2714, 3313, 2850, 2340, 183…
#> $ Maximum.Stocks <dbl> 5821, 5471, 5132, 4904, 4185, 3693, 334…
#> $ PI.Index <chr> "OverStock", "OverStock", "OverStock", …
#> $ Ratio.PI.vs.min <dbl> 3.60, 2.63, 2.02, 1.58, 1.57, 1.55, 1.5…
#> $ Ratio.PI.vs.Max <dbl> 1.07, 1.07, 1.07, 1.06, 1.07, 0.98, 0.8…First, let’s create a function status_PI.Index()
# create a function status.PI.Index
status_PI.Index <- function(color = "#aaa", width = "0.55rem", height = width) {
span(style = list(
display = "inline-block",
marginRight = "0.5rem",
width = width,
height = height,
backgroundColor = color,
borderRadius = "50%"
))
}Let’s create a table using reactable :
# set a working df
df1 <- Selected_DB
# remove not needed column
df1 <- df1[ , -which(names(df1) %in% c("DFU"))]
# 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 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,
#round_edges = TRUE
#value <- format(value, big.mark = ","),
#number_fmt = big.mark = ",",
fill_color = "#3fc1c9",
#fill_opacity = 0.8,
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,
#round_edges = TRUE
#value <- format(value, big.mark = ","),
#number_fmt = big.mark = ",",
fill_color = "#3CB371",
#fill_opacity = 0.8,
text_position = "outside-end"
)
#format = colFormat(separators = TRUE, digits=0)
#number_fmt = big.mark = ","
),
PI.Index = colDef(
name = "Analysis",
cell = function(value) {
color <- switch(
value,
TBC = "hsl(154, 3%, 50%)",
OverStock = "hsl(214, 45%, 50%)",
OK = "hsl(154, 64%, 50%)",
Alert = "hsl(30, 97%, 70%)",
Shortage = "hsl(3, 69%, 50%)"
)
PI.Index <- status_PI.Index(color = color)
tagList(PI.Index, value)
}),
`Safety.Stocks`= colDef(
name = "Safety Stocks (units)",
format = colFormat(separators = TRUE, digits=0)
),
`Maximum.Stocks`= colDef(
name = "Maximum Stocks (units)",
format = colFormat(separators = TRUE, digits=0)
),
`Opening`= colDef(
name = "Opening Inventories (units)",
format = colFormat(separators = TRUE, digits=0)
),
`Min.Cov`= colDef(name = "Min Stocks Coverage (Periods)"),
`Max.Cov`= colDef(name = "Maximum Stocks Coverage (Periods)"),
# ratios
`Ratio.PI.vs.min`= colDef(name = "Ratio PI vs min"),
`Ratio.PI.vs.Max`= colDef(name = "Ratio PI vs Max")
), # close columns lits
columnGroups = list(
colGroup(name = "Projected Inventories", columns = c("Calculated.Coverage.in.Periods",
"Projected.Inventories.Qty")),
colGroup(name = "Stocks Levels Parameters", columns = c("Min.Cov",
"Max.Cov",
"Safety.Stocks",
"Maximum.Stocks")),
colGroup(name = "Analysis Features", columns = c("PI.Index",
"Ratio.PI.vs.min",
"Ratio.PI.vs.Max"))
)
) # close reactableWe can see that in the column [PI.Index] we have several possible values, among them: - OverStock - OK - Alert - Shortage
We might be interested especially in 3 of them : OverStock / Alert / Shortage And a second question after having identified those values could be: - my how much (vs target) are we in an Overstock or Alert situation?
The 2 ratios become quite useful here, to focus only on the important differences: - Ratio.PI.vs.min - Ratio.PI.vs.Max
Let’s say that we want to look only at the Overstock situations, without considering any particular ratio. We can then highlight only the Overstock and just create a Supply Risks Alarm table as we saw previously.
If we want to focus on only the important Overstocks, we can filter based on the field [Ratio.PI.vs.Max].
Let’s highlight only the Overstocks :
# set a working dataframe
df1 <-as.data.frame(calculated_projection_and_analysis)
#------------------------------
# Filter
# subset Period based on those Starting and Ending Periods
df1 <- subset(df1,df1$Period >= "2022-07-03" & df1$Period <= "2022-09-25")
df1$PI.Index <- if_else(df1$PI.Index == "OverStock", "OverStock", "")
glimpse(df1)
#> Rows: 130
#> Columns: 14
#> $ 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, …
#> $ Min.Cov <dbl> 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, …
#> $ Max.Cov <dbl> 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,…
#> $ Safety.Stocks <dbl> 1724, 2219, 2714, 3313, 2850, 2340, 183…
#> $ Maximum.Stocks <dbl> 5821, 5471, 5132, 4904, 4185, 3693, 334…
#> $ PI.Index <chr> "OverStock", "OverStock", "OverStock", …
#> $ Ratio.PI.vs.min <dbl> 3.60, 2.63, 2.02, 1.58, 1.57, 1.55, 1.5…
#> $ Ratio.PI.vs.Max <dbl> 1.07, 1.07, 1.07, 1.06, 1.07, 0.98, 0.8…Now let’s create the table
#--------
# 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 %>% select(
DFU,
Demand) %>%
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[,c("DFU","Period","PI.Index")]
# spread data
df1 <- df1 %>% spread(Period, PI.Index)
# 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)
#> Joining with `by = join_by(DFU)`
# Sort by Demand.Qty descending
df1 <- df1[order(-df1$Demand.Qty),]
# rename column
df1 <- df1 %>% rename(
"Total Demand (units)" = Demand.Qty
)
# Get Results
Interim_DB <- df1Let’s visualize through a DT table :
# set a working df
df1 <- Interim_DB
# 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(2:2, 1) %>%
formatStyle(columns = c(1:100), fontSize = '85%') %>%
formatStyle(
3:20,
backgroundColor = styleEqual(
c('OverStock'), c('orange')
)) %>%
formatStyle(
2:2,
backgroundColor = 'mediumseagreen'
) We can imagine a cockpit informing us about : - OverStock - Alert - Shortage
#------------------------------
# Get data
df1 <- calculated_projection_and_analysis
df1 <- as.data.frame(df1)
#------------------------------
# Filter
# subset Period based on those Starting and Ending Periods
df1 <- subset(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 %>% select(DFU,
Demand,
Opening,
Supply) %>%
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)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# generate Sparkline
df1 <- df1 %>%
group_by(DFU) %>%
summarise(PI.Quantity = list(Quantity))
# keep Results
PI_Sparklines_DB <- df1
#--------
# Check if OverStock
#--------
# set a working df
df1 <- Initial_DB
# focus on OverStocks, by filtering data
df1$PI.Index.Value <- if_else(df1$PI.Index == "OverStock", 1, 0)
# aggregate
df1 <- df1 %>% select(DFU, PI.Index.Value) %>%
group_by(DFU) %>%
summarise(OverStock = max(PI.Index.Value)
)
# Get Results
OverStock_DB <- df1
#--------
# Check if Alert
#--------
# set a working df
df1 <- Initial_DB
# focus on Alert, by filtering data
df1$PI.Index.Value <- if_else(df1$PI.Index == "Alert", 1, 0)
# aggregate
df1 <- df1 %>% select(DFU, PI.Index.Value) %>%
group_by(DFU) %>%
summarise(Alert = max(PI.Index.Value)
)
# Get Results
Alert_DB <- df1
#--------
# Check if Shortage
#--------
# set a working df
df1 <- Initial_DB
# focus on Shortage, by filtering data
df1$PI.Index.Value <- if_else(df1$PI.Index == "Shortage", 1, 0)
# aggregate
df1 <- df1 %>% select(DFU, PI.Index.Value) %>%
group_by(DFU) %>%
summarise(Shortage = max(PI.Index.Value)
)
# Get Results
Shortage_DB <- df1
#-----------------
# Merge dataframes
#-----------------
# merge
df1 <- left_join(Value_DB, Demand_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Supply_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, PI_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, OverStock_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Alert_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Shortage_DB)
#> Joining with `by = join_by(DFU)`
# reorder columns
df1 <- df1 %>% select(DFU, Demand, Demand.pc, Demand.Quantity,
Supply, Supply.Quantity,
Opening,
PI.Quantity,
OverStock,
Alert,
Shortage)
# replace figures by values
df1$OverStock <- if_else(df1$OverStock == 1, "Y", "")
df1$Alert <- if_else(df1$Alert == 1, "Y", "")
df1$Shortage <- if_else(df1$Shortage == 1, "Y", "")
# get results
Summary_DB <- df1
glimpse(Summary_DB)
#> Rows: 10
#> Columns: 11
#> $ 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,…
#> $ OverStock <chr> "Y", "", "Y", "Y", "Y", "", "", "", "Y", ""
#> $ Alert <chr> "", "Y", "", "Y", "Y", "Y", "Y", "Y", "Y", "Y"
#> $ Shortage <chr> "", "", "", "", "", "", "", "Y", "", "Y"We will use again the previous function to display a badge.
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)
)
}),
OverStock = colDef(
name = "OverStock",
cell = function(value) {
color <- switch(
value,
N = "hsl(120,61%,50%)",
Y = "rgb(135,206,250)"
)
badge <- status_badge(color = color)
tagList(badge, value)
}),
Alert = colDef(
name = "Alert",
cell = function(value) {
color <- switch(
value,
N = "hsl(120,61%,50%)",
Y = "hsl(39,100%,50%)"
)
badge <- status_badge(color = color)
tagList(badge, value)
}),
Shortage = colDef(
name = "Shortage",
cell = function(value) {
color <- switch(
value,
N = "hsl(120,61%,50%)",
Y = "hsl(16,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")),
colGroup(name = "Analysis",
columns = c("OverStock", "Alert", "Shortage"))
)
) # close reactableWe could look at it through a different angle, considering the Period. For example a display of the analysis for the next 4 periods of time, the next 5 to 8, the next 9 to 12 periods. This way we get one more insight : when the issue (OverStock / Delay / Shortage) will occur.
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, …Let’s have a summary view, using the reactable package:
#-----------------
# Get Summary of variables
#-----------------
# set a working df
df1 <- blueprint_drp
# aggregate
df1 <- df1 %>% select(DFU,
Demand,
Opening,
Supply,
SSCov,
DRPCovDur,
MOQ) %>%
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[is.na(df1$Demand)] <- 0
# aggregate
df1 <- df1 %>%
group_by(
DFU,
Period
) %>%
summarise(
Quantity = sum(Demand)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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[is.na(df1$Supply)] <- 0
# aggregate
df1 <- df1 %>%
group_by(
DFU,
Period
) %>%
summarise(
Quantity = sum(Supply)
)
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
# 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)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Supply_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
# 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: 10
#> $ 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
#> $ MOQ <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
#> $ 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, 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)
)
}),
`SSCov`= colDef(
name = "Safety Stock (Periods)",
style = function(value) {
bar_style(width = value / max(df1$Min.Cov), fill = "hsl(208, 70%, 90%)")
}
),
`DRPCovDur`= colDef(
name = "Frequency of Supply (Periods)",
style = function(value) {
bar_style(width = value / max(df1$Max.Cov), fill = "hsl(0,79%,72%)")
}
)
), # close columns list
defaultColDef = colDef(footerStyle = list(fontWeight = "bold")),
columnGroups = list(
colGroup(name = "DRP parameters",
columns = c("SSCov", "DRPCovDur", "MOQ")),
colGroup(name = "Demand",
columns = c("Demand",
"Demand.pc",
"Demand.Quantity")),
colGroup(name = "Supply",
columns = c("Supply", "Supply.Quantity"))
)
) # close reactable
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -InfWe have 3 values for the Frozen Horizon: - Frozen - Free
The DRP Calculation is only performed within the Free Horizon, and 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,
#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(
2:20,
backgroundColor = styleEqual(
c('Frozen'), c('yellow')
)) Let’s apply the drp() function :
# set a working df
df1 <- blueprint_drp
df1 <- as.data.frame(df1)
# calculate drp
calculated_drp <- drp(data = df1,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening = Opening,
Supply = Supply,
SSCov = SSCov,
DRPCovDur = DRPCovDur,
MOQ = MOQ,
FH = FH
)
#> Joining with `by = join_by(DFU, Period)`
#> Joining with `by = join_by(DFU, Period)`
#> Joining with `by = join_by(DFU, Period)`
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 0Let’s look at the Item 000004 :
calculated_drp <-as.data.frame(calculated_drp)
# 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 :
# 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[is.na(df1$DRP.Projected.Inventories.Qty)] <- 0
df1$DRP.plan[is.na(df1$DRP.plan)] <- 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 reactableWe 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_drp
df1 <- as.data.frame(df1)
#------------------------------
# Filter
# subset Period based on those Starting and Ending Periods
df1 <- subset(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 %>% select(
DFU,
Demand) %>%
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[,c("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)
#> Joining with `by = join_by(DFU)`
# Sort by Demand.Qty descending
df1 <- df1[order(-df1$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,4.0), c('#FF6347', 'orange', 'yellow','lightblue'))
) %>%
formatStyle(
2:2,
backgroundColor = 'mediumseagreen'
)