29  Short Shelf Life Stocks

First, let’s load a few libraries :

# ETL
library(tidyverse)
library(sparkline)

# Tables
library(reactable)
library(reactablefmtr)

# Charts
library(highcharter)

# Supply Chain
library(planr)

Now we’re going to show how to use the ssl() function from the planr package.

SSL stands for “Short Shelf Life”.

The idea is to calculate, based on the Demand Forecasts and the different Expiry Dates of the stocks, the SSL quantity, which is the amount of remaining stocks that we won’t be able to sell.

Let’s use the built-in demo data frame slob from the planr package.

We are here in Monthly Buckets, but it could be in weekly bucket as well.

The Opening variable contains the details of the Expiry Dates (or minimum Remaining Shelf Life for Sale) of the different batches which composed the Opening Inventories.

The quantities are placed in the Period of time when they will be expired (or won’t have enough Remaining Shelf Life for Sale).

# get data
data("slob")

head(slob)
# A tibble: 6 × 4
  DFU    Period     Demand Opening
  <chr>  <date>      <dbl>   <dbl>
1 Item 1 2023-01-01    200      NA
2 Item 1 2023-02-01    200      NA
3 Item 1 2023-03-01    200    1000
4 Item 1 2023-04-01    200      NA
5 Item 1 2023-05-01    200      NA
6 Item 1 2023-06-01    200      NA

Let’s rename the variable Opening as Opening.Expiry and keep this data frame as initial_dataset.

Because later on we will calculate some projected inventories and will use a variable Opening, which is the total of all the Opening inventories (summing the different batches).

# set a working df
df1 <- slob

# rename
df1 <- df1 |> rename(Opening.Expiry = Opening)

# replace missing values by zero
df1$Opening.Expiry <- df1$Opening.Expiry |> replace_na(0)

# keep results
initial_dataset <- df1

glimpse(initial_dataset)
Rows: 44
Columns: 4
$ DFU            <chr> "Item 1", "Item 1", "Item 1", "Item 1", "Item 1", "Item…
$ Period         <date> 2023-01-01, 2023-02-01, 2023-03-01, 2023-04-01, 2023-0…
$ Demand         <dbl> 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, …
$ Opening.Expiry <dbl> 0, 0, 1000, 0, 0, 0, 1000, 0, 0, 1000, 0, 0, 0, 0, 0, 0…

30 Calculate SSL

To apply the ssl() function we need, on top of the 2 variables DFU and Period of time :

  • the Demand Forecasts.

  • the different Expiry Dates of the stocks.

As a result, we will get the SSL quantity, which is the amount of remaining stocks that we won’t be able to sell, at a particular period of time (when the stocks will expire).

# set a working df
df1 <- initial_dataset

# rename
df1 <- df1 |> rename(Opening = Opening.Expiry)

# apply ssl() function
calculated_ssl <- planr::ssl(
  dataset = df1, 
  DFU, 
  Period, 
  Demand, 
  Opening)

# see results
head(calculated_ssl)
     DFU     Period Demand Opening SSL.Qty
1 Item 1 2023-01-01    200       0       0
2 Item 1 2023-02-01    200       0       0
3 Item 1 2023-03-01    200    1000     400
4 Item 1 2023-04-01    200       0       0
5 Item 1 2023-05-01    200       0       0
6 Item 1 2023-06-01    200       0       0

Considering the expiry dates of the opening inventories and the Demand Forecasts, we can foresee some SSL quantities, i.e. that some opening stocks won’t be consumed before they expire.

This can lead to some financial losses, and also to actually lower projected inventories (than if we don’t consider those expiry dates).

Let’s put this in the perspective of projected inventories, to better visualize the impact.

31 Prepare Proj Inv Templates

Let’s identify the Start.Date.

We need this date to place the Total of the Opening Inventories at the beginning of the horizon (which is then the Start.Date).

We will create 2 templates to calculate 2 different types of Projected Inventories :

  • without considering the SSL quantities.

  • considering the SSL quantities.

The idea is to show how impacting is this parameter (when the data are available) in our calculation of both the Projected Inventories and the Replenishment Plan (DRP).

#-------------------------------
# Get Start Date
#-------------------------------

Start.Date <- min(initial_dataset$Period)

Start.Date
[1] "2023-01-01"

31.1 without SSL

