Portfolio Calculation

The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.

Part 1 : Projected Inventories & Coverages

1.1) Overview Demo dataset

Let’s look at the demo dataset blueprint_light.

The raw data look like this:


df1 <- blueprint_light

glimpse(df1)
#> Rows: 520
#> Columns: 5
#> $ 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,…

Let’s have a summary view, using the reactable package:




#-----------------
# Get Summary of variables
#-----------------

# set a working df
df1 <- blueprint_light

# 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 <- blueprint_light
    
# replace missing values by zero
df1$Demand[is.na(df1$Demand)] <- 0
    
# aggregate
df1 <- df1 %>%
      group_by(
        DFU,
        Period
      ) %>%
      summarise(
        Quantity = sum(Demand)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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_light
    
# replace missing values by zero
df1$Supply[is.na(df1$Supply)] <- 0
    
# aggregate
df1 <- df1 %>%
      group_by(
        DFU,
        Period
      ) %>%
      summarise(
        Quantity = sum(Supply)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Supply_Sparklines_DB)
#> Joining with `by = join_by(DFU)`


# reorder columns
df1 <- df1 %>% select(DFU, Demand, Demand.pc, Demand.Quantity, Opening,
                      Supply, Supply.Quantity)


# get results
Summary_DB <- df1

glimpse(Summary_DB)
#> Rows: 10
#> Columns: 7
#> $ DFU             <chr> "Item 000001", "Item 000002", "Item 000003", "Item 000…
#> $ 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, 34…
#> $ Opening         <dbl> 6570, 5509, 2494, 7172, 17500, 9954, 2092, 17500, 1222…
#> $ Supply          <dbl> 6187, 17927, 3000, 20000, 30000, 21660, 6347, 73000, 7…
#> $ Supply.Quantity <list> <0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5000, 0, 0…

and now let’s create the 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)
                    )
                  })
                


 
                
                
              ), # 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

1.2) Calculate Projected Inventories



# set a working df
df1 <- blueprint_light


df1 <- as.data.frame(df1)

glimpse(df1)
#> Rows: 520
#> Columns: 5
#> $ 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,…

# calculate
calculated_projection <- light_proj_inv(dataset = df1, 
                                        DFU = DFU, 
                                        Period = Period, 
                                        Demand =  Demand, 
                                        Opening = Opening, 
                                        Supply = Supply)
#> Joining with `by = join_by(DFU, Period)`

# see results
head(calculated_projection)
#>           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
#> 1                      6206      0
#> 2                      5842      0
#> 3                      5478      0
#> 4                      5218      0
#> 5                      4482      0
#> 6                      3623      0

1.3) Analysis

1.3.1) For one Item

Let’s look at the Item 000001 :


calculated_projection <-as.data.frame(calculated_projection)

# filter data
Selected_DB <- filter(calculated_projection, calculated_projection$DFU == "Item 000001")


glimpse(Selected_DB)
#> Rows: 52
#> Columns: 7
#> $ 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, …

Let’s create a table using reactable :


# keep only the needed columns
df1 <- Selected_DB %>% 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 > 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 = 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

1.3.2) For multiple Items

We can create a simple table that we could call a “Supply Risks Alarm”, giving a quick overview of: - projected inventories - projected coverages


#------------------------------
# Get data
df1 <- calculated_projection
df1 <- as.data.frame(df1)


#------------------------------
# Filter

# subset Period based on those Starting and Ending Periods
df1 <- subset(df1,df1$Period >= "2022-07-03" & df1$Period <= "2022-09-25")


#--------
# Keep Initial data
#--------
    
# replace missing values by zero
df1$Demand[is.na(df1$Demand)] <- 0
    
Initial_DB <- df1
   


#------------------------------
# Transform
    
    
    
#--------
# Create a Summary database
#--------
    
# set a working df
df1 <- Initial_DB
    
# aggregate
df1 <- df1 %>% select(
      DFU,
      Demand) %>%
      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[,c("DFU","Period","Calculated.Coverage.in.Periods")]

# format as numeric
df1$Calculated.Coverage.in.Periods <- as.numeric(df1$Calculated.Coverage.in.Periods)

# formatting 1 digit after comma
df1$Calculated.Coverage.in.Periods = round(df1$Calculated.Coverage.in.Periods, 1)

# spread data
df1 <- df1 %>% spread(Period, Calculated.Coverage.in.Periods)

# 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[order(-df1$Demand.Qty),]


