Exercise 5.1

Produce forecasts for the following series using whichever of NAIVE(y), SNAIVE(y) or RW(y ~ drift()) is more appropriate in each case: Australian Population (global_economy), Bricks (aus_production), NSW Lambs (aus_livestock), Household wealth (hh_budget), Australian takeaway food turnover (aus_retail).

Australian population — drift (annual, steady upward trend, no seasonality)

aus_pop <- global_economy |> filter(Country == "Australia")

aus_pop |>
  model(RW(Population ~ drift())) |>
  forecast(h = 10) |>
  autoplot(aus_pop) +
  labs(title = "                             Australian population: drift forecast", y = "People")

Bricks — seasonal naïve (quarterly, strong seasonality)

bricks <- aus_production |> filter(!is.na(Bricks))   # series ends in 2005 Q2

bricks |>
  model(SNAIVE(Bricks)) |>
  forecast(h = "5 years") |>
  autoplot(bricks) +
  labs(title = "Australian brick production: seasonal naïve forecast",
       y = "Millions of bricks")

NSW lambs — seasonal naïve (monthly, clear seasonal pattern)

nsw_lambs <- aus_livestock |>
  filter(State == "New South Wales", Animal == "Lambs")

nsw_lambs |>
  model(SNAIVE(Count)) |>
  forecast(h = "5 years") |>
  autoplot(nsw_lambs) +
  labs(title = "NSW lambs slaughtered: seasonal naïve forecast", y = "Count")

Australian takeaway food turnover — seasonal naïve (monthly, seasonal)

takeaway <- aus_retail |>
  filter(Industry == "Takeaway food services") |>
  summarise(Turnover = sum(Turnover))            # total across all states

takeaway |>
  model(SNAIVE(Turnover)) |>
  forecast(h = "5 years") |>
  autoplot(takeaway) +
  labs(title = "Australian takeaway food turnover: seasonal naïve forecast",
       y = "$Million AUD")

Exercise 5.2

Use the Facebook stock price (data set gafa_stock) to do the following:

Stock prices are recorded only on trading days, so the index is re-set to a regular trading-day count (as in Section 5.2 of the book).

fb <- gafa_stock |>
  filter(Symbol == "FB") |>
  mutate(day = row_number()) |>
  update_tsibble(index = day, regular = TRUE)

a. Time plot

fb |>
  autoplot(Close) +
  labs(title = "Facebook daily closing price", x = "Trading day", y = "USD")

b. Drift forecasts

fb_fc <- fb |>
  model(Drift = RW(Close ~ drift())) |>
  forecast(h = 100)

fb_fc |>
  autoplot(fb) +
  labs(title = "Facebook closing price: drift forecast",
       x = "Trading day", y = "USD")

c. Drift = extending the line between the first and last observations

n     <- nrow(fb)
y1    <- fb$Close[1]
yn    <- fb$Close[n]
slope <- (yn - y1) / (n - 1)

fb_fc |>
  autoplot(fb, level = NULL) +
  annotate("segment", x = 1, y = y1, xend = n + 100, yend = yn + slope * 100,
           colour = "red", linetype = "dashed") +
  labs(title = "Drift forecast vs. line through first and last observations",
       x = "Trading day", y = "USD")

# Numeric check: drift forecasts equal y_T + h * slope
all.equal(fb_fc$.mean, yn + slope * (1:100))
## [1] TRUE

Findings

The dashed line from the first observation to the last, extended forward, lies exactly on the drift forecasts, and all.equal() returns TRUE. The drift forecast is \(\hat{y}_{T+h} = y_T + h\frac{y_T - y_1}{T-1}\), which is the slope of the line joining the first and last points.

d. Other benchmark methods

fb |>
  model(Mean  = MEAN(Close),
        Naive = NAIVE(Close),
        Drift = RW(Close ~ drift())) |>
  forecast(h = 100) |>
  autoplot(fb, level = NULL) +
  labs(title = "Facebook: benchmark forecasts", x = "Trading day", y = "USD")

Accuracy check: train on 2014–2017, test on 2018.

fb_train <- fb |> filter(year(Date) < 2018)
fb_test  <- fb |> filter(year(Date) == 2018)

fb_train |>
  model(Mean  = MEAN(Close),
        Naive = NAIVE(Close),
        Drift = RW(Close ~ drift())) |>
  forecast(new_data = fb_test) |>
  accuracy(fb) |>
  select(.model, RMSE, MAE, MAPE)