We consider :

  • all the Opening inventories together, 3000 units.

  • only one Demand Forecasts, without the SSL quantities we previously calculated.

#-------------------------------
# add Opening
#-------------------------------

# set a working df
df1 <- initial_dataset

# aggregate
df1 <- df1 |> group_by(DFU) |>
  summarise(Opening = sum(Opening.Expiry))

# add Period
df1$Period <- Start.Date

# merge w/ previous dataset
df1 <- left_join(initial_dataset, df1)

# replace missing values by zero
df1$Opening <- df1$Opening |> replace_na(0)



#-------------------------------
# Add Supply
#-------------------------------

# add Supply Variable
# let's put zero by default
df1$Supply <- 0


# remove Opening.Expiry
df1 <- df1 |> select(-Opening.Expiry)

# keep results
demo_dataset <- df1

# check results
head(demo_dataset)
# A tibble: 6 × 5
  DFU    Period     Demand Opening Supply
  <chr>  <date>      <dbl>   <dbl>  <dbl>
1 Item 1 2023-01-01    200    3000      0
2 Item 1 2023-02-01    200       0      0
3 Item 1 2023-03-01    200       0      0
4 Item 1 2023-04-01    200       0      0
5 Item 1 2023-05-01    200       0      0
6 Item 1 2023-06-01    200       0      0

31.2 considering SSL

We consider :

  • all the Opening inventories together, 3000 units.

  • an additional Demand, related to the SSL quantities we previously calculated.

The projected (available) inventories will be reduced of this additional Demand, to reflect the expiry of the stocks.

#-------------------------------
# add Opening
#-------------------------------

# set a working df
df1 <- calculated_ssl

# aggregate
df1 <- df1 |> group_by(DFU) |>
  summarise(Opening = sum(Opening))

# add Period
df1$Period <- Start.Date

# remove previous Opening variable
calculated_ssl <- calculated_ssl |> select(-Opening)

# merge w/ previous dataset
df1 <- left_join(calculated_ssl, df1)

# replace missing values by zero
df1$Opening <- df1$Opening |> replace_na(0)


#-------------------------------
# Add Supply
#-------------------------------

# add Supply Variable
# let's put zero by default
df1$Supply <- 0

# keep results
calculated_ssl <- df1


head(calculated_ssl)
     DFU     Period Demand SSL.Qty Opening Supply
1 Item 1 2023-01-01    200       0    3000      0
2 Item 1 2023-02-01    200       0       0      0
3 Item 1 2023-03-01    200     400       0      0
4 Item 1 2023-04-01    200       0       0      0
5 Item 1 2023-05-01    200       0       0      0
6 Item 1 2023-06-01    200       0       0      0

32 Calculate Projected Inventories

We will use the function light_proj_inv() and calculate 2 projected inventories : without considering the SSL and considering the SSL.

32.1 without SSL

It’s the usual calculation, considering the Demand as it is and without considering the inventories shelf lives.

# set a working df
df1 <- demo_dataset

# calculate projected inventories
df1 <- planr::light_proj_inv(data = df1,
                             DFU = DFU, 
                             Period = Period,
                             Demand =  Demand,
                             Opening = Opening, 
                             Supply = Supply)


# rename
df1 <- df1 |> rename(Coverage.wo.SSL = Calculated.Coverage.in.Periods,
                     PI.wo.SSL = Projected.Inventories.Qty)

# keep only needed variables
df1 <- df1 |> select(DFU, Period,
                     Coverage.wo.SSL,
                     PI.wo.SSL)

# keep results
PI_wo_SSL_data <- df1

head(PI_wo_SSL_data)
     DFU     Period Coverage.wo.SSL PI.wo.SSL
1 Item 1 2023-01-01              14      2800
2 Item 1 2023-02-01              13      2600
3 Item 1 2023-03-01              12      2400
4 Item 1 2023-04-01              11      2200
5 Item 1 2023-05-01              10      2000
6 Item 1 2023-06-01               9      1800

32.2 considering SSL

Here we will consider the SSL.Qty as an additional Demand.

It’s a way to consume the stocks :

  • though they won’t be sold, they will become expired for sale.

  • by adding the SSL.Qty to the initial Demand, we will then remove this quantity from the Projected Inventories later on.

# set a working df
df1 <- calculated_ssl

