inst/doc/vignette_01_monthly_expanding.R

In tscv: Functions and Utilities for Tidy Time Series Forecasting and Time Series Cross-Validation

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  dev = "png",
  fig.height = 5,
  fig.width = 7
)

## ----packages, message = FALSE, warning = FALSE-------------------------------
# Load relevant packages
library(tscv)
library(tidyverse)
library(tsibble)
library(fable)
library(feasts)

## ----abbreviations, echo=FALSE, warning=FALSE, message=FALSE, results='hide'----
Sys.setlocale("LC_TIME", "C")

## ----clean_data, fig.alt = "Plot raw M4 monthly data"-------------------------
series_id = "series"
value_id = "value"
index_id = "index"

context <- list(
  series_id = series_id,
  value_id = value_id,
  index_id = index_id
)

# Prepare data set
main_frame <- M4_monthly_data |>
  filter(series %in% c("M23100", "M14395"))

main_frame

main_frame |>
  plot_line(
    x = index,
    y = value,
    facet_var = series,
    title = "M4 Monthly Time Series",
    subtitle = "Series M23100 and M14395",
    xlab = "Time",
    ylab = "Value",
    caption = "Data: M4 Forecasting Competition"
  )

summarise_data(
  .data = main_frame,
  context = context
)

summarise_stats(
  .data = main_frame,
  context = context
)

## ----split_data---------------------------------------------------------------
# Setup for time series cross validation
type = "first"
value = 120       # initial training window (= 10 years of monthly observations)
n_ahead = 18      # testing window (= forecast horizon, 18 months ahead)
n_skip = 17       # skip 17 observations to obtain non-overlapping test windows
n_lag = 0         # no lag
mode = "stretch"  # expanding window approach
exceed = FALSE    # only pseudo out-of-sample forecast

split_frame <- make_split(
  main_frame = main_frame,
  context = context,
  type = type,
  value = value,
  n_ahead = n_ahead,
  n_skip = n_skip,
  n_lag = n_lag,
  mode = mode,
  exceed = exceed
)

split_frame

## ----train_models-------------------------------------------------------------
# Slice training data from main_frame according to split_frame
train_frame <- slice_train(
  main_frame = main_frame,
  split_frame = split_frame,
  context = context
)

train_frame

# Slice test data from main_frame according to split_frame
test_frame <- slice_test(
  main_frame = main_frame,
  split_frame = split_frame,
  context = context
)

test_frame

# Convert tibble to tsibble
train_frame <- train_frame |>
  as_tsibble(
    index = index,
    key = c(series, split)
  )

train_frame

# Model training via fabletools::model()
model_frame <- train_frame |>
  model(
    "SNAIVE" = SNAIVE(value ~ lag("year")),
    "ETS" = ETS(value),
    "ARIMA" = ARIMA(value)
  )

model_frame

# Forecasting via fabletools::forecast()
fable_frame <- model_frame |>
  forecast(h = n_ahead)

fable_frame

# Convert fable_frame (fable) to future_frame (tibble)
future_frame <- make_future(
  fable = fable_frame,
  context = context
)

future_frame

## ----plot_forecasts, fig.alt = "Plot forecasts"-------------------------------
# Combine actual values from train and test data
actual_frame <- bind_rows(
  train_frame,
  test_frame
)

# Combine actual values and forecasts
plot_frame <- bind_rows(
  actual_frame |>
    as_tibble() |>
    transmute(
      index,
      series,
      model = "ACTUAL",
      split,
      horizon = 0L,
      point = value
    ),
  future_frame
)

plot_frame

## ----plot_forecasts_m23100, fig.alt = "Rolling forecasts for M23100"----------
plot_frame |>
  filter(series == "M23100") |>
  plot_line(
    x = index,
    y = point,
    color = model,
    facet_var = split,
    title = "Rolling forecasts for M23100",
    subtitle = "Expanding window approach with 18-month forecast horizon",
    xlab = "Time",
    ylab = "Value",
    caption = "Data: M4 Forecasting Competition"
  )

## ----plot_forecasts_m14395, fig.alt = "Rolling forecasts for M14395"----------
plot_frame |>
  filter(series == "M14395") |>
  plot_line(
    x = index,
    y = point,
    color = model,
    facet_var = split,
    title = "Rolling forecasts for M14395",
    subtitle = "Expanding window approach with 18-month forecast horizon",
    xlab = "Time",
    ylab = "Value",
    caption = "Data: M4 Forecasting Competition"
  )

## ----accuracy_horizon---------------------------------------------------------
accuracy_horizon <- make_accuracy(
  future_frame = future_frame,
  main_frame = main_frame,
  context = context,
  dimension = "horizon"
)

accuracy_horizon |>
  filter(metric == "sMAPE")

## ----accuracy_split-----------------------------------------------------------
accuracy_split <- make_accuracy(
  future_frame = future_frame,
  main_frame = main_frame,
  context = context,
  dimension = "split"
)

accuracy_split |>
  filter(metric == "sMAPE")