Exercise 5.1

5.1a Australian Population

install.packages("fpp3")
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.6'
## (as 'lib' is unspecified)
library(fpp3)
## ── Attaching packages ──────────────────────────────────────────── fpp3 1.0.3 ──
## ✔ tibble      3.3.1     ✔ tsibble     1.2.0
## ✔ dplyr       1.2.1     ✔ tsibbledata 0.4.1
## ✔ tidyr       1.3.2     ✔ ggtime      1.0.0
## ✔ lubridate   1.9.5     ✔ feasts      0.5.0
## ✔ ggplot2     4.0.3     ✔ fable       0.5.0
## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date()    masks base::date()
## ✖ dplyr::filter()      masks stats::filter()
## ✖ tsibble::intersect() masks base::intersect()
## ✖ tsibble::interval()  masks lubridate::interval()
## ✖ dplyr::lag()         masks stats::lag()
## ✖ tsibble::setdiff()   masks base::setdiff()
## ✖ tsibble::union()     masks base::union()
aus_population <- global_economy |>
  filter(Country == "Australia")
aus_population |>
  autoplot(Population)

fit_population <- aus_population |>
  model(Drift = RW(Population ~ drift()))
fit_population |>
  forecast(h = 10) |>
  autoplot(aus_population)

The Australian population shows a clear upward trend without a seasonal pattern. I used the drift method because it continues the average change in population over time. The forecast shows the population continuing to increase.

5.1b Australian Bricks

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

bricks |>
  autoplot(Bricks)

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

fit_bricks |>
  forecast(h = 12) |>
  autoplot(bricks)

The Bricks series has a seasonal pattern, so I used the seasonal naïve method. This method uses the value from the same quarter of the previous year as the forecast. The forecasts continue the seasonal pattern seen in the historical data.

5.1c NSW Lambs

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

fit_lambs <- nsw_lambs |>
  model(SNaive = SNAIVE(Count))
fit_lambs |>
  forecast(h = 24) |>
  autoplot(nsw_lambs)

The NSW Lambs series has a seasonal pattern, so I used the seasonal naïve method. The forecast repeats the values from the corresponding season of the previous year, which provides a simple benchmark for the series.

5.1d Household Wealth

hh_budget |>
  autoplot(Wealth)

aus_wealth <- hh_budget |>
  filter(Country == "Australia")

aus_wealth |>
  autoplot(Wealth)

fit_wealth <- aus_wealth |>
  model(Drift = RW(Wealth ~ drift()))
fit_wealth |>
  forecast(h = 10) |>
  autoplot(aus_wealth)

Household wealth shows an overall trend but does not have a clear seasonal pattern. I used the drift method because it accounts for the average change in wealth over time and extends that trend into the forecast period.

5.1e Australian Takeaway Food turnover

takeaway <- aus_retail |>
  filter(Industry == "Takeaway food services") |>
  summarise(Turnover = sum(Turnover))
takeaway |>
  autoplot(Turnover)

fit_takeaway <- takeaway |>
  model(SNaive = SNAIVE(Turnover))
fit_takeaway |>
  forecast(h = 24) |>
  autoplot(takeaway)

Australian takeaway food turnover shows a strong upward trend and a seasonal pattern. I used the seasonal naïve method because the data are monthly and the seasonal pattern repeats each year. The forecast continues this seasonal pattern for the next two years.

Exercise 5.2

5.2a

fb <- gafa_stock |>
  filter(Symbol == "FB") |>
  mutate(day = row_number()) |>
  update_tsibble(index = day, regular = TRUE)
fb |>
  ggplot(aes(x = Date, y = Close)) +
  geom_line()

Facebook’s stock price generally increased over the time period, although there were several large fluctuations.

5.2b

fit_fb <- fb |>
  model(Drift = RW(Close ~ drift()))

fc_fb <- fit_fb |>
  forecast(h = 500)

fc_fb |>
  autoplot(fb)

The drift forecast continues the average change in Facebook’s stock price into the future. The prediction intervals become wider as the forecast horizon increases, showing greater uncertainty further into the future.

5.2c

fb |>
  as_tibble() |>
  summarise(
    First = first(Close),
    Last = last(Close),
    N = n()
  )

The first Facebook closing price was $54.71 and the last was $131.09, with 1,258 observations. The slope of the line between the first and last observations is:

(131.09 - 54.71) / (1258 - 1) = 0.06076

Therefore, extending this line gives the forecast:

131.09 + 0.06076h

This is the same formula used by the drift method, showing that the drift forecasts are identical to extending the line between the first and last observations.

5.2d

fit_fb_all <- fb |>
  model(
    Mean = MEAN(Close),
    Naive = NAIVE(Close),
    Drift = RW(Close ~ drift())
  )
fit_fb_all |>
  forecast(h = 500) |>
  autoplot(fb)

For stock prices, I would use the naïve method as the benchmark because future stock-price changes are difficult to predict reliably from the historical trend alone. The naïve method simply uses the most recent closing price as the forecast and does not assume that the long-term upward drift will continue.

Exercise 5.3 Australian Beer Production

5.3a

recent_beer <- aus_production |>
  filter(Quarter >= yearquarter("1992 Q1"))
recent_beer |>
  autoplot(Beer)

