library(fpp3)
library(tidyverse)

1

#a. Australian Population
aus_pop <- global_economy %>%
  filter(Country == "Australia") %>%
  select(Year, Population)

pop_fit <- aus_pop %>%
  model(RW(Population ~ drift()))

pop_fc <- pop_fit %>% forecast(h = 10)

ggplot(aus_pop, aes(x = Year, y = Population)) +
  geom_line() +
  autolayer(pop_fc, Population) +
  labs(title = "Australian Population: RW with drift",
       y = "Population")

#b. Bricks
bricks_fit <- aus_production %>%
  model(SNAIVE(Bricks))

bricks_fc <- bricks_fit %>% forecast(h = 8)

ggplot(aus_production, aes(x = Quarter, y = Bricks)) +
  geom_line() +
  autolayer(bricks_fc, Bricks) +
  labs(title = "Bricks Production: Seasonal Naive",
       y = "Bricks")

#c. NSW Lambs
nsw_lambs <- aus_livestock %>%
  filter(State == "New South Wales")

lambs_fit <- nsw_lambs %>%
  model(SNAIVE(Count))

lambs_fc <- lambs_fit %>% forecast(h = 24)

ggplot(nsw_lambs, aes(x = Month, y = Count)) +
  geom_line() +
  autolayer(lambs_fc, Count) +
  labs(title = "NSW Lambs: Seasonal Naive",
       y = "Number of lambs")

#d. Household wealth
wealth_fit <- hh_budget %>%
  model(RW(Wealth ~ drift()))

wealth_fc <- wealth_fit %>% forecast(h = 10)

ggplot(hh_budget, aes(x = Year, y = Wealth)) +
  geom_line() +
  autolayer(wealth_fc, Wealth) +
  labs(title = "Household Wealth: RW with drift",
       y = "Wealth")

#e. Takeaway food turnover
takeaway <- aus_retail %>%
  filter(Industry == "Takeaway food services")

takeaway_fit <- takeaway %>%
  model(SNAIVE(Turnover))

takeaway_fc <- takeaway_fit %>% forecast(h = 24)

ggplot(takeaway, aes(x = Month, y = Turnover)) +
  geom_line() +
  autolayer(takeaway_fc, Turnover) +
  labs(title = "Takeaway Food Turnover: Seasonal Naive",
       y = "Turnover")

2.

#a. Time plot series
fb <- gafa_stock %>%
  filter(Symbol == "FB") %>%
  select(Date, Close)

ggplot(fb, aes(x = Date, y = Close)) +
  geom_line() +
  labs(
    title = "Facebook Daily Closing Stock Price",
    y = "Closing price (USD)",
    x = "Date"
  )

#b. Forecast using drift method
fb_w <- gafa_stock %>%
  filter(Symbol == "FB") %>%
  index_by(Week = yearweek(Date)) %>%
  summarise(Close = last(Close)) %>%
  as_tsibble(index = Week)

fit_drift <- fb_w %>% model(RW(Close ~ drift()))
fc_drift  <- fit_drift %>% forecast(h = 20)

ggplot(fb_w, aes(x = Week, y = Close)) +
  geom_line() +
  autolayer(fc_drift, Close) +
  labs(title = "Drift forecast (weekly FB close)",
       x = "Week", y = "Close")

#c. Forecast from first to last
y1 <- fb_w$Close[1]
yT <- fb_w$Close[nrow(fb_w)]
T  <- nrow(fb_w)

drift <- (yT - y1) / (T - 1)

line_ext <- tibble(
  Week = seq(max(fb_w$Week) + 1, by = 1, length.out = 20),
  Close = yT + drift * (1:20)
) %>% as_tsibble(index = Week)

ggplot(fb_w, aes(Week, Close)) +
  geom_line() +
  geom_line(data = line_ext, aes(Week, Close), linetype = "dashed") +
  autolayer(fc_drift, Close) +
  labs(title = "Drift forecast equals straight-line extension",
       x = "Week", y = "Close")

