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
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
# 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 0Let’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