# rename column
df1 <- df1 %>% rename(
      "Total Demand (units)" = Demand.Qty
    )


# Get Results
Interim_DB <- df1

Let’s visualize through a DT table :


#------------------------------
# create DT
  
df1 <- Interim_DB

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 = styleInterval(c(-0.1,0.0,1.0), c('#FF6347', 'orange', 'yellow','lightblue'))
      ) %>%

    formatStyle(
      2:2,
      backgroundColor = 'mediumseagreen'
    )

1.3.3) Add Delay Analysis Check

We can imagine creating a tag to inform us when the projected inventories are negative, which means we have a risk of delay. It’s somehowe like “screening” all the projected inventories (in a pretty simple way!).


#--------
# 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

head(Check_DB)
#> # A tibble: 6 × 4
#>   DFU         min.Projected.Inventories.…¹ max.Projected.Invent…² Delay.Analysis
#>   <chr>                              <dbl>                  <dbl> <chr>         
#> 1 Item 000001                          385                   6206 OK            
#> 2 Item 000002                         1252                  10954 OK            
#> 3 Item 000003                         1180                   2229 OK            
#> 4 Item 000004                           98                   9307 OK            
#> 5 Item 000005                         3100                  28600 OK            
#> 6 Item 000006                         6531                  15730 OK            
#> # ℹ abbreviated names: ¹min.Projected.Inventories.Qty,
#> #   ²max.Projected.Inventories.Qty

Now let’s add this Check_DB to the previous dataframes :



#--------
# Merge
#--------

# merge
df1 <- left_join(Check_DB, Interim_DB)
#> Joining with `by = join_by(DFU)`
df1 <- as.data.frame(df1)

# Note : we could use a filter to keep only those rows, in a shiny app for example
# filter on Delay.Analysis
# df1 <- filter(df1,df1$Delay.Analysis %in% input$Selected.Delay.Analysis)


# remove not needed columns
df1 <- df1[ , -which(names(df1) %in% c("min.Projected.Inventories.Qty",
                                           "max.Projected.Inventories.Qty"
                                           #"Delay.Analysis"
                                       ))]

    
    
#------------------------------
# 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(3:3, 1) %>%

      formatStyle(columns = c(1:100), fontSize = '85%') %>%

      formatStyle(
        4:20,
        backgroundColor = styleInterval(c(-0.1,0.0,1.0), c('#FF6347', 'orange', 'yellow','lightblue'))
      ) %>%

    formatStyle(
      3:3,
      backgroundColor = 'mediumseagreen'
    )

1.4) Cockpit

We can also use another way, more compact, to get : - an overview of the projected inventories - an analysis of the projected values

1.4.1) Create Dataframe




#------------------------------
# Get data
df1 <- calculated_projection
df1 <- as.data.frame(df1)


#------------------------------
# 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)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Supply_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, PI_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Check_DB)
#> Joining with `by = join_by(DFU)`


# 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: 10
#> Columns: 9
#> $ 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,…
#> $ Delay.Analysis  <chr> "OK", "OK", "OK", "OK", "OK", "OK", "OK", "Delay", "O…

1.4.2) Display Table

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 reactable

This 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.

Part 2 : Projected Inventories & Analysis

2.1) Overview Demo dataset

Let’s look at the demo dataset blueprint_light.

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 %>% select(DFU,
                      Demand,
                      Opening,
                      Supply,
                      Min.Cov,
                      Max.Cov) %>%
      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_light
    
# replace missing values by zero
df1$Demand[is.na(df1$Demand)] <- 0
    
