Approach for every series below: look at the plot first, decide from
what is visible (trend, repeating seasonal pattern) which benchmark
method fits, then forecast with it. The four benchmarks are
MEAN() (average of all history), NAIVE() (last
value), SNAIVE() (last value from the same season) and
RW(y ~ drift()) (last value plus the average change per
period). The exercises do not set forecast horizons, so I use 5 years
for the series in 5.1 and 42 trading days (about two months) in 5.2, the
horizon used in the lecture’s Facebook example.
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).
aus_pop <- global_economy |> filter(Country == "Australia")
aus_pop |> autoplot(Population)
The data are annual, so there is no seasonal pattern, and the line
rises throughout, with a slope that changes gradually.
NAIVE() would forecast a flat line at the last value, which
would ignore that rise, so I use the drift method to continue the same
average yearly growth.
aus_pop |>
model(Drift = RW(Population ~ drift())) |>
forecast(h = "5 years") |>
autoplot(aus_pop)
# same 1970 Q1 to 2004 Q4 window the book uses for bricks in Section 5.2
bricks <- aus_production |>
filter_index("1970 Q1" ~ "2004 Q4") |>
select(Bricks)
bricks |> autoplot(Bricks)
This uses the same 1970 Q1 to 2004 Q4 window as the book’s bricks
example, so what follows applies to that period. The plot (millions of
bricks) shows an up-and-down pattern that repeats every year on top of
longer swings in the level. A repeating quarterly shape is exactly what
SNAIVE() carries forward, and it is the only one of the
benchmarks that accounts for seasonality, so that is the method I
use.
bricks |>
model(Seasonal_naive = SNAIVE(Bricks)) |>
forecast(h = "5 years") |>
autoplot(bricks)
nsw_lambs <- aus_livestock |> filter(State == "New South Wales", Animal == "Lambs")
nsw_lambs |> autoplot(Count)
nsw_lambs |> gg_season(Count)
The time plot has long swings in level (a fall from the mid-1980s to
the mid-1990s and a partial recovery afterwards) plus a lot of
month-to-month noise. The season plot suggests some differences between
months, but the yearly lines overlap heavily and the shape changes a lot
from year to year, so a single repeating pattern is not clear. I use
NAIVE() as a simple benchmark that starts the forecast from
the most recent level, while recognizing that it does not capture any
seasonal differences. SNAIVE() would also be a reasonable
candidate.
nsw_lambs |>
model(Naive = NAIVE(Count)) |>
forecast(h = "5 years") |>
autoplot(nsw_lambs)
At longer horizons the lower prediction limits go below zero, which is not possible for a count of animals. This comes from the forecast distribution not being restricted to positive values.
hh_budget |> autoplot(Wealth)
These are annual series for four countries. Wealth here is a percentage of net disposable income. All four series end above their starting levels, although their paths differ and each falls around 2008. There is no seasonality at an annual frequency, so I use drift as a benchmark that extends each country’s average annual change. It does not reproduce the rises and falls in between.
hh_budget |>
model(Drift = RW(Wealth ~ drift())) |>
forecast(h = "5 years") |>
autoplot(hh_budget)
takeaway <- aus_retail |>
filter(Industry == "Takeaway food services") |>
summarise(Turnover = sum(Turnover))
takeaway |> autoplot(Turnover)
Monthly turnover (in $ million) trends upward and repeats a clear
zigzag every year, and the size of the zigzag grows with the level.
NAIVE() and drift would both draw a smooth line through
that zigzag, so I use SNAIVE(), which repeats the last
year’s monthly pattern.
takeaway |>
model(Seasonal_naive = SNAIVE(Turnover)) |>
forecast(h = "5 years") |>
autoplot(takeaway)
Because SNAIVE() repeats last year exactly, the forecast
stays at the level of the last 12 months and does not continue the
upward trend seen in the plot.
Use the Facebook stock price (data set gafa_stock) to do
the following:
The stock only trades on business days, so the calendar dates have gaps. I index the data by trading-day number instead, so every step is exactly one trading day.
fb_stock <- gafa_stock |>
filter(Symbol == "FB") |>
mutate(trading_day = row_number()) |>
update_tsibble(index = trading_day, regular = TRUE)
fb_stock |> autoplot(Close)
The price climbs with ups and downs until about trading day 1150, then falls sharply toward the end of the series. There is no repeating seasonal pattern.
fb_drift <- fb_stock |>
model(Drift = RW(Close ~ drift())) |>
forecast(h = 42)
fb_drift |> autoplot(fb_stock)
The drift forecast is the last value plus the average change per day, which is the slope of the line joining the first and last observations. Below I draw that line (dashed red) across the whole series and 42 days beyond, and compare it with the forecast.
n <- nrow(fb_stock)
slope <- (fb_stock$Close[n] - fb_stock$Close[1]) / (n - 1)
line <- tibble(trading_day = c(1, n + 42),
Close = fb_stock$Close[1] + slope * c(0, n + 41))
fb_drift |>
autoplot(fb_stock, level = NULL) +
geom_line(data = line, aes(y = Close), colour = "red", linetype = "dashed")
all.equal(fb_drift$.mean, fb_stock$Close[n] + slope * (1:42))
## [1] TRUE
The forecast lies on the dashed line, and all.equal()
returns TRUE, so the drift forecasts are the first-to-last
line extended forward.
fb_stock |>
model(Mean = MEAN(Close), Naive = NAIVE(Close), Drift = RW(Close ~ drift())) |>
forecast(h = 42) |>
autoplot(fb_stock, level = NULL)
The mean method gives a flat line at the average of the whole
history, which ignores that the price has trended and is not tied to
where the price ended. Naive and drift both start at the last observed
price. Drift then slopes upward because it uses the average change over
the entire series, but the most recent movement in the plot is a steep
decline, so that upward slope points the opposite way from the latest
direction. I choose NAIVE() as the preferred benchmark
here. The price shows no repeating pattern, and Section 5.2 and its
lecture video make the point that for stock prices and exchange rates
the last observed value is hard to beat, because the market price
already reflects what is known about the future. A trend extrapolated
from the whole history adds little on top of that.
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_beer <- recent_production |> model(SNAIVE(Beer))
fit_beer |> gg_tsresiduals()
fit_beer |> 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_beer |> forecast() |> autoplot(recent_production)
Beer production is measured in megalitres. The Ljung-Box test uses 8 lags, which is twice the quarterly seasonal period as recommended in the chapter.
White-noise residuals need to be uncorrelated with mean zero; constant variance and normality are also useful because they mainly affect the prediction intervals. The residual time plot is centered on zero with a fairly steady spread and the histogram is roughly symmetric, so those three look acceptable. The problem is correlation. About 1 in 20 ACF spikes falls outside the bounds by chance, but the spike at lag 4 is far outside (strongly negative), and lags 1 and 3 also reach the bounds. The Ljung-Box test combines all the lags into one test, and its p-value is far below 0.05, so I reject white noise. Separately, the beer series itself shows the yearly peaks getting lower over time, which the seasonal naive forecast does not follow. The forecast plot shows the same shape repeated at a flat level. It follows the seasonal pattern well, but the residuals show that the method leaves information unused, and because the intervals assume white-noise residuals they should be treated with caution.
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.
aus_exports <- global_economy |>
filter(Country == "Australia") |>
select(Year, Exports)
aus_exports |> autoplot(Exports)
The data are annual (exports as a percentage of GDP), so there is no
seasonal period for SNAIVE() to use. I use
NAIVE().
fit_exports <- aus_exports |> model(NAIVE(Exports))
fit_exports |> gg_tsresiduals()
fit_exports |> augment() |> features(.innov, ljung_box, lag = 10)
## # A tibble: 1 × 3
## .model lb_stat lb_pvalue
## <chr> <dbl> <dbl>
## 1 NAIVE(Exports) 16.4 0.0896
fit_exports |> forecast(h = 10) |> autoplot(aus_exports)
Ten lags are used because the data are not seasonal.
The residual time plot is centered on zero with no trend or pattern
and a fairly steady spread, and the histogram is roughly bell-shaped. In
the ACF plot only lag 1 goes past the bound, which is about what chance
alone would produce across this many lags, and the Ljung-Box p-value is
above 0.05, so I do not reject white noise. This is a reasonable fit for
the NAIVE() residuals. The forecast is a flat line with
prediction intervals that widen with the horizon, so it does not follow
the upward drift of exports over the decades.
fit_bricks <- bricks |> model(SNAIVE(Bricks))
fit_bricks |> gg_tsresiduals()
fit_bricks |> augment() |> features(.innov, ljung_box, lag = 8)
## # A tibble: 1 × 3
## .model lb_stat lb_pvalue
## <chr> <dbl> <dbl>
## 1 SNAIVE(Bricks) 206. 0
fit_bricks |> forecast() |> autoplot(bricks)
I use SNAIVE() because the bricks plot in Exercise 5.1
shows a pattern that repeats every year.
These residuals are not white noise. The time plot shows long runs above and below zero with a few deep drops (around 1975, 1983 and the late 1990s), the ACF has large positive spikes at the early lags that die away slowly and then turn negative, and the Ljung-Box p-value is far below 0.05. The histogram is left-skewed, with a long tail of large negative residuals, and the spread is wider around the deep drops, so constant variance and normality look doubtful. The bricks plot explains why: production peaks around 1980, drops sharply in the early 1980s, and later runs at a lower level, so a method that only repeats last year keeps missing the changes in level. The forecast is a reasonable seasonal benchmark, but the residual dependence shows that it leaves structure unused, so its prediction intervals may not have the stated coverage.
For your retail time series (from Exercise 7 in Section 2.10):
SNAIVE() applied to
your training data.The series is built as in exercise 2.7, using my Brightspace user ID as the random seed.
set.seed(219562)
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 Queensland Cafes, restaurants and takeaway food services
myseries_train <- myseries |> filter(year(Month) < 2011)
autoplot(myseries, Turnover) +
autolayer(myseries_train, Turnover, colour = "red")
The red training data end at 2010 and the black test data continue from 2011, so the split is where it should be.
fit <- myseries_train |> model(SNAIVE(Turnover))
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 Queensland Cafes, restaurants and takeaway food serv… SNAIV… 780. 0
Twenty-four lags are used, twice the monthly seasonal period.
None of the four properties holds. The residuals are correlated: the ACF has a long run of spikes above the bounds at the early lags, decaying slowly, and the Ljung-Box p-value is essentially zero. They are not centered on zero, since most residuals in the time plot are positive, which means the forecasts are biased low. The spread is not constant, because the residuals swing more widely from about 2003. And the histogram is skewed to the right rather than bell-shaped. Since the series trends upward, each value is usually above the same month one year earlier, which produces mostly positive residuals.
fc <- fit |>
forecast(new_data = anti_join(myseries, myseries_train))
fc |> autoplot(myseries)
The forecasts repeat the 2010 monthly pattern while actual turnover (in $ million) rises well above them. From about 2013 onward almost every actual value lies above the upper 95% limit. Since the residuals in part d are not white noise, the intervals cannot be taken at face value, and the actual series leaving them is consistent with that.
bind_rows(accuracy(fit), accuracy(fc, myseries)) |>
select(.type, RMSE, MAE, MAPE, MASE) |>
knitr::kable(digits = 2)
| .type | RMSE | MAE | MAPE | MASE |
|---|---|---|---|---|
| Training | 30.75 | 22.09 | 9.32 | 1.00 |
| Test | 179.98 | 163.83 | 23.39 | 7.42 |
The first row is training accuracy, computed from the residuals of the fitted values. The second is test accuracy, computed from true forecast errors on data the model never saw. MASE is 1 in the training row because it is scaled by the in-sample seasonal naive error, which is exactly this model, so the test MASE of 7.42 means the test MAE is about seven times the average seasonal naive error in the training data. That compares errors across the two periods; it is not a comparison against another model on the test set. The test-set errors are much larger than the training-set errors on every measure (RMSE, MAE, MAPE, MASE). The plot in part e shows why: the actual series keeps rising while the forecast stays level, so the gap grows over the test period.
To isolate the amount of training data, I keep the test period fixed (2011 onward) and the training end fixed (December 2010), and change only how far back the training data start.
myseries_test <- myseries |> filter(year(Month) >= 2011)
sensitivity <- function(start_year) {
train <- myseries |> filter(year(Month) >= start_year, year(Month) < 2011)
train |>
model(SNAIVE(Turnover)) |>
forecast(new_data = myseries_test) |>
accuracy(bind_rows(train, myseries_test)) |>
mutate(start_year = start_year, training_months = nrow(train))
}
bind_rows(lapply(c(1982, 1990, 2000, 2005, 2009), sensitivity)) |>
select(start_year, training_months, RMSE, MAE, MAPE, MASE) |>
knitr::kable(digits = 2)
| start_year | training_months | RMSE | MAE | MAPE | MASE |
|---|---|---|---|---|---|
| 1982 | 345 | 179.98 | 163.83 | 23.39 | 7.42 |
| 1990 | 252 | 179.98 | 163.83 | 23.39 | 6.38 |
| 2000 | 132 | 179.98 | 163.83 | 23.39 | 4.86 |
| 2005 | 72 | 179.98 | 163.83 | 23.39 | 5.68 |
| 2009 | 24 | 179.98 | 163.83 | 23.39 | 7.96 |
RMSE, MAE and MAPE are identical in every row. With the training end
fixed at December 2010, all five seasonal naive models repeat the same
2010 monthly values, so removing older observations does not change the
point forecasts or these three measures on the fixed test set. MASE
changes because its denominator is calculated from the seasonal naive
errors within each training window, not because the point forecasts
differ. In this experiment, then, adding older data does not improve the
point forecasts, although it changes the MASE scale and can affect the
estimated prediction intervals. A single train/test split gives only one
set of errors per forecast horizon, which is the gap the chapter’s time
series cross-validation (stretch_tsibble()) addresses.