# A fable: 5 x 4 [1Y]
# Key: .model [1]
.model Year Population
<chr> <dbl> <dist>
1 Drift 2018 N(2.5e+07, 6.1e+09)
2 Drift 2019 N(2.5e+07, 1.2e+10)
3 Drift 2020 N(2.5e+07, 1.9e+10)
4 Drift 2021 N(2.6e+07, 2.6e+10)
5 Drift 2022 N(2.6e+07, 3.3e+10)
# ℹ 1 more variable: .mean <dbl>
pop_fc |>autoplot(aus_pop, level =NULL) +labs(title ="Australian Population", y ="Total Population")
For this data set, I choose the Drift Forecast Method because the visualization showed a linear increase. If I used the Naive or Seasonal Naive method, it would’ve given an incorrect forecast based off of the linear trend.
bricks_fc |>autoplot(bricks, level =NULL) +labs(title ="Clay brick production in Australia", y ="Millions of bricks")
For this data set, I choose to use the Seasonal Naive (SNAIVE) Forecast Method because the data set is very seasonal. A naive forecast wouldn’t have been taken into account the seasonality. A drift forecast would’ve also ignored the obvious seasonal variations.
NSW Lambs (aus_livestock)
NSW_Lambs <- aus_livestock |>filter(!is.na(Count), State =="New South Wales", Animal =="Lambs") |>select(Count)NSW_Lambs
# A tsibble: 558 x 2 [1M]
Count Month
<dbl> <mth>
1 587600 1972 Jul
2 553700 1972 Aug
3 494900 1972 Sep
4 533500 1972 Oct
5 574300 1972 Nov
6 517500 1972 Dec
7 562600 1973 Jan
8 426900 1973 Feb
9 496300 1973 Mar
10 496000 1973 Apr
# ℹ 548 more rows
# A tsibble: 88 x 3 [1Y]
# Key: Country [4]
Wealth Year Country
<dbl> <dbl> <chr>
1 315. 1995 Australia
2 315. 1996 Australia
3 323. 1997 Australia
4 339. 1998 Australia
5 354. 1999 Australia
6 350. 2000 Australia
7 348. 2001 Australia
8 349. 2002 Australia
9 360. 2003 Australia
10 379. 2004 Australia
# ℹ 78 more rows
# A mable: 4 x 2
# Key: Country [4]
Country Drift
<chr> <model>
1 Australia <RW w/ drift>
2 Canada <RW w/ drift>
3 Japan <RW w/ drift>
4 USA <RW w/ drift>
# A fable: 20 x 5 [1Y]
# Key: Country, .model [4]
Country .model Year
<chr> <chr> <dbl>
1 Australia Drift 2017
2 Australia Drift 2018
3 Australia Drift 2019
4 Australia Drift 2020
5 Australia Drift 2021
6 Canada Drift 2017
7 Canada Drift 2018
8 Canada Drift 2019
9 Canada Drift 2020
10 Canada Drift 2021
11 Japan Drift 2017
12 Japan Drift 2018
13 Japan Drift 2019
14 Japan Drift 2020
15 Japan Drift 2021
16 USA Drift 2017
17 USA Drift 2018
18 USA Drift 2019
19 USA Drift 2020
20 USA Drift 2021
# ℹ 2 more variables: Wealth <dist>, .mean <dbl>
hh_wealth_fc |>autoplot(hh_wealth, level =NULL) +labs(title ="Household Wealth", y ="Wealth as percentage of net disposable income")
For this data set, I chose to use the Drift Forecast Method since it doesn’t have seasonal changes. I chose not to use a NAIVE Forecast because there is a upward trend in the data and a NAIVE Forecast would’ve just projected the most recent observation as the forecast.
Australian takeaway food turnover (aus_retail)
aus_takeaway_food_turnover <- aus_retail |>filter(!is.na(Turnover), Industry =="Cafes, restaurants and takeaway food services") |>select(Turnover)aus_takeaway_food_turnover
# A tsibble: 3,456 x 4 [1M]
# Key: State, Industry [8]
Turnover Month State Industry
<dbl> <mth> <chr> <chr>
1 7.6 1982 Apr Australian Capital Territory Cafes, restaurants and takeaw…
2 6.7 1982 May Australian Capital Territory Cafes, restaurants and takeaw…
3 7.1 1982 Jun Australian Capital Territory Cafes, restaurants and takeaw…
4 7.5 1982 Jul Australian Capital Territory Cafes, restaurants and takeaw…
5 7.3 1982 Aug Australian Capital Territory Cafes, restaurants and takeaw…
6 8.1 1982 Sep Australian Capital Territory Cafes, restaurants and takeaw…
7 8.9 1982 Oct Australian Capital Territory Cafes, restaurants and takeaw…
8 9.6 1982 Nov Australian Capital Territory Cafes, restaurants and takeaw…
9 11.2 1982 Dec Australian Capital Territory Cafes, restaurants and takeaw…
10 7.7 1983 Jan Australian Capital Territory Cafes, restaurants and takeaw…
# ℹ 3,446 more rows
# A mable: 8 x 3
# Key: State, Industry [8]
State Industry Drift
<chr> <chr> <model>
1 Australian Capital Territory Cafes, restaurants and takeaway fo… <RW w/ drift>
2 New South Wales Cafes, restaurants and takeaway fo… <RW w/ drift>
3 Northern Territory Cafes, restaurants and takeaway fo… <RW w/ drift>
4 Queensland Cafes, restaurants and takeaway fo… <RW w/ drift>
5 South Australia Cafes, restaurants and takeaway fo… <RW w/ drift>
6 Tasmania Cafes, restaurants and takeaway fo… <RW w/ drift>
7 Victoria Cafes, restaurants and takeaway fo… <RW w/ drift>
8 Western Australia Cafes, restaurants and takeaway fo… <RW w/ drift>
# A fable: 480 x 6 [1M]
# Key: State, Industry, .model [8]
State Industry .model Month
<chr> <chr> <chr> <mth>
1 Australian Capital Territory Cafes, restaurants and takeaway… Drift 2019 Jan
2 Australian Capital Territory Cafes, restaurants and takeaway… Drift 2019 Feb
3 Australian Capital Territory Cafes, restaurants and takeaway… Drift 2019 Mar
4 Australian Capital Territory Cafes, restaurants and takeaway… Drift 2019 Apr
5 Australian Capital Territory Cafes, restaurants and takeaway… Drift 2019 May
6 Australian Capital Territory Cafes, restaurants and takeaway… Drift 2019 Jun
7 Australian Capital Territory Cafes, restaurants and takeaway… Drift 2019 Jul
8 Australian Capital Territory Cafes, restaurants and takeaway… Drift 2019 Aug
9 Australian Capital Territory Cafes, restaurants and takeaway… Drift 2019 Sep
10 Australian Capital Territory Cafes, restaurants and takeaway… Drift 2019 Oct
# ℹ 470 more rows
# ℹ 2 more variables: Turnover <dist>, .mean <dbl>
takeaway_fc |>autoplot(aus_takeaway_food_turnover, level =NULL) +labs(title ="Australian Takeaway Food Turnover", y ="Turnover in $Million AUD") +facet_wrap(vars(State), ncol =2, scales ="free_y")
For this data set, I chose to use the Drift Forecast Method because the plot has an upward trend which wouldn’t have been displayed correctly with either of the SNAIVE or NAIVE Forecast methods. There are seasonal changes so I think a method that incorporates both a Drift Forecast and SNAIVE Forecast would’ve worked the best.
Exercise 5.2
Use the Facebook stock price (data set gafa_stock) to do the following:
# A mable: 1 x 3
Mean Naive Drift
<model> <model> <model>
1 <MEAN> <NAIVE> <RW w/ drift>
fb_fc <- fb_fit |>forecast(h =100)fb_fc
# A fable: 300 x 4 [1]
# Key: .model [3]
.model trading_day
<chr> <dbl>
1 Mean 1259
2 Mean 1260
3 Mean 1261
4 Mean 1262
5 Mean 1263
6 Mean 1264
7 Mean 1265
8 Mean 1266
9 Mean 1267
10 Mean 1268
# ℹ 290 more rows
# ℹ 2 more variables: Close <dist>, .mean <dbl>
I believe that the Naive function is the best benchmark function because this is financial data. In an efficient market, the best predictor of price is the current price.
Exercise 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 interestrecent_production <- aus_production |>filter(year(Quarter) >=1992)# Define and estimate a modelfit <- recent_production |>model(SNAIVE(Beer))# Look at the residualsfit |>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()`).
The residuals do not look like white noise based on the acf plot even though the time plot shows homoscedasticity and the histogram seems to have a zero mean. At lag 4, there is a massive spike that goes past the blue dashed line. This shows that there is a repeating annual pattern that is not captured in the model since the data is quarterly and 4 quarters make up a year.
# Look at some forecastsfit |>forecast() |>autoplot(recent_production)
augment(fit) |>features(.innov, ljung_box, lag =8)
Using the Ljung-box test with a lag of 8 or 2 year window, the p value of 8.335611e-05 also shows that the residuals are not white noise.
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 series from global_economy
# Extract data of interestaus_exports <- global_economy |>filter(!is.na(Exports), Country =="Australia") |>select(Exports)aus_exports
# Define and estimate a modelaus_exports_fit <- aus_exports |>model(NAIVE(Exports))# Look at the residualsaus_exports_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()`).
NAIVE() is more appropriate for this data because it’s annual data and therefore doesn’t have seasonality for a SNAIVE(). The histogram shows a zero mean and the time plot shows general homoscedasticity. For this data set, there is a similar issue at lag 1 for the ACF plot that goes past the blue dashed line. In order to do a further assessment, I’ll use the Ljung-box test.
# Look at some forecastsaus_exports_fit |>forecast() |>autoplot(aus_exports)
augment(aus_exports_fit) |>features(.innov, ljung_box, lag =10)
Using the Ljung-box test with a lag of 10, it returns a p-value of 0.08963678. This shows that the residuals are not distinguishable from a white noise series considering the p-value is greater than 0.05.
# Define and estimate a modelbricks_fit <- bricks |>model(SNAIVE(Bricks))# Look at the residualsbricks_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()`).
I chose to use a SNAIVE() model for this data set because it is quarterly data and has seasonal changes. These residuals do not look like white noise considering the acf plot has multiple points that cross the blue dashed line. The time plot also does not display homoscedasticity with the variance increasing drastically after 1970. The histogram also looks a bit left skewed as well.
# Look at some forecastsbricks_fit |>forecast() |>autoplot(bricks)
augment(bricks_fit) |>features(.innov, ljung_box, lag =8)
# A tsibble: 345 x 5 [1M]
# Key: State, Industry [1]
State Industry `Series ID` Month Turnover
<chr> <chr> <chr> <mth> <dbl>
1 New South Wales Other retailing n.e.c. A3349873A 1982 Apr 62.4
2 New South Wales Other retailing n.e.c. A3349873A 1982 May 63.1
3 New South Wales Other retailing n.e.c. A3349873A 1982 Jun 59.6
4 New South Wales Other retailing n.e.c. A3349873A 1982 Jul 61.9
5 New South Wales Other retailing n.e.c. A3349873A 1982 Aug 60.7
6 New South Wales Other retailing n.e.c. A3349873A 1982 Sep 61.2
7 New South Wales Other retailing n.e.c. A3349873A 1982 Oct 62.1
8 New South Wales Other retailing n.e.c. A3349873A 1982 Nov 68.3
9 New South Wales Other retailing n.e.c. A3349873A 1982 Dec 104
10 New South Wales Other retailing n.e.c. A3349873A 1983 Jan 63.9
# ℹ 335 more rows
b. Check that your data have been split appropriately by producing the following plot.
# A mable: 1 x 3
# Key: State, Industry [1]
State Industry `SNAIVE(Turnover)`
<chr> <chr> <model>
1 New South Wales Other retailing n.e.c. <SNAIVE>
d. Check the residuals. Do the residuals appear to be uncorrelated and normally distributed?
my_series_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 appear to be normally distributed but are not uncorrelated. The acf plot shows many positive spikes past the blue dashed line from lag 1 to lag 9. There is also negative spikes at lag 12 and lag 25. The time plot also does not exhibit homoscedasticity with the variance being irregular. This shows that the residuals are not white noise.
Joining with `by = join_by(State, Industry, `Series ID`, Month, Turnover)`
my_series_fc |>autoplot(myseries)
f. Compare the accuracy of your forecasts against the actual values.
my_series_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 New Sou… Other r… SNAIV… Trai… 7.77 20.2 16.0 4.70 8.11 1 1 0.739
my_series_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… New … Other r… Test 190. 215. 190. 37.1 37.1 11.9 10.6 0.871
The forecasts were not accurate when compared against the actual values. The actual values were significantly higher since there was an upward trend from 2011 onwards. Meanwhile since the forecast used a SNAIVE Forecast Method, it only used the previous seasonal values to predict the forecasts. The values were off by over 30% between the forecast and actual values according to the MAPE value of 37.13291.
g. How sensitive are the accuracy measures to the amount of training data used?
The accuracy measures are highly sensitive to the amount of training data used. Too little data and the model might not incorporate long trends. The SNAIVE Forecast did not take into account the previous upward trend before the year 2000 because it only grabbed the last seasonal data.
Too much data might result in the model incorporating one off events that don’t happen regularly. If something like a economic depression happened in the last season then the forecast would also be wildly inaccurate considering economic depressions are usually not seasonal and are more irregular.
