library(fpp3)

Exercise 5.1

Produce forecasts using whichever of NAIVE(), SNAIVE(), or RW() with drift is most appropriate.

Australian Population

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

population_fit <- australia_population |>
  model(
    Drift = RW(Population ~ drift())
  )

population_forecast <- population_fit |>
  forecast(h = 10)

population_forecast |>
  autoplot(australia_population) +
  labs(
    title = "Australian Population Forecasts",
    x = "Year",
    y = "Population"
  )

Australian population increased steadily over the historical period. The drift method extends that average upward change into the next ten years. The shaded prediction intervals widen farther into the future, reflecting greater uncertainty.

Exercise 5.1(b): Australian Brick Production

bricks <- aus_production |>
  filter(!is.na(Bricks))

bricks_fit <- bricks |>
  model(Seasonal_naive = SNAIVE(Bricks))

bricks_fit |>
  forecast(h = 8) |>
  autoplot(bricks) +
  labs(
    title = "Australian Brick Production Forecasts",
    x = "Year",
    y = "Bricks"
  )

Brick production has a repeating quarterly pattern, so the seasonal naïve method is an appropriate benchmark. Each forecast uses the value from the same quarter of the previous year.

Exercise 5.1(c): New South Wales Lambs

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

lambs_fit <- nsw_lambs |>
  model(Seasonal_naive = SNAIVE(Count))

lambs_fit |>
  forecast(h = 12) |>
  autoplot(nsw_lambs) +
  labs(
    title = "New South Wales Lamb Slaughter Forecasts",
    x = "Year",
    y = "Number of lambs slaughtered"
  )

The seasonal naïve method is a benchmark for this monthly series. It forecasts each month using the observed count from the same month of the previous year.

Exercise 5.1(d): Household Wealth

wealth_fit <- hh_budget |>
  model(Naive = NAIVE(Wealth))

wealth_fit |>
  forecast(h = 5) |>
  autoplot(hh_budget) +
  facet_wrap(vars(Country), scales = "free_y") +
  labs(
    title = "Household Wealth Forecasts by Country",
    x = "Year",
    y = "Wealth (% of disposable income)"
  )

Household wealth is measured annually, so there is no within-year seasonality to repeat. The naïve method provides a simple benchmark: it carries each country’s last observed wealth value forward.

Exercise 5.1(e): Australian Takeaway Food Turnover

australian_takeaway <- aus_retail |>
  filter(Industry == "Takeaway food services") |>
  as_tibble() |>
  group_by(Month) |>
  summarise(Turnover = sum(Turnover), .groups = "drop") |>
  as_tsibble(index = Month)

takeaway_fit <- australian_takeaway |>
  model(Seasonal_naive = SNAIVE(Turnover))

takeaway_fit |>
  forecast(h = 12) |>
  autoplot(australian_takeaway) +
  labs(
    title = "Australian Takeaway Food Turnover Forecasts",
    x = "Year",
    y = "Turnover"
  )

This combines takeaway-food turnover across the Australian states into one monthly series. The seasonal naïve method repeats the turnover from the same month of the previous year. Because the overall level has grown over time, this is a simple benchmark rather than a forecast that accounts for continued growth.

Exercise 5.2(a): Facebook Stock Price

facebook_stock <- gafa_stock |>
  filter(Symbol == "FB")

facebook_stock |>
  autoplot(Close) +
  labs(
    title = "Facebook Daily Closing Stock Price",
    x = "Date",
    y = "Closing price (US dollars)"
  )

This time plot shows how Facebook’s daily closing stock price changed over the period in the dataset.

Exercise 5.2(b): Facebook Stock Price Forecast Using Drift

facebook_trading <- facebook_stock |>
  mutate(day = row_number()) |>
  update_tsibble(index = day, regular = TRUE)

facebook_drift <- facebook_trading |>
  model(Drift = RW(Close ~ drift()))

facebook_drift |>
  forecast(h = 20) |>
  autoplot(facebook_trading) +
  labs(
    title = "Facebook Closing Stock Price: Drift Forecast",
    x = "Trading day",
    y = "Closing price (US dollars)"
  )

The drift method extends the average change between the first and last observed prices into the next 20 trading days.

Exercise 5.2(c): Comparing Drift with a Straight-Line Extension

