Forecast monthly mean from daily time series using latest forecast package syntax

Question

I am trying to forecast the mean of a month of daily time series data. I need to forecast the mean of the current month (meaning we have partial data) as well as the next month(s) (meaning I need to forecast the path of the daily time series throughout this month and the next month).

Using the modern forecast package and techniques from Hyndman's FPP3, it is straightforward to forecast the daily. It would then be straightforward, with some data manipulation, to calculate the forecasted mean of the month from the forecasted daily observations.

But, from what I understand, doing it this way forces you to go outside the bounds of the forecast package, and thus you miss out on being able to model and forecast the actual monthly mean directly using the scenarios feature as well as being able to forecast the monthly mean with prediction intervals.

My aim is to be able to re-forecast the monthly every day as the new daily observation comes in, and have the uncertainty / prediction interval around monthly mean forecast start to decrease as we approach the end of the month.

I've cooked up the following repro to demonstrate what I'm getting at.

# cross validated question
library(fpp3)
library(lubridate)
library(tidyverse)

repro_data <-
  tsibble(date = as_date(ymd("2023-06-01"):ymd("2023-08-23"))) |>
  mutate(obs = 1:84,
         explanatory_var = 1:84 + 10)

# it is trivial to model the underlying daily series
tslm_fit <- repro_data |>
  model(tslm = TSLM(obs ~ explanatory_var))

explanatory_scenarios <- scenarios(
  # trend continuing scenario
  continued_increase = new_data(repro_data, 38) |>
    mutate(explanatory_var = 84:(84 + 37) + 10),
  # trend reversing scenario
  decrease = new_data(repro_data, 38) |>
    mutate(explanatory_var = 84:(84 - 37) + 10)
)

# forecast thru september
fcast <- tslm_fit |>
  forecast(h = 38, new_data = explanatory_scenarios)

# bind each scenario with past reality and then compute monthly means

monthly_mean_fcast <- fcast |>
  as_tsibble(date, .scenario) |>
  select(.scenario, date, obs = .mean) |>
  bind_rows(map_dfr(
    names(explanatory_scenarios),
    ~ mutate(as_tibble(repro_data), .scenario = .x)
  )) |> 
  index_by(yearmonth = yearmonth(date)) |>
  group_by_key() |> 
  summarise(
    mean_obs = mean(obs, na.rm = TRUE)
  )
monthly_mean_fcast

As you can see, I can use the scenarios to forecast August and September, but it's in a roundabout way. I'm not directly modeling and forecasting the monthly mean. Is there a way to go more directly to the goal of forecasting the monthly mean and get prediction intervals in the process?

Answer 1

The simplest way to do this is to use simulation. You can generate future sample paths from the daily model, and then combine the historical data and simulated futures to create the forecast distributions. The following code works with the fable package. I've added some noise to your artificial data so you can see the effect more easily when converting from daily to monthly.

# cross validated question
library(fpp3)
#> ── Attaching packages ─────────────────────────────────────── fpp3 0.5.0.9000 ──
#> ✔ tibble      3.2.1          ✔ tsibble     1.1.3     
#> ✔ dplyr       1.1.2          ✔ tsibbledata 0.4.1.9000
#> ✔ tidyr       1.3.0          ✔ feasts      0.3.1.9000
#> ✔ lubridate   1.9.2          ✔ fable       0.3.2.9000
#> ✔ ggplot2     3.4.3          ✔ fabletools  0.3.3.9000
#> ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
#> ✖ lubridate::date()    masks base::date()
#> ✖ dplyr::filter()      masks stats::filter()
#> ✖ tsibble::intersect() masks base::intersect()
#> ✖ tsibble::interval()  masks lubridate::interval()
#> ✖ dplyr::lag()         masks stats::lag()
#> ✖ tsibble::setdiff()   masks base::setdiff()
#> ✖ tsibble::union()     masks base::union()

repro_data <-   tsibble(date = as_date(ymd("2023-06-01"):ymd("2023-08-23"))) |>
    mutate(
        obs = 1:84 + rnorm(84, sd=20),
        explanatory_var = 1:84 + 10
    )
#> Using `date` as index variable.

# it is trivial to model the underlying daily series
tslm_fit <- repro_data |>
    model(tslm = TSLM(obs ~ explanatory_var))

explanatory_scenarios <- scenarios(
    # trend continuing scenario
    continued_increase = new_data(repro_data, 38) |>
        mutate(explanatory_var = 84:(84 + 37) + 10),
    # trend reversing scenario
    decrease = new_data(repro_data, 38) |>
        mutate(explanatory_var = 84:(84 - 37) + 10)
)

# Daily forecasts thru september
fcast1 <- tslm_fit |>
    forecast(new_data = explanatory_scenarios)

Increase nsim below to something larger. At least 1000.

# Generate future sample paths
nsim <- 10
fcast2 <- tslm_fit |>
    generate(new_data = explanatory_scenarios, times = nsim) |>
    as_tibble() |>
    # Add in historical data to each sample path
    bind_rows(
        expand_grid(
            date = unique(repro_data$date),
            .scenario = names(explanatory_scenarios),
            .model = colnames(tslm_fit),
            .rep = as.character(seq(nsim))
        ) |>
            left_join(repro_data |> transmute(.sim = obs), by = "date")
    ) |>
    # Compute monthly averages
    mutate(month = yearmonth(date)) |>
    group_by(month, .scenario, .model, .rep) |>
    summarise(.sim = mean(.sim), .groups = "drop") |>
    # Nest replicates
    nest(.sim = .sim, .by = c("month", ".scenario", ".model")) |>
    # Create forecast distributions
    group_by(month, .scenario,.model) |>
    mutate(
        .sim = distributional::dist_sample(list(unlist(.sim))),
        .mean = mean(.sim)
    ) |>
    ungroup() |>
    # Create fable
    as_fable(
        index = month,
        response = ".sim",
        distribution = .sim,
        key = c(.scenario, .model)
    )

# Daily forecasts
autoplot(fcast1) + geom_line(data=repro_data, aes(y=obs))

# Monthly forecasts
autoplot(fcast2) + geom_line(data = fcast2, aes(x=month, y=.mean))

^{Created on 2023-08-30 with reprex v2.0.2}