#d. benchmark methods
fit_bench <- fb_w %>%
  model(
    Naive = NAIVE(Close),
    Drift = RW(Close ~ drift()),
    Mean  = MEAN(Close)
  )

fc_bench <- fit_bench %>% forecast(h = 20)

ggplot(fb_w, aes(Week, Close)) +
  geom_line() +
  autolayer(fc_bench, Close) +
  labs(title = "Benchmark forecasts (weekly FB close)",
       x = "Week", y = "Close")

3.

# extract beer production from 1992
recent_production <- aus_production %>%
  filter(year(Quarter) >= 1992)

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

fit %>%
  gg_tsresiduals()

fc <- fit %>% forecast(h = 8)

ggplot(recent_production, aes(x = Quarter, y = Beer)) +
  geom_line() +
  autolayer(fc, Beer) +
  labs(
    title = "Seasonal Naïve Forecasts: Australian Beer Production (from 1992)",
    x = "Quarter",
    y = "Beer production"
  )

The residual plots show no remaining seasonality and little autocorrelation, so they are close to white noise.

4.

# Australian Exports
# NAIVE() becuase no seasonality in annual data
aus_exports <- global_economy %>%
  filter(Country == "Australia") %>%
  select(Year, Exports)


fit_exports <- aus_exports %>%
  model(NAIVE(Exports))


fit_exports %>%
  gg_tsresiduals()

fc_exports <- fit_exports %>% forecast(h = 10)

# Plot 
ggplot(aus_exports, aes(x = Year, y = Exports)) +
  geom_line() +
  autolayer(fc_exports, Exports) +
  labs(
    title = "Naïve Forecasts: Australian Exports",
    x = "Year",
    y = "Exports"
  )

# Bricks 
# SNAIVE() strong quarterly seasonality
fit_bricks <- aus_production %>%
  model(SNAIVE(Bricks))

fit_bricks %>%
  gg_tsresiduals()

fc_bricks <- fit_bricks %>% forecast(h = 8)

# Plot 
ggplot(aus_production, aes(x = Quarter, y = Bricks)) +
  geom_line() +
  autolayer(fc_bricks, Bricks) +
  labs(
    title = "Seasonal Naïve Forecasts: Australian Bricks Production",
    x = "Quarter",
    y = "Bricks"
  )

Australian Exports, NAIVE(), No seasonality, only level changes

Bricks, SNAIVE(), Strong, stable quarterly seasonality

7

set.seed(12345678)
myseries <- aus_retail |>
  filter(`Series ID` == sample(aus_retail$`Series ID`,1))
myseries_train <- myseries %>%
  filter(year(Month) < 2011)

ggplot(myseries, aes(x = Month, y = Turnover)) +
  geom_line() +
  autolayer(myseries_train, Turnover, colour = "red") +
  labs(
    title = "Training and Full Data Split",
    x = "Month",
    y = "Turnover"
  )

# red shows training data
fit <- myseries_train %>%
  model(SNAIVE(Turnover))

fit %>%
  gg_tsresiduals()

fc <- fit %>%
  forecast(new_data = anti_join(myseries, myseries_train))
## Joining with `by = join_by(State, Industry, `Series ID`, Month, Turnover)`
ggplot(myseries, aes(x = Month, y = Turnover)) +
  geom_line() +
  autolayer(fc, Turnover) +
  labs(
    title = "Seasonal Naïve Forecasts vs Actuals",
    x = "Month",
    y = "Turnover"
  )

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.768
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… Nort… Clothin… Test  0.836  1.55  1.24  5.94  9.06  1.36  1.28 0.601

Accuracy measures are sensitive to the amount of training data. With less training data, seasonal patterns are estimated less reliably, increasing forecast errors.

With more training data, seasonal naïve forecasts stabilize because more complete seasonal cycles are observed.