Section 5.11 Problem #8
8. Consider the number of pigs slaughtered in New South Wales
(data set aus_livestock
).
a. Produce some plots of the data in order to become familiar
with it.
nsw_pigs <- aus_livestock |>
filter(State == "New South Wales", Animal == "Pigs")
nsw_pigs |>
autoplot(Count)

Data generally follows a downward trend, however there are some
periods where the amount of pigs slaughtered changes rapidly.
nsw_pigs |> gg_season(Count, labels = "right")

nsw_pigs |> gg_subseries(Count)

Some seasonality is apparent, with notable increases in December and
decreases during January, February and April.
b. Create a training set of 486 observations, withholding a
test set of 72 observations (6 years).
nsw_pigs_train <- nsw_pigs |> slice(1:486)
c.Try using various benchmark methods to forecast the
training set and compare the results on the test set. Which method did
best?
fit <- nsw_pigs_train |>
model(
mean = MEAN(Count),
naive = NAIVE(Count),
snaive = SNAIVE(Count),
drift = RW(Count ~ drift())
)
fit |>
forecast(h = "6 years") |>
accuracy(nsw_pigs)
The drift method performed best for all measures of accuracy
(although it had a larger first order auto-correlation)
d.Check the residuals of your preferred method. Do they
resemble white noise?
fit |>
select(drift) |>
gg_tsresiduals()

The residuals do not appear to be white noise as the ACF plot
contains many significant lags. It is also clear that the seasonal
component is not captured by the drift method, as there exists a strong
positive auto-correlation at lag 12 (1 year). The histogram appears to
have a slightly long left tail.
Section 7.10 Problem #5
5. The us_gasoline series consists of weekly data for
supplies of US finished motor gasoline product, from 2 February 1991 to
20 January 2017. The units are in “million barrels per day”. Consider
only the data to the end of 2004.
a.Fit a harmonic regression with trend to the data.
Experiment with changing the number Fourier terms. Plot the observed
gasoline and fitted values and comment on what you see.
gas <- us_gasoline |> filter(year(Week) <= 2004)
gas |> autoplot(Barrels)

fit <- gas |>
model(
fourier1 = TSLM(Barrels ~ trend() + fourier(K = 1)),
fourier2 = TSLM(Barrels ~ trend() + fourier(K = 2)),
fourier3 = TSLM(Barrels ~ trend() + fourier(K = 3)),
fourier4 = TSLM(Barrels ~ trend() + fourier(K = 4)),
fourier5 = TSLM(Barrels ~ trend() + fourier(K = 5)),
fourier6 = TSLM(Barrels ~ trend() + fourier(K = 6)),
fourier7 = TSLM(Barrels ~ trend() + fourier(K = 7)),
fourier8 = TSLM(Barrels ~ trend() + fourier(K = 8)),
fourier9 = TSLM(Barrels ~ trend() + fourier(K = 9)),
fourier10 = TSLM(Barrels ~ trend() + fourier(K = 10)),
fourier11 = TSLM(Barrels ~ trend() + fourier(K = 11)),
fourier12 = TSLM(Barrels ~ trend() + fourier(K = 12)),
fourier13 = TSLM(Barrels ~ trend() + fourier(K = 13)),
fourier14 = TSLM(Barrels ~ trend() + fourier(K = 14)),
fourier15 = TSLM(Barrels ~ trend() + fourier(K = 15))
)
glance(fit) |>
arrange(AICc) |>
select(.model, AICc, CV)
Best model has order 7
gas |>
autoplot(Barrels, col = "gray") +
geom_line(
data = augment(fit) |> filter(.model == "fourier7"),
aes(y = .fitted), col = "blue"
)

This seems to have captured the annual seasonality quite well.
b. Select the appropriate number of Fourier terms to include
by minimising the AICc or CV value.
See above
c. Plot the residuals of the final model using the
gg_tsresiduals()
function and comment on these. Use a
Ljung-Box test to check for residual autocorrelation.
fit |>
select(fourier7) |>
gg_tsresiduals()