# aggregate
df1 <- df1 %>%
      group_by(
        DFU,
        Period
      ) %>%
      summarise(
        Quantity = sum(Demand)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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_light
    
# replace missing values by zero
df1$Supply[is.na(df1$Supply)] <- 0
    
# aggregate
df1 <- df1 %>%
      group_by(
        DFU,
        Period
      ) %>%
      summarise(
        Quantity = sum(Supply)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Supply_Sparklines_DB)
#> Joining with `by = join_by(DFU)`


# 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 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)
                    )
                  }),
                
                
                
                `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

2.2) Calculate Projected Inventories

Let’s apply the proj_inv() function :



# set a working df
df1 <- blueprint
df1 <- as.data.frame(df1)


# calculate
calculated_projection_and_analysis <- proj_inv(data = df1, 
                DFU = DFU, 
                Period = Period, 
                Demand =  Demand, 
                Opening = Opening, 
                Supply = Supply,
                Min.Cov = Min.Cov, 
                Max.Cov = Max.Cov)
#> Joining with `by = join_by(DFU, Period)`
#> Joining with `by = join_by(DFU, Period)`


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

2.3) Analysis

2.3.1) For one Item

Let’s look at the Item 000001 :


calculated_projection_and_analysis <-as.data.frame(calculated_projection_and_analysis)

# 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 :



# set a working df
df1 <- Selected_DB


# 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 = 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

2.3.2) For multiple items

We can see that in the column [PI.Index] we have several possible values, among them: - OverStock - OK - Alert - Shortage

We might be interested especially in 3 of them : OverStock / Alert / Shortage And a second question after having identified those values could be: - my how much (vs target) are we in an Overstock or 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 as we saw previously.

If we want to focus on only the important Overstocks, we can filter based on the field [Ratio.PI.vs.Max].

Let’s highlight only the Overstocks :



# set a working dataframe
df1 <-as.data.frame(calculated_projection_and_analysis)


#------------------------------
# Filter

# subset Period based on those Starting and Ending Periods
df1 <- subset(df1,df1$Period >= "2022-07-03" & df1$Period <= "2022-09-25")


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[is.na(df1$Demand)] <- 0
    
Initial_DB <- df1
   


#------------------------------
# Transform
    
    
    
#--------
# Create a Summary database
#--------
    
# set a working df
df1 <- Initial_DB
    
# aggregate
df1 <- df1 %>% select(
      DFU,
      Demand) %>%
      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[,c("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[order(-df1$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'
    )

2.4) Cockpit

We can imagine a cockpit informing us about : - OverStock - Alert - Shortage

2.4.1) Create Dataframe




#------------------------------
# Get data
df1 <- calculated_projection_and_analysis
df1 <- as.data.frame(df1)


#------------------------------
# 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)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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 %>% select(DFU, PI.Index.Value) %>%
      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 %>% select(DFU, PI.Index.Value) %>%
      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 %>% select(DFU, PI.Index.Value) %>%
      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)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Supply_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, PI_Sparklines_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, OverStock_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Alert_DB)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Shortage_DB)
#> Joining with `by = join_by(DFU)`


# 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"

2.4.2) Display Table

We will use again the previous function to display a badge.

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)
                    )
                  }),
                
                
                
                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 could look at it through a different angle, considering the Period. For example a display of the analysis for the next 4 periods of time, the next 5 to 8, the next 9 to 12 periods. This way we get one more insight : when the issue (OverStock / Delay / Shortage) will occur.

Part 3 : DRP Calculation

3.1) Overview Demo dataset

Let’s look at the demo dataset blueprint_drp.

The raw data look like this:


df1 <- blueprint_drp

glimpse(df1)
#> Rows: 520
#> Columns: 9
#> $ DFU       <chr> "Item 000001", "Item 000001", "Item 000001", "Item 000001", …
#> $ Period    <date> 2022-07-03, 2022-07-10, 2022-07-17, 2022-07-24, 2022-07-31,…
#> $ Demand    <dbl> 364, 364, 364, 260, 736, 859, 859, 859, 273, 349, 349, 349, …
#> $ Opening   <dbl> 6570, 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, …
#> $ FH        <chr> "Frozen", "Frozen", "Free", "Free", "Free", "Free", "Free", …
#> $ SSCov     <dbl> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, …
#> $ DRPCovDur <dbl> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, …
#> $ MOQ       <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …

3.1.1) DRP Parameters

Let’s have a summary view, using the reactable package:




#-----------------
# Get Summary of variables
#-----------------

# set a working df
df1 <- blueprint_drp

# aggregate
df1 <- df1 %>% select(DFU,
                      Demand,
                      Opening,
                      Supply,
                      SSCov,
                      DRPCovDur,
                      MOQ) %>%
      group_by(DFU) %>%
      summarise(Demand = sum(Demand),
                Opening = sum(Opening),
                Supply = sum(Supply),
                SSCov = mean(SSCov),
                DRPCovDur = mean(DRPCovDur),
                MOQ = mean(MOQ)
      )
    
# 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_drp
    
# replace missing values by zero
df1$Demand[is.na(df1$Demand)] <- 0
    
# aggregate
df1 <- df1 %>%
      group_by(
        DFU,
        Period
      ) %>%
      summarise(
        Quantity = sum(Demand)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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_drp
    
# replace missing values by zero
df1$Supply[is.na(df1$Supply)] <- 0
    
# aggregate
df1 <- df1 %>%
      group_by(
        DFU,
        Period
      ) %>%
      summarise(
        Quantity = sum(Supply)
      )
#> `summarise()` has grouped output by 'DFU'. You can override using the `.groups`
#> argument.
    
    # 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)
#> Joining with `by = join_by(DFU)`
df1 <- left_join(df1, Supply_Sparklines_DB)
#> Joining with `by = join_by(DFU)`


# reorder columns
df1 <- df1 %>% select(DFU,
                      SSCov,
                      DRPCovDur,
                      MOQ, 
                      Demand, Demand.pc, Demand.Quantity, Opening,
                      Supply, Supply.Quantity)


# get results
Summary_DB <- df1

glimpse(Summary_DB)
#> Rows: 10
#> Columns: 10
#> $ DFU             <chr> "Item 000001", "Item 000002", "Item 000003", "Item 000…
#> $ SSCov           <dbl> 3, 3, 2, 3, 2, 5, 8, 2, 8, 6
#> $ DRPCovDur       <dbl> 3, 2, 2, 4, 4, 3, 4, 4, 8, 10
#> $ MOQ             <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
#> $ 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, 7…
#> $ Supply.Quantity <list> <0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5000, 0, 0…

and now let’s create the 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)
                    )
                  }),
                
                
                
                `SSCov`= colDef(
                  name = "Safety Stock (Periods)",
                  style = function(value) {
                    bar_style(width = value / max(df1$Min.Cov), fill = "hsl(208, 70%, 90%)")
                  }
                ),
                
                
                `DRPCovDur`= colDef(
                  name = "Frequency of Supply (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 = "DRP parameters",
                         columns = c("SSCov", "DRPCovDur", "MOQ")),
                
                colGroup(name = "Demand",
                         columns = c("Demand",
                                     "Demand.pc",
                                     "Demand.Quantity")),
                
                colGroup(name = "Supply",
                         columns = c("Supply", "Supply.Quantity"))
                
                
              )
          
) # close reactable
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Min.Cov`.
#> Warning in max(df1$Min.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf
#> Warning: Unknown or uninitialised column: `Max.Cov`.
#> Warning in max(df1$Max.Cov): no non-missing arguments to max; returning -Inf

