Discussion 2

Data & Packages

library(fpp3)
Warning: package 'fpp3' was built under R version 4.5.2
── Attaching packages ──────────────────────────────────────────── fpp3 1.0.3 ──
✔ tibble      3.3.0     ✔ tsibble     1.2.0
✔ dplyr       1.2.1     ✔ tsibbledata 0.4.1
✔ tidyr       1.3.1     ✔ ggtime      0.2.0
✔ lubridate   1.9.4     ✔ feasts      0.5.0
✔ ggplot2     4.0.3     ✔ fable       0.5.0
Warning: package 'dplyr' was built under R version 4.5.2
Warning: package 'ggplot2' was built under R version 4.5.2
Warning: package 'tsibble' was built under R version 4.5.2
Warning: package 'ggtime' was built under R version 4.5.2
Warning: package 'feasts' was built under R version 4.5.2
Warning: package 'fabletools' was built under R version 4.5.2
Warning: package 'fable' was built under R version 4.5.2
── 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()
library(conflicted)
conflicts_prefer(ggtime::gg_season, ggtime::gg_subseries)
[conflicted] Will prefer ggtime::gg_season over any other package.
[conflicted] Will prefer ggtime::gg_subseries over any other package.
data("aus_tobacco")
aus_tobacco
# A tsibble: 1,232 x 3 [1Q]
# Key:       State [8]
   Quarter State Expenditure
     <qtr> <chr>       <dbl>
 1 1985 Q3 ACT         0.294
 2 1985 Q4 ACT         0.288
 3 1986 Q1 ACT         0.257
 4 1986 Q2 ACT         0.257
 5 1986 Q3 ACT         0.267
 6 1986 Q4 ACT         0.287
 7 1987 Q1 ACT         0.264
 8 1987 Q2 ACT         0.261
 9 1987 Q3 ACT         0.269
10 1987 Q4 ACT         0.291
# ℹ 1,222 more rows
cigar<- aus_tobacco %>%dplyr::filter(State =="ACT")

cigar
# A tsibble: 154 x 3 [1Q]
# Key:       State [1]
   Quarter State Expenditure
     <qtr> <chr>       <dbl>
 1 1985 Q3 ACT         0.294
 2 1985 Q4 ACT         0.288
 3 1986 Q1 ACT         0.257
 4 1986 Q2 ACT         0.257
 5 1986 Q3 ACT         0.267
 6 1986 Q4 ACT         0.287
 7 1987 Q1 ACT         0.264
 8 1987 Q2 ACT         0.261
 9 1987 Q3 ACT         0.269
10 1987 Q4 ACT         0.291
# ℹ 144 more rows

Dataset provides 1,232 quarterly observations of household tobacco/cigarette expenditure across Australia’s 8 states/territories from 1985 Q3 onward; filtering to State= ACT.

Classical Decomposition

cigar %>%
  model(classical = classical_decomposition(Expenditure, type = "additive")) %>%
  components() %>%
  autoplot() +
  labs(title = "Classical decomposition — NSW Tobacco Expenditure")
Warning: Removed 8 rows containing missing values or values outside the scale range
(`geom_line()`).

STL Decomposition

cigar %>%
  model(stl = STL(Expenditure ~ trend(window = 7) + season(window = "periodic"))) %>%
  components() %>%
  autoplot() +
  labs(title = "STL decomposition — NSW Tobacco Expenditure")

The two decompositions show the same trend shape,and both fail to capture the first two quarters of the trend estimation (with the small NA box at the beginning), which is to be expected from the moving-average method at the core of both decompositions. This is why you see the two seasonal panels are looking so alike here, it’s not that STL didn’t have the edge, it’s that this particular spec had it turned off.

Forecasting

n <- nrow(cigar)
train_n <- floor(0.7 * n)

train <- cigar %>% slice(1:train_n)
test  <- cigar %>% slice((train_n + 1):n)
fit <- train %>%
  model(
    Mean   = MEAN(Expenditure),
    Naive  = NAIVE(Expenditure),
    SNaive = SNAIVE(Expenditure),
    Drift  = RW(Expenditure ~ drift())
  )

fc <- fit %>% forecast(h = nrow(test))

fc %>%
  autoplot(cigar, level = NULL) +
  labs(title = "Forecasts vs. actual holdout — NSW Tobacco Expenditure")

accuracy(fc, cigar) %>%
  mutate(MSE = RMSE^2) %>%
  select(.model, ME, MPE, MAPE, MSE, MAE)
# A tibble: 4 × 6
  .model       ME     MPE  MAPE       MSE     MAE
  <chr>     <dbl>   <dbl> <dbl>     <dbl>   <dbl>
1 Drift   0.00382    7.93  12.5 0.0000643 0.00665
2 Mean   -0.140   -265.   265.  0.0201    0.140  
3 Naive  -0.0394   -84.8   86.1 0.00211   0.041  
4 SNaive -0.0519  -107.   107.  0.00327   0.0519 

The story of the accuracy table is visually apparent from looking at the forecast plot: Mean, Naive, and SNaive all show roughly horizontal lines from the end of the training data, and the true holdout data continues to fall off sharply below all three. The only way the downward slope continues into the forecast period is by drift, which follows the true decline pretty well hence its dominance in all of the accuracy measures: Forecasting methods that ignore the trend (Mean, Naive, SNaive) will systematically over forecast when the trend continues past the training window.