There is some small remaining autocorrelation at lag 1.
augment(fit) |>
filter(.model == "fourier7") |>
features(.innov, ljung_box, lag = 52)
The Ljung-Box test is not significant. Even if the Ljung-Box test had
given a significant result here, the correlations are very small, so it
would not make much difference to the forecasts and prediction
intervals.
d. Generate forecasts for the next year of data and plot
these along with the actual data for 2005. Comment on the
forecasts.
fit |>
select("fourier7") |>
forecast(h = "1 year") |>
autoplot(filter_index(us_gasoline, "2000" ~ "2006"))

The forecasts fit pretty well for the first six months, but not so
well after that.
LS0tDQp0aXRsZTogIlRpbWUgc2VyaWVzIHJlZ3Jlc3Npb24sIGF1dG9jb3JyZWxhdGlvbiwgbW92aW5nIGF2ZXJhZ2VzLiINCm91dHB1dDogDQogIGh0bWxfbm90ZWJvb2s6DQogICAgdG9jOiB0cnVlDQogICAgdG9jX2Zsb2F0OiB0cnVlDQotLS0NCg0KIyBTZWN0aW9uIDUuMTEgUHJvYmxlbSBbIzhdKGh0dHBzOi8vb3RleHRzLmNvbS9mcHAzL3Rvb2xib3gtZXhlcmNpc2VzLmh0bWwpICANCg0KX184LiBDb25zaWRlciB0aGUgbnVtYmVyIG9mIHBpZ3Mgc2xhdWdodGVyZWQgaW4gTmV3IFNvdXRoIFdhbGVzIChkYXRhIHNldCBgYXVzX2xpdmVzdG9ja2ApLl9fDQoNCl9fYS4gUHJvZHVjZSBzb21lIHBsb3RzIG9mIHRoZSBkYXRhIGluIG9yZGVyIHRvIGJlY29tZSBmYW1pbGlhciB3aXRoIGl0Ll9fICANCg0KYGBge3J9DQpuc3dfcGlncyA8LSBhdXNfbGl2ZXN0b2NrIHw+DQogIGZpbHRlcihTdGF0ZSA9PSAiTmV3IFNvdXRoIFdhbGVzIiwgQW5pbWFsID09ICJQaWdzIikNCm5zd19waWdzIHw+DQogIGF1dG9wbG90KENvdW50KQ0KYGBgDQoNCkRhdGEgZ2VuZXJhbGx5IGZvbGxvd3MgYSBkb3dud2FyZCB0cmVuZCwgaG93ZXZlciB0aGVyZSBhcmUgc29tZSBwZXJpb2RzIHdoZXJlIHRoZSBhbW91bnQgb2YgcGlncyBzbGF1Z2h0ZXJlZCBjaGFuZ2VzIHJhcGlkbHkuDQoNCmBgYHtyfQ0KbnN3X3BpZ3MgfD4gZ2dfc2Vhc29uKENvdW50LCBsYWJlbHMgPSAicmlnaHQiKQ0KDQpuc3dfcGlncyB8PiBnZ19zdWJzZXJpZXMoQ291bnQpDQpgYGANCg0KU29tZSBzZWFzb25hbGl0eSBpcyBhcHBhcmVudCwgd2l0aCBub3RhYmxlIGluY3JlYXNlcyBpbiBEZWNlbWJlciBhbmQgZGVjcmVhc2VzIGR1cmluZyBKYW51YXJ5LCBGZWJydWFyeSBhbmQgQXByaWwuICANCg0KX19iLiBDcmVhdGUgYSB0cmFpbmluZyBzZXQgb2YgNDg2IG9ic2VydmF0aW9ucywgd2l0aGhvbGRpbmcgYSB0ZXN0IHNldCBvZiA3MiBvYnNlcnZhdGlvbnMgKDYgeWVhcnMpLl9fDQpgYGB7cn0NCm5zd19waWdzX3RyYWluIDwtIG5zd19waWdzIHw+IHNsaWNlKDE6NDg2KQ0KYGBgDQoNCl9fYy5UcnkgdXNpbmcgdmFyaW91cyBiZW5jaG1hcmsgbWV0aG9kcyB0byBmb3JlY2FzdCB0aGUgdHJhaW5pbmcgc2V0IGFuZCBjb21wYXJlIHRoZSByZXN1bHRzIG9uIHRoZSB0ZXN0IHNldC4gV2hpY2ggbWV0aG9kIGRpZCBiZXN0P19fDQoNCmBgYHtyfQ0KZml0IDwtIG5zd19waWdzX3RyYWluIHw+DQogIG1vZGVsKA0KICAgIG1lYW4gPSBNRUFOKENvdW50KSwNCiAgICBuYWl2ZSA9IE5BSVZFKENvdW50KSwNCiAgICBzbmFpdmUgPSBTTkFJVkUoQ291bnQpLA0KICAgIGRyaWZ0ID0gUlcoQ291bnQgfiBkcmlmdCgpKQ0KICApDQpmaXQgfD4NCiAgZm9yZWNhc3QoaCA9ICI2IHllYXJzIikgfD4NCiAgYWNjdXJhY3kobnN3X3BpZ3MpDQpgYGANCg0KVGhlIGRyaWZ0IG1ldGhvZCBwZXJmb3JtZWQgYmVzdCBmb3IgYWxsIG1lYXN1cmVzIG9mIGFjY3VyYWN5IChhbHRob3VnaCBpdCBoYWQgYSBsYXJnZXIgZmlyc3Qgb3JkZXIgYXV0by1jb3JyZWxhdGlvbikgIA0KDQpfX2QuQ2hlY2sgdGhlIHJlc2lkdWFscyBvZiB5b3VyIHByZWZlcnJlZCBtZXRob2QuIERvIHRoZXkgcmVzZW1ibGUgd2hpdGUgbm9pc2U/X18NCg0KYGBge3J9DQpmaXQgfD4NCiAgc2VsZWN0KGRyaWZ0KSB8Pg0KICBnZ190c3Jlc2lkdWFscygpDQpgYGANCg0KVGhlIHJlc2lkdWFscyBkbyBub3QgYXBwZWFyIHRvIGJlIHdoaXRlIG5vaXNlIGFzIHRoZSBBQ0YgcGxvdCBjb250YWlucyBtYW55IHNpZ25pZmljYW50IGxhZ3MuIEl0IGlzIGFsc28gY2xlYXIgdGhhdCB0aGUgc2Vhc29uYWwgY29tcG9uZW50IGlzIG5vdCBjYXB0dXJlZCBieSB0aGUgZHJpZnQgbWV0aG9kLCBhcyB0aGVyZSBleGlzdHMgYSBzdHJvbmcgcG9zaXRpdmUgYXV0by1jb3JyZWxhdGlvbiBhdCBsYWcgMTIgKDEgeWVhcikuIFRoZSBoaXN0b2dyYW0gYXBwZWFycyB0byBoYXZlIGEgc2xpZ2h0bHkgbG9uZyBsZWZ0IHRhaWwuDQoNCiMgU2VjdGlvbiA3LjEwIFByb2JsZW0gWyM1XShodHRwczovL290ZXh0cy5jb20vZnBwMy9yZWdyZXNzaW9uLWV4ZXJjaXNlcy5odG1sKQ0KDQpfXzUuIFRoZSB1c19nYXNvbGluZSBzZXJpZXMgY29uc2lzdHMgb2Ygd2Vla2x5IGRhdGEgZm9yIHN1cHBsaWVzIG9mIFVTIGZpbmlzaGVkIG1vdG9yIGdhc29saW5lIHByb2R1Y3QsIGZyb20gMiBGZWJydWFyeSAxOTkxIHRvIDIwIEphbnVhcnkgMjAxNy4gVGhlIHVuaXRzIGFyZSBpbiDigJxtaWxsaW9uIGJhcnJlbHMgcGVyIGRheeKAnS4gQ29uc2lkZXIgb25seSB0aGUgZGF0YSB0byB0aGUgZW5kIG9mIDIwMDQuX18NCg0KX19hLkZpdCBhIGhhcm1vbmljIHJlZ3Jlc3Npb24gd2l0aCB0cmVuZCB0byB0aGUgZGF0YS4gRXhwZXJpbWVudCB3aXRoIGNoYW5naW5nIHRoZSBudW1iZXIgRm91cmllciB0ZXJtcy4gUGxvdCB0aGUgb2JzZXJ2ZWQgZ2Fzb2xpbmUgYW5kIGZpdHRlZCB2YWx1ZXMgYW5kIGNvbW1lbnQgb24gd2hhdCB5b3Ugc2VlLl9fDQoNCmBgYHtyfQ0KZ2FzIDwtIHVzX2dhc29saW5lIHw+IGZpbHRlcih5ZWFyKFdlZWspIDw9IDIwMDQpDQpnYXMgfD4gYXV0b3Bsb3QoQmFycmVscykNCg0KDQpmaXQgPC0gZ2FzIHw+DQogIG1vZGVsKA0KICAgIGZvdXJpZXIxID0gVFNMTShCYXJyZWxzIH4gdHJlbmQoKSArIGZvdXJpZXIoSyA9IDEpKSwNCiAgICBmb3VyaWVyMiA9IFRTTE0oQmFycmVscyB+IHRyZW5kKCkgKyBmb3VyaWVyKEsgPSAyKSksDQogICAgZm91cmllcjMgPSBUU0xNKEJhcnJlbHMgfiB0cmVuZCgpICsgZm91cmllcihLID0gMykpLA0KICAgIGZvdXJpZXI0ID0gVFNMTShCYXJyZWxzIH4gdHJlbmQoKSArIGZvdXJpZXIoSyA9IDQpKSwNCiAgICBmb3VyaWVyNSA9IFRTTE0oQmFycmVscyB+IHRyZW5kKCkgKyBmb3VyaWVyKEsgPSA1KSksDQogICAgZm91cmllcjYgPSBUU0xNKEJhcnJlbHMgfiB0cmVuZCgpICsgZm91cmllcihLID0gNikpLA0KICAgIGZvdXJpZXI3ID0gVFNMTShCYXJyZWxzIH4gdHJlbmQoKSArIGZvdXJpZXIoSyA9IDcpKSwNCiAgICBmb3VyaWVyOCA9IFRTTE0oQmFycmVscyB+IHRyZW5kKCkgKyBmb3VyaWVyKEsgPSA4KSksDQogICAgZm91cmllcjkgPSBUU0xNKEJhcnJlbHMgfiB0cmVuZCgpICsgZm91cmllcihLID0gOSkpLA0KICAgIGZvdXJpZXIxMCA9IFRTTE0oQmFycmVscyB+IHRyZW5kKCkgKyBmb3VyaWVyKEsgPSAxMCkpLA0KICAgIGZvdXJpZXIxMSA9IFRTTE0oQmFycmVscyB+IHRyZW5kKCkgKyBmb3VyaWVyKEsgPSAxMSkpLA0KICAgIGZvdXJpZXIxMiA9IFRTTE0oQmFycmVscyB+IHRyZW5kKCkgKyBmb3VyaWVyKEsgPSAxMikpLA0KICAgIGZvdXJpZXIxMyA9IFRTTE0oQmFycmVscyB+IHRyZW5kKCkgKyBmb3VyaWVyKEsgPSAxMykpLA0KICAgIGZvdXJpZXIxNCA9IFRTTE0oQmFycmVscyB+IHRyZW5kKCkgKyBmb3VyaWVyKEsgPSAxNCkpLA0KICAgIGZvdXJpZXIxNSA9IFRTTE0oQmFycmVscyB+IHRyZW5kKCkgKyBmb3VyaWVyKEsgPSAxNSkpDQogICkNCg0KZ2xhbmNlKGZpdCkgfD4NCiAgYXJyYW5nZShBSUNjKSB8Pg0KICBzZWxlY3QoLm1vZGVsLCBBSUNjLCBDVikNCmBgYA0KDQpCZXN0IG1vZGVsIGhhcyBvcmRlciA3DQpgYGB7cn0NCmdhcyB8Pg0KICBhdXRvcGxvdChCYXJyZWxzLCBjb2wgPSAiZ3JheSIpICsNCiAgZ2VvbV9saW5lKA0KICAgIGRhdGEgPSBhdWdtZW50KGZpdCkgfD4gZmlsdGVyKC5tb2RlbCA9PSAiZm91cmllcjciKSwNCiAgICBhZXMoeSA9IC5maXR0ZWQpLCBjb2wgPSAiYmx1ZSINCiAgKQ0KYGBgDQoNClRoaXMgc2VlbXMgdG8gaGF2ZSBjYXB0dXJlZCB0aGUgYW5udWFsIHNlYXNvbmFsaXR5IHF1aXRlIHdlbGwuDQoNCl9fYi4gU2VsZWN0IHRoZSBhcHByb3ByaWF0ZSBudW1iZXIgb2YgRm91cmllciB0ZXJtcyB0byBpbmNsdWRlIGJ5IG1pbmltaXNpbmcgdGhlIEFJQ2Mgb3IgQ1YgdmFsdWUuX18NCg0KU2VlIGFib3ZlDQoNCl9fYy4gUGxvdCB0aGUgcmVzaWR1YWxzIG9mIHRoZSBmaW5hbCBtb2RlbCB1c2luZyB0aGUgYGdnX3RzcmVzaWR1YWxzKClgIGZ1bmN0aW9uIGFuZCBjb21tZW50IG9uIHRoZXNlLiBVc2UgYSBManVuZy1Cb3ggdGVzdCB0byBjaGVjayBmb3IgcmVzaWR1YWwgYXV0b2NvcnJlbGF0aW9uLl9fDQoNCmBgYHtyfQ0KZml0IHw+DQogIHNlbGVjdChmb3VyaWVyNykgfD4NCiAgZ2dfdHNyZXNpZHVhbHMoKQ0KYGBgDQpUaGVyZSBpcyBzb21lIHNtYWxsIHJlbWFpbmluZyBhdXRvY29ycmVsYXRpb24gYXQgbGFnIDEuDQoNCmBgYHtyfQ0KYXVnbWVudChmaXQpIHw+DQogIGZpbHRlcigubW9kZWwgPT0gImZvdXJpZXI3IikgfD4NCiAgZmVhdHVyZXMoLmlubm92LCBsanVuZ19ib3gsIGxhZyA9IDUyKQ0KYGBgDQoNClRoZSBManVuZy1Cb3ggdGVzdCBpcyBub3Qgc2lnbmlmaWNhbnQuIEV2ZW4gaWYgdGhlIExqdW5nLUJveCB0ZXN0IGhhZCBnaXZlbiBhIHNpZ25pZmljYW50IHJlc3VsdCBoZXJlLCB0aGUgY29ycmVsYXRpb25zIGFyZSB2ZXJ5IHNtYWxsLCBzbyBpdCB3b3VsZCBub3QgbWFrZSBtdWNoIGRpZmZlcmVuY2UgdG8gdGhlIGZvcmVjYXN0cyBhbmQgcHJlZGljdGlvbiBpbnRlcnZhbHMuDQoNCl9fZC4gR2VuZXJhdGUgZm9yZWNhc3RzIGZvciB0aGUgbmV4dCB5ZWFyIG9mIGRhdGEgYW5kIHBsb3QgdGhlc2UgYWxvbmcgd2l0aCB0aGUgYWN0dWFsIGRhdGEgZm9yIDIwMDUuIENvbW1lbnQgb24gdGhlIGZvcmVjYXN0cy5fXw0KDQpgYGB7cn0NCmZpdCB8Pg0KICBzZWxlY3QoImZvdXJpZXI3IikgfD4NCiAgZm9yZWNhc3QoaCA9ICIxIHllYXIiKSB8Pg0KICBhdXRvcGxvdChmaWx0ZXJfaW5kZXgodXNfZ2Fzb2xpbmUsICIyMDAwIiB+ICIyMDA2IikpDQpgYGANCg0KVGhlIGZvcmVjYXN0cyBmaXQgcHJldHR5IHdlbGwgZm9yIHRoZSBmaXJzdCBzaXggbW9udGhzLCBidXQgbm90IHNvIHdlbGwgYWZ0ZXIgdGhhdC4=