#-------------------------------
# Calculate Adjusted Demand : initial + SSL.Qty
#-------------------------------

# add the 2 types of demand
df1$Demand <- df1$Demand + df1$SSL.Qty

# remove SSL.Qty
df1 <- df1 |> select(-SSL.Qty)


#-------------------------------
# Calculate projected inventories
#-------------------------------

# calculate projected inventories
df1 <- planr::light_proj_inv(data = df1, 
                             DFU = DFU,
                             Period = Period,
                             Demand =  Demand, 
                             Opening = Opening, 
                             Supply = Supply)


# rename
df1 <- df1 |> rename(Coverage.with.SSL = Calculated.Coverage.in.Periods,
                     PI.with.SSL = Projected.Inventories.Qty)

# keep only needed variables
df1 <- df1 |> select(DFU, Period,
                     Coverage.with.SSL,
                     PI.with.SSL)


# keep results
PI_with_SSL_data <- df1

head(PI_with_SSL_data)
     DFU     Period Coverage.with.SSL PI.with.SSL
1 Item 1 2023-01-01                 9        2800
2 Item 1 2023-02-01                 8        2600
3 Item 1 2023-03-01                 7        2000
4 Item 1 2023-04-01                 6        1800
5 Item 1 2023-05-01                 5        1600
6 Item 1 2023-06-01                 4        1400

Combine

Now we add both calculated Projected Inventories to the initial dataset.

By doing so we will have a single data frame with all the variables we need to compare.

# merge
df1 <- left_join(initial_dataset, calculated_ssl)
df1 <- left_join(df1, PI_wo_SSL_data)
df1 <- left_join(df1, PI_with_SSL_data)

# keep only needed variables
df1 <- df1 |> select(DFU, 
                     Period,
                     Demand,
                     
                     Opening.Expiry, 
                     SSL.Qty,
                     Opening,
                     
                     Coverage.wo.SSL, PI.wo.SSL,
                     Coverage.with.SSL, PI.with.SSL,
                     
                     Supply
                     )

# keep results
Calculated_PI_data <- df1

glimpse(Calculated_PI_data)
Rows: 44
Columns: 11
$ DFU               <chr> "Item 1", "Item 1", "Item 1", "Item 1", "Item 1", "I…
$ Period            <date> 2023-01-01, 2023-02-01, 2023-03-01, 2023-04-01, 202…
$ Demand            <dbl> 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 20…
$ Opening.Expiry    <dbl> 0, 0, 1000, 0, 0, 0, 1000, 0, 0, 1000, 0, 0, 0, 0, 0…
$ SSL.Qty           <dbl> 0, 0, 400, 0, 0, 0, 200, 0, 0, 400, 0, 0, 0, 0, 0, 0…
$ Opening           <dbl> 3000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ Coverage.wo.SSL   <dbl> 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0, 0,…
$ PI.wo.SSL         <dbl> 2800, 2600, 2400, 2200, 2000, 1800, 1600, 1400, 1200…
$ Coverage.with.SSL <dbl> 9, 8, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ PI.with.SSL       <dbl> 2800, 2600, 2000, 1800, 1600, 1400, 1000, 800, 600, …
$ Supply            <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…

33 Create SSL Summary

It’s a summary table which can be useful for a cockpit to analyze the SSL risks.

It indicates :

  • where (which item) we have a SSL risk.

  • when we have it.

  • how much is the risk.

We will display this as a total amount, and also through a sparkline to make it more visual.

First we create a data frame, and then we create a cockpit using the reactable package.

33.1 create data frame

#----------------------
# Create Summary
#----------------------

# aggregate
df1 <- Calculated_PI_data |> group_by(DFU) |>
  summarise(Opening = sum(Opening),
            SSL.Qty = sum(SSL.Qty)
            )

# calculate % with risk of SSL
df1$SSL.Qty.pc <- df1$SSL.Qty / df1$Opening

# keep results
Summary_data <- df1



#----------------------
# Create Sparkline
#----------------------

# aggregate
df1 <- Calculated_PI_data |> group_by(DFU, Period) |>
  summarise(SSL.Qty = sum(SSL.Qty)
            )

df1 <- df1 |> group_by(DFU) |>
  summarise(Quantity = list(SSL.Qty)
            )

# keep results
Sparkline_data <- df1


