month_to_weekx

We’re going to present here how to use the month_to_weekx() function from the R package planr.

More info on : https://github.com/nguyennico/planr

This function allows to split a Demand (for ex.: Sales Forecasts) from monthly into weekly buckets.

We need a dataset with the 3 variables to use this function :

And also 4 variables, which are coefficients :

#————————————————————————–

Part 1 : Demo dataset

Let’s create a dataset with 4 products (A, B, C , D) with an identical Demand expressed in monthly bucket.

We’re going to transform the Monthly Demand into Weekly Bucket, using as examples 4 types of distributions :

  • demand evenly distributed among each week of the month

  • demand following a “L pattern” (occurring mainly during the beginning of the month)

  • demand following a “J pattern” (occurring mainly during the end of the month)

  • demand following a random pattern (with some peaks during some weeks)

a) Product A

#--------------------------------
# Input values for the test
#--------------------------------

# Create a vector of Monthly Period
Period <- c("2023-06-01", "2023-07-01", "2023-08-01")


# Create a vector of Demand
Demand <- c(1000, 2000, 1000)


# assemble
input <- data.frame(Period,
                      Demand)

# let's add a Product
input$DFU <- "Product A"

# format the Period as a date
input$Period <- as.Date(as.character(input$Period), format = '%Y-%m-%d')



# define weekly distribution values
input$W1 <- 0.25
input$W2 <- 0.25
input$W3 <- 0.25
input$W4 <- 0.25


# keep results
input_ProdA <- input

glimpse(input_ProdA)
Rows: 3
Columns: 7
$ Period <date> 2023-06-01, 2023-07-01, 2023-08-01
$ Demand <dbl> 1000, 2000, 1000
$ DFU    <chr> "Product A", "Product A", "Product A"
$ W1     <dbl> 0.25, 0.25, 0.25
$ W2     <dbl> 0.25, 0.25, 0.25
$ W3     <dbl> 0.25, 0.25, 0.25
$ W4     <dbl> 0.25, 0.25, 0.25

b) Product B

#--------------------------------
# Input values for the test
#--------------------------------

# Create a vector of Monthly Period
Period <- c("2023-06-01", "2023-07-01", "2023-08-01")


# Create a vector of Demand
Demand <- c(1000, 2000, 1000)


# assemble
input <- data.frame(Period,
                      Demand)

# let's add a Product
input$DFU <- "Product B"

# format the Period as a date
input$Period <- as.Date(as.character(input$Period), format = '%Y-%m-%d')


# define weekly distribution values
input$W1 <- 0.75
input$W2 <- 0.15
input$W3 <- 0.05
input$W4 <- 0.05


# keep results
input_ProdB <- input

glimpse(input_ProdB)
Rows: 3
Columns: 7
$ Period <date> 2023-06-01, 2023-07-01, 2023-08-01
$ Demand <dbl> 1000, 2000, 1000
$ DFU    <chr> "Product B", "Product B", "Product B"
$ W1     <dbl> 0.75, 0.75, 0.75
$ W2     <dbl> 0.15, 0.15, 0.15
$ W3     <dbl> 0.05, 0.05, 0.05
$ W4     <dbl> 0.05, 0.05, 0.05

c) Product C

#--------------------------------
# Input values for the test
#--------------------------------

# Create a vector of Monthly Period
Period <- c("2023-06-01", "2023-07-01", "2023-08-01")


# Create a vector of Demand
Demand <- c(1000, 2000, 1000)


# assemble
input <- data.frame(Period,
                      Demand)

# let's add a Product
input$DFU <- "Product C"

# format the Period as a date
input$Period <- as.Date(as.character(input$Period), format = '%Y-%m-%d')


# define weekly distribution values
input$W1 <- 0.05
input$W2 <- 0.05
input$W3 <- 0.15
input$W4 <- 0.75


# keep results
input_ProdC <- input

glimpse(input_ProdC)
Rows: 3
Columns: 7
$ Period <date> 2023-06-01, 2023-07-01, 2023-08-01
$ Demand <dbl> 1000, 2000, 1000
$ DFU    <chr> "Product C", "Product C", "Product C"
$ W1     <dbl> 0.05, 0.05, 0.05
$ W2     <dbl> 0.05, 0.05, 0.05
$ W3     <dbl> 0.15, 0.15, 0.15
$ W4     <dbl> 0.75, 0.75, 0.75