## # A tibble: 3 × 4
##   .model  RMSE   MAE  MAPE
##   <chr>  <dbl> <dbl> <dbl>
## 1 Drift   33.1  24.5  16.0
## 2 Mean    66.8  63.8  36.3
## 3 Naive   20.5  16.3  10.2

Findings

The mean method is clearly unsuitable because the series has a strong trend. Seasonal naïve does not apply (no seasonality in daily stock prices). Naive has the lowest test RMSE (20.5), compared with Drift (33.1) and Mean (66.8). The naïve method is the standard benchmark for stock prices because prices behave close to a random walk: the best guess for tomorrow is today’s price. Drift assumes the 2014–2017 upward trend continues, which did not hold in 2018, when the price fell sharply.

Exercise 5.3

Apply a seasonal naïve method to the quarterly Australian beer production data from 1992. Check if the residuals look like white noise, and plot the forecasts. What do you conclude?

recent_production <- aus_production |>
  filter(year(Quarter) >= 1992)

fit <- recent_production |> model(SNAIVE(Beer))

fit |> gg_tsresiduals()

# Ljung-Box test (quarterly data: lag = 2m = 8)
fit |> augment() |> features(.innov, ljung_box, lag = 8)
## # A tibble: 1 × 3
##   .model       lb_stat lb_pvalue
##   <chr>          <dbl>     <dbl>
## 1 SNAIVE(Beer)    32.3 0.0000834
fit |> forecast() |> autoplot(recent_production) +
  labs(title = "Australian beer production: seasonal naïve forecast",
       y = "Megalitres")

Findings

The residual ACF shows a large significant spike at lag 4, and the Ljung-Box p-value is 0.0000834, below 0.05, so the residuals are not white noise. The residuals are centred close to zero, and the histogram is roughly normal. Conclusion: the seasonal naïve forecasts capture the seasonal pattern and are a reasonable benchmark, but some information remains in the residuals, so a better model is possible.

Exercise 5.4

Repeat the previous exercise using the Australian Exports series from global_economy and the Bricks series from aus_production. Use whichever of NAIVE() or SNAIVE() is more appropriate in each case.

Australian exports — NAIVE (annual data, no seasonality)

aus_exports <- global_economy |> filter(Country == "Australia")

fit_exp <- aus_exports |> model(NAIVE(Exports))

fit_exp |> gg_tsresiduals()

# Non-seasonal data: lag = 10
fit_exp |> augment() |> features(.innov, ljung_box, lag = 10)
## # A tibble: 1 × 4
##   Country   .model         lb_stat lb_pvalue
##   <fct>     <chr>            <dbl>     <dbl>
## 1 Australia NAIVE(Exports)    16.4    0.0896
fit_exp |> forecast(h = 10) |> autoplot(aus_exports) +
  labs(title = "Australian exports: naïve forecast", y = "% of GDP")

Bricks — SNAIVE (quarterly, seasonal)

fit_bricks <- bricks |> model(SNAIVE(Bricks))

fit_bricks |> gg_tsresiduals()

# Quarterly data: lag = 8
fit_bricks |> augment() |> features(.innov, ljung_box, lag = 8)
## # A tibble: 1 × 3
##   .model         lb_stat lb_pvalue
##   <chr>            <dbl>     <dbl>
## 1 SNAIVE(Bricks)    274.         0
fit_bricks |> forecast(h = "5 years") |> autoplot(bricks) +
  labs(title = "Australian brick production: seasonal naïve forecast",
       y = "Millions of bricks")

Findings

Exports: annual data has no seasonality, so NAIVE is used. The Ljung-Box p-value is 0.0896, above 0.05, so the residuals resemble white noise. The ACF has one spike just past the bound at lag 1, but one spike out of about 17 lags is consistent with chance. The histogram is roughly normal. NAIVE is adequate for this series.

Bricks: quarterly and seasonal, so SNAIVE is used. The residual ACF shows strong autocorrelation at many lags, with a wave pattern (positive at lags 1–3, negative at 5–11, positive again at 16–21), and the Ljung-Box p-value is effectively 0, so the residuals are not white noise. The histogram is left-skewed from the large drops. SNAIVE ignores the long rise-and-fall cycles in brick production, which remain in the residuals.

Exercise 5.7