3.1.2) Look at Frozen Horizon

We have 3 values for the Frozen Horizon: - Frozen - Free

The DRP Calculation is only performed within the Free Horizon, and takes into account the values of the Supply Plan which are within the Frozen Horizon.


# keep only needed columns
df1 <- blueprint_drp %>% select(DFU, Period, FH)

# spread
df1 <- df1 %>% spread(Period, FH)


# 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(
    2:20,
    backgroundColor = styleEqual(
      c('Frozen'), c('yellow')
    ))

3.2) Calculate DRP

Let’s apply the drp() function :



# set a working df
df1 <- blueprint_drp
df1 <- as.data.frame(df1)


# calculate drp
calculated_drp <- drp(data = df1,
           DFU = DFU,
           Period = Period,
           Demand =  Demand,
           Opening = Opening,
           Supply = Supply,
           SSCov = SSCov,
           DRPCovDur = DRPCovDur,
           MOQ = MOQ,
           FH = FH
)
#> Joining with `by = join_by(DFU, Period)`
#> Joining with `by = join_by(DFU, Period)`
#> Joining with `by = join_by(DFU, Period)`


head(calculated_drp)
#>           DFU     Period Demand Opening Supply SSCov DRPCovDur Stock.Max MOQ
#> 1 Item 000001 2022-07-03    364    6570      0     3         3         6   1
#> 2 Item 000001 2022-07-10    364       0      0     3         3         6   1
#> 3 Item 000001 2022-07-17    364       0      0     3         3         6   1
#> 4 Item 000001 2022-07-24    260       0      0     3         3         6   1
#> 5 Item 000001 2022-07-31    736       0      0     3         3         6   1
#> 6 Item 000001 2022-08-07    859       0      0     3         3         6   1
#>       FH Safety.Stocks Maximum.Stocks DRP.Calculated.Coverage.in.Periods
#> 1 Frozen           988           3442                               16.8
#> 2 Frozen          1360           3937                               15.8
#> 3   Free          1855           3846                               14.8
#> 4   Free          2454           3935                               13.8
#> 5   Free          2577           3548                               12.8
#> 6   Free          1991           3038                               11.8
#>   DRP.Projected.Inventories.Qty DRP.plan
#> 1                          6206        0
#> 2                          5842        0
#> 3                          5478        0
#> 4                          5218        0
#> 5                          4482        0
#> 6                          3623        0

