8.1, 8.5, 8.6, 8.7, 8.8, 8.9

8.1

aus_livestock <- aus_livestock

vic_pig <- subset(aus_livestock,State =="Victoria" & Animal == "Pigs")

vic_pig <- vic_pig %>%
  select(Month,Count) %>%
  mutate(Month = yearmonth(Month)) %>%
  as_tsibble(index=Month)

fit <- vic_pig %>%
  model(ETS(Count))

report(fit)
## Series: Count 
## Model: ETS(A,N,A) 
##   Smoothing parameters:
##     alpha = 0.3579401 
##     gamma = 0.0001000139 
## 
##   Initial states:
##     l[0]     s[0]    s[-1]     s[-2]     s[-3]     s[-4]     s[-5]   s[-6]
##  95487.5 2066.235 6717.311 -2809.562 -1341.299 -7750.173 -8483.418 5610.89
##      s[-7]    s[-8]     s[-9]   s[-10]   s[-11]
##  -579.8107 1215.464 -2827.091 1739.465 6441.989
## 
##   sigma^2:  60742898
## 
##      AIC     AICc      BIC 
## 13545.38 13546.26 13610.24
components(fit) %>%
  autoplot()+
  labs(title= "ETS(M,N,A) Components")+
  theme(plot.title = element_text(hjust = 0.5))
## Warning: Removed 12 row(s) containing missing values (geom_path).

\(\ell_0 = 95487.5, \alpha = 0.3579401\)

vic_pig$Count <- as.numeric(vic_pig$Count)

vic_pig %>%
  model(ETS(Count)) %>%
  forecast(h=4) %>%
  autoplot(vic_pig)

## B

fit <- vic_pig %>%
  model(ETS(Count))

prediction <- vic_pig %>%
  model(ETS(Count)) %>%
  forecast(h=4)

prediction 
s <- residuals(fit)$.resid %>%
  sd()

y <- prediction$.mean[1]

high <- y + 1.96*s
low <- y - 1.96*s

95% Confidence Interval: (69328, 99521)

When compared to R’s 95% intervals: \(\approx\) (84425,61,000,000), this method reveals a significantly smaller interval. The mean of each prediction falls within the calculated confidence interval.

8.5

A

global_economy <- global_economy

usa <- subset(global_economy, Code == "USA")
autoplot(usa,Exports)
## Warning: Removed 1 row(s) containing missing values (geom_path).

## B

usa <- usa[-c(58),]

fit <- usa %>%
  model(ETS(Exports ~ error("A") + trend("N") + season("N")))


fit %>%
  forecast(h=15) %>%
  autoplot(usa)

prediction <- fit %>%
  forecast(h=15)

C

accuracy(fit)$RMSE
## [1] 0.6270672
s_ann <- residuals(fit)$.resid %>%
  sd()

y_ann <- prediction$.mean[1]

ann_low <- y_ann - 1.96 * s_ann

ann_high <- y_ann + 1.96 * s_ann

D, E, and F

fit <- usa %>%
  model(ETS(Exports ~ error("A") + trend("A") + season("N")))


fit %>%
  forecast(h=15) %>%
  autoplot(usa)

accuracy(fit)$RMSE
## [1] 0.6149566
s_aan <- residuals(fit)$.resid %>%
  sd()

y_aan <- prediction$.mean[1]

aan_low <- y_aan - 1.96 * s_aan

aan_high <- y_aan + 1.96 * s_aan

The ETS(A,A,N) model is much more realistic when considering the holistic view of the growth of the Exports in the USA over the past 57 years, while the ETS(A,N,N) model seems to maintain the status quo. The ETS(A,N,N) model provides a forecast that resembles an expected continuation of the average exports in the short-term history, whereas the ETS(A,A,N) has a longer memory.

The RMSE for both are quite similar, though the ETS(A,A,N) has a slightly lower RMSE.