#----------------------
# Combine
#----------------------

# merge
df1 <- left_join(Summary_data, Sparkline_data)

# keep results
SSL_Summary_data <- df1

glimpse(SSL_Summary_data)
Rows: 2
Columns: 5
$ DFU        <chr> "Item 1", "Item 2"
$ Opening    <dbl> 3000, 4000
$ SSL.Qty    <dbl> 1000, 1600
$ SSL.Qty.pc <dbl> 0.3333333, 0.4000000
$ Quantity   <list> <0, 0, 400, 0, 0, 0, 200, 0, 0, 400, 0, 0, 0, 0, 0, 0, 0, 0…

33.2 display table

# set a working df
df1 <- SSL_Summary_data


# create reactable
reactable(df1,compact = TRUE,
              
              defaultSortOrder = "desc",
              defaultSorted = c("DFU"),
              
              columns = list(
                
                `DFU` = colDef(name = "Product",
                               minWidth = 170),
                
                `Opening`= colDef(
                  name = "Opening (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")
                  ), 

                `SSL.Qty`= colDef(
                  name = "SSL (units)",
                  aggregate = "sum",
                  footer = function(values) formatC(sum(values),
                                                    format="f", 
                                                    big.mark=",", 
                                                    digits=0), 
                  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")
                  }
                  ),
                

                
                `SSL.Qty.pc` = colDef(
                  name = "SSL (%)",
                  format = colFormat(percent = TRUE, digits = 1)
                  ),
                
                Quantity = colDef(
                  name = "",
                  cell = function(value, index) {
                    sparkline(df1$Quantity[[index]])
                  })

              ), # close columns list
              
              defaultColDef = colDef(footerStyle = list(fontWeight = "bold"))
              
    ) # close reactable

We here can see that somehow we have a large part of our Opening Inventories with Obsolescence Risks, especially on the Item 2, with 40%.

  • this analysis can be useful to point out some necessary actions to reduce those risks.

    • for example running some promotions to deplete the stocks earlier, or re-balancing the stocks with other distribution channels / markets.
  • it also shows the importance to consider those SSL quantities when we calculate our Projected Inventories and DRP.

34 Display Projected Inventories

Now, let’s compare the 2 calculations of projected inventories we just did :

  • the “original” data : where we don’t consider the details of the expiry dates of the Opening inventories.

  • with the SSL : where we consider the obsolescence risks.

34.1 Table

We can display a table which displays side by side those 2 situations, for the “Item 1”,

# set a working df
df1 <- Calculated_PI_data

#--------------
# Select Item
#--------------

# filter
df1 <- filter(df1, df1$DFU %in% c("Item 1"))




#--------------
# Transform
#--------------

# keep only the needed columns
df1 <- df1 |> select(Period,
                     Demand,
                     SSL.Qty,
                     
                     Coverage.wo.SSL,
                     PI.wo.SSL,
                     
                     Coverage.with.SSL,
                     PI.with.SSL,
                     
                     Supply)

#--------------
# create a f_colorpal field
#--------------

# case without SSL
df1 <- df1 |> mutate(f_colorpal_wo_SSL = case_when( 
  Coverage.wo.SSL > 8 ~ "#FFA500",
  Coverage.wo.SSL > 2 ~ "#32CD32",
  Coverage.wo.SSL > 0 ~ "#FFFF99",
  TRUE ~ "#FF0000" ))

# case with SSL
df1 <- df1 |> mutate(f_colorpal_with_SSL = case_when( 
  Coverage.with.SSL > 8 ~ "#FFA500",
  Coverage.with.SSL > 2 ~ "#32CD32",
  Coverage.with.SSL > 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"
                  )

                ),
                
                
                SSL.Qty = colDef(
                  name = "SSL (units)",

                  cell = data_bars(df1,
                                   fill_color = "#e00000",
                                   text_position = "outside-end"
                  )

                ),

                
              #-----------------------
              # without SSL (Original)

              Coverage.wo.SSL = colDef(
                name = "Original Coverage (Periods)",
                maxWidth = 90,
                cell= color_tiles(df1, color_ref = "f_colorpal_wo_SSL")
              ),

              f_colorpal_wo_SSL = colDef(show = FALSE), # hidden, just used for the coverages
              
              
              `PI.wo.SSL`= colDef(
                  name = "Original 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"
                    )
                  }
                ),

              #-----------------------
              # with SSL
              
              Coverage.with.SSL = colDef(
                name = "Coverage w/ SSL (Periods)",
                maxWidth = 90,
                cell= color_tiles(df1, color_ref = "f_colorpal_with_SSL")
              ),

              f_colorpal_with_SSL = colDef(show = FALSE), # hidden, just used for the coverages
              
              `PI.with.SSL`= colDef(
                  name = "Projected Inventories w/ SSL (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 = "Original Projected Inventories", 
                         columns = c("Coverage.wo.SSL",
                                     "PI.wo.SSL")),
                
                
                colGroup(name = "Projected Inventories w/ SSL", 
                         columns = c("Coverage.with.SSL",
                                     "PI.with.SSL"))

              )

    ) # close reactable