For your retail time series (from Exercise 7 in Section 2.10):

The retail series is the same one generated in Assignment 2 (seed 2026).

set.seed(2026)
myseries <- aus_retail |>
  filter(`Series ID` == sample(aus_retail$`Series ID`, 1))

myseries |> distinct(State, Industry)
## # A tibble: 1 × 2
##   State           Industry        
##   <chr>           <chr>           
## 1 South Australia Liquor retailing

a. Training set: observations before 2011

myseries_train <- myseries |>
  filter(year(Month) < 2011)

b. Check the split

autoplot(myseries, Turnover) +
  autolayer(myseries_train, Turnover, colour = "red") +
  labs(title = "Training data (red) vs. full series", y = "$Million AUD")

c. Seasonal naïve model on the training data

fit <- myseries_train |>
  model(SNAIVE(Turnover))

d. Residuals

fit |> gg_tsresiduals()

fit |> augment() |> features(.innov, ljung_box, lag = 24)
## # A tibble: 1 × 5
##   State           Industry         .model           lb_stat lb_pvalue
##   <chr>           <chr>            <chr>              <dbl>     <dbl>
## 1 South Australia Liquor retailing SNAIVE(Turnover)    934.         0

Do the residuals appear to be uncorrelated and normally distributed?

Findings

The ACF shows large positive spikes that decay slowly and stay significant up to about lag 18, and the Ljung-Box p-value is effectively 0, so the residuals are strongly correlated. The histogram is roughly bell-shaped but centred above zero (training ME = 1.28) with a right tail. The residuals are not uncorrelated, and although they are roughly normal in shape, they are biased upward because SNAIVE does not account for the trend.

e. Forecasts for the test data

fc <- fit |>
  forecast(new_data = anti_join(myseries, myseries_train))

fc |> autoplot(myseries) +
  labs(title = "Seasonal naïve forecasts vs. actual turnover",
       y = "$Million AUD")

f. Accuracy

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 South A… Liquor … SNAIV… Trai…  1.28  2.62  2.00  5.89  10.8     1     1 0.677
fc |> 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… Sout… Liquor … Test   5.57  7.07  5.73  11.0  11.4  2.86  2.70 0.571

Findings

Test RMSE is [value] vs. training RMSE of [value]. The forecasts [under/over]-predict because SNAIVE repeats 2010 and ignores the trend, so errors grow further into the test period.

g. Sensitivity to the amount of training data

The test set is held fixed (2011 onward) while the start of the training window changes.

starts  <- c(1982, 1990, 2000, 2005, 2009)
test_df <- myseries |> filter(year(Month) >= 2011)

sens <- lapply(starts, function(s) {
  fit_s <- myseries |>
    filter(year(Month) >= s, year(Month) < 2011) |>
    model(SNAIVE(Turnover))

  bind_rows(
    accuracy(fit_s),
    fit_s |> forecast(new_data = test_df) |> accuracy(myseries)
  ) |>
    mutate(train_start = s)
}) |>
  bind_rows()

sens |> select(train_start, .type, RMSE, MAE, MAPE)
## # A tibble: 10 × 5
##    train_start .type     RMSE   MAE  MAPE
##          <dbl> <chr>    <dbl> <dbl> <dbl>
##  1        1982 Training  2.62  2.00 10.8 
##  2        1982 Test      7.07  5.73 11.4 
##  3        1990 Training  2.95  2.33 10.5 
##  4        1990 Test      7.07  5.73 11.4 
##  5        2000 Training  3.54  2.95 10.2 
##  6        2000 Test      7.07  5.73 11.4 
##  7        2005 Training  4.24  3.72 10.9 
##  8        2005 Test      7.07  5.73 11.4 
##  9        2009 Training  4.04  3.63  8.64
## 10        2009 Test      7.07  5.73 11.4

Findings

The test accuracy measures are identical for every training window, because a seasonal naïve forecast uses only the last year of the training data; earlier observations have no effect on the forecasts. The training accuracy measures do change (RMSE ranges from 2.62 to 4.24) because they are averaged over different stretches of history. Training RMSE generally rises as the window starts later because recent turnover is larger, and RMSE is scale-dependent; MAPE, which is scale-free, stays between 8.6 and 10.9. So for SNAIVE, the test accuracy is insensitive to the amount of training data, while the training accuracy is sensitive to which years are included.