# Import required R libraries
library(fpp3)

Exercise 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:

Definitions

NAIVE - Set all forecasts to be the value of the last observation. Because a naive forecast is optimal when data follow a random walk.

SNAIVE - Set each forecast to be equal to the last observed value from the same season of the year.

drift() - Allow the forecasts to increase or decrease over time, where the amount of change over time is set to be the average change seen in the historical data.

I followed the Australian quarterly beer production and Google stock price examples from section 5.2 of the textbook, in which the forecast is performed on a training set of the given data and then compared to the test set of the data to properly evaluate the appropriate forecast method.

Australian Population (global_economy)

# 1960-2017 (57 years total)
aus_pop <- global_economy %>%
  filter(Country == "Australia") %>%
  mutate(Population = Population/1e6) %>%
  select(c(Country, Code, Year, Population))

# Set training data from 1960 to 2002 (43 years)
train <- aus_pop %>%
  filter_index("1960" ~ "2002")

# Fit the models
pop_fit <- train %>%
  model(
    Naive = NAIVE(Population),
    `Seasonal naive` = SNAIVE(Population),
    `Random walk` = RW(Population ~ drift())
  )

# Generate forecasts for 14 years
pop_fc <- pop_fit %>% forecast(h = "14 years")

# Plot forecasts against actual values
pop_fc %>%
  autoplot(train, level = NULL) +
  autolayer(
    filter_index(aus_pop, "2003" ~ "2017"),
    colour = "black"
  ) +
  labs(
    y = "Population (in millions)",
    title = "Forecasts for annual population in Australia"
  ) +
  guides(colour = guide_legend(title = "Forecast"))

Random walk with drift() appears most appropriate as the overall plot shows an increasing trend. Naive not appropriate as naive doesn’t capture trend and Seasonal Naive not appropriate as there doesn’t appear to be a seasonal nature to the dataset.

Bricks (aus_production)

Note on data prep: I removed quarters at the tail of the aus_production tsibble without any data for Bricks.

# 1956 Q1 to 2005 Q2 (198 quarters)
aus_bricks <- aus_production %>%
  select(c(Quarter, Bricks)) %>% na.omit(aus_bricks)

# Set training data from 1992 to 2006
train <- aus_bricks %>%
  filter_index("1956 Q1" ~ "1993 Q4")

# Fit the models
brick_fit <- train %>%
  model(
    `Naive` = NAIVE(Bricks),
    `Seasonal naive` = SNAIVE(Bricks),
    `Random walk` = RW(Bricks ~ drift())
  )

# Generate forecasts for 14 quarters
brick_fc <- brick_fit %>% forecast(h = 46)

# Plot forecasts against actual values
brick_fc %>%
  autoplot(train, level = NULL) +
  autolayer(
    filter_index(aus_bricks, "1994 Q1" ~ .),
    colour = "black"
  ) +
  labs(
    y = "Millions",
    title = "Forecasts for quarterly brick production"
  ) +
  guides(colour = guide_legend(title = "Forecast"))

On first appearance, neither of the 3, Naive, Seasonal Naive, nor Random Walk with drift appear good. Requiring a selection, I will go with Seasonal Naive, as the dataset does appear to have a strong seasonal pattern. I did attempt Seasonal Naive with drift, but the forecasts showed an increasing trend which did not follow the data, as the data shows a more recent decreasing trend. All that being said, Seasonal Naive as it at least captures the seasonal aspect of the dataset.

NSW Lambs (aus_livestock)

# 1972 JUL to 2018 DEC (558 months)
nsw_lambs <- aus_livestock %>%
  filter(State == 'New South Wales' &
           Animal == 'Lambs') %>%
  mutate(Count = Count/1e3) %>%
  select(c(Month, Count))

# Set training data from 1972 through 2006
train <- nsw_lambs %>%
  filter_index("1972 JUL" ~ "2006 DEC")

# Fit the models
lamb_fit <- train %>%
  model(
    `Naive` = NAIVE(Count),
    `Seasonal naive` = SNAIVE(Count),
    `Random walk` = RW(Count ~ drift())
  )

# Generate forecasts for 144 months
lamb_fc <- lamb_fit %>% forecast(h = 144)

# Plot forecasts against actual values
lamb_fc %>%
  autoplot(train, level = NULL) +
  autolayer(
    filter_index(nsw_lambs, "2007 JAN" ~ .),
    colour = "black"
  ) +
  labs(
    y = "Thousands",
    title = "Forecasts for lambs slaughtered in NSW"
  ) +
  guides(colour = guide_legend(title = "Forecast"))