This illustrates that :

  • in the original case : we have an Opening Coverage of 14 months.

  • when we consider the SSL quantities : we have an Opening Coverage of 9 months.

    • a more accurate (and important) calculation.

    • which will lead to an earlier calculation of a Replenishment Plan (DRP), as we will see in the next section.

34.2 Chart

The difference can also be illustrated via 2 charts :

  • one without considering the SSL quantities : theoretical coverage until February 2024.

  • one considering the SSL quantities : real coverage until September 2023, 5 months earlier.

34.2.1 without SSL

# set a working df
df1 <- Calculated_PI_data


#--------------
# Select Item
#--------------

# filter
df1 <- filter(df1, df1$DFU %in% c("Item 1"))

# keep only the needed columns
df1 <- df1 |> select(Period, PI.wo.SSL)


# create a value.index
df1$Value.Index <- if_else(df1$PI.wo.SSL < 0, "Shortage", "Stock")
    
    
# spread
df1 <- df1 |> spread(Value.Index, PI.wo.SSL)
    
    
#--------------
# Chart
#--------------

highchart() |> 
  
      hc_title(text = "Projected Inventories w/o SSL") |> 
      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"))

34.2.2 considering SSL

# set a working df
df1 <- Calculated_PI_data


#--------------
# Select Item
#--------------

# filter
df1 <- filter(df1, df1$DFU %in% c("Item 1"))


# keep only the needed columns
df1 <- df1 |> select(Period, PI.with.SSL)


# create a value.index
df1$Value.Index <- if_else(df1$PI.with.SSL < 0, "Shortage", "Stock")
    
    
# spread
df1 <- df1 |> spread(Value.Index, PI.with.SSL)
    
    
#--------------
# Chart
#--------------

highchart() |> 
  
      hc_title(text = "Projected Inventories considering SSL") |> 
      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"))

35 Calculate DRP

As we did in the previous part, we are now going to calculate the DRP in 2 different situations :

  • without considering the SSL quantities.

  • considering the SSL quantities.

35.1 without SSL

Usual calculation, considering the Demand as it is and without considering the inventories shelf lives.

# set a working df
df1 <- demo_dataset


#--------------
# Add DRP parameters
#--------------

df1$SSCov <- 2
df1$DRPCovDur <- 3

df1$MOQ <- 1
df1$FH <- if_else(df1$Period <= '2023-03-01', "Frozen", "Free")

#--------------
# Calculate DRP
#--------------

# calculate DRP
df1 <- planr::drp(dataset = df1, 
                  DFU, 
                  Period, 
                  Demand, 
                  Opening, 
                  Supply, 
                  SSCov, 
                  DRPCovDur, 
                  MOQ, 
                  FH)



# rename
df1 <- df1 |> rename(Coverage.wo.SSL = DRP.Calculated.Coverage.in.Periods,
                     PI.wo.SSL = DRP.Projected.Inventories.Qty,
                     DRP.plan.wo.SSL = DRP.plan)

# keep only needed variables
df1 <- df1 |> select(DFU, Period,
                     Coverage.wo.SSL,
                     PI.wo.SSL,
                     DRP.plan.wo.SSL)

# keep results
DRP_wo_SSL_data <- df1

head(DRP_wo_SSL_data)
     DFU     Period Coverage.wo.SSL PI.wo.SSL DRP.plan.wo.SSL
