month_to_week

We’re going to present here how to use the month_to_week() 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 :

Get demo dataset

Data

Let’s use the demo dataset from the planr package : demo_monthly_dmd.

It’s a dataset with 2 products (Product A & Product B), a Period expressed in monthly bucket, and the related monthly Demand.

# get dataset
demo_monthly_dmd <- planr::demo_monthly_dmd

glimpse(demo_monthly_dmd)
Rows: 24
Columns: 3
$ DFU    <chr> "Product A", "Product A", "Product A", "Product A", "Product A"…
$ Period <date> 2023-01-01, 2023-02-01, 2023-03-01, 2023-04-01, 2023-05-01, 20…
$ Demand <dbl> 1000, 1000, 2000, 1000, 1000, 2000, 1000, 1000, 2000, 1000, 100…

Chart

Let’s look at the Product A :

# set a working df
df1 <- demo_monthly_dmd

# Select only the Product A
df1 <- filter(df1, df1$DFU == "Product A")

#-----------------
# chart
#-----------------

u <- highchart() |> 
  
  hc_title(text = "Monthly Demand") |>
  hc_subtitle(text = "in units") |> 
  hc_add_theme(hc_theme_google()) |>
  
  hc_xAxis(categories = df1$Period) |> 
  
  hc_add_series(name = "Initial Demand", 
                color = "mediumseagreen",
                dataLabels = list(align = "center", enabled = TRUE),
                data = df1$Demand) |>

  
  hc_chart(type = "column") 

# display chart   
u 

Convert Monthly Demand into Weekly Demand

Calculation

Let’s apply the function, month_to_week .

# apply month_to_week()
Weekly_Demand <- planr::month_to_week(dataset = demo_monthly_dmd, DFU, Period, Demand)

glimpse(Weekly_Demand)
Rows: 104
Columns: 3
$ DFU    <chr> "Product A", "Product A", "Product A", "Product A", "Product A"…
$ Period <date> 2023-01-01, 2023-01-08, 2023-01-15, 2023-01-22, 2023-01-29, 20…
$ Demand <dbl> 250.0000, 250.0000, 250.0000, 250.0000, 142.8571, 250.0000, 250…

Chart

Let’s look at the Product A :

# set a working df
df1 <- Weekly_Demand

# Select only the Product A
df1 <- filter(df1, df1$DFU == "Product A")

#-----------------
# chart
#-----------------

u <- highchart() |> 
  
  hc_title(text = "Calculated Weekly Demand") |>
  hc_subtitle(text = "in units") |> 
  hc_add_theme(hc_theme_google()) |>
  
  hc_xAxis(categories = df1$Period) |> 

  hc_add_series(name = "Weekly Demand", 
                color = "gold",
                #dataLabels = list(align = "center", enabled = TRUE),
                data = df1$Demand) |>
  
  
  hc_chart(type = "column") 

# display chart   
u 

We have splitted the initial monthly demand into weekly buckets.
By default, the split is performed evenly for each week.

Control Results

Table

We want to control the quality of the split of the Demand, from monthly into weekly buckets.

Let’s then aggregate the calculated weekly Demand into monthly bucket, and compare the values with the initial ones.

We will look at the Product A for our analysis.

# set a working dataset
df1 <- Weekly_Demand

# create a (Monthly) Period
df1$Monthly.Period <- floor_date(df1$Period, unit = "month")

# aggregate
df1 <- df1 |> group_by(DFU, Monthly.Period) |> summarise(New.Demand = sum(Demand))

# rename
df1 <- df1 |> rename(Period = Monthly.Period)

#-----------------------------
# Add to initial dataset
#-----------------------------

# merge
df1 <- left_join(demo_monthly_dmd, df1)

# calculate accumulated values
df1 <- df1 |> group_by(DFU, Period) |>
    summarise(
      Demand = sum(Demand),
      New.Demand = sum(New.Demand)
    ) |>
  
    mutate(
      acc_Demand = cumsum(Demand),
      acc_New.Demand = cumsum(New.Demand)
    )

# formatting
df1 <- as.data.frame(df1)

# calculate delta
df1$delta <- (df1$acc_New.Demand - df1$acc_Demand) / df1$acc_Demand




#-----------------
# Focus on Product A
#-----------------


# Select only the Product A
df1 <- filter(df1, df1$DFU == "Product A")


#-----------------
# Formatting for a better display
#-----------------

df1$New.Demand <- as.integer(df1$New.Demand)
df1$acc_New.Demand <- as.integer(df1$acc_New.Demand)

df1
         DFU     Period Demand New.Demand acc_Demand acc_New.Demand       delta
1  Product A 2023-01-01   1000       1142       1000           1142 0.142857143
2  Product A 2023-02-01   1000       1142       2000           2285 0.142857143
3  Product A 2023-03-01   2000       1750       4000           4035 0.008928571
4  Product A 2023-04-01   1000       1178       5000           5214 0.042857143
5  Product A 2023-05-01   1000       1000       6000           6214 0.035714286
6  Product A 2023-06-01   2000       1821       8000           8035 0.004464286
7  Product A 2023-07-01   1000       1142       9000           9178 0.019841270
8  Product A 2023-08-01   1000        964      10000          10142 0.014285714
9  Product A 2023-09-01   2000       1857      12000          12000 0.000000000
10 Product A 2023-10-01   1000       1142      13000          13142 0.010989011
11 Product A 2023-11-01   1000       1000      14000          14142 0.010204082
12 Product A 2023-12-01   2000       1857      16000          16000 0.000000000

We can see that there is a little difference between the initial and the new value.

However, how is it when we look at the accumulated values ?

We can see that the accumulated values show almost no difference.
- during the 1st two periods there is a slight difference
- which almost totally disappears from the 3rd period

Let’s look at it through 2 charts :

Chart 1 : Initial vs New Demand

Let’s compare the initial & the new monthly Demand :

#-----------------
# chart
#-----------------

u <- highchart() |> 
  
  hc_title(text = "Initial vs New Demand") |>
  hc_subtitle(text = "in units") |> 
  hc_add_theme(hc_theme_google()) |>
  
  hc_xAxis(categories = df1$Period) |> 
  
  hc_add_series(name = "Initial Demand", 
                color = "mediumseagreen",
                dataLabels = list(align = "center", enabled = TRUE),
                data = df1$Demand) |>
  
  hc_add_series(name = "New Demand", 
                color = "gold",
                dataLabels = list(align = "center", enabled = TRUE),
                data = df1$New.Demand) |>
  
  
  hc_chart(type = "column") 

# display chart   
u 

Chart 2 : Accumulated Initial vs New Demand

p <- highchart() |> 
  
  hc_title(text = "Accumulated Initial vs New Demand") |>
  hc_subtitle(text = "in units") |> 
  hc_add_theme(hc_theme_google()) |>
  
  hc_xAxis(categories = df1$Period) |> 
  
  hc_add_series(name = "Initial Demand", 
                color = "mediumseagreen",
                dataLabels = list(align = "center", enabled = TRUE),
                data = df1$acc_Demand) |>
  
  hc_add_series(name = "New Demand", 
                color = "gold",
                dataLabels = list(align = "center", enabled = TRUE),
                data = df1$acc_New.Demand) |>
  
  hc_add_theme(hc_theme_google())
 
# display chart   
p