I select the Seasonal Naive forecast for the NSW lambs. As mentioned in the Brick plot, the seasonal nature of the NSW lambs data lends itself to the Seasonal Naive forecast method.

Household wealth (hh_budget).

# Wealth as a percentage of net disposable income.
hh_wealth <- hh_budget %>%
  select(c(Country, Year, Wealth))

# 1995- 2016 (22 years)

# Set training data from 1995 through 2010
train <- hh_wealth %>%
  filter_index("1995" ~ "2010")

# Fit the models
hh_w_fit <- train %>%
  model(
    `Naive` = NAIVE(Wealth),
    `Seasonal naive` = SNAIVE(Wealth),
    `Random walk` = RW(Wealth ~ drift())
  )

# Generate forecasts for 6 years
hh_w_fc <- hh_w_fit %>% forecast(h = 6)

# Plot forecasts against actual values
hh_w_fc %>%
  autoplot(train, level = NULL) +
  autolayer(
    filter_index(hh_wealth, "2011" ~ .),
    colour = "black"
  ) +
  labs(
    y = "Percentage",
    title = "Forecasts for wealth as percentage of net disposable income"
  ) +
  guides(colour = guide_legend(title = "Forecast"))

The household wealth plot shows the forecast for the four countries included, Australia, Canada, Japan, and the United States. I considered combining the four countries into one, but given the small number of countries included (4), I figured it made more sense to forecast them individually as the R functions could easily handle the “mable”. As each country shows an increasing trend in household wealth, I believe the Random Walk with drift() is the most appropriate forecast approach.

Australian takeaway food turnover (aus_retail).

# 8 states
# 1982 Apr - 2018 Dec (36 years)
aus_ta_to <- aus_retail %>%
  filter(Industry == "Takeaway food services") %>%
  select(c(State, Month, Turnover))

# Set training data from 1982 Apr through 2008 Dec
train <- aus_ta_to %>%
  filter_index("1982 Apr" ~ "2008 DEC")

# Fit the models
austato_fit <- train %>%
  model(
    `Naive` = NAIVE(Turnover),
    `Seasonal naive` = SNAIVE(Turnover),
    `Random walk` = RW(Turnover ~ drift())
  )

# Generate forecasts for 120 months
austato_fc <- austato_fit %>% forecast(h = 120)

# Plot forecasts against actual values
austato_fc %>%
  autoplot(train, level = NULL) +
  autolayer(
    filter_index(aus_ta_to, "2009 JAN" ~ .),
    colour = "black"
  ) +
  labs(
    y = "$Million AUD",
    title = "Retail turnover in Australian takeaway food"
  ) +
  guides(colour = guide_legend(title = "Forecast"))

Presenting each of the eight Australian states individually, a pattern does appear in which the Seasonal Naive captures the seasonal nature of the retail turnover, but the Random Walk with drift actually captures the increasing trend better. I believe the increasing trend plays a larger role in the data, thus I believe the Random Walk with drift is the most appropriate forecast method for this dataset.

Exercise 5.2

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

A

Produce a time plot of the series.

# Tail shows the last day is 2018-12-31
fb_stock <- gafa_stock %>%
  filter(Symbol == 'FB')

fb_stock %>% autoplot(Close) +
  labs(
    y = "Price (in USD)",
    title = "Closing Stock Price of Facebook"
  )

Straightforward plot using the autoplot() function.

B

Produce forecasts using the drift method and plot them.

# Re-index based on trading days
fb_stock <- gafa_stock %>%
  filter(Symbol == "FB") %>%
  mutate(day = row_number()) %>%
  update_tsibble(index = day, regular = TRUE)

# Fit the models
fb_fit <- fb_stock %>%
  model(
    `Naive Drift` = NAIVE(Close ~ drift()),
    `Random Walk` = RW(Close ~ drift())
  )

# Produce forecasts for next 253 days (~1 year)
fb_fc <- fb_fit %>% forecast(h = 253)

# Plot the forecasts
fb_fc %>%
  autoplot(fb_stock, level = NULL) +
  autolayer(fb_stock, Close, colour = "black") +
  labs(y = "$US",
       title = "Facebook daily closing stock prices"
  ) +
  guides(colour = guide_legend(title = "Forecast"))

Naive Drift and Random Walk with Drift have the same line, thus only one line appears on the plot above.

C

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

fb_fc %>%
  autoplot(fb_stock, level = NULL) +
  autolayer(fb_stock, Close, colour = "black") +
  labs(y = "$US",
       title = "Facebook daily closing stock prices",
  ) +
  guides(colour = guide_legend(title = "Forecast")) +
  geom_segment(aes(x=first(fb_stock$day), y=first(fb_stock$Close), 
                   xend=last(fb_stock$day), yend=last(fb_stock$Close)),
               linetype='dashed')

