DATA 624 — Assignment 3 (Forecasting, FPP3 Chapter 5)
Cailinn
2026-09-23
Exercise 5.1
For each series I pick the benchmark that matches its features: drift for trended non-seasonal series, seasonal naive for seasonal series.
# Australian population: trend, no seasonality -> drift
global_economy |>
filter(Country == "Australia") |>
model(Drift = RW(Population ~ drift())) |>
forecast(h = 10) |>
autoplot(global_economy |> filter(Country == "Australia")) +
labs(title = "Australian population (drift)")
# Bricks: quarterly seasonality -> seasonal naive (drop trailing NAs)
bricks <- aus_production |> filter(!is.na(Bricks))
bricks |>
model(SNAIVE(Bricks)) |>
forecast(h = "3 years") |>
autoplot(bricks) +
labs(title = "Australian brick production (seasonal naive)")
# NSW lambs: monthly seasonality -> seasonal naive
lambs <- aus_livestock |>
filter(State == "New South Wales", Animal == "Lambs")
lambs |>
model(SNAIVE(Count)) |>
forecast(h = "2 years") |>
autoplot(lambs) +
labs(title = "NSW lamb slaughter (seasonal naive)")
# Household wealth: trend, annual -> drift
hh_budget |>
model(Drift = RW(Wealth ~ drift())) |>
forecast(h = 5) |>
autoplot(hh_budget) +
labs(title = "Household wealth (drift)")
# Australian takeaway food turnover: trend + seasonality -> seasonal naive
takeaway <- aus_retail |>
filter(Industry == "Takeaway food services") |>
summarise(Turnover = sum(Turnover))
takeaway |>
model(SNAIVE(Turnover)) |>
forecast(h = "2 years") |>
autoplot(takeaway) +
labs(title = "Australian takeaway food turnover (seasonal naive)")
Exercise 5.2
fb <- gafa_stock |>
filter(Symbol == "FB") |>
mutate(day = row_number()) |>
update_tsibble(index = day, regular = TRUE)(a) Time plot:
autoplot(fb, Close) +
labs(title = "Facebook closing stock price", y = "US$")
(b) Drift forecasts:
fb_fit <- fb |> model(Drift = RW(Close ~ drift()))
fb_fc <- fb_fit |> forecast(h = 60)
fb_fc |>
autoplot(fb) +
labs(title = "Facebook close: drift forecast")
(c) The drift forecast is exactly the line through the first and last observations, extended forward:
endpoints <- fb |> filter(day %in% range(day))
fb_fc |>
autoplot(fb, level = NULL) +
geom_line(data = endpoints, aes(x = day, y = Close),
linetype = "dashed", colour = "red") +
labs(title = "Drift forecast lies on the first-to-last line")
(d) Comparing benchmark methods:
fb |>
model(
Mean = MEAN(Close),
Naive = NAIVE(Close),
Drift = RW(Close ~ drift())
) |>
forecast(h = 60) |>
autoplot(fb, level = NULL) +
labs(title = "Benchmark methods for Facebook close")
For a stock price the naive method is best: prices behave like a random walk, so the best forecast of tomorrow is today’s price. Drift adds a small upward slope from the overall rise, and the mean method is clearly poor because it ignores the trend entirely.
Exercise 5.3
recent_production <- aus_production |>
filter(year(Quarter) >= 1992)
fit <- recent_production |> model(SNAIVE(Beer))
fit |> gg_tsresiduals()
fit |> forecast() |> autoplot(recent_production) +
labs(title = "Quarterly beer production: seasonal naive forecast")
The residuals are centred near zero and roughly normal, but the ACF still shows a significant spike at lag 4, so they are not quite white noise — there is a little seasonal information the seasonal naive method does not capture. Even so, it is a reasonable benchmark and the forecasts look sensible.
Exercise 5.4
# Australian Exports: annual, no seasonality -> naive
aus_exports <- global_economy |> filter(Country == "Australia")
fit_ex <- aus_exports |> model(NAIVE(Exports))
fit_ex |> gg_tsresiduals()
fit_ex |> forecast(h = 10) |> autoplot(aus_exports) +
labs(title = "Australian exports: naive forecast", y = "% of GDP")
Exports have no seasonality, so NAIVE() is appropriate.
The residuals look uncorrelated and roughly normal, so the naive method
is adequate here.
# Bricks: quarterly seasonality -> seasonal naive
bricks <- aus_production |> filter(!is.na(Bricks))
fit_br <- bricks |> model(SNAIVE(Bricks))
fit_br |> gg_tsresiduals()
fit_br |> forecast(h = "3 years") |> autoplot(bricks) +
labs(title = "Brick production: seasonal naive forecast")
Bricks are strongly seasonal, so SNAIVE() is
appropriate. The residuals are autocorrelated (several significant ACF
spikes) and not centred, because the seasonal naive method does not
capture the trend or the changing seasonal pattern — the forecasts are a
useful benchmark but the model could be improved.
Exercise 5.7
set.seed(12345678)
myseries <- aus_retail |>
filter(`Series ID` == sample(aus_retail$`Series ID`, 1))(a) Training set (before 2011):
myseries_train <- myseries |>
filter(year(Month) < 2011)(b) Check the split:
autoplot(myseries, Turnover) +
autolayer(myseries_train, Turnover, colour = "red") +
labs(title = "Retail turnover: full series (black) vs training (red)")
(c) Fit a seasonal naive model:
fit <- myseries_train |> model(SNAIVE(Turnover))(d) Residual diagnostics:
fit |> gg_tsresiduals()
The residuals are not white noise: the ACF has many significant spikes and the residuals have a positive mean and right skew. Seasonal naive leaves the upward trend in the residuals, so they are correlated and not normally distributed.
(e) Forecast the test period:
fc <- fit |> forecast(new_data = anti_join(myseries, myseries_train))
fc |> autoplot(myseries) +
labs(title = "Seasonal naive forecast vs actuals (test period)")
(f) Accuracy on training vs test:
fit |> accuracy()## # A tibble: 1 × 12
## State Industry .model .type ME RMSE MAE MPE MAPE MASE RMSSE ACF1
## <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Norther… Clothin… SNAIV… Trai… 0.439 1.21 0.915 5.23 12.4 1 1 0.768fc |> accuracy(myseries)## # A tibble: 1 × 12
## .model State Industry .type ME RMSE MAE MPE MAPE MASE RMSSE ACF1
## <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 SNAIVE(T… Nort… Clothin… Test 0.836 1.55 1.24 5.94 9.06 1.36 1.28 0.601Training accuracy is much better than test accuracy (e.g. RMSE and MASE are far larger on the test set), which is expected: the model was fit on the training data, and the trend continued to grow after 2011 so the seasonal naive forecasts fall below the actuals.
(g) Accuracy measures are quite sensitive to how much training data is used. A shorter training set covers less of the trend and fewer seasonal cycles, so the seasonal indices are estimated from less data and the test-set errors grow; a longer training set generally lowers the test error, up to the point where older data is no longer representative of current behaviour.
Session info
sessionInfo()## R version 4.6.1 (2026-06-24)
## Platform: aarch64-apple-darwin25.4.0
## Running under: macOS Tahoe 26.6.2
##
## Matrix products: default
## BLAS: /opt/homebrew/Cellar/openblas/0.3.34/lib/libopenblasp-r0.3.34.dylib
## LAPACK: /opt/homebrew/Cellar/r/4.6.1/lib/R/lib/libRlapack.dylib; LAPACK version 3.12.1
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## time zone: America/New_York
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] fable_0.5.0 feasts_0.5.0 fabletools_0.8.0 ggtime_1.0.0
## [5] tsibbledata_0.4.1 tsibble_1.2.0 ggplot2_4.0.3 lubridate_1.9.5
## [9] tidyr_1.3.2 dplyr_1.2.1 tibble_3.3.1 fpp3_1.0.3
##
## loaded via a namespace (and not attached):
## [1] ggdist_3.3.3 utf8_1.2.6 rappdirs_0.3.4
## [4] sass_0.4.10 generics_0.1.4 anytime_0.3.13
## [7] digest_0.6.39 magrittr_2.0.5 evaluate_1.0.5
## [10] grid_4.6.1 timechange_0.4.0 RColorBrewer_1.1-3
## [13] mixtime_0.3.0 fastmap_1.2.0 jsonlite_2.0.0
## [16] purrr_1.2.2 scales_1.4.0 jquerylib_0.1.4
## [19] cli_3.6.6 rlang_1.3.0 crayon_1.5.3
## [22] vecvec_1.3.0 withr_3.0.3 cachem_1.1.0
## [25] yaml_2.3.12 tools_4.6.1 tzdb_0.5.0
## [28] vctrs_0.7.3 R6_2.6.1 lifecycle_1.0.5
## [31] pkgconfig_2.0.3 progressr_1.0.0 pillar_1.11.1
## [34] bslib_0.12.0 gtable_0.3.6 glue_1.8.1
## [37] Rcpp_1.1.2 xfun_0.60 tidyselect_1.2.1
## [40] rstudioapi_0.19.0 knitr_1.52 farver_2.1.2
## [43] htmltools_0.5.9 labeling_0.4.3 rmarkdown_2.32
## [46] compiler_4.6.1 S7_0.2.2 distributional_0.9.0