A little demo to calculate projected inventories & coverages, using the R package planr.
planr is available on :
CRAN : https://cran.r-project.org/web/packages/planr/index.html
GitHub : https://github.com/nguyennico/planr
About planr package:
Tools for Supply Chain Management, Demand and Supply Planning
Perform flexible and quick calculations for Demand and Supply Planning, such as projected inventories and coverages, as well as replenishment plan.
For any time bucket, daily, weekly or monthly, and any granularity level, product or group of products
Upload Libraries
# Demand
df1 <- read_csv("Demand_Forecasts_DB.csv")## Rows: 50 Columns: 53
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): DFU
## dbl (52): 7/3/2022, 7/10/2022, 7/17/2022, 7/24/2022, 7/31/2022, 8/7/2022, 8/...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Melt
df1 <- df1 %>% gather(key = "Period", value = "Demand", 2:length(df1))
# Format Date
df1$Period <- as.Date(as.character(df1$Period), format = '%m/%d/%Y')
# remove rows w/ NA in Period
df1 <- df1 %>% drop_na(Period)
# Get Results
Demand_DB <- df1
glimpse(Demand_DB)## Rows: 2,600
## Columns: 3
## $ DFU <chr> "Item 000001", "Item 000002", "Item 000003", "Item 000004", "It…
## $ Period <date> 2022-07-03, 2022-07-03, 2022-07-03, 2022-07-03, 2022-07-03, 20…
## $ Demand <dbl> 364, 1419, 265, 1296, 265, 1141, 126, 6859, 66, 380, 7, 61, 128…# get raw data
df1 <- read_csv("Opening_Inventories_DB.csv")## Rows: 50 Columns: 53
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): DFU
## dbl (52): 7/3/2022, 7/10/2022, 7/17/2022, 7/24/2022, 7/31/2022, 8/7/2022, 8/...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Melt
df1 <- df1 %>% gather(key = "Period", value = "Opening", 2:length(df1))
# Format Date
df1$Period<-as.Date(as.character(df1$Period), format = '%m/%d/%Y')
# get results
Opening_Inventories_DB <- df1
glimpse(Opening_Inventories_DB)## Rows: 2,600
## Columns: 3
## $ DFU <chr> "Item 000001", "Item 000002", "Item 000003", "Item 000004", "I…
## $ Period <date> 2022-07-03, 2022-07-03, 2022-07-03, 2022-07-03, 2022-07-03, 2…
## $ Opening <dbl> 6570, 5509, 2494, 7172, 1464, 9954, 2092, 17772, 1222, 3411, 2…# get raw data
df1 <- read_csv("Supply_Plan_DB.csv")## Rows: 50 Columns: 53
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): DFU
## dbl (52): 7/3/2022, 7/10/2022, 7/17/2022, 7/24/2022, 7/31/2022, 8/7/2022, 8/...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Melt
df1 <- df1 %>% gather(key = "Period", value = "Supply", 2:length(df1))
# Format Date
df1$Period<-as.Date(as.character(df1$Period), format = '%m/%d/%Y')
# get results
Supply_DB <- df1
glimpse(Supply_DB)## Rows: 2,600
## Columns: 3
## $ DFU <chr> "Item 000001", "Item 000002", "Item 000003", "Item 000004", "It…
## $ Period <date> 2022-07-03, 2022-07-03, 2022-07-03, 2022-07-03, 2022-07-03, 20…
## $ Supply <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1585, …# merge
df1 <- left_join(Demand_DB, Opening_Inventories_DB)
df1 <- left_join(df1, Supply_DB)
# Get Results
Blueprint_DB <- df1
head(Blueprint_DB)## # 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 000002 2022-07-03 1419 5509 0
## 3 Item 000003 2022-07-03 265 2494 0
## 4 Item 000004 2022-07-03 1296 7172 0
## 5 Item 000005 2022-07-03 265 1464 0
## 6 Item 000006 2022-07-03 1141 9954 0Apply function light_proj_inv
start_time <- Sys.time()
Calculated_PI_DB <- light_proj_inv(data = Blueprint_DB,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening = Opening,
Supply = Supply)
end_time <- Sys.time()
calculation.time <- end_time - start_time
calculation.time## Time difference of 0.645745 secshead(Calculated_PI_DB)## # A tibble: 6 × 7
## # Groups: DFU [1]
## DFU Period Demand Opening Calculated.Coverage.…¹ Projected.Inventorie…²
## <chr> <date> <dbl> <dbl> <dbl> <dbl>
## 1 Item … 2022-07-03 364 6570 17 6206
## 2 Item … 2022-07-10 364 0 16 5842
## 3 Item … 2022-07-17 364 0 15 5478
## 4 Item … 2022-07-24 260 0 14 5218
## 5 Item … 2022-07-31 736 0 13 4482
## 6 Item … 2022-08-07 859 0 12 3623
## # ℹ abbreviated names: ¹Calculated.Coverage.in.Periods,
## # ²Projected.Inventories.Qty
## # ℹ 1 more variable: Supply <dbl>for a single Item
#--------------
# Select Item
#--------------
# set a working df
df1 <- Calculated_PI_DB
df1 <- as.data.frame(df1)
# filter
df1 <- filter(df1, df1$DFU %in% c("Item 000008"))
#--------------
# Create Table
#--------------
# keep only the needed columns
df1 <- df1 %>% 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 > 8 ~ "#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 reactable#--------------
# Select Item
#--------------
# set a working df
df1 <- Calculated_PI_DB
df1 <- as.data.frame(df1)
# filter
df1 <- filter(df1, df1$DFU %in% c("Item 000008"))
# subset Period based on those Starting and Ending Periods
df1 <- subset(df1,df1$Period >= "2022-07-03" & df1$Period <= "2022-11-30")
#--------------
# Prepare data
#--------------
# keep only the needed columns
df1 <- df1 %>% select(Period,
Projected.Inventories.Qty)
# 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 #------------------------------
# Get data
df1 <- Calculated_PI_DB
#------------------------------
# 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)
)
# 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 %>% 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)
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: 50
## Columns: 9
## $ DFU <chr> "Item 000001", "Item 000002", "Item 000003", "Item 000…
## $ Demand <dbl> 6185, 18458, 1314, 12336, 1546, 17846, 3870, 49416, 90…
## $ Demand.pc <dbl> 0.012262677, 0.036595714, 0.002605199, 0.024457944, 0.…
## $ Demand.Quantity <list> <364, 364, 364, 260, 736, 859, 859, 859, 273, 349, 34…
## $ Supply <dbl> 0, 15120, 6733, 11713, 1187, 17556, 2593, 25709, 0, 25…
## $ Supply.Quantity <list> <0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0>, <0, 0, 0, 10…
## $ Opening <dbl> 6570, 5509, 2494, 7172, 1464, 9954, 2092, 17772, 1222,…
## $ PI.Quantity <list> <6206, 5842, 5478, 5218, 4482, 3623, 2764, 1905, 1632…
## $ Delay.Analysis <chr> "OK", "OK", "OK", "Delay", "OK", "OK", "OK", "Delay", …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.