1 Item 1 2023-01-01              14      2800               0
2 Item 1 2023-02-01              13      2600               0
3 Item 1 2023-03-01              12      2400               0
4 Item 1 2023-04-01              11      2200               0
5 Item 1 2023-05-01              10      2000               0
6 Item 1 2023-06-01               9      1800               0

35.2 considering SSL

Here we need to consider the SSL.Qty as an additional Demand.

# set a working df
df1 <- calculated_ssl

#-------------------------------
# Calculate Adjusted Demand : initial + SSL.Qty
#-------------------------------

# add the 2 types of demand
df1$Demand <- df1$Demand + df1$SSL.Qty

# remove SSL.Qty
df1 <- df1 |> select(-SSL.Qty)


#--------------
# Add DRP parameters
#--------------

df1$SSCov <- 2
df1$DRPCovDur <- 3

df1$MOQ <- 1
df1$FH <- if_else(df1$Period <= '2023-03-01', "Frozen", "Free")

#--------------
# Calculate DRP
#--------------

# calculate DRP
df1 <- planr::drp(dataset = df1, 
                  DFU, 
                  Period, 
                  Demand, 
                  Opening, 
                  Supply, 
                  SSCov, 
                  DRPCovDur, 
                  MOQ, 
                  FH)

# rename
df1 <- df1 |> rename(Coverage.with.SSL = DRP.Calculated.Coverage.in.Periods,
                     PI.with.SSL = DRP.Projected.Inventories.Qty,
                     DRP.plan.with.SSL = DRP.plan)

# keep only needed variables
df1 <- df1 |> select(DFU, Period,
                     Coverage.with.SSL,
                     PI.with.SSL,
                     DRP.plan.with.SSL)


# keep results
DRP_with_SSL_data <- df1

head(DRP_with_SSL_data)
     DFU     Period Coverage.with.SSL PI.with.SSL DRP.plan.with.SSL
1 Item 1 2023-01-01                 9        2800                 0
2 Item 1 2023-02-01                 8        2600                 0
3 Item 1 2023-03-01                 7        2000                 0
4 Item 1 2023-04-01                 6        1800                 0
5 Item 1 2023-05-01                 5        1600                 0
6 Item 1 2023-06-01                 4        1400                 0

Combine

Now we add both calculated Projected Inventories & Replenishment Plan to the initial dataset.

As we did previously, by doing so we will have a compact data frame with all the variables we need to compare.

# merge
df1 <- left_join(initial_dataset, calculated_ssl)
df1 <- left_join(df1, DRP_wo_SSL_data)
df1 <- left_join(df1, DRP_with_SSL_data)

# keep only needed variables
df1 <- df1 |> select(DFU, 
                     Period,
                     Demand,
                     
                     Opening.Expiry, 
                     SSL.Qty,
                     Opening,
                     
                     Coverage.wo.SSL, 
                     PI.wo.SSL, 
                     DRP.plan.wo.SSL,
                     
                     Coverage.with.SSL, 
                     PI.with.SSL,
                     DRP.plan.with.SSL
                     )

# replace missing values by zero
df1$PI.wo.SSL <- df1$PI.wo.SSL |> replace_na(0)
df1$PI.with.SSL <- df1$PI.with.SSL |> replace_na(0)

df1$DRP.plan.wo.SSL <- df1$DRP.plan.wo.SSL |> replace_na(0)
df1$DRP.plan.with.SSL <- df1$DRP.plan.with.SSL |> replace_na(0)

# keep results
Calculated_DRP_data <- df1

glimpse(Calculated_DRP_data)
Rows: 44
Columns: 12
$ DFU               <chr> "Item 1", "Item 1", "Item 1", "Item 1", "Item 1", "I…
$ Period            <date> 2023-01-01, 2023-02-01, 2023-03-01, 2023-04-01, 202…
$ Demand            <dbl> 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 20…
$ Opening.Expiry    <dbl> 0, 0, 1000, 0, 0, 0, 1000, 0, 0, 1000, 0, 0, 0, 0, 0…
$ SSL.Qty           <dbl> 0, 0, 400, 0, 0, 0, 200, 0, 0, 400, 0, 0, 0, 0, 0, 0…
$ Opening           <dbl> 3000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ Coverage.wo.SSL   <dbl> 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 5, 4, 3, 5,…
$ PI.wo.SSL         <dbl> 2800, 2600, 2400, 2200, 2000, 1800, 1600, 1400, 1200…
$ DRP.plan.wo.SSL   <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 600, 0, 0, 600, …
$ Coverage.with.SSL <dbl> 9, 8, 7, 6, 5, 4, 3, 5, 4, 3, 5, 4, 3, 5, 4, 3, NA, …
$ PI.with.SSL       <dbl> 2800, 2600, 2000, 1800, 1600, 1400, 1000, 1400, 1200…
$ DRP.plan.with.SSL <dbl> 0, 0, 0, 0, 0, 0, 0, 600, 0, 0, 600, 0, 0, 600, 0, 0…