Overall, I think the ETS(A,A,N) model provides a better, more realistic forecast for the medium term. The ETS(A,N,N) suffers from recency bias and it neglects the past performance of the Export growth.

95% Confidence Interval ETS(A,N,N): (10.676, 13.106)

95% Confidence Interval ETS(A,A,N): (10.675, 13.107)

The 95% confidence intervals appear significantly smaller than the intervals shown in the forecast plots, which range from approximately (9,17) for ETS(A,A,N) and (7,17) for ETS(A,N,N)

8.6

china <- subset(global_economy,Country =="China")

fit_ann <- china %>%
  model(ETS(GDP ~ error("A") + trend("N") + season("N")))


fit_ann %>%
  forecast(h=25) %>%
  autoplot(china)

prediction <- fit_ann %>%
  forecast(h=25)
china <- subset(global_economy,Country =="China")

fit_aan <- china %>%
  model(ETS(GDP ~ error("A") + trend("A") + season("N")))


fit_aan %>%
  forecast(h=25) %>%
  autoplot(china)

prediction <- fit_aan %>%
  forecast(h=25)
china <- subset(global_economy,Country =="China")

fit_damp <- china %>%
  model(ETS(GDP ~ error("A") + trend("Ad",phi=0.9) + season("N")))


fit_damp %>%
  forecast(h=25) %>%
  autoplot(china)

prediction <- fit_damp %>%
  forecast(h=25)
china %>%
  model(
    "ETS(A,A,N) (Holt's)" = ETS(GDP ~ error("A") + trend("A") + season("N")),
    "ETS(A,N,N) " = ETS(GDP ~ error("A") + trend("N") + season("N")),
    "ETS(A,Ad,N) (Damped Holt's)" = ETS(GDP ~ error("A") + trend("Ad",phi=0.9) + season("N"))
  ) %>%
  forecast(h=25) %>%
  autoplot(china, level=NULL)+
  labs(title="Forecasting China's GDP",y="Millions")+
  theme(plot.title = element_text(hjust = 0.5))

The Damped Holt’s ETS(A,Ad,N) model may be the most realistic of the three models. ETS(A,A,N) appears to form a tangent line to the trajectory of the growth chart, while ETS(A,N,N) assumes that there will be no further growth. A combination of the three models may be necessary to draw conclusions from the forecasts.

8.7

aus_gas <- aus_production

aus_gas %>%
  model(
    "ETS(A,A,N) (Holt's)" = ETS(Gas ~ error("A") + trend("A") + season("N")),
    "ETS(A,N,N) " = ETS(Gas ~ error("A") + trend("N") + season("N")),
    "ETS(A,Ad,N) (Damped Holt's)" = ETS(Gas ~ error("A") + trend("Ad",phi=0.9) + season("N"))
  ) %>%
  forecast(h=100) %>%
  autoplot(aus_gas, level=NULL)+
  labs(title="Forecasting Australia's Gas Production")+
  theme(plot.title = element_text(hjust = 0.5))

fit_ann <- aus_gas %>%
  model(ETS(Gas ~ error("A") + trend("N") + season("N")))

fit_ann %>%
  forecast(h=25) %>%
  autoplot(aus_gas)

fit_aan <- aus_gas %>%
  model(ETS(Gas ~ error("A") + trend("A") + season("N")))

fit_aan %>%
  forecast(h=25) %>%
  autoplot(aus_gas)

fit_damp <- aus_gas %>%
  model(ETS(Gas ~ error("A") + trend("Ad",phi=0.9) + season("N")))

fit_damp %>%
  forecast(h=25) %>%
  autoplot(aus_gas)

fit_damp_less <- aus_gas %>%
  model(ETS(Gas ~ error("A") + trend("Ad",phi=0.5) + season("N")))

fit_damp_less %>%
  forecast(h=25) %>%
  autoplot(aus_gas)