By plotting a straight, dashed line from the first point to the final point of the provided observations, sure enough, the dashed line extends into the color lines for Naive Drift and Random Walk with Drift.

D

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

fb_fit_2 <- fb_stock %>%
  model(
    Mean = MEAN(Close),
    Naive = NAIVE(Close),
    `Seasonal naive` = SNAIVE(Close),
    `Random Walk` = RW(Close)
  )

# Produce forecasts for next 253 days (~1 year)
fb_fc_2 <- fb_fit_2 %>% forecast(h = 253)

# Plot the forecasts
fb_fc_2 %>%
  autoplot(fb_stock, level = NULL) +
  autolayer(fb_stock, Close, colour = "black") +
  labs(y = "$US",
       title = "Facebook daily closing stock prices") +
  guides(colour = guide_legend(title = "Forecast"))

Attempting the other benchmark functions, I tried MEAN, NAIVE, SNAIVE, and RW without drift. First thoughts on the above plot, none of the four additional attempts capture the visual trend well. After a long increasing trend, the Facebook stock appears to be in a decreasing trend. No seasonal pattern is detected. I want to select MEAN by defense of the popular phrase “regression to the mean”, but I don’t think there’s enough history of Facebook stock to use that argument. All that being said, I would select the NAIVE method. Looking at just the two above plots, I would anticipate a continued decreasing trend, but none of the benchmark functions present that forecast. So given the long increasing trend and more recent decreasing trend, I think forecasting the stock price based on the previous observation is the most appropriate approach.

Exercise 5.3

Apply a seasonal naive 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.

# 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 at some forecasts
fit %>% forecast() %>% autoplot(recent_production)

What do you conclude?

The residuals do appear as white noise. The Innovation residuals plot shows a mean around zero along with constant variance around the mean. The ACF plot shows there is one lag (fourth lag) with a meaningful correlation in the residuals series, but otherwise no other correlations appear present. The histogram of the residuals isn’t quite normal with the dip in the center but the overall shape does follow a normal distribution with no outliers. Given this reading of the residual plots, I would venture to conclude the seasonal naive method produces forecasts accounting for almost all available information. There’s probably an opportunity to tease out a better seasonal forecast, but this seasonal naive forecast is valid.

Exercise 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.

Australian Exports

# Extract data of interest
# 1960-2017 (57 years total)
aus_exports <- global_economy %>%
  filter(Country == 'Australia')

# Define and estimate a model
fit <- aus_exports %>% model(NAIVE(Exports ~ drift()))

# Look at the residuals
fit %>% gg_tsresiduals()

# Look at some forecasts
fit %>% forecast() %>% autoplot(aus_exports)

Innovation residuals plot: Mean near zero, near constant variance … white noise.

ACF: No significant correlation.

Histogram: Normal distribution.

NAIVE: Selected over SNAIVE as no seasonal pattern appears.

Conclusion: Naive, is by definition naive, but better than the seasonal option. The residuals do show the model accounts for most of the available data.

Note: I did include drift() as the drift does provide an increasing trend to the forecast which I would conclude a slightly better forecast that NAIVE without drift() in this case.

Bricks

# 1956 Q1 to 2005 Q2 (198 quarters)
aus_bricks <- aus_production %>%
  select(c(Quarter, Bricks)) %>% na.omit(aus_bricks)

# Define and estimate a model
fit <- aus_bricks %>% model(SNAIVE(Bricks))

# Look at the residuals
fit %>% gg_tsresiduals()

# Look at some forecasts
fit %>% forecast() %>% autoplot(aus_bricks)

The residual plots tell me the model does not account for most of the available data.

Innovation residuals: Not white noise.

ACF: Clear correlation present.

Histogram: Not normal.

Conclusion: Selected seasonal naive because I only had two options, and NAIVE method indicated a clear quarterly correlation in the ACF, so I selected SNAIVE. Considering the forecast plot, I do think the forecasts follow the visual seasonal pattern of the data. Given my struggle to answer the Bricks part of question 5.1, I think a cyclic aspect to the model is missing and thus causing the poor residual performance. Yes, the seasonal naive model can identify the seasonal nature to the data, but no the cyclic nature. Similar to Bricks in question 5.1, of the provided choices, seasonal naive is better but certainly not the best model for this dataset.

Exercise 5.7

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

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

A

Create a training dataset consisting of observations before 2011 using

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).

# lambda from Assignment 2
lambda <- 0.24