first_price <- facebook_trading$Close[1]
n_days <- nrow(facebook_trading)
last_price <- facebook_trading$Close[n_days]

comparison <- facebook_drift |>
  forecast(h = 20) |>
  as_tibble() |>
  mutate(
    LineExtension = last_price +
      (day - n_days) * (last_price - first_price) / (n_days - 1)
  ) |>
  select(day, DriftForecast = .mean, LineExtension)

comparison
## # A tibble: 20 × 3
##      day DriftForecast LineExtension
##    <dbl>         <dbl>         <dbl>
##  1  1259          131.          131.
##  2  1260          131.          131.
##  3  1261          131.          131.
##  4  1262          131.          131.
##  5  1263          131.          131.
##  6  1264          131.          131.
##  7  1265          132.          132.
##  8  1266          132.          132.
##  9  1267          132.          132.
## 10  1268          132.          132.
## 11  1269          132.          132.
## 12  1270          132.          132.
## 13  1271          132.          132.
## 14  1272          132.          132.
## 15  1273          132.          132.
## 16  1274          132.          132.
## 17  1275          132.          132.
## 18  1276          132.          132.
## 19  1277          132.          132.
## 20  1278          132.          132.

The DriftForecast and LineExtension columns should have the same values, apart from possible tiny rounding differences. This shows that the drift method extends the line connecting the first and last observed prices.

Exercise 5.2(d): Comparing Benchmark Forecasts

facebook_train <- facebook_trading |>
  filter(day <= max(facebook_trading$day) - 20)

facebook_test <- facebook_trading |>
  filter(day > max(facebook_trading$day) - 20)

facebook_models <- facebook_train |>
  model(
    Mean = MEAN(Close),
    Naive = NAIVE(Close),
    Drift = RW(Close ~ drift())
  )

facebook_comparison <- facebook_models |>
  forecast(new_data = facebook_test)

facebook_comparison |>
  accuracy(facebook_test) |>
  select(.model, RMSE, MAE) |>
  arrange(RMSE)
## # A tibble: 3 × 3
##   .model  RMSE   MAE
##   <chr>  <dbl> <dbl>
## 1 Naive   6.12  4.93
## 2 Drift   6.55  5.17
## 3 Mean   18.2  17.1

I held out the final 20 trading days to compare the forecasts with actual prices. The naïve method performed best, with the lowest RMSE (6.12) and MAE (4.93). It forecasts each future price at the last observed price. Drift was slightly less accurate, while the mean method was substantially less accurate on this test period.

Exercise 5.3: Australian Beer Production

# Extract data of interest
recent_production <- aus_production |>
  filter(year(Quarter) >= 1992)

# Define and estimate a seasonal naïve model
fit <- recent_production |>
  model(SNAIVE(Beer))

# Check the residuals
fit |> gg_tsresiduals()
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 4 rows containing non-finite outside the scale range
## (`stat_bin()`).
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_rug()`).

# Plot the forecasts
fit |>
  forecast() |>
  autoplot(recent_production)

The seasonal naïve forecasts repeat the most recently observed quarterly pattern. However, several residual autocorrelations extend beyond the dashed bounds in the ACF plot. The residuals therefore do not appear to be white noise, suggesting that the model has not captured all the patterns in beer production. It is a useful seasonal benchmark, but there may be room for improvement.

Exercise 5.4(a): Australian Exports

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

exports_fit <- australian_exports |>
  model(NAIVE(Exports))

exports_fit |> gg_tsresiduals()
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_bin()`).
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_rug()`).

exports_fit |>
  forecast(h = 5) |>
  autoplot(australian_exports) +
  labs(
    title = "Australian Exports: Naïve Forecast",
    x = "Year",
    y = "Exports"
  )

Australian exports are measured annually, so I used the naïve method rather than a seasonal naïve method. The forecast holds exports at the most recent observed value for the next five years. The residuals fluctuate around zero, and the ACF shows no clear significant autocorrelation; they appear reasonably close to white noise, although the historical series has increased over the long term.

Exercise 5.4(b): Australian Brick Production

bricks_data <- aus_production |>
  filter(!is.na(Bricks))

bricks_fit <- bricks_data |>
  model(SNAIVE(Bricks))

bricks_fit |> gg_tsresiduals()
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 4 rows containing non-finite outside the scale range
## (`stat_bin()`).
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_rug()`).

