Portfolio Calculation


library(tidyverse)
library(dplyr)
library(lubridate)
library(tidyverse)
library(shiny)

# for the tables
library(reactable)
library(reactablefmtr)
library(sparkline)
library(DT)

# for the charts
library(highcharter)

# the library planr
library(planr)

Some examples to apply the planr functions for portfolios

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)
#> # A tibble: 6 × 7
#> # Groups:   DFU [1]
#>   DFU    Period     Demand Opening Calculated.Coverage.…¹ Projected.Inventorie…²
#>   <chr>  <date>      <dbl>   <dbl>                  <dbl>                  <dbl>
#> 1 Item … 2022-07-03    364    6570                   16.8                   6206
#> 2 Item … 2022-07-10    364       0                   15.8                   5842
#> 3 Item … 2022-07-17    364       0                   14.8                   5478
#> 4 Item … 2022-07-24    260       0                   13.8                   5218
#> 5 Item … 2022-07-31    736       0                   12.8                   4482
#> 6 Item … 2022-08-07    859       0                   11.8                   3623
#> # ℹ abbreviated names: ¹​Calculated.Coverage.in.Periods,
#> #   ²​Projected.Inventories.Qty
#> # ℹ 1 more variable: Supply <dbl>

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