library(tidyverse)
library(fpp2)
library(fma)

7.1 a

pigs <- force(pigs)
fc <- ses(pigs, h = 4)
forecast(fc)
##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Sep 1995       98816.41 85605.43 112027.4 78611.97 119020.8
## Oct 1995       98816.41 85034.52 112598.3 77738.83 119894.0
## Nov 1995       98816.41 84486.34 113146.5 76900.46 120732.4
## Dec 1995       98816.41 83958.37 113674.4 76092.99 121539.8
fc$model
## Simple exponential smoothing 
## 
## Call:
##  ses(y = pigs, h = 4) 
## 
##   Smoothing parameters:
##     alpha = 0.2971 
## 
##   Initial states:
##     l = 77260.0561 
## 
##   sigma:  10308.58
## 
##      AIC     AICc      BIC 
## 4462.955 4463.086 4472.665

b

fc$upper[1, 2]
##      95% 
## 119020.8
fc$lower[1, 2]
##      95% 
## 78611.97
s <- sd(fc$residuals)
(fc$mean[1] + 1.96*s)
## [1] 118952.8
(fc$mean[1] - 1.96*s)
## [1] 78679.97

7.5 a

data(books)
autoplot(books)

There appears to be a positive trend for both paperback and hardcover books over this 30 day period. No obvious seasonaility or lags without running further analysis.

b

pb <- ses(books[,1], h=4)
hc <- ses(books[,2], h=4)

forecast(pb)
##    Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 31       207.1097 162.4882 251.7311 138.8670 275.3523
## 32       207.1097 161.8589 252.3604 137.9046 276.3147
## 33       207.1097 161.2382 252.9811 136.9554 277.2639
## 34       207.1097 160.6259 253.5935 136.0188 278.2005
forecast(hc)
##    Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## 31       239.5601 197.2026 281.9176 174.7799 304.3403
## 32       239.5601 194.9788 284.1414 171.3788 307.7414
## 33       239.5601 192.8607 286.2595 168.1396 310.9806
## 34       239.5601 190.8347 288.2855 165.0410 314.0792
autoplot(pb, series = "Paperback", alpha = 0.5) +
  autolayer(hc, series = "Hardcover", alpha = 0.5)  +
  autolayer(books[,1], series = "Paperback") +
  autolayer(books[,2], series = "Hardcover")

c

accuracy(pb)
##                    ME     RMSE     MAE       MPE     MAPE      MASE
## Training set 7.175981 33.63769 27.8431 0.4736071 15.57784 0.7021303
##                    ACF1
## Training set -0.2117522
accuracy(hc)
##                    ME     RMSE      MAE      MPE     MAPE      MASE
## Training set 9.166735 31.93101 26.77319 2.636189 13.39487 0.7987887
##                    ACF1
## Training set -0.1417763

7.6 a

hpb <- holt(books[,1], h=4)
hhc <- holt(books[,2], h=4)

b

accuracy(hpb)
##                     ME     RMSE      MAE       MPE     MAPE      MASE
## Training set -3.717178 31.13692 26.18083 -5.508526 15.58354 0.6602122
##                    ACF1
## Training set -0.1750792
accuracy(hhc)
##                      ME     RMSE      MAE       MPE    MAPE      MASE
## Training set -0.1357882 27.19358 23.15557 -2.114792 12.1626 0.6908555
##                     ACF1
## Training set -0.03245186

Since there is a linear trend in the data, adding the linear component in Holts model is a good idea. I this case both RMSEs have been decreased indicating a better fitting model.

c

autoplot(hpb, series = "Paperback", alpha = 0.5) +
  autolayer(hhc, series = "Hardcover",  alpha = 0.5) +
  autolayer(books[,1], series = "Paperback") +
  autolayer(books[,2], series = "Hardcover")

There are three things that I like better about Holt’s method for these book series’. First, I like that Holt’s has a lower RMSE. Second I like that there is a smaller range in the 80 and 95% confidence intervals using the Holt’s method. Last, I like that the 80 and 95% confidence intervals are showing a positive trend in the range of data estimates.

d

list <- cbind(c(pb$upper[1, 2],
pb$lower[1, 2],
hc$upper[1, 2],
hc$lower[1, 2]),c(
hpb$upper[1, 2],
hpb$lower[1, 2],
hhc$upper[1, 2],
hhc$lower[1, 2]))
colnames(list) <- c("ses", "holt")
list
##          ses     holt
## 95% 275.3523 275.0205
## 95% 138.8670 143.9130
## 95% 304.3403 307.4256
## 95% 174.7799 192.9222