bricks_fit |>
  forecast(h = 8) |>
  autoplot(bricks_data) +
  labs(
    title = "Australian Brick Production: Seasonal Naïve Forecast",
    x = "Quarter",
    y = "Bricks"
  )

Brick production is quarterly, so I used the seasonal naïve method to repeat the latest four-quarter pattern over the next eight quarters. However, several residual autocorrelations lie outside the dashed bounds, and the residuals show sustained changes over time. They do not resemble white noise. Seasonal naïve is a useful benchmark, but it does not adequately capture all the changes in brick production.

Exercise 5.7(a–b): Retail Series and Training Data

myseries <- aus_retail |>
  filter(`Series ID` == "A3349792X")

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

autoplot(myseries, Turnover) +
  autolayer(myseries_train, Turnover, colour = "red") +
  labs(
    title = "NSW Takeaway Food Turnover: Training and Test Periods",
    x = "Month",
    y = "Turnover"
  )

The red line shows the observations used to train the model, ending before 2011. The remaining observations form the test period.

Exercise 5.7(c–d): Seasonal Naïve Model and Residuals

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

retail_fit |> gg_tsresiduals()
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 12 rows containing non-finite outside the scale range
## (`stat_bin()`).
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_rug()`).

The residuals are not uncorrelated: the ACF shows strong positive autocorrelation at several consecutive lags. The residual time plot also shows sustained patterns and increasing variability. The histogram is roughly bell-shaped but somewhat asymmetric, so a normal distribution is only an approximate description. Overall, the residuals do not resemble white noise, indicating that the seasonal naïve model leaves important patterns unexplained.

Exercise 5.7(e): Forecasts for the Test Period

retail_fc <- retail_fit |>
  forecast(
    new_data = anti_join(myseries, myseries_train)
  )
## Joining with `by = join_by(State, Industry, `Series ID`, Month, Turnover)`
retail_fc |>
  autoplot(myseries) +
  labs(
    title = "NSW Takeaway Food Turnover: Seasonal Naïve Forecasts",
    x = "Month",
    y = "Turnover"
  )

The forecasts cover the test period beginning in January 2011. The seasonal naïve method repeats the monthly values from the final year of training data. The black line shows actual turnover, while the shaded areas show the prediction intervals.

Exercise 5.7(f): Forecast Accuracy

# Accuracy on the training data
retail_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 New Sou… Takeawa… SNAIV… Trai…  11.5  26.1  19.2  4.81  9.59     1     1 0.890
# Accuracy on the test data
retail_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… New … Takeawa… Test   48.6  96.8  79.5  7.67  16.3  4.14  3.71 0.964

The test RMSE (96.80) and MAE (79.55) are substantially higher than the training RMSE (26.12) and MAE (19.22). The test MAPE is approximately 16.30%. This agrees with the forecast plot: repeating the 2010 monthly values does not capture the later increase in turnover, resulting in large errors over the test period.

Exercise 5.7(g): Sensitivity to Training Data Length

retail_test <- myseries |>
  filter(year(Month) >= 2011)

# Train using only observations from 2005 through 2010
retail_short_train <- myseries_train |>
  filter(year(Month) >= 2005)

retail_short_fit <- retail_short_train |>
  model(SNAIVE(Turnover))

retail_short_fc <- retail_short_fit |>
  forecast(new_data = retail_test)

# Compare accuracy on the same test period
bind_rows(
  "All data before 2011" = accuracy(retail_fc, myseries),
  "2005 through 2010" = accuracy(retail_short_fc, myseries),
  .id = "TrainingPeriod"
) |>
  select(TrainingPeriod, RMSE, MAE, MAPE)
## # A tibble: 2 × 4
##   TrainingPeriod        RMSE   MAE  MAPE
##   <chr>                <dbl> <dbl> <dbl>
## 1 All data before 2011  96.8  79.5  16.3
## 2 2005 through 2010     96.8  79.5  16.3

Shortening the training period to 2005–2010 did not change the test RMSE (96.80), MAE (79.55), or MAPE (16.30%). Seasonal naïve point forecasts depend on the final year’s observations, which are identical in both training sets. Therefore, removing older observations did not affect these test accuracy measures. Prediction intervals may still change because their estimated uncertainty uses the training residuals.