36 Display DRP results

Let’s create a reactable to visualize the results.

We notice that the Replenishment Plan starts (obviously!) earlier, in August 2023, in the case when we consider the SSL, versus January 2024 in the case when we don’t consider the SSL.

It leads to a more accurate Replenishment Plan, and avoid to be in shortage.

# set a working df
df1 <- Calculated_DRP_data

#--------------
# Select Item
#--------------

# filter
df1 <- filter(df1, df1$DFU %in% c("Item 1"))

# remove the end horizon (where the calculation is not effective)
df1 <- filter(df1, df1$Period <= '2024-04-01')


#--------------
# Transform
#--------------

# keep only the needed columns
df1 <- df1 |> select(Period,
                     Demand,
                     SSL.Qty,
                     
                     Coverage.wo.SSL,
                     PI.wo.SSL,
                     DRP.plan.wo.SSL,
                     
                     Coverage.with.SSL,
                     PI.with.SSL,
                     DRP.plan.with.SSL
                     )

#--------------
# create a f_colorpal field
#--------------

# case without SSL
df1 <- df1 |> mutate(f_colorpal_wo_SSL = case_when( 
  Coverage.wo.SSL > 8 ~ "#FFA500",
  Coverage.wo.SSL > 2 ~ "#32CD32",
  Coverage.wo.SSL > 0 ~ "#FFFF99",
  TRUE ~ "#FF0000" ))

# case with SSL
df1 <- df1 |> mutate(f_colorpal_with_SSL = case_when( 
  Coverage.with.SSL > 8 ~ "#FFA500",
  Coverage.with.SSL > 2 ~ "#32CD32",
  Coverage.with.SSL > 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")
                  ),
                
                
                SSL.Qty = colDef(
                  name = "SSL (units)",

                  cell = data_bars(df1,
                                   fill_color = "#e00000",
                                   text_position = "outside-end")
                  ),

                
              #-----------------------
              # without SSL (Original)

              Coverage.wo.SSL = colDef(
                name = "Original Coverage (Periods)",
                maxWidth = 90,
                cell= color_tiles(df1, color_ref = "f_colorpal_wo_SSL")
              ),

              f_colorpal_wo_SSL = colDef(show = FALSE), # hidden, just used for the coverages

                `PI.wo.SSL`= colDef(
                  name = "Original 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"
                    )
                  }
                ),

              #-----------------------
              # with SSL
              
              Coverage.with.SSL = colDef(
                name = "Coverage w/ SSL (Periods)",
                maxWidth = 90,
                cell= color_tiles(df1, color_ref = "f_colorpal_with_SSL")
              ),

              f_colorpal_with_SSL = colDef(show = FALSE), # hidden, just used for the coverages
              
              `PI.with.SSL`= colDef(
                  name = "Projected Inventories w/ SSL (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.wo.SSL = colDef(
                name = "Original Replenishment Plan (units)",
                cell = data_bars(df1,
                                 fill_color = "#3CB371",
                                 text_position = "outside-end"
                                 )
                ),
              
              
              DRP.plan.with.SSL = colDef(
                name = "Replenishment Plan w/ SSL (units)",
                cell = data_bars(df1,
                                 fill_color = "#3CB371",
                                 text_position = "outside-end"
                                 )
                )

              ), # close columns list

              columnGroups = list(
                
                colGroup(name = "Original Projected Inventories", 
                         columns = c("Coverage.wo.SSL",
                                     "PI.wo.SSL",
                                     "DRP.plan.wo.SSL")),
                
                
                colGroup(name = "Projected Inventories w/ SSL", 
                         columns = c("Coverage.with.SSL",
                                     "PI.with.SSL",
                                     "DRP.plan.with.SSL"))

              )

    ) # close reactable