fit_beer <- recent_beer |>
  model(SNaive = SNAIVE(Beer))
fit_beer |>
  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()`).

augment(fit_beer) |>
  features(.innov, ljung_box, lag = 8, dof = 0)

The seasonal naïve method captures the strong quarterly seasonality in beer production, but the residuals still contain some structure. The Ljung-Box test gives a p-value of about 0.00008, which is below 0.05. This suggests that the residuals are not white noise and there is still some information in the data that the seasonal naïve model does not capture.

fc_beer <- fit_beer |>
  forecast(h = 12)
fc_beer |>
  autoplot(recent_beer)

The forecasts continue the strong quarterly seasonal pattern in beer production. The seasonal naïve method uses the production from the same quarter of the previous year as the forecast. The prediction intervals become wider over time, showing that uncertainty increases further into the future. Although this method captures the seasonality, the residual analysis shows that it does not capture all of the patterns in the data.

Exercise 5.4

5.4a

global_economy |>
  filter(Country == "Australia") |>
  autoplot(Exports)

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

fit_exports <- aus_exports |>
  model(Naive = NAIVE(Exports))
fit_exports |>
  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()`).

augment(fit_exports) |>
  features(.innov, ljung_box, lag = 10, dof = 0)

The naïve method was used for Australian Exports because the data are annual and do not have a seasonal pattern. The Ljung-Box test gives a p-value of about 0.090, which is greater than 0.05. This suggests that there is no significant autocorrelation remaining in the residuals, so the naïve method provides a reasonable benchmark for this series.

fc_exports <- fit_exports |>
  forecast(h = 10)
fc_exports |>
  autoplot(aus_exports)

The naïve forecast keeps Australian Exports at the most recent observed value for all future years. The prediction intervals become wider as the forecast horizon increases, showing greater uncertainty further into the future.

5.4b

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

fit_bricks |>
  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()`).

augment(fit_bricks) |>
  features(.innov, ljung_box, lag = 8, dof = 0)
fc_bricks <- fit_bricks |>
  forecast(h = 12)

fc_bricks |>
  autoplot(bricks)

The seasonal naïve forecast continues the quarterly pattern in Australian brick production. The forecast repeats the values from the same quarters of the previous year, while the prediction intervals become wider over time. The residual analysis also showed significant autocorrelation, so the seasonal naïve method does not capture all of the patterns in the data.

Exercise 5.7

set.seed(12345678)

myseries <- aus_retail |>
  filter(`Series ID` == sample(aus_retail$`Series ID`, 1))
myseries
train <- myseries |>
  filter(Month < yearmonth("2011 Jan"))

myseries |>
  autoplot(Turnover) +
  autolayer(train, Turnover, colour = "red")

fit_retail <- train |>
  model(SNaive = SNAIVE(Turnover))
fit_retail |>
  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()`).

augment(fit_retail) |>
  features(.innov, ljung_box, lag = 24, dof = 0)

The seasonal naïve method was fitted to the training data before 2011. The Ljung-Box test gives a p-value close to 0, which shows significant autocorrelation in the residuals. The residual histogram also does not appear perfectly symmetric and contains some large residuals. Therefore, the residuals do not appear to be uncorrelated and normally distributed, and the seasonal naïve model does not capture all of the patterns in the retail series.

test <- myseries |>
  filter(Month >= yearmonth("2011 Jan"))
fc_retail <- fit_retail |>
  forecast(h = nrow(test))
fc_retail |>
  autoplot(myseries)

fc_retail |>
  accuracy(test)

The seasonal naïve model was tested on the observations from 2011 onward. The model had an RMSE of 1.55, an MAE of 1.24, and a MAPE of about 9.06%. The positive mean error also suggests that the model tends to underforecast the actual retail turnover. Overall, the seasonal naïve method captures the seasonal pattern, but it does not fully capture the growth in the series.

train_1990 <- myseries |>
  filter(Month >= yearmonth("1990 Jan"),
         Month < yearmonth("2011 Jan"))

train_2000 <- myseries |>
  filter(Month >= yearmonth("2000 Jan"),
         Month < yearmonth("2011 Jan"))

train_2005 <- myseries |>
  filter(Month >= yearmonth("2005 Jan"),
         Month < yearmonth("2011 Jan"))
fit_1990 <- train_1990 |>
  model(SNaive = SNAIVE(Turnover))

fit_2000 <- train_2000 |>
  model(SNaive = SNAIVE(Turnover))

fit_2005 <- train_2005 |>
  model(SNaive = SNAIVE(Turnover))
fit_1990 |>
  forecast(h = nrow(test)) |>
  accuracy(test)
fit_2000 |>
  forecast(h = nrow(test)) |>
  accuracy(test)
fit_2005 |>
  forecast(h = nrow(test)) |>
  accuracy(test)

I compared the seasonal naïve model using training sets beginning in 1990, 2000, and 2005. The forecast accuracy was the same for each training period, with an RMSE of about 1.55, an MAE of 1.24, and a MAPE of 9.06%.

This shows that the seasonal naïve forecasts were not sensitive to the amount of training data used in this example. This makes sense because the seasonal naïve method bases its forecasts on the most recent seasonal observations rather than using the entire history to estimate the forecast values.