Of the ETS(A,A,N),ETS(A,N,N),ETS(A,Ad,N) (Damped), and ETS(A,Ad,N) (Damped with lower phi) models, only the ETS(A,A,N) model predicted significant future growth.

Consistently, I have noticed ETS(A,A,N) to heavily consider historical performance in addition to recent performance. As one can see, without multiplicative seasonality, the forecasts are relatively linear. Multiplicative seasonality makes for a much more realistic prediction. Both Additive and multiplicative seasonality improve the feasibility of the forecasts.

fit_mult <- aus_gas %>%
  model(ETS(Gas ~ error("M") + trend("A") + season("M")))

fit_mult %>%
  forecast(h=25) %>%
  autoplot(aus_gas)

fit_add <- aus_gas %>%
  model(ETS(Gas ~ error("A") + trend("A") + season("A")))

fit_add %>%
  forecast(h=25) %>%
  autoplot(aus_gas)

aus_gas <- aus_production

aus_gas %>%
  model(
    "ETS(A,A,N) (Holt's)" = ETS(Gas ~ error("A") + trend("A") + season("N")),
    "ETS(A,N,N) " = ETS(Gas ~ error("A") + trend("N") + season("N")),
    "ETS(A,Ad,N) (Damped Holt's)" = ETS(Gas ~ error("A") + trend("Ad",phi=0.9) + season("N")),
    "Multiplicative" = ETS(Gas ~ error("M") + trend("A") + season("M")),
    "Additive" = ETS(Gas ~ error("A") + trend("A") + season("A"))
  ) %>%
  forecast(h=100) %>%
  autoplot(aus_gas, level=NULL)+
  labs(title="Forecasting Australia's Gas Production")+
  theme(plot.title = element_text(hjust = 0.5))

8.8

set.seed(34)

aus_retail_series <- aus_retail %>%
  filter(`Series ID` == sample(aus_retail$`Series ID`,1))

autoplot(aus_retail_series)
## Plot variable not specified, automatically selected `.vars = Turnover`

gg_season(aus_retail_series)
## Plot variable not specified, automatically selected `y = Turnover`

gg_subseries(aus_retail_series)
## Plot variable not specified, automatically selected `y = Turnover`

gg_lag(aus_retail_series)
## Plot variable not specified, automatically selected `y = Turnover`

aus_retail_series %>%
  ACF(Turnover) %>%
  autoplot()

A

Multiplicative seasonality is needed because the data is heavily seasonal.

B

fit_hw <- aus_retail_series %>%
  model(ETS(Turnover ~ error("M") + trend("A") + season("M")))

fit_hw %>%
  forecast(h=100) %>%
  autoplot(aus_retail_series)

fit_hw_add <- aus_retail_series %>%
  model(ETS(Turnover ~ error("A") + trend("A") + season("A")))

fit_hw_add %>%
  forecast(h=100) %>%
  autoplot(aus_retail_series)

fit_hw_damp <- aus_retail_series %>%
  model(ETS(Turnover ~ error("M") + trend("Ad",phi=0.9) + season("M")))

fit_hw_damp %>%
  forecast(h=100) %>%
  autoplot(aus_retail_series)

fit_hw_damp25 <- aus_retail_series %>%
  model(ETS(Turnover ~ error("M") + trend("Ad",phi=0.25) + season("M")))

fit_hw_damp25 %>%
  forecast(h=100) %>%
  autoplot(aus_retail_series)

aus_retail_series %>%
  model(
    "ETS(M,A,M) Holt-Winter's Multiplicative" = ETS(Turnover ~ error("M") + trend("A") + season("M")),
    "ETS(A,A,A) Holt-Winter's Additive" = ETS(Turnover ~ error("A") + trend("A") + season("A")),
    "ETS(A,Ad,N) (Damped Holt's)" = ETS(Turnover ~ error("M") + trend("Ad",phi=0.9) + season("M"))
  ) %>%
  forecast(h=250) %>%
  autoplot(aus_retail_series, level=NULL)+
  labs(title="Forecasting Australia's Retail Turnover")+
  theme(plot.title = element_text(hjust = 0.5))

