library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(lubridate)
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(planr)
library(tidyverse)
## ── Attaching packages
## ───────────────────────────────────────
## tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6 ✔ purrr 0.3.4
## ✔ tibble 3.1.8 ✔ stringr 1.4.0
## ✔ tidyr 1.2.0 ✔ forcats 0.5.1
## ✔ readr 2.1.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ lubridate::as.difftime() masks base::as.difftime()
## ✖ lubridate::date() masks base::date()
## ✖ dplyr::filter() masks stats::filter()
## ✖ lubridate::intersect() masks base::intersect()
## ✖ dplyr::lag() masks stats::lag()
## ✖ lubridate::setdiff() masks base::setdiff()
## ✖ lubridate::union() masks base::union()
library(shiny)
# for the tables
library(reactable)
library(reactablefmtr)
##
## Attaching package: 'reactablefmtr'
##
## The following object is masked from 'package:ggplot2':
##
## margin
# for the charts
library(highcharter)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
# the library planr
library(planr)
Period <- c(
"1/1/2020", "2/1/2020", "3/1/2020", "4/1/2020", "5/1/2020", "6/1/2020", "7/1/2020", "8/1/2020", "9/1/2020", "10/1/2020", "11/1/2020", "12/1/2020","1/1/2021", "2/1/2021", "3/1/2021", "4/1/2021", "5/1/2021", "6/1/2021", "7/1/2021", "8/1/2021", "9/1/2021", "10/1/2021", "11/1/2021", "12/1/2021")
Demand <- c(360, 458,300,264,140,233,229,208,260,336,295,226,336,434,276,240,116,209,205,183,235,312,270,201)
Opening.Inventories <- c(1310,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
Supply.Plan <- c(0,0,0,0,0,2500,0,0,0,0,0,0,0,0,0,2000,0,0,0,0,0,0,0,0)
# assemble
my_demand_and_suppply <- data.frame(Period,
Demand,
Opening.Inventories,
Supply.Plan)
# let's add a Product
my_demand_and_suppply$DFU <- "Product A"
# format the Period as a date
my_demand_and_suppply$Period <- as.Date(as.character(my_demand_and_suppply$Period), format = '%m/%d/%Y')
# let's have a look at it
head(my_demand_and_suppply)
## Period Demand Opening.Inventories Supply.Plan DFU
## 1 2020-01-01 360 1310 0 Product A
## 2 2020-02-01 458 0 0 Product A
## 3 2020-03-01 300 0 0 Product A
## 4 2020-04-01 264 0 0 Product A
## 5 2020-05-01 140 0 0 Product A
## 6 2020-06-01 233 0 2500 Product A
It contains some basic features:
a Product: it’s an item, a SKU (Storage Keeping Unit), or a SKU at a location, also called a DFU (Demand Forecast Unit)
a Period of time : for example monthly or weekly buckets
a Demand : could be some sales forecasts, expressed in units
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
Let’s apply the light_proj_inv().
We are going to calculate 2 new features for each DFU:
projected inventories
projected coverages, based on the Demand Forecasts
# calculate
calculated_projection <- light_proj_inv(dataset = my_demand_and_suppply,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening.Inventories = Opening.Inventories,
Supply.Plan = Supply.Plan)
## Joining, by = c("DFU", "Period")
# see results
calculated_projection
## # A tibble: 24 × 7
## # Groups: DFU [1]
## DFU Period Demand Opening.Inventories Calculated.…¹ Proje…² Suppl…³
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Product A 2020-01-01 360 1310 2.7 950 0
## 2 Product A 2020-02-01 458 0 1.7 492 0
## 3 Product A 2020-03-01 300 0 0.7 192 0
## 4 Product A 2020-04-01 264 0 0 -72 0
## 5 Product A 2020-05-01 140 0 0 -212 0
## 6 Product A 2020-06-01 233 0 7.4 2055 2500
## 7 Product A 2020-07-01 229 0 6.4 1826 0
## 8 Product A 2020-08-01 208 0 5.4 1618 0
## 9 Product A 2020-09-01 260 0 4.4 1358 0
## 10 Product A 2020-10-01 336 0 3.4 1022 0
## # … with 14 more rows, and abbreviated variable names
## # ¹Calculated.Coverage.in.Periods, ²Projected.Inventories.Qty, ³Supply.Plan
We will use the libraries reactable and reactablefmtr to create a nice table.
# set a working df
df1 <- calculated_projection
# keep only the needed columns
df1 <- df1 %>% select(Period,
Demand,
Calculated.Coverage.in.Periods,
Projected.Inventories.Qty,
Supply.Plan)
## Adding missing grouping variables: `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 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.Plan = 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 reactable
# set a working df
df1 <- calculated_projection
# keep only the needed columns
df1 <- df1 %>% select(Period,
Projected.Inventories.Qty)
## Adding missing grouping variables: `DFU`
# create a value.index
df1$Value.Index <- if_else(df1$Projected.Inventories.Qty < 0, "Shortage", "Stock")
# spread
df1 <- df1 %>% spread(Value.Index, Projected.Inventories.Qty)
#----------------------------------------------------
# Chart
u <- highchart() %>%
hc_title(text = "Projected Inventories") %>%
hc_subtitle(text = "in units") %>%
hc_add_theme(hc_theme_google()) %>%
hc_xAxis(categories = df1$Period) %>%
hc_add_series(name = "Stock",
color = "#32CD32",
#dataLabels = list(align = "center", enabled = TRUE),
data = df1$Stock) %>%
hc_add_series(name = "Shortage",
color = "#dc3220",
#dataLabels = list(align = "center", enabled = TRUE),
data = df1$Shortage) %>%
hc_chart(type = "column") %>%
hc_plotOptions(series = list(stacking = "normal"))
u
Now, let’s consider some parameters such as : - a target of minimum stock level - a target of maximum stock level
And then: - calculate the projected inventories and coverages - analyze those values vs those defined targets
First, let’s add some parameters to our initial database.
Define min & max coverages, through 2 parameters: - Min.Stocks.Coverage - Max.Stocks.Coverage
Expressed in number of periods of coverages. The periods can be in monthly buckets, weekly buckets, etc…
my_data_with_parameters <- my_demand_and_suppply
my_data_with_parameters$Min.Stocks.Coverage <- 2
my_data_with_parameters$Max.Stocks.Coverage <- 4
my_data_with_parameters
## Period Demand Opening.Inventories Supply.Plan DFU
## 1 2020-01-01 360 1310 0 Product A
## 2 2020-02-01 458 0 0 Product A
## 3 2020-03-01 300 0 0 Product A
## 4 2020-04-01 264 0 0 Product A
## 5 2020-05-01 140 0 0 Product A
## 6 2020-06-01 233 0 2500 Product A
## 7 2020-07-01 229 0 0 Product A
## 8 2020-08-01 208 0 0 Product A
## 9 2020-09-01 260 0 0 Product A
## 10 2020-10-01 336 0 0 Product A
## 11 2020-11-01 295 0 0 Product A
## 12 2020-12-01 226 0 0 Product A
## 13 2021-01-01 336 0 0 Product A
## 14 2021-02-01 434 0 0 Product A
## 15 2021-03-01 276 0 0 Product A
## 16 2021-04-01 240 0 2000 Product A
## 17 2021-05-01 116 0 0 Product A
## 18 2021-06-01 209 0 0 Product A
## 19 2021-07-01 205 0 0 Product A
## 20 2021-08-01 183 0 0 Product A
## 21 2021-09-01 235 0 0 Product A
## 22 2021-10-01 312 0 0 Product A
## 23 2021-11-01 270 0 0 Product A
## 24 2021-12-01 201 0 0 Product A
## Min.Stocks.Coverage Max.Stocks.Coverage
## 1 2 4
## 2 2 4
## 3 2 4
## 4 2 4
## 5 2 4
## 6 2 4
## 7 2 4
## 8 2 4
## 9 2 4
## 10 2 4
## 11 2 4
## 12 2 4
## 13 2 4
## 14 2 4
## 15 2 4
## 16 2 4
## 17 2 4
## 18 2 4
## 19 2 4
## 20 2 4
## 21 2 4
## 22 2 4
## 23 2 4
## 24 2 4
Let’s apply the proj_inv() function
df1 <- proj_inv(data = my_data_with_parameters,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening.Inventories = Opening.Inventories,
Supply.Plan = Supply.Plan,
Min.Stocks.Coverage = Min.Stocks.Coverage,
Max.Stocks.Coverage = Max.Stocks.Coverage)
## Joining, by = c("DFU", "Period")
## Joining, by = c("DFU", "Period")
# see results
calculated_projection_and_analysis <- df1
head(calculated_projection_and_analysis)
## # A tibble: 6 × 14
## # Groups: DFU [1]
## DFU Period Demand Opening.…¹ Calcu…² Proje…³ Suppl…⁴ Min.S…⁵ Max.S…⁶
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Product A 2020-01-01 360 1310 2.7 950 0 2 4
## 2 Product A 2020-02-01 458 0 1.7 492 0 2 4
## 3 Product A 2020-03-01 300 0 0.7 192 0 2 4
## 4 Product A 2020-04-01 264 0 0 -72 0 2 4
## 5 Product A 2020-05-01 140 0 0 -212 0 2 4
## 6 Product A 2020-06-01 233 0 7.4 2055 2500 2 4
## # … with 5 more variables: Safety.Stocks <dbl>, Maximum.Stocks <dbl>,
## # PI.Index <chr>, Ratio.PI.vs.min <dbl>, Ratio.PI.vs.Max <dbl>, and
## # abbreviated variable names ¹Opening.Inventories,
## # ²Calculated.Coverage.in.Periods, ³Projected.Inventories.Qty, ⁴Supply.Plan,
## # ⁵Min.Stocks.Coverage, ⁶Max.Stocks.Coverage
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%"
))
}
And now let’s create a reactable:
# set a working df
df1 <- calculated_projection_and_analysis
# 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.Plan = 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.Inventories`= colDef(
name = "Opening Inventories (units)",
format = colFormat(separators = TRUE, digits=0)
),
`Min.Stocks.Coverage`= colDef(name = "Min Stocks Coverage (Periods)"),
`Max.Stocks.Coverage`= 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.Stocks.Coverage",
"Max.Stocks.Coverage",
"Safety.Stocks",
"Maximum.Stocks")),
colGroup(name = "Analysis Features", columns = c("PI.Index",
"Ratio.PI.vs.min",
"Ratio.PI.vs.Max"))
)
) # close reactable
Compared to the previous table, we have here some additional information available: the calculated fields [Analysis Features] - based on safety & maximum stocks targets - useful for a mass analysis (Cockpit / Supply Risks Alarm), but perhaps too detailed for a focus on a SKU
We also can notice that the minimum and maximum stocks coverages, initially expressed in Periods (of coverage) are converted in units. It’s quite useful to chart the projected inventories vs those 2 thresholds for example.
# set a working df
df1 <- calculated_projection_and_analysis
# Chart
p <- highchart() %>%
hc_add_series(name = "Max", color = "crimson", data = df1$Maximum.Stocks) %>%
hc_add_series(name = "min", color = "lightblue", data = df1$Safety.Stocks) %>%
hc_add_series(name = "Projected Inventories", color = "gold", data = df1$Projected.Inventories.Qty) %>%
hc_title(text = "Projected Inventories") %>%
hc_subtitle(text = "in units") %>%
hc_xAxis(categories = df1$Period) %>%
#hc_yAxis(title = list(text = "Sales (units)")) %>%
hc_add_theme(hc_theme_google())
p
We can visualize the periods when we are in Alert & OverStock, comparing to the minimum and Maximum stocks levels.
Let’s now add a few parameters to the initial database “my_demand_and_suppply”
df1 <- my_demand_and_suppply
df1$SSCov <- 2
df1$DRPCovDur <- 3
df1$Reorder.Qty <- 1
df1$DRP.Grid <- c("Frozen",
"Frozen",
"Frozen",
"Frozen",
"Frozen",
"Frozen",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free",
"Free")
# get Results
my_drp_template <- df1
head(my_drp_template)
## Period Demand Opening.Inventories Supply.Plan DFU SSCov DRPCovDur
## 1 2020-01-01 360 1310 0 Product A 2 3
## 2 2020-02-01 458 0 0 Product A 2 3
## 3 2020-03-01 300 0 0 Product A 2 3
## 4 2020-04-01 264 0 0 Product A 2 3
## 5 2020-05-01 140 0 0 Product A 2 3
## 6 2020-06-01 233 0 2500 Product A 2 3
## Reorder.Qty DRP.Grid
## 1 1 Frozen
## 2 1 Frozen
## 3 1 Frozen
## 4 1 Frozen
## 5 1 Frozen
## 6 1 Frozen
Apply drp()
# set a working df
df1 <- my_drp_template
# calculate drp
demo_drp <- drp(data = df1,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening.Inventories = Opening.Inventories,
Supply.Plan = Supply.Plan,
SSCov = SSCov,
DRPCovDur = DRPCovDur,
Reorder.Qty = Reorder.Qty,
DRP.Grid = DRP.Grid
)
## Joining, by = c("DFU", "Period")
## Joining, by = c("DFU", "Period")
## Joining, by = c("DFU", "Period")
demo_drp
## # A tibble: 24 × 15
## # Groups: DFU [1]
## DFU Period Demand Openi…¹ Suppl…² SSCov DRPCo…³ Stock…⁴ Reord…⁵ DRP.G…⁶
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 Prod… 2020-01-01 360 1310 0 2 3 5 1 Frozen
## 2 Prod… 2020-02-01 458 0 0 2 3 5 1 Frozen
## 3 Prod… 2020-03-01 300 0 0 2 3 5 1 Frozen
## 4 Prod… 2020-04-01 264 0 0 2 3 5 1 Frozen
## 5 Prod… 2020-05-01 140 0 0 2 3 5 1 Frozen
## 6 Prod… 2020-06-01 233 0 2500 2 3 5 1 Frozen
## 7 Prod… 2020-07-01 229 0 0 2 3 5 1 Free
## 8 Prod… 2020-08-01 208 0 0 2 3 5 1 Free
## 9 Prod… 2020-09-01 260 0 0 2 3 5 1 Free
## 10 Prod… 2020-10-01 336 0 0 2 3 5 1 Free
## # … with 14 more rows, 5 more variables: Safety.Stocks <dbl>,
## # Maximum.Stocks <dbl>, DRP.Calculated.Coverage.in.Periods <dbl>,
## # DRP.Projected.Inventories.Qty <dbl>, DRP.plan <dbl>, and abbreviated
## # variable names ¹Opening.Inventories, ²Supply.Plan, ³DRPCovDur, ⁴Stock.Max,
## # ⁵Reorder.Qty, ⁶DRP.Grid
# set a working df
df1 <- demo_drp
# keep only the needed columns
df1 <- df1 %>% select(Period,
Demand,
DRP.Calculated.Coverage.in.Periods,
DRP.Projected.Inventories.Qty,
DRP.plan)
## Adding missing grouping variables: `DFU`
# replace missing values by zero
df1$DRP.plan[is.na(df1$DRP.plan)] <- 0
df1$DRP.Projected.Inventories.Qty[is.na(df1$DRP.Projected.Inventories.Qty)] <- 0
# create a f_colorpal field
df1 <- df1 %>% mutate(f_colorpal = case_when( DRP.Calculated.Coverage.in.Periods > 8 ~ "#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 = "Replenishment (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 reactable
# set a working df
df1 <- demo_drp
# Chart
p <- highchart() %>%
hc_add_series(name = "Max", color = "crimson", data = df1$Maximum.Stocks) %>%
hc_add_series(name = "min", color = "lightblue", data = df1$Safety.Stocks) %>%
hc_add_series(name = "Projected Inventories", color = "gold", data = df1$DRP.Projected.Inventories.Qty) %>%
hc_title(text = "(DRP) Projected Inventories") %>%
hc_subtitle(text = "in units") %>%
hc_xAxis(categories = df1$Period) %>%
#hc_yAxis(title = list(text = "Sales (units)")) %>%
hc_add_theme(hc_theme_google())
p