7.7 a

eggs <- force(eggs)
caret::BoxCoxTrans(eggs)
## Box-Cox Transformation
## 
## 94 data points used to estimate Lambda
## 
## Input data summary:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   62.27  148.87  209.15  206.15  276.71  358.78 
## 
## Largest/Smallest: 5.76 
## Sample Skewness: -0.0758 
## 
## Estimated Lambda: 0.9 
## With fudge factor, no transformation is applied
efc <- holt(eggs, h=100)
efcd <- holt(eggs, damped = TRUE, h=100)
efcl <- holt(eggs, lambda = .9, h=100)
efcdl <- holt(eggs, damped = TRUE, lambda = .9, h=100)

autoplot(eggs) +
  autolayer(efc, series = "holt", PI=FALSE) +
  autolayer(efcd, series = "holt damped", PI=FALSE) +
  autolayer(efcl, series = "holt boxcox", PI=FALSE) +
  autolayer(efcdl, series = "holt damped boxcox", PI=FALSE)

a <- accuracy(efc)
b <- accuracy(efcd)
c <- accuracy(efcl)
d <- accuracy(efcdl)
list <- cbind(
  a[2],
  b[2],
  c[2],
  d[2]
)
list
##          [,1]     [,2]     [,3]     [,4]
## [1,] 26.58219 26.54019 26.66924 26.72889

For the eggs data series, Holt’s with damped trend model has the lowest RMSE

7.8

retaildata <- readxl::read_excel("retail.xlsx", skip=1)
myts <- ts(retaildata[,"A3349873A"],  frequency=12, start=c(1982,4))
myts %>% 
  autoplot()

a. The plot shows seasonaility increasing. Any change in seasonaility means we should uses a multiplicative model.

retailhw <- hw(myts, seasonal = "multiplicative")
retailhwd <- hw(myts, seasonal = "multiplicative", damped = TRUE)
autoplot(window(myts, start=2012)) +
  autolayer(retailhw, PI=FALSE, series = "hw") +
  autolayer(retailhwd, PI=FALSE, series = "hw damped")

a <- accuracy(retailhw)
b <- accuracy(retailhwd)
list <- cbind(
  a[2],
  b[2])
list
##          [,1]     [,2]
## [1,] 13.29378 13.30494

The RMSE of the Holt Winters’ model without damping the trend is lower.

checkresiduals(retailhw)

## 
##  Ljung-Box test
## 
## data:  Residuals from Holt-Winters' multiplicative method
## Q* = 40.405, df = 8, p-value = 2.692e-06
## 
## Model df: 16.   Total lags used: 24

The residuals are normally distributed but have an increasing trend and the Ljung-Box test rejects the null hypothesis of white noise.

e

train <- window(myts, end = c(2010, 12))
test <- window(myts, start = 2011)
fc <- hw(train, h = 36, seasonal = "multiplicative")
fcn <- snaive(train, h = 36)
autoplot(fc)

cbind(accuracy(fc, test), accuracy(fcn, test))
##                       ME      RMSE       MAE          MPE      MAPE
## Training set  0.03021223  9.107356  6.553533  0.001995484  3.293399
## Test set     78.34068365 94.806617 78.340684 19.945024968 19.945025
##                   MASE       ACF1 Theil's U        ME      RMSE      MAE
## Training set 0.4107058 0.02752875        NA  7.772973  20.24576 15.95676
## Test set     4.9095618 0.52802701  1.613903 81.744444 100.00869 82.06667
##                    MPE      MAPE     MASE      ACF1 Theil's U
## Training set  4.702754  8.109777 1.000000 0.7385090        NA
## Test set     20.549055 20.669738 5.143067 0.6830879   1.67023

The Holt Winters’ model has a lower RMSE than the seasonal naive model.

7.9

stl <- stlf(train, lambda = "auto")
accuracy(stl, test)
##                     ME      RMSE       MAE        MPE      MAPE      MASE
## Training set -0.646515  8.147517  5.855529 -0.3001347  2.885877 0.3669624
## Test set     56.462144 71.117890 56.462144 15.5079003 15.507900 3.5384474
##                    ACF1 Theil's U
## Training set 0.02389584        NA
## Test set     0.35938690  1.322933

The STL decomposition with BoxCox transformation has a lower RMSE than the Holt Winters’ model.