First, let’s load a few libraries :
# 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)
We’re going to use the proj_inv() from the R package planr, and apply it on a portfolio of products.
This function is presented in : https://rpubs.com/nikonguyen/proj_inv_simple_demo
More info on : https://github.com/nguyennico/planr
We’re going to create a cockpit with more features compared to the
one built using the function light_proj_inv().
The idea is to know about :
the possible overstocks
whether those delays, or overstocks, are significant versus some targets
We then use the 2 new parameters :
Min.Cov : Minimum Coverage target, expressed in Periods
Max.Cov : Maximum Coverage target, expressed in Periods
And we’ll be able to compare the projected inventories & coverages versus those 2 target levels.
Let’s look at the demo dataset blueprint.
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 |> 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
# replace missing values by zero
df1$Demand <- df1$Demand |> replace_na(0)
# aggregate
df1 <- df1 |> group_by(DFU, Period) |> summarise(Quantity = sum(Demand))
# generate Sparkline
df1 <- df1 |> group_by(DFU) |> summarise(Demand.Quantity = list(Quantity))
# keep Results
Demand_Sparklines_DB <- df1
#-----------------
# Get Sparklines Supply
#-----------------
# set a working df
df1 <- blueprint
# replace missing values by zero
df1$Supply <- df1$Supply |> replace_na(0)
# aggregate
df1 <- df1 |> group_by(DFU, Period) |> summarise(Quantity = sum(Supply))
# generate Sparkline
df1 <- df1 |> group_by(DFU) |> summarise(Supply.Quantity = list(Quantity))
# keep Results
Supply_Sparklines_DB <- df1
#-----------------
# Merge dataframes
#-----------------
# merge
df1 <- left_join(Value_DB, Demand_Sparklines_DB)
df1 <- left_join(df1, Supply_Sparklines_DB)
# reorder columns
df1 <- df1 |> select(DFU,
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 table, using the packages reactable and reactablefmtr :
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 reactable
Let’s apply the proj_inv() function :
# set a working df
df1 <- blueprint
df1 <- as.data.frame(df1)
# calculate
calculated_projection_and_analysis <- planr::proj_inv(data = df1,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening = Opening,
Supply = Supply,
Min.Cov = Min.Cov,
Max.Cov = Max.Cov)
# format as dataframe
calculated_projection_and_analysis <-as.data.frame(calculated_projection_and_analysis)
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.98
Let’s look at the Item 000001 :
# 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 and reactablefmtr :
# set a working df
df1 <- Selected_DB
# remove not needed column
df1 <- df1 |> select(-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 reactable
We can see that in the column [PI.Index] we have several possible values, among them :
OverStock : which means that the projected inventories are above the maximum stock target
OK : which means that the projected inventories are between the minimim & maximum stock targets
Alert : which means that the projected inventories are below the minimum stock target
Shortage : which means that the projected inventories are negative
We might be interested in looking especially at 3 of them : OverStock / Alert / Shortage.
Then a second question after having identified those values could be: by how much (vs target) are we in an Overstock or in an 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.
If we want to focus on only the important Overstocks, then we can filter based on the field [Ratio.PI.vs.Max].
Let’s highlight only the Overstocks :
# set a working dataframe
df1 <- calculated_projection_and_analysis
#------------------------------
# Filter
# filter Period based on those Starting and Ending Periods
df1 <- filter(df1, df1$Period >= "2022-07-03" & df1$Period <= "2022-09-25")
# Highlight only the OverStock situations
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 <- df1$Demand |> replace_na(0)
# keep results
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, 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 |> arrange(-Demand.Qty)
# rename column
df1 <- df1 |> rename("Total Demand (units)" = Demand.Qty)
# Get Results
Interim_DB <- df1
Let’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
#------------------------------
# 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 <- df1$Demand |> replace_na(0)
# aggregate
df1 <- df1 |> group_by(DFU, Period) |>
summarise(Quantity = sum(Demand))
# generate Sparkline
df1 <- df1 |> group_by(DFU) |> summarise(Demand.Quantity = list(Quantity))
# keep Results
Demand_Sparklines_DB <- df1
#-----------------
# Get Sparklines Supply
#-----------------
# set a working df
df1 <- Initial_DB
# replace missing values by zero
df1$Supply <- df1$Supply |> replace_na(0)
# aggregate
df1 <- df1 |> group_by(DFU, Period) |>
summarise(Quantity = sum(Supply))
# generate Sparkline
df1 <- df1 |> group_by(DFU) |> summarise(Supply.Quantity = list(Quantity))
# keep Results
Supply_Sparklines_DB <- df1
#-----------------
# Get Sparklines Projected Inventories
#-----------------
# set a working df
df1 <- Initial_DB
# replace missing values by zero
df1$Projected.Inventories.Qty <- df1$Projected.Inventories.Qty |> replace_na(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
#--------
# 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 |> 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 |> 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 |> 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)
df1 <- left_join(df1, Supply_Sparklines_DB)
df1 <- left_join(df1, PI_Sparklines_DB)
df1 <- left_join(df1, OverStock_DB)
df1 <- left_join(df1, Alert_DB)
df1 <- left_join(df1, Shortage_DB)
# 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"
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 table using reactable and reactablefmtr packages :
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 reactable
We also could look at it through a different angle, considering the
horizon of time.
For example a display of the analysis for :
the next 4 periods
the next 5 to 8
the next 9 to 12 periods
This way we get more easily one insight : when the issue (OverStock / Delay / Shortage) will occur.