3.3) Analysis

3.3.1) For one Item

Let’s look at the Item 000004 :


calculated_drp <-as.data.frame(calculated_drp)

# filter data
Selected_DB <- filter(calculated_drp, calculated_drp$DFU == "Item 000004")


glimpse(Selected_DB)
#> Rows: 52
#> Columns: 15
#> $ DFU                                <chr> "Item 000004", "Item 000004", "Item…
#> $ Period                             <date> 2022-07-03, 2022-07-10, 2022-07-17…
#> $ Demand                             <dbl> 1296, 1296, 1296, 926, 678, 791, 79…
#> $ Opening                            <dbl> 7172, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
#> $ Supply                             <dbl> 0, 0, 0, 0, 0, 0, 0, 10000, 0, 0, 0…
#> $ SSCov                              <dbl> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,…
#> $ DRPCovDur                          <dbl> 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,…
#> $ Stock.Max                          <dbl> 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,…
#> $ MOQ                                <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
#> $ FH                                 <chr> "Frozen", "Frozen", "Frozen", "Froz…
#> $ Safety.Stocks                      <dbl> 3518, 2900, 2395, 2260, 2373, 2142,…
#> $ Maximum.Stocks                     <dbl> 6569, 5833, 5579, 5695, 6059, 6053,…
#> $ DRP.Calculated.Coverage.in.Periods <dbl> 6.1, 5.1, 4.1, 3.1, 2.1, 1.1, 0.1, …
#> $ DRP.Projected.Inventories.Qty      <dbl> 5876, 4580, 3284, 2358, 1680, 889, …
#> $ DRP.plan                           <dbl> 0, 0, 0, 0, 0, 0, 0, 10000, 0, 0, 0…

Let’s create a table using reactable :


# keep only the needed columns
df1 <- Selected_DB %>% select(Period,
                              FH,
                              Demand,
                              DRP.Calculated.Coverage.in.Periods,
                              DRP.Projected.Inventories.Qty,
                              DRP.plan)



# replace missing values by zero
df1$DRP.Projected.Inventories.Qty[is.na(df1$DRP.Projected.Inventories.Qty)] <- 0
df1$DRP.plan[is.na(df1$DRP.plan)] <- 0


# create a f_colorpal field
df1 <- df1 %>% mutate(f_colorpal = case_when( DRP.Calculated.Coverage.in.Periods > 6 ~ "#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 = "Calculated Supply (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

3.3.2) For multiple Items

We can create a simple table that we could call a “Supply Risks Alarm”, giving a quick overview of: - projected inventories - projected coverages


#------------------------------
# Get data
df1 <- calculated_drp
df1 <- as.data.frame(df1)


#------------------------------
# Filter

# subset Period based on those Starting and Ending Periods
df1 <- subset(df1,df1$Period >= "2022-07-03" & df1$Period <= "2022-09-25")


#--------
# Keep Initial data
#--------
    
# replace missing values by zero
df1$Demand[is.na(df1$Demand)] <- 0
    
Initial_DB <- df1
   


#------------------------------
# Transform
    
    
    
#--------
# Create a Summary database
#--------
    
# set a working df
df1 <- Initial_DB
    
# aggregate
df1 <- df1 %>% select(
      DFU,
      Demand) %>%
      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[,c("DFU","Period","DRP.Calculated.Coverage.in.Periods")]

# format as numeric
df1$DRP.Calculated.Coverage.in.Periods <- as.numeric(df1$DRP.Calculated.Coverage.in.Periods)

# formatting 1 digit after comma
df1$DRP.Calculated.Coverage.in.Periods = round(df1$DRP.Calculated.Coverage.in.Periods, 1)

# spread data
df1 <- df1 %>% spread(Period, DRP.Calculated.Coverage.in.Periods)

# 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[order(-df1$Demand.Qty),]


# rename column
df1 <- df1 %>% rename(
      "Total Demand (units)" = Demand.Qty
    )


# Get Results
Interim_DB <- df1

Let’s visualize through a DT table :


#------------------------------
# create DT
  


df1 <- Interim_DB

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 = styleInterval(c(-0.1,0.0,4.0), c('#FF6347', 'orange', 'yellow','lightblue'))
      ) %>%

    formatStyle(
      2:2,
      backgroundColor = 'mediumseagreen'
    )

These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.