c) Product D

#--------------------------------
# Input values for the test
#--------------------------------

# Create a vector of Monthly Period
Period <- c("2023-06-01", "2023-07-01", "2023-08-01")


# Create a vector of Demand
Demand <- c(1000, 2000, 1000)


# assemble
input <- data.frame(Period,
                      Demand)

# let's add a Product
input$DFU <- "Product D"

# format the Period as a date
input$Period <- as.Date(as.character(input$Period), format = '%Y-%m-%d')


# define weekly distribution values
input$W1 <- 0.5
input$W2 <- 0.1
input$W3 <- 0.3
input$W4 <- 0.1


# keep results
input_ProdD <- input

glimpse(input_ProdD)
Rows: 3
Columns: 7
$ Period <date> 2023-06-01, 2023-07-01, 2023-08-01
$ Demand <dbl> 1000, 2000, 1000
$ DFU    <chr> "Product D", "Product D", "Product D"
$ W1     <dbl> 0.5, 0.5, 0.5
$ W2     <dbl> 0.1, 0.1, 0.1
$ W3     <dbl> 0.3, 0.3, 0.3
$ W4     <dbl> 0.1, 0.1, 0.1

d) Assemble

df1 <- rbind(input_ProdA, input_ProdB, input_ProdC, input_ProdD)

# keep results
input <- df1

glimpse(input)
Rows: 12
Columns: 7
$ Period <date> 2023-06-01, 2023-07-01, 2023-08-01, 2023-06-01, 2023-07-01, 20…
$ Demand <dbl> 1000, 2000, 1000, 1000, 2000, 1000, 1000, 2000, 1000, 1000, 200…
$ DFU    <chr> "Product A", "Product A", "Product A", "Product B", "Product B"…
$ W1     <dbl> 0.25, 0.25, 0.25, 0.75, 0.75, 0.75, 0.05, 0.05, 0.05, 0.50, 0.5…
$ W2     <dbl> 0.25, 0.25, 0.25, 0.15, 0.15, 0.15, 0.05, 0.05, 0.05, 0.10, 0.1…
$ W3     <dbl> 0.25, 0.25, 0.25, 0.05, 0.05, 0.05, 0.15, 0.15, 0.15, 0.30, 0.3…
$ W4     <dbl> 0.25, 0.25, 0.25, 0.05, 0.05, 0.05, 0.75, 0.75, 0.75, 0.10, 0.1…

#————————————————————————–

Part 2 : Summary Table

We could summarize the patterns in the following table.

a) Create Nanoplots Table

#-----------------
# Create dataset
#-----------------

pattern <- c("even distribution", "L pattern", "J pattern", "random")

W1 <- c(0.25, 0.75, 0.05, 0.5)
W2 <- c(0.25, 0.15, 0.05, 0.1)
W3 <- c(0.25, 0.05, 0.15, 0.3)
W4 <- c(0.25, 0.05, 0.75, 0.1)

patterns_data <- data.frame(pattern,
                            W1,
                            W2,
                            W3,
                            W4)

patterns_data
            pattern   W1   W2   W3   W4
1 even distribution 0.25 0.25 0.25 0.25
2         L pattern 0.75 0.15 0.05 0.05
3         J pattern 0.05 0.05 0.15 0.75
4            random 0.50 0.10 0.30 0.10

b) Display table

patterns_data |>
  gt(rowname_col = "pattern") |>
  tab_header("Examples of Weekly Distribution patterns") |>
  tab_stubhead(label = md("**Pattern**")) |>
  #cols_hide(columns = c(starts_with("norm"), units)) |>
  cols_nanoplot(
    columns = starts_with("W"),
    new_col_name = "nanoplots",
    new_col_label = md("*Distribution*")
  ) |>
  cols_align(align = "center", columns = nanoplots) |>
  tab_footnote(
    footnote = "Sales Forecasts from Week1 through Week4.",
    locations = cells_column_labels(columns = nanoplots)
  )