C

models <- aus_retail_series %>%
  model(
    "ETS(M,A,M) Holt-Winter's Multiplicative" = ETS(Turnover ~ error("M") + trend("A") + season("M")),
    "ETS(A,A,A) Holt-Winter's Additive" = ETS(Turnover ~ error("A") + trend("A") + season("A")),
    "ETS(A,Ad,N) (Damped Holt's)" = ETS(Turnover ~ error("M") + trend("Ad",phi=0.9) + season("M")))

accuracy(models) %>%
  select(.model,RMSE)

As I expected, the additive seasonality model had the highest RMSE of the three. The multiplicative model has a slightly better RMSE than the additive model. The additive model is more conservative than the multiplicative model.

The damped Holt’s model is the least realistic, as it projects stagnant growth with no clear signs suggesting a sustained period of stagnant growth is looming.

D

fit_hw %>%
  gg_tsresiduals()

The residuals are normally distributed and there is no obvious pattern to the innovation residuals. The lag plot does not indicate a clear pattern either.

E

aus_retail_series %>%
  model(
    "ETS(M,A,M) Holt-Winter's Multiplicative" = ETS(Turnover ~ error("M") + trend("A") + season("M")),
    "ETS(A,A,A) Holt-Winter's Additive" = ETS(Turnover ~ error("A") + trend("A") + season("A")),
    "ETS(A,Ad,N) (Damped Holt's)" = ETS(Turnover ~ error("M") + trend("Ad",phi=0.9) + season("M")),
    "Seasonal Naive" = SNAIVE(Turnover)
  ) %>%
  forecast(h=250) %>%
  autoplot(aus_retail_series, level=NULL)+
  labs(title="Forecasting Australia's Retail Turnover")+
  theme(plot.title = element_text(hjust = 0.5))

models <- aus_retail_series %>%
  model(
    "ETS(M,A,M) Holt-Winter's Multiplicative" = ETS(Turnover ~ error("M") + trend("A") + season("M")),
    "ETS(A,A,A) Holt-Winter's Additive" = ETS(Turnover ~ error("A") + trend("A") + season("A")),
    "ETS(A,Ad,N) (Damped Holt's)" = ETS(Turnover ~ error("M") + trend("Ad",phi=0.9) + season("M")),
    "Seasonal Naive" = SNAIVE(Turnover))

accuracy(models) %>%
  select(.model,RMSE)

From the RMSE alone, the seasonal naive approach is a substantial underfit compared to the other three models.

8.9

lambda <- aus_retail_series %>%
  features(Turnover, features = guerrero) %>%
  pull(lambda_guerrero)

transform <- box_cox(aus_retail_series$Turnover,lambda)

decomp <- aus_retail_series %>%
  model(STL(transform ~ season(window = 'periodic'), robust=TRUE)) %>%
  components()%>%
  autoplot()

decomp

season_adjust <- aus_retail_series %>%
  model(STL(transform ~ season(window = 'periodic'), robust=TRUE)) %>%
  components()

aus_retail_series$Turnover_adj <- season_adjust$season_adjust

fit_hw_adj <- aus_retail_series %>%
  model(ETS(Turnover_adj ~ error("M") + trend("A") + season("M")))

fit_hw_adj %>%
  forecast(h=100) %>%
  autoplot(aus_retail_series)

accuracy(fit_hw_adj) %>%
  select(.model,RMSE)
fit_hw_adj %>%
  gg_tsresiduals()

The RMSE for the seasonally adjusted multiplicative model (0.1225) is much lower than the other four models. This is a great lesson in understanding the value of seasonal adjustments.

The residuals are normally distributed, and the innovation residuals look like white noise.