DATA624 Homework 3

Exercises

Forecasting: Principles and Practice (3rd ed)
Chapter 5 The forecaster’s toolbox

5.1

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)

aus_pop = global_economy |>
  filter(!is.na(Population), Country == 'Australia')

aus_pop |>
  model(
    `Naïve` = NAIVE(Population),
    # `Seasonal Naïve` = SNAIVE(Population),
    Drift = RW(Population ~ drift())
  ) |>
  forecast(h = 10) |>
  autoplot(aus_pop, level = NULL) +
  labs(
    title='Australian Population Over Time with Forecasts'
  )

The drift forecast is the most appropriate due to capturing the overall increasing trend of the time series. This is equivalent to drawing a line between the first and last observations, and extrapolating it into the future.

• Bricks (aus_production)

aus_bricks = aus_production |>
  filter(!is.na(Bricks)) |>
  select(Quarter, Bricks)

aus_bricks |> model(
    Mean = MEAN(Bricks),
    `Naïve` = NAIVE(Bricks),
    `Seasonal Naïve` = SNAIVE(Bricks),
    Drift = RW(Bricks ~ drift())
  ) |>
  forecast(h = 10) |>
  autoplot(aus_bricks, level = NULL) +
  labs(
    title='Australian Brick Production Over Time with Forecasts'
  )

The seasonal naïve forecast is the most appropriate due to capturing the highly seasonal trend in the time series.

• NSW Lambs (aus_livestock)

aus_nsw_lambs = aus_livestock |>
   filter(
     Animal == "Lambs",
     State == "New South Wales"
    ) |>
  filter_index("2010 Jan"~.)

aus_nsw_lambs |> model(
    Mean = MEAN(Count),
    `Naïve` = NAIVE(Count),
    `Seasonal Naïve` = SNAIVE(Count),
    Drift = RW(Count ~ drift())
  ) |>
  forecast(h = 10) |>
  autoplot(aus_nsw_lambs, level = NULL) +
  labs(
    title='New South Wales Lamd Slaughter Over Time with Forecasts'
  )

The seasonal naïve forecast is the most appropriate due to capturing the highly seasonal trend in the time series.

• Household wealth (hh_budget).

hh_wealth = hh_budget |>
  filter(!is.na(Wealth)) |>
  select(Year, Wealth)

hh_wealth |> model(
    Mean = MEAN(Wealth),
    `Naïve` = NAIVE(Wealth),
    # `Seasonal Naïve` = SNAIVE(Wealth),
    Drift = RW(Wealth ~ drift())
  ) |>
  forecast(h = 10) |>
  autoplot(hh_wealth, level = NULL) +
  labs(
    title='Household Wealth Over Time with Forecasts'
  )

The drift forecast is the most appropriate due to capturing the overall increasing trend in each of the country household wealth time series. This is equivalent to drawing a line between the first and last observations, and extrapolating it into the future.

• Australian takeaway food turnover (aus_retail).

aus_food = aus_retail |>
  filter(
    State == 'Australian Capital Territory',
    Industry == "Takeaway food services"
  ) |>
  select(Month, State, Turnover) |>
  filter_index("2010 Jan"~.)

aus_food |> model(
    Mean = MEAN(Turnover),
    `Naïve` = NAIVE(Turnover),
    `Seasonal Naïve` = SNAIVE(Turnover),
    Drift = RW(Turnover ~ drift())
  ) |>
  forecast(h = 15) |>
  autoplot(aus_food, level = NULL) +
  labs(
    title='Australian Takeaway Food Turnover Over Time with Forecasts',
    y = '$Million AUD'
  )

The drift forecast is the most appropriate due to capturing the overall increasing trend of the time series. This is equivalent to drawing a line between the first and last observations, and extrapolating it into the future.

---

5.2

Use the Facebook stock price (data set gafa_stock) to do the following:

a

Produce a time plot of the series.

fb_stock = gafa_stock |>
  filter(Symbol == "FB")

fb_stock |>
  autoplot(Close) +
  labs(title = "Facebook Closing Stock Price Over Time",
       x = "Date",
       y = "Closing Stock Price ($USD)")

b

Produce forecasts using the drift method and plot them.

fb_stock = fb_stock |>
  mutate(day = row_number()) |>
  update_tsibble(index = day, regular = TRUE) |>
  select(Close)

fb_stock |>
  model(Drift = RW(Close ~ drift())) |>
  forecast(h = 50) |>
  autoplot(fb_stock) +
  labs(title = "Facebook Clsoing Stock Price Over Time with Drift Forecast",
       x = "Day",
       y = "Closing Stock Price ($USD)")

c

Show that the forecasts are identical to extending the line drawn between the first and last observations.

# select the first and last values of FB closing stock price
segment_data <- fb_stock |>
  slice(c(1, n()))


fb_stock |>
  model(Drift = RW(Close ~ drift())) |>
  forecast(h = 50) |>
  autoplot(fb_stock) +
  labs(title = "Facebook Clsoing Stock Price Over Time with Drift Forecast",
       x = "Day",
       y = "Closing Stock Price ($USD)")

d

Try using some of the other benchmark functions to forecast the same data set. Which do you think is best? Why?

fb_stock |>
  model(
    Mean = MEAN(Close),
    `Naïve` = NAIVE(Close),
    Drift = RW(Close ~ drift())
  ) |>
  forecast(h = 100) |>
  autoplot(fb_stock, level = NULL) +
  labs(title = "Facebook Clsoing Stock Price Over Time with Forecasts",
       x = "Day",
       y = "Closing Stock Price ($USD)")

The seasonal naïve benchmark is not appropriate for this time series due to not having a clear seasonal pattern. Of the other benchmark functions (mean, naïve, and drift), drift appears to be the best option due to capturing the overall increasing trend that occurs for majority of the time series. Although, the increasing trend is not seen as of the most recent data, the drift forecast does the mean and naïve forecasts do not account for potential variation or fluctuation that is anticipated for stock price time series.

---

5.3

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. The following code will help. What do you conclude?

# Extract data of interest
recent_production <- aus_production |>
  filter(year(Quarter) >= 1992)
# Define and estimate a model
fit <- recent_production |> model(SNAIVE(Beer))
# Look at the residuals
fit |> gg_tsresiduals()

# Look a some forecasts
fit |> forecast() |> autoplot(recent_production)

These graphs show that the seasonal naïve method produces forecasts that do not appear to account for all available information and the residuals do not look like white noise. While the mean of the residuals is close to zero, the innovation residuals plot shows a lot of variance which supports the model might not have fully captured all underlying patterns. This can also be seen on the histogram of the residuals which shows a bimodal normal distribution Lastly, the ACF plot shows multiple lags (lags 1, 3, and 4) that exceed the confidence interval. This indicates that the residuals are not entirely white noise.

---

5.4

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(!is.na(Exports), Country == 'Australia')

# Define and estimate a model
fit <- aus_exports |> model(NAIVE(Exports))
# Look at the residuals
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()`).

# Look a some forecasts
fit |> forecast(h=10) |> autoplot(aus_exports)

# Applying the Ljung-Box test
augment(fit) |> features(.innov, ljung_box, lag=10)

## # A tibble: 1 × 4
##   Country   .model         lb_stat lb_pvalue
##   <fct>     <chr>            <dbl>     <dbl>
## 1 Australia NAIVE(Exports)    16.4    0.0896

# Applying the Box-Pierce test
augment(fit) |> features(.innov, box_pierce, lag = 10)

## # A tibble: 1 × 4
##   Country   .model         bp_stat bp_pvalue
##   <fct>     <chr>            <dbl>     <dbl>
## 1 Australia NAIVE(Exports)    14.6     0.148

The residuals from the Australian Exports series from global_economy appears to be white noise and the model appears to be a good fit for the data. The residuals are centered around zero and appear to have constant variance. In addition, the histogram supports that the residuals follow a distribution very close to normal. The ACF plot shows there is some autocorrelation at lag 1; however, both the Box-Pierce and Ljung-Box tests show that the results are not significant at a significance level of p=0.05. This supports that the residuals are not distinguishable from white noise.

# Define and estimate a model
fit <- aus_bricks |> model(SNAIVE(Bricks))
# Look at 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()`).

# Look a some forecasts
fit |> forecast(h=10) |> autoplot(aus_bricks)

# Applying the Ljung-Box test
augment(fit) |> features(.innov, ljung_box, lag=10)

## # A tibble: 1 × 3
##   .model         lb_stat lb_pvalue
##   <chr>            <dbl>     <dbl>
## 1 SNAIVE(Bricks)    301.         0

# Applying the Box-Pierce test
augment(fit) |> features(.innov, box_pierce, lag = 10)

## # A tibble: 1 × 3
##   .model         bp_stat bp_pvalue
##   <chr>            <dbl>     <dbl>
## 1 SNAIVE(Bricks)    292.         0

The residuals from the Bricks series from aus_production appear to not be white noise and the seasonal native forecast does not appear to be a good fit to the data. The residuals show inconsistent variance around zero which is supported by the histogram that is left skewed. The ACF has many lags that exceed the confidence interval limit and follow a wave pattern. This suggests that the residuals are not completely white noise and that some structure in the data remains unexplained or there is some seasonal information left in the residuals which should be used in computing forecasts. Lastly, the Box-Pierce and Ljung-Box tests show that the results are significant at a significance level of p=0.05. This supports that the residuals are distinguishable from white noise.

5.7

For your retail time series (from Exercise 7 in Section 2.10):

a

Create a training dataset consisting of observations before 2011 using

set.seed(87654321)
myseries <- aus_retail |>
  filter(`Series ID` == sample(aus_retail$`Series ID`,1))

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

b

Check that your data have been split appropriately by producing the following plot.

autoplot(myseries, Turnover) +
  autolayer(myseries_train, Turnover, colour = "red")

c

Fit a seasonal naïve model using SNAIVE() applied to your training data (myseries_train).

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

d

Check the residuals. Do the residuals appear to be uncorrelated and normally distributed?

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 so not appear to be normally distirbuted. The residuals display inconsistent variance and a ditirbution that is centered around zero but slightly right skewed.

e

Produce forecasts for the test data

fc <- fit |>
  forecast(new_data = anti_join(myseries, myseries_train))

## Joining with `by = join_by(State, Industry, `Series ID`, Month, Turnover)`

fc |> autoplot(myseries)

f

Compare the accuracy of your forecasts against the actual values.

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 Victoria Footwea… SNAIV… Trai…  5.12  10.2  7.33  5.99  8.82     1     1 0.681

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… Vict… Footwea… Test  -1.47  20.4  16.0 -2.37  9.54  2.19  1.99 0.646

g

How sensitive are the accuracy measures to the amount of training data used?

The accuracy measures are sensitive to the proportion of data as training data. Including too much of the data in training can cause for an over-fit model, and using too less of the data can cause an under-fit model. In addition, insufficient data leads to high variance and poor generalization, while larger datasets often improve accuracy and robustness. It may be best to do cross validation and find the smallest RMSE (or other accurac metric) computed.