library(readxl, quietly = TRUE, warn.conflicts =  FALSE, verbose = F)
library(fpp2,quietly = TRUE, warn.conflicts =  FALSE, verbose = F)
library(ggplot2)
library(gridExtra)
library(mlbench)
library(caret)
library(corrplot)
library(dplyr )
library(kableExtra)
library(e1071)

Excercise 7.1

a

 l = 77260.0561  and    alpha = 0.2971 
ses_pigs <- ses(pigs, h=4)
summary(ses_pigs)
## 
## Forecast method: Simple exponential smoothing
## 
## Model Information:
## 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 
## 
## Error measures:
##                    ME    RMSE      MAE       MPE     MAPE      MASE       ACF1
## Training set 385.8721 10253.6 7961.383 -0.922652 9.274016 0.7966249 0.01282239
## 
## Forecasts:
##          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
autoplot(ses_pigs) +
  xlab("Year") + ylab("number of pigs slaughtered in Victoria")

b

Prediction intervals calculated is slighty narrower tha R cacluated intervals.

 calcuated <- c(98816.4 - sd(ses_pigs$residuals)*1.96, 98816.4 + sd(ses_pigs$residuals)*1.96)
 R <- c(78611.97,   119020.8)
 
kable_styling (kable(rbind(calcuated, R)),bootstrap_options = c("striped", "hover", "condensed", "responsive"))
calcuated 78679.96 118952.8
R 78611.97 119020.8

Excercise 7.5

a

Based on the plots we see that both series are cyclic and are trending updaward. Hard to say if there is any seasonality. Toward the end of the series there are more hardcover sales.

autoplot(books)

b

paperback_ses <- ses(books[,1])
autoplot(paperback_ses) +
  xlab("Year") + ylab("Paperback")

forecast(paperback_ses)
##    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
## 35       207.1097 160.0215 254.1979 135.0945 279.1249
## 36       207.1097 159.4247 254.7946 134.1818 280.0375
## 37       207.1097 158.8353 255.3840 133.2804 280.9389
## 38       207.1097 158.2531 255.9663 132.3899 281.8294
## 39       207.1097 157.6777 256.5417 131.5099 282.7094
## 40       207.1097 157.1089 257.1105 130.6400 283.5793
hardcover_ses <- ses(books[,2])
autoplot(hardcover_ses) +
  xlab("Year") + ylab("Hardcover")

forecast(hardcover_ses)
##    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
## 35       239.5601 188.8895 290.2306 162.0662 317.0540
## 36       239.5601 187.0164 292.1038 159.2014 319.9188
## 37       239.5601 185.2077 293.9124 156.4353 322.6848
## 38       239.5601 183.4574 295.6628 153.7584 325.3618
## 39       239.5601 181.7600 297.3602 151.1625 327.9577
## 40       239.5601 180.1111 299.0091 148.6406 330.4795

c

Below table displays RMSE values.

SES_Hardcover_RMSE <- accuracy(hardcover_ses)[2]
SES_Paperback_RMSE <- accuracy(paperback_ses)[2]
kable_styling (kable(rbind(SES_Hardcover_RMSE,SES_Paperback_RMSE)),bootstrap_options = c("striped", "hover", "condensed", "responsive"))
SES_Hardcover_RMSE 31.93101
SES_Paperback_RMSE 33.63769

Excercise 7.6

a

paperback_holt <- holt(books[,1], h =  4)

