HW5
Harris Dupre
3/12/2022
8.1
a.
fit <- aus_livestock %>%
filter(Animal == 'Pigs', State == 'Victoria') %>%
model(ETS(Count ~ error("A") + trend("N") + season("N")))
fc <- fit %>%
forecast(h = 4)
fc## # A fable: 4 x 6 [1M]
## # Key: Animal, State, .model [1]
## Animal State .model Month Count .mean
## <fct> <fct> <chr> <mth> <dist> <dbl>
## 1 Pigs Victoria "ETS(Count ~ error(\"A\") +… 2019 Jan N(95187, 8.7e+07) 95187.
## 2 Pigs Victoria "ETS(Count ~ error(\"A\") +… 2019 Feb N(95187, 9.7e+07) 95187.
## 3 Pigs Victoria "ETS(Count ~ error(\"A\") +… 2019 Mar N(95187, 1.1e+08) 95187.
## 4 Pigs Victoria "ETS(Count ~ error(\"A\") +… 2019 Apr N(95187, 1.1e+08) 95187.# aus_livestock %>%
# filter(Animal == 'Pigs', State == 'Victoria') %>%
# autoplot()
#
# aus_livestock %>%
# filter(Animal == 'Pigs', State == 'Victoria', Month == Date > "2015-01-01") %>%
# autoplot(fc)Forecast value is 95186.56 for each of the next four months.
b.
# get residuals for y hat +- 1.96s where s is stdev of residuals
fit_resid <- augment(fit)
s <- sd(fit_resid$.resid)
95186.56 + (s *1.96)## [1] 113502.195186.56 - (s *1.96)## [1] 76871.02fc %>%
hilo() -> fc_interval
fc_interval$`95%`## <hilo[4]>
## [1] [76854.79, 113518.3]95 [75927.17, 114445.9]95 [75042.22, 115330.9]95
## [4] [74194.54, 116178.6]95The R generated value and the value calculated with the formula above are pretty close.
8.5
a.
global_economy %>%
filter(Country == "Morocco") %>%
autoplot(Exports)
We are dealing with yearly data so there is no indication of seasonality and exports from Morocco do not seem to have a cyclic nature. We can say that there is an upward trend, though this is most pronounced since approximately 1980.
b.
mor_exp <- global_economy %>%
filter(Country == "Morocco")
fitANN <- mor_exp %>%
model(ETS(Exports~ error("A") + trend("N") + season("N")))
fcANN <- fitANN %>%
forecast(h = 5)
fcANN %>%
autoplot(mor_exp)
c.
accANN <- fitANN %>%
accuracy()
accANN## # A tibble: 1 × 11
## Country .model .type ME RMSE MAE MPE MAPE MASE RMSSE ACF1
## <fct> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Morocco "ETS(Exports … Trai… 0.259 2.34 1.77 0.363 7.38 0.987 0.989 0.00928RMSE is 2.342965
d.
fitAAN <- mor_exp %>%
model(ETS(Exports~ error("A") + trend("A") + season("N")))
fcAAN <- fitAAN %>%
forecast(h = 5)
fcAAN %>%
autoplot(mor_exp)
accAAN <- fitAAN %>%
accuracy()
accAAN## # A tibble: 1 × 11
## Country .model .type ME RMSE MAE MPE MAPE MASE RMSSE ACF1
## <fct> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Morocco "ETS(Export… Trai… -0.0249 2.33 1.74 -0.882 7.39 0.970 0.983 0.0222The simple exponential smoothing may be appropriate due to the lack of seasonal pattern – but there does appear to be some trend. This would indicate the suitability of Holt’s method.
e.
I think the slight upward trend of the Holt’s method model is more realistic and this is reinforced (though just barely) by the Holt’s method RMSE being lower.
f.
fitANN_resid <- augment(fitANN)
fitAAN_resid <- augment(fitAAN)
sANN <- sd(fitANN_resid$.resid)
sAAN <- sd(fitAAN_resid$.resid)
#ANN
AAN_hilo <- c((36.91837 - (sANN * 1.96)),(36.91837 + (sANN * 1.96)))
#AAN
ANN_hilo <- c((37.17436 - (sAAN * 1.96)),(37.17436 + (sAAN * 1.96)))
fcANN_interval <- fcANN %>%
hilo()
fcAAN_interval <- fcAAN %>%
hilo()
AAN_hilo## [1] 32.31447 41.52227ANN_hilo## [1] 32.56963 41.77909fcANN_interval$`95%`[1]## <hilo[1]>
## [1] [32.24496, 41.59178]95fcAAN_interval$`95%`[1]## <hilo[1]>
## [1] [32.44327, 41.90546]95The intervals are all relatively close together.
8.6
chinese_gdp <- global_economy %>%
filter(Country=='China')
chinese_gdp %>%
autoplot(GDP)
chinese_gdp %>%
model(`Holt's method` = ETS(GDP ~ error("A") + trend("A") + season("N")),
`Damped Holt's method` = ETS(GDP ~ error("A") + trend("Ad", phi = 0.9) + season("N"))) %>%
forecast(h=20) %>%
autoplot(chinese_gdp, level=NULL)
A damped trend tapers off the increase in GDP. This is probably more realistic than the forecast by Holt’s method alone as it would be surprising if China continued an exponential increase in GDP as the country transitions more to a service economy and a larger proportion of people who were previously living in poverty until 2000 join the middle class.
8.7
aus_gas <- aus_production
aus_gas %>%
model(
multiplicative = ETS(Gas ~ error("M") + trend("A") +
season("M"))
) %>%
forecast(h=80) %>%
autoplot(aus_gas,level=NULL)
aus_gas %>%
model(
damped = ETS(Gas ~ error("M") + trend("Ad") +
season("M"))
) %>%
forecast(h=80) %>%
autoplot(aus_gas,level=NULL)
The multiplicative method is preferred here because the variation in the seasonality is changing as the level of the series changes. Additive would be better if variation stayed approximately constant.
The damped forecast has a very slight impact on the data if you only look at a few quarters so I changed the “h” parameter to 80 (20 years) and I believe damping does improve the forecast. If this forecast was for only a few quarters or years then the difference would be imperceptible – so it appears damping for this data is more needed for longer-term forecasts.
8.8
a.
set.seed(81023948)
myseries <- aus_retail %>%
filter(`Series ID` == sample(aus_retail$`Series ID`,1))
myseries %>%
autoplot(Turnover)
Multiplicative seasonality is necessary because the variation in the seasonality isn’t consistent – after approximately 2010 the amplitude of the seasonal oscillations greatly increases.
b.
myseries %>%
model(
multiplicative = ETS(Turnover ~ error("M") + trend("A") +
season("M")),
damped = ETS(Turnover ~ error("M") + trend("Ad") +
season("M"))
) %>%
forecast(h=60) %>%
autoplot(myseries)
c.
multi_accuracy <- myseries %>%
model(ETS(Turnover ~ error("M") + trend("A") + season("M"))) %>%
accuracy()
damp_accuracy <- myseries %>%
model(ETS(Turnover ~ error("M") + trend("Ad") + season("M"))) %>%
accuracy()
multi_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 Tasm… Clothin… "ETS(… Trai… -0.0221 1.31 0.870 -0.675 6.24 0.510 0.482 0.168damp_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 Tasma… Clothin… "ETS(… Trai… 0.0292 1.31 0.865 -0.206 6.18 0.507 0.481 0.159Multiplicative seasonal model has an RMSE of 1.314709. Damped model has an RMSE of 1.311007. Damped model has a better RMSE (slightly).
d.
myseries %>%
model(ETS(Turnover ~ error("M") + trend("Ad") + season("M"))) %>%
gg_tsresiduals()
The residuals from the damped method do look like white noise.
e.
myseries_train <- myseries %>%
filter(year(Month) < 2011)
myseries_test <- myseries %>%
filter(year(Month) >= 2011)
fit_test <- myseries_test %>%
model(ETS(Turnover ~ error("M") + trend("Ad") + season("M"))) %>%
augment()
rmse <- sqrt(mean(fit_test$.resid^2))
rmse## [1] 1.865339The RMSE of the test set here is 1.8653 while the RMSE from HW3 SNAIVE model was 1.3788. So the SNAIVE model is a better forecast.
8.9
lambda <- myseries %>%
features(Turnover, features=guerrero) %>%
pull(lambda_guerrero)
fit_stl_accuracy <- myseries %>%
model(STL(box_cox(Turnover,lambda))) %>%
accuracy()
fit_ets_accuracy <- myseries %>%
model(ETS(Turnover ~ error("M") + trend("Ad") + season("M"))) %>%
accuracy()
fit_stl_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 Tasma… Clothin… STL(b… Trai… 0.0402 0.912 0.614 -0.168 4.32 0.360 0.334 0.207fit_ets_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 Tasma… Clothin… "ETS(… Trai… 0.0292 1.31 0.865 -0.206 6.18 0.507 0.481 0.159The STL decomposition has a much lower RMSE (0.912 vs 1.311) than ETS with damping.