Examples of Weekly Distribution patterns

Pattern

Distribution

1
even distribution
0.30 0.20 0.25 0.25 0.25 0.25
L pattern
0.75 0.050 0.75 0.15 0.050 0.050
J pattern
0.75 0.050 0.050 0.050 0.15 0.75
random
0.50 0.10 0.50 0.10 0.30 0.10
1 Sales Forecasts from Week1 through Week4.

#————————————————————————–

Part 3 : Transform into Weekly Buckets

We now apply the month_to_weekx() function to the demo dataset.

It will transform the Demand initially expressed in monthly buckets into weekly buckets, following the weekly coefficients W1 | W2 | W3 | W4 .

# calculate
df1 <- planr::month_to_weekx(dataset = input,
                      DFU = DFU,
                      W1 = W1,
                      W2 = W2,
                      W3 = W3,
                      W4 = W4,
                      Period = Period,
                      Demand = Demand
                      )
Joining with `by = join_by(Monthly.Week.no)`
Joining with `by = join_by(Day.no)`
Joining with `by = join_by(Monthly.Period, DFU)`
# keep results
calculated_data <- df1

glimpse(calculated_data)
Rows: 56
Columns: 3
$ DFU    <chr> "Product A", "Product A", "Product A", "Product A", "Product A"…
$ Period <date> 2023-05-28, 2023-06-04, 2023-06-11, 2023-06-18, 2023-06-25, 20…
$ Demand <dbl> 107.14286, 250.00000, 250.00000, 250.00000, 214.28571, 500.0000…

#————————————————————————–

Part 4 : Charts

a) Even pattern

This is the Product A

# select Product A
df1 <- calculated_data |> filter(DFU == "Product A")

# chart
p <- highchart() |> 
      
      hc_add_series(name = "Weekly Demand", 
                    color = "mediumseagreen",
                    type = 'spline',
                    #dataLabels = list(align = "center", enabled = TRUE),
                    data = df1$`Demand`) %>% 
      
      hc_title(text = "Even Distribution") |>
      hc_subtitle(text = "in units") |> 
      
      hc_xAxis(categories = df1$Period) |>
      
      hc_add_theme(hc_theme_google())
    
    
    p

b) Test L pattern

This is the Product B

# select Product B
df1 <- calculated_data |> filter(DFU == "Product B")

# chart
p <- highchart() |> 
      
      hc_add_series(name = "Weekly Demand", 
                    color = "salmon",
                    type = 'spline',
                    #dataLabels = list(align = "center", enabled = TRUE),
                    data = df1$`Demand`) %>% 
      
      hc_title(text = "L Pattern") |>
      hc_subtitle(text = "in units") |> 
      
      hc_xAxis(categories = df1$Period) |>
      
      hc_add_theme(hc_theme_google())
    
    
    p

c) Test J pattern

This is the Product C

# select Product B
df1 <- calculated_data |> filter(DFU == "Product C")

# chart
p <- highchart() |> 
      
      hc_add_series(name = "Weekly Demand", 
                    color = "steelblue",
                    type = 'spline',
                    #dataLabels = list(align = "center", enabled = TRUE),
                    data = df1$`Demand`) %>% 
      
      hc_title(text = "J Pattern") |>
      hc_subtitle(text = "in units") |> 
      
      hc_xAxis(categories = df1$Period) |>
      
      hc_add_theme(hc_theme_google())
    
    
    p

d) Random pattern

This is the Product D

# select Product D
df1 <- calculated_data |> filter(DFU == "Product D")

# chart
p <- highchart() |> 
      
      hc_add_series(name = "Weekly Demand", 
                    color = "gold", 
                    type = 'spline',
                    #dataLabels = list(align = "center", enabled = TRUE),
                    data = df1$`Demand`) %>% 
      
      hc_title(text = "Random Pattern") |>
      hc_subtitle(text = "in units") |> 
      
      hc_xAxis(categories = df1$Period) |>
      
      hc_add_theme(hc_theme_google())
    
    
    p

Choosing the appropriate distribution pattern when converting the Demand from Monthly into Weekly bucket can provide a more accurate calculation of :

  • projected inventories & coverages

  • replenishment plan