kable_styling (kable(forecast(paperback_holt)),bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
31 209.4668 166.6035 252.3301 143.9130 275.0205
32 210.7177 167.8544 253.5811 145.1640 276.2715
33 211.9687 169.1054 254.8320 146.4149 277.5225
34 213.2197 170.3564 256.0830 147.6659 278.7735 
hardcover_holt <- holt(books[,2], h =  4)
kable_styling (kable(forecast(hardcover_holt)),bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
31 250.1739 212.7390 287.6087 192.9222 307.4256
32 253.4765 216.0416 290.9113 196.2248 310.7282
33 256.7791 219.3442 294.2140 199.5274 314.0308
34 260.0817 222.6468 297.5166 202.8300 317.3334

b

Table below displays RMSE values forSES and Holt’s methods. Based on the RMSE values Holt’s method is better than SES.Holt’s method takes into account the trend element and SES does not. Plot of the series above showed clear uptrend, so Holt’s method is a better choice.

Holt_Hardcover_RMSE <- accuracy(hardcover_holt)[2]
Holt_Paperback_RMSE <- accuracy(paperback_holt)[2]

rmsesholt <- cbind(Holt_Hardcover_RMSE,Holt_Paperback_RMSE)
rmsseses <-cbind( SES_Hardcover_RMSE, SES_Paperback_RMSE)

rmeseval <- rbind(rmsseses, rmsesholt)

colnames(rmeseval)<- c('Hardcover', 'Paperback')

rownames(rmeseval)<- c('SES', 'Holts')

kable_styling (kable(rmeseval),bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Hardcover Paperback
SES 31.93101 33.63769
Holts 27.19358 31.13692

c

Holt’s method is better because it takes trend into account. Point forecast for SES is always constant and do not account for trend.

autoplot(books[,1]) +
  autolayer(paperback_holt, series="Holt's method", PI=FALSE) +
  autolayer(paperback_ses, series="SES method", PI=FALSE) +
  ggtitle("Forecasts from Holt's method") + xlab("Year") +
  ylab("Paperback Books") +
  guides(colour=guide_legend(title="Forecast"))

autoplot(books[,2]) +
  autolayer(hardcover_holt, series="Holt's method", PI=FALSE) +
  autolayer(hardcover_ses, series="SES method", PI=FALSE) +
  ggtitle("Forecasts from Holt's method") + xlab("Year") +
  ylab("Hardcover Books") +
  guides(colour=guide_legend(title="Forecast"))

d

Hardcover

rmse_hardcover_holt <- 27.19358

rmse_hardcover_ses <- 31.93101

hardcover_ses_int <- cbind(  239.5601 - rmse_hardcover_ses * 1.96, 239.5601 + rmse_hardcover_ses * 1.96 , 174.7799,304.3403)
hardcover_holt_int <- cbind(250.1739 - rmse_hardcover_holt * 1.96,  250.1739 + rmse_hardcover_holt * 1.96, 192.9222, 307.4256)

hard_int <- rbind(hardcover_holt_int,hardcover_ses_int )

rownames(hard_int) <- c("Holt","SES" )

colnames(hard_int) <- c("Calc 95 Low","Calc 95 High", "R95 Low", "R 95 High " )

kable_styling (kable(hard_int),bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Calc 95 Low Calc 95 High R95 Low R 95 High
Holt 196.8745 303.4733 192.9222 307.4256
SES 176.9753 302.1449 174.7799 304.3403

Paperback

rmse_paperback_holt <- 31.13692 

rmse_paperback_ses <- 33.63769 

softcover_ses_int <- cbind(   207.1097  - rmse_paperback_ses * 1.96,  207.1097  + rmse_paperback_ses * 1.96 , 138.8670,275.3523)
softcover_holt_int <- cbind( 209.4668  - rmse_paperback_holt * 1.96,   209.4668  + rmse_paperback_holt * 1.96, 143.9130, 275.0205)

paper_int <- rbind(softcover_holt_int,softcover_ses_int )

rownames(paper_int) <- c("Holt","SES" )

colnames(paper_int) <- c("Calc 95 Low","Calc 95 High", "R95 Low", "R 95 High " )

kable_styling (kable(paper_int),bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Calc 95 Low Calc 95 High R95 Low R 95 High
Holt 148.4384 270.4952 143.913 275.0205
SES 141.1798 273.0396 138.867 275.3523

RMSE values for Holt’s method are better than SES. Calculated inverals are narrower than R calculated values.

Excercise 7.7

The plot show a downward trend

autoplot(eggs)

Holt’s with default options

Holt’s model is forecasting negative prices wich is not realistic.

eggs_holt <- holt(eggs, h=100)

autoplot(eggs_holt) + autolayer(eggs_holt)

egg_RMSE_default = 26.58219

Damped Holt’s method

Price is above zero but does not show the trend in the data

eggs_holt <- holt(eggs, h=100, damped = T)

autoplot(eggs_holt) + autolayer(eggs_holt)

egg_RMSE_Damped <- 26.54019

BoxCox + Holt

Price is abover zero and trend is also reflected in the plot. Lower predition intverals are still below zero.

eggs_lambda <- BoxCox.lambda(eggs)
eggs_bc_holt <- holt(eggs, lambda =  eggs_lambda, h = 100)
autoplot(eggs_bc_holt) + autolayer(eggs_bc_holt)

egg_RMSE_BoxCox <- 26.39376

BoxCox + Damped Holt

Price is abover zero and trend is also reflected in the plot. Prediction intervals are better than the previous forecast.

eggs_lambda <- BoxCox.lambda(eggs)
eggs_bc_holt <- holt(eggs, lambda =  eggs_lambda, h = 100, damped =  T)
autoplot(eggs_bc_holt) + autolayer(eggs_bc_holt)

egg_RMSE_DampedBoxCox <- 26.53321

RMSE

Table below displays RMSE values. We see that Holt’s method(damped= false) with lambda 0.3956183 gives the best RMSE

rms <- cbind(egg_RMSE_default, egg_RMSE_Damped,  egg_RMSE_BoxCox, egg_RMSE_DampedBoxCox )
kable_styling (kable(rms),bootstrap_options = c("striped", "hover", "condensed", "responsive"))
egg_RMSE_default egg_RMSE_Damped egg_RMSE_BoxCox egg_RMSE_DampedBoxCox
26.58219 26.54019 26.39376 26.53321

Excercise 7.8

a

Plot below shows variation increases as the level of the series increases so we need to usemultiplicative seasonality.

retaildata <- readxl::read_excel("retail.xlsx", skip=1)
lts <- ts(retaildata[,"A3349499L"], frequency=12, start=c(1982,4))
 
autoplot(lts) +
  ggtitle("X11 Liquor retail")

b

liq_hw <- hw(lts, seasonal = "multiplicative")

autoplot(liq_hw)

liq_hw_damped <- hw(lts, seasonal = "multiplicative",  damped = TRUE)

autoplot(liq_hw_damped)

### c

Non damped RMSE is slightly better. Based on this I would probably use non damaped version.

accuracy(liq_hw)
##                     ME    RMSE       MAE        MPE     MAPE      MASE
## Training set 0.0277793 1.36942 0.9780015 -0.4781182 5.436905 0.4895978
##                    ACF1
## Training set -0.0485131
accuracy(liq_hw_damped)
##                    ME     RMSE       MAE       MPE     MAPE      MASE
## Training set 0.132716 1.377265 0.9776508 0.1961295 5.365016 0.4894222
##                     ACF1
## Training set -0.05156151

d

Residual ACF plot show there is correlation.

checkresiduals(liq_hw)

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

e

The test set RMSE is 1.342792 compared to 2.620243 for the seasonal naive method, so the Holt-Winters’ method is better.

 lts_train <- window(lts,end=c(2010,12))
 lthw<- hw(lts_train, seasonal='multiplicative', damped=T)
  accuracy(lthw, x=lts)
##                     ME     RMSE       MAE        MPE     MAPE      MASE
## Training set 0.1271778 1.349997 0.9499428 0.08570552 5.564892 0.4743304
## Test set     0.8039552 2.137253 1.6646641 1.54271052 3.681347 0.8312088
##                    ACF1 Theil's U
## Training set -0.0599359        NA
## Test set      0.3945962 0.2582985
  #naive  
fc <- snaive(lts_train)
accuracy(fc)
##                    ME     RMSE      MAE     MPE     MAPE MASE      ACF1
## Training set 1.276577 2.620243 2.002703 5.88758 10.78815    1 0.6768455

Excercise 7.9

This RMSE is better. RMSE for stlf is 1.132108 compared to 1.349997

trains <- stlf(lts_train, lambda = BoxCox.lambda(lts_train), h = 12)
f <- forecast(trains)
autoplot(f)

accuracy(f)
##                        ME     RMSE       MAE       MPE     MAPE      MASE
## Training set -0.007744652 1.132108 0.8012989 -0.288104 4.658119 0.4001088
##                     ACF1
## Training set -0.03921206