fit <- myseries_train %>%
  model(SNAIVE(box_cox(Turnover, lambda) ~ drift()))

fit_3 <- myseries_train %>%
  model(
    `SNAIVE` = SNAIVE(Turnover),
    `SNAIVE with drift` = SNAIVE(Turnover ~ drift()),
    `SNAIVE with drift and Box-Cox` = SNAIVE(box_cox(Turnover, lambda) ~ drift()))

With a bit of trial and error, and remembering the Box-Cox transformation from Assignment 2, I applied the Box-Cox transformation with lambda 0.24 (as calculated in Assignment 2) along with drift to the seasonal naive model for my retail time series.

In order to provide some variety for comparisons in the later steps, I created a model with basic seasonal naive method, season naive method with drift, and finally the seasonal naive with drift and Box-Cox transformation.

D

Check the residuals.

fit %>% gg_tsresiduals()

Do the residuals appear to be uncorrelated and normally distributed?

No, the residuals do show correlation in the ACF plot. The Innovation residuals plot shows a near-constant variance and certainly outperformed the variance of the plot without the Box-Cox transformation. Overall, the histogram plot has a good normal shape, again better than the histogram with the Box-Cox transformation.

Note: The `gg_tsresiduals() function can only handle one model, so I used the model with Box-Cox transformation.

E

Produce forecasts for the test data

fc <- fit_3 %>%
  forecast(new_data = anti_join(myseries, myseries_train))
fc %>% autoplot(myseries)

For the forecast with Box-Cox transformation, the forecast certainly follow the trajectory of the time series. The increase in the seasonal nature of the time series does not appear reflected in the forecasts despite the use of the Box-Cox transformation. Overall though, the actual values do appear with the 80% confidence interval which is a good sign of the forecast model.

The forecast with drift does provide the seasonal pattern along with the increase in trend. The basic seasonal naive forecast simply forecasts a seasonal pattern with no regard for trend.

F

Compare the accuracy of your forecasts against the actual values.

fit_3 %>% accuracy()
## # A tibble: 3 × 12
##   State  Industry  .model  .type        ME  RMSE   MAE     MPE  MAPE  MASE RMSSE
##   <chr>  <chr>     <chr>   <chr>     <dbl> <dbl> <dbl>   <dbl> <dbl> <dbl> <dbl>
## 1 Queen… Takeaway… SNAIVE  Trai…  7.07e+ 0  15.0 11.5   6.79    9.57 1     1    
## 2 Queen… Takeaway… SNAIVE… Trai… -6.28e-15  13.2  9.69 -0.972   7.65 0.840 0.882
## 3 Queen… Takeaway… SNAIVE… Trai… -1.37e+ 0  14.1 10.4  -0.0720  7.86 0.901 0.937
## # … with 1 more variable: ACF1 <dbl>

For comparison of the three models on the fitted values, the seasonal naive with draft model outperforms the other two with a MAE of 9.68, RMSE of 13.2, MAPE of 7.65, and MASE of 0.840. The second best performing model on the fitted values is the seasonal naive with drift and the Box-Cox transformation. Values can be seen above.

fc %>% accuracy(myseries)
## # A tibble: 3 × 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  Quee… Takeawa… Test  71.6    77.4  71.9 23.4   23.5   6.23  5.16 0.861
## 2 SNAIVE… Quee… Takeawa… Test  39.8    44.9  40.2 13.0   13.1   3.49  2.99 0.761
## 3 SNAIVE… Quee… Takeawa… Test   0.630  27.6  21.8  0.163  7.17  1.89  1.84 0.850

For evaluating the models on the forecasted data, the seasonal naive model with drift and the Box-Cox transformation clearly outperforms the other two. The model with Box-Cox transformation shows results of a MAE of 21.8, RMSE of 27.6, MAPE of 7.17, and MASE of 1.89. The MAPE of 7.17 is actually the best score for this metric across all six combinations.

With the evaluation of the forecasts, the seasonal naive model with drift and Box-Cox transformation proves the most accurate.

G

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

I suspect the accuracy measures are greatly dependent on the amount of training data used. As the book suggests, a test set should use about 20% of the total sample, implying roughly 80% of the training data should be used. The amount of training data plays a direct role in the calculation of the model, which then has a direct impact on the fitted values and point forecasts. A model with too little of the training data may perform poorly on the test set. Even a model with perfect fit on the training set may perform poorly on the test set. This is known as overfitting. The amount of training data has a direct impact on the accuracy through the fit of the model as it applies to the test set. This understanding of training data amount leads to the notion of forecasting being as much an art as it is a science.