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.# Pivot
df1 <- df1 %>% gather(key = "Period", value = "Demand", 2:length(df1))
# Format Date
df1$Period <- as.Date(as.character(df1$Period), format = '%m/%d/%Y')
# 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.# Pivot
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.# Pivot
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)## Joining with `by = join_by(DFU, Period)`df1 <- left_join(df1, Supply_DB)## Joining with `by = join_by(DFU, Period)`# 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 <- planr::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.4526031 secshead(Calculated_PI_DB)## DFU Period Demand Opening Calculated.Coverage.in.Periods
## 1 Item 000001 2022-07-03 364 6570 17
## 2 Item 000001 2022-07-10 364 0 16
## 3 Item 000001 2022-07-17 364 0 15
## 4 Item 000001 2022-07-24 260 0 14
## 5 Item 000001 2022-07-31 736 0 13
## 6 Item 000001 2022-08-07 859 0 12
## Projected.Inventories.Qty Supply
## 1 6206 0
## 2 5842 0
## 3 5478 0
## 4 5218 0
## 5 4482 0
## 6 3623 0for a single Item
#--------------
# Get Data
#--------------
# set a working df
df1 <- Calculated_PI_DB
df1 <- as.data.frame(df1)
#--------------
# Select Item
#--------------
# filter
df1 <- filter(df1, df1$DFU %in% c("Item 000008"))
#--------------
# Transform
#--------------
# 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 Table
#--------------
# 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#--------------
# Get Data
#--------------
# set a working df
df1 <- Calculated_PI_DB
df1 <- as.data.frame(df1)
#--------------
# Filters
#--------------
# filter
df1 <- filter(df1, df1$DFU %in% c("Item 000008"))
# filter Period based on those Starting and Ending Periods
df1 <- filter(df1,df1$Period >= "2022-07-03" & df1$Period <= "2022-11-30")
#--------------
# Transform
#--------------
# 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
#--------------
# set a working df
df1 <- Calculated_PI_DB
df1 <- as.data.frame(df1)
#--------------
# Filters
#--------------
# 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
#--------
# Create a Delay.Analysis check
#--------
# set a working df
df1 <- Initial_DB
# aggregate
df1 <- df1 |> group_by(DFU) |>
summarise(min.Projected.Inventories.Qty = min(Projected.Inventories.Qty),
max.Projected.Inventories.Qty = max(Projected.Inventories.Qty)
)
#-----------------
# Identify where we are late to supply
#-----------------
# Add a character info to analyze whether there is an identified delay or not
df1$Delay.Analysis <- if_else(df1$min.Projected.Inventories.Qty <= 0, "Delay", "OK")
# Get Results
Check_DB <- df1
#-----------------
# Merge dataframes
#-----------------
# merge
df1 <- left_join(Value_DB, Demand_Sparklines_DB)
df1 <- left_join(df1, Supply_Sparklines_DB)
df1 <- left_join(df1, PI_Sparklines_DB)
df1 <- left_join(df1, Check_DB)
# reorder columns
df1 <- df1 %>% select(DFU, Demand, Demand.pc, Demand.Quantity,
Supply, Supply.Quantity,
Opening,
PI.Quantity,
Delay.Analysis)
# get results
Summary_DB <- df1
glimpse(Summary_DB)## Rows: 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")
}),
PI.Quantity = colDef(
name = "Projected Inventories",
cell = function(values) {
sparkline(values, type = "bar")
}),
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 reactable# get raw data
Products_Families_DB <- read_csv("Products_Families_DB.csv")## Rows: 50 Columns: 2
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): DFU, Product.Family
##
## ℹ 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.glimpse(Products_Families_DB)## Rows: 50
## Columns: 2
## $ DFU <chr> "Item 000001", "Item 000002", "Item 000003", "Item 0000…
## $ Product.Family <chr> "Product A", "Product A", "Product A", "Product A", "Pr…collapsibleTree(Products_Families_DB, c("Product.Family", "DFU"))# merge w/ other datasets
df1 <- left_join(Demand_DB, Opening_Inventories_DB)## Joining with `by = join_by(DFU, Period)`df1 <- left_join(df1, Supply_DB)## Joining with `by = join_by(DFU, Period)`df1 <- left_join(df1, Products_Families_DB)## Joining with `by = join_by(DFU)`# keep only needed rows
df1 <- df1 |> select(Product.Family, Period,
Demand, Opening, Supply)
# aggregate
df1 <- df1 |> group_by(Product.Family, Period) |>
summarise(Demand = sum(Demand),
Opening = sum(Opening),
Supply = sum(Supply)
)## `summarise()` has grouped output by 'Product.Family'. You can override using
## the `.groups` argument.# rename
df1 <- df1 |> rename(DFU = Product.Family)
# Get Results
Blueprint_Products_Families_DB <- df1
head(Blueprint_Products_Families_DB)## # A tibble: 6 × 5
## # Groups: DFU [1]
## DFU Period Demand Opening Supply
## <chr> <date> <dbl> <dbl> <dbl>
## 1 Product A 2022-07-03 12181 57660 0
## 2 Product A 2022-07-10 12181 0 6733
## 3 Product A 2022-07-17 12181 0 12012
## 4 Product A 2022-07-24 8703 0 20940
## 5 Product A 2022-07-31 5626 0 10000
## 6 Product A 2022-08-07 6566 0 600At Products Family level.
start_time <- Sys.time()
Calculated_PI_Family_DB <- planr::light_proj_inv(data = Blueprint_Products_Families_DB,
DFU = DFU,
Period = Period,
Demand = Demand,
Opening = Opening,
Supply = Supply)## Joining with `by = join_by(DFU, Period)`end_time <- Sys.time()
calculation.time <- end_time - start_time
calculation.time## Time difference of 0.1339841 secs# formatting
Calculated_PI_Family_DB <- as.data.frame(Calculated_PI_Family_DB)
glimpse(Calculated_PI_Family_DB)## Rows: 208
## Columns: 7
## $ DFU <chr> "Product A", "Product A", "Product A", …
## $ Period <date> 2022-07-03, 2022-07-10, 2022-07-17, 20…
## $ Demand <dbl> 12181, 12181, 12181, 8703, 5626, 6566, …
## $ Opening <dbl> 57660, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ Calculated.Coverage.in.Periods <dbl> 5.0, 5.1, 6.0, 7.1, 7.0, 6.1, 5.1, 4.1,…
## $ Projected.Inventories.Qty <dbl> 45479, 40031, 39862, 52099, 56473, 5050…
## $ Supply <dbl> 0, 6733, 12012, 20940, 10000, 600, 0, 0…Projection of Coverages at Product Family level.
#----------------
# Prepare Data
#----------------
# set a working df
df1 <- Calculated_PI_Family_DB
# keep only needed variables
df1 <- df1 |> select(Period, DFU, Calculated.Coverage.in.Periods)
# spread
df1 <- df1 |> spread(DFU, Calculated.Coverage.in.Periods)
#--------------
# Filters
#--------------
# Filter Period based on those Starting and Ending Periods
df1 <- filter(df1, df1$Period >= "2022-07-03" & df1$Period <= "2022-09-25")
#----------------
# Chart
#----------------
p <- highchart() |>
hc_add_series(name = "Product A", color = "gold",
dataLabels = list(align = "center", enabled = TRUE),
data = df1$`Product A`) |>
hc_add_series(name = "Product B", color = "steelblue",
dataLabels = list(align = "center", enabled = TRUE),
data = df1$`Product B`) |>
hc_add_series(name = "Product C", color = "salmon",
dataLabels = list(align = "center", enabled = TRUE),
data = df1$`Product C`) |>
hc_add_series(name = "Product D", color = "mediumseagreen",
dataLabels = list(align = "center", enabled = TRUE),
data = df1$`Product D`) |>
hc_title(text = "Projected Coverages by Families") |>
hc_subtitle(text = "in weeks") |>
hc_xAxis(categories = df1$Period) |>
hc_add_theme(hc_theme_google())
# display chart
pUseful links :
github R planr package : nguyennico/planr (github.com)
R cran : CRAN - Package planr (r-project.org)
R planr package website : planr - About (quarto.pub)
The R package planr provides some tools for Supply Chain management, to perform calculations related to Demand & Supply Planning or S&OP (Sales & Operations Planning) process.