## ----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")