library(fpp)
library(fma)
library(forecast)
library(ggplot2)
books
## Time Series:
## Start = 1
## End = 30
## Frequency = 1
## Paperback Hardcover
## 1 199 139
## 2 172 128
## 3 111 172
## 4 209 139
## 5 161 191
## 6 119 168
## 7 195 170
## 8 195 145
## 9 131 184
## 10 183 135
## 11 143 218
## 12 141 198
## 13 168 230
## 14 201 222
## 15 155 206
## 16 243 240
## 17 225 189
## 18 167 222
## 19 237 158
## 20 202 178
## 21 186 217
## 22 176 261
## 23 232 238
## 24 195 240
## 25 190 214
## 26 182 200
## 27 222 201
## 28 217 283
## 29 188 220
## 30 247 259
plot(books, main = "daily sales", xlab = "Days")
Both paperback and hardcover books exhibit upward trends. Periodic spikes also seem to be the case for both types of books. Because data is only available for 30 days, it is hard to gauge seasonality.
Let’s try to decompose data to see if there is seasonality. Since the data is provided for 30 days, it is logical to try frequency = 7 representing seven days in a week.
booksTS <- ts(books, frequency = 7)
autoplot(decompose(booksTS[, 1]))
autoplot(decompose(booksTS[, 2]))
Based on the charts above both paperback and hardcover books exhibit seasonality, which is quite logical as more people tend to go to the bookstore over the weekend as compared to other days of the week.
PaperBack <-books[,1]
alphas <- numeric()
SSEs <- numeric()
for(i in seq(0, 1, 0.05)) {
alphas <- c(alphas, i)
s <- ses(PaperBack, initial="simple", alpha=i, h=4)
SSEs <- c(SSEs, s$model$SSE)
}
PaperBackDF <- data.frame(alphas, SSEs)
PaperBackDF
## alphas SSEs
## 1 0.00 41270.00
## 2 0.05 39244.90
## 3 0.10 37785.20
## 4 0.15 36738.44
## 5 0.20 36329.34
## 6 0.25 36438.42
## 7 0.30 36930.75
## 8 0.35 37715.63
## 9 0.40 38738.40
## 10 0.45 39967.19
## 11 0.50 41383.70
## 12 0.55 42977.49
## 13 0.60 44742.62
## 14 0.65 46675.48
## 15 0.70 48773.56
## 16 0.75 51034.58
## 17 0.80 53456.14
## 18 0.85 56035.45
## 19 0.90 58769.45
## 20 0.95 61655.09
## 21 1.00 64690.00
plot(PaperBackDF)
Based on the chart above, the SSE drops at around alpha=.2 and then goes up quite rapidly after that. The table confirms this, as the lowest value is 36329.34, which corresponds to alpha= 0.2.
optAlphaSimple <- ses(PaperBack, initial="simple", h=4)
summary(optAlphaSimple)
##
## Forecast method: Simple exponential smoothing
##
## Model Information:
## Simple exponential smoothing
##
## Call:
## ses(y = PaperBack, h = 4, initial = "simple")
##
## Smoothing parameters:
## alpha = 0.2125
##
## Initial states:
## l = 199
##
## sigma: 34.7918
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 1.749509 34.79175 28.64424 -2.770157 16.56938 0.7223331
## ACF1
## Training set -0.1268119
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 31 210.1537 165.5663 254.7411 141.9631 278.3443
## 32 210.1537 164.5706 255.7368 140.4404 279.8671
## 33 210.1537 163.5962 256.7112 138.9501 281.3573
## 34 210.1537 162.6418 257.6657 137.4905 282.8170
As seen in the table above, the optimal value of alpha is .2125, which seems to be a more accurate estimate of alpha as compared to the method above.
optAlphaOpt <- ses(PaperBack, initial="optimal", h=4)
summary(optAlphaOpt)
##
## Forecast method: Simple exponential smoothing
##
## Model Information:
## Simple exponential smoothing
##
## Call:
## ses(y = PaperBack, h = 4, initial = "optimal")
##
## Smoothing parameters:
## alpha = 0.1685
##
## Initial states:
## l = 170.8257
##
## sigma: 33.6377
##
## AIC AICc BIC
## 318.9747 319.8978 323.1783
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 7.176212 33.63769 27.8431 0.4737524 15.57782 0.7021303
## ACF1
## Training set -0.2117579
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 31 207.1098 164.0013 250.2182 141.1811 273.0384
## 32 207.1098 163.3934 250.8261 140.2513 273.9682
## 33 207.1098 162.7937 251.4258 139.3342 274.8853
## 34 207.1098 162.2021 252.0174 138.4294 275.7901
The initial level = “optimal” lowered alpha to .1685.
Hardcover <-books[,2]
alphasS <- numeric()
SSEsS <- numeric()
for(i in seq(0, 1, 0.05)) {
alphasS <- c(alphasS, i)
s <- ses(Hardcover, initial="simple", alpha=i, h=4)
SSEsS <- c(SSEsS, s$model$SSE)
}
HardcoverDF <- data.frame(alphasS, SSEsS)
HardcoverDF
## alphasS SSEsS
## 1 0.00 154503.00
## 2 0.05 70483.46
## 3 0.10 45714.82
## 4 0.15 36814.18
## 5 0.20 33148.16
## 6 0.25 31553.85
## 7 0.30 30909.69
## 8 0.35 30758.47
## 9 0.40 30895.27
## 10 0.45 31224.35
## 11 0.50 31702.60
## 12 0.55 32314.49
## 13 0.60 33059.93
## 14 0.65 33948.03
## 15 0.70 34993.95
## 16 0.75 36217.34
## 17 0.80 37641.79
## 18 0.85 39295.05
## 19 0.90 41209.53
## 20 0.95 43423.39
## 21 1.00 45982.00
plot(HardcoverDF)
Based on the chart above, the lowest point of SSE seems to be around alpha=.35. The table confirms that assumption.
optAlphaSimpleS <- ses(Hardcover, initial="simple", h=4)
summary(optAlphaSimpleS)
##
## Forecast method: Simple exponential smoothing
##
## Model Information:
## Simple exponential smoothing
##
## Call:
## ses(y = Hardcover, h = 4, initial = "simple")
##
## Smoothing parameters:
## alpha = 0.3473
##
## Initial states:
## l = 139
##
## sigma: 32.0198
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 9.72952 32.01982 26.34467 3.104211 13.05063 0.7860035
## ACF1
## Training set -0.1629042
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 31 240.3808 199.3457 281.4158 177.6231 303.1385
## 32 240.3808 196.9410 283.8206 173.9453 306.8162
## 33 240.3808 194.6625 286.0990 170.4608 310.3008
## 34 240.3808 192.4924 288.2691 167.1418 313.6197
As seen in the table above, the optimal value of alpha is .3473, which seems to be a more accurate estimate of alpha as compared to the method above.
optAlphaOptS <- ses(Hardcover, initial="optimal", h=4)
summary(optAlphaOptS)
##
## Forecast method: Simple exponential smoothing
##
## Model Information:
## Simple exponential smoothing
##
## Call:
## ses(y = Hardcover, h = 4, initial = "optimal")
##
## Smoothing parameters:
## alpha = 0.3283
##
## Initial states:
## l = 149.2836
##
## sigma: 31.931
##
## AIC AICc BIC
## 315.8506 316.7737 320.0542
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 9.166918 31.93101 26.7731 2.636328 13.39479 0.7987858
## ACF1
## Training set -0.1417817
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 31 239.5602 198.6390 280.4815 176.9766 302.1439
## 32 239.5602 196.4905 282.6299 173.6908 305.4297
## 33 239.5602 194.4443 284.6762 170.5613 308.5591
## 34 239.5602 192.4869 286.6336 167.5677 311.5527
The initial level = “optimal” lowered alpha to .3283.
PaperBackH <- holt(PaperBack, initial="simple", h=4)
summary(PaperBackH)
##
## Forecast method: Holt's method
##
## Model Information:
## Holt's method
##
## Call:
## holt(y = PaperBack, h = 4, initial = "simple")
##
## Smoothing parameters:
## alpha = 0.2984
## beta = 0.4984
##
## Initial states:
## l = 199
## b = -27
##
## sigma: 39.5463
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 7.769844 39.54634 33.5377 1.633306 18.19621 0.8457332
## ACF1
## Training set -0.1088681
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 31 222.0201 171.3394 272.7007 144.51068 299.5295
## 32 229.6904 164.8872 294.4935 130.58245 328.7983
## 33 237.3606 145.1175 329.6038 96.28696 378.4343
## 34 245.0309 115.5211 374.5407 46.96280 443.0991
HardcoverH <- holt(Hardcover, initial="simple", h=4)
summary(HardcoverH)
##
## Forecast method: Holt's method
##
## Model Information:
## Holt's method
##
## Call:
## holt(y = Hardcover, h = 4, initial = "simple")
##
## Smoothing parameters:
## alpha = 0.439
## beta = 0.1574
##
## Initial states:
## l = 139
## b = -11
##
## sigma: 35.0438
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 7.193267 35.04383 27.99174 2.423793 14.18241 0.8351445
## ACF1
## Training set -0.07743714
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 31 250.7889 205.8784 295.6993 182.1042 319.4735
## 32 254.7003 202.4087 306.9918 174.7273 334.6733
## 33 258.6117 196.3181 320.9052 163.3419 353.8815
## 34 262.5231 187.9903 337.0558 148.5350 376.5111
sum(residuals(PaperBackH)^2)
## [1] 46917.39
optAlphaSimple$model$SSE
## [1] 36313.98
Check the results:
sum(residuals(optAlphaSimple)^2)
## [1] 36313.98
sum(residuals(optAlphaOpt)^2)
## [1] 33944.82
The simple exponential smoothing model with the parameter initial=“optimal” has the lowest SSE for the paperback time series.
sum(residuals(HardcoverH)^2)
## [1] 36842.1
optAlphaSimpleS$model$SSE
## [1] 30758.07
Check the results:
sum(residuals(optAlphaSimpleS)^2)
## [1] 30758.07
sum(residuals(optAlphaOptS)^2)
## [1] 30587.69
The simple exponential smoothing model with the parameter initial=“optimal” has the lowest SSE for the hardcover time series.
autoplot(PaperBack) + xlab("Days") + autolayer(optAlphaSimple, PI=FALSE, series="SES simple") + autolayer(optAlphaOpt, PI=FALSE, series="SES optimal") + autolayer(PaperBackH, series="Holt", PI=FALSE)
accuracy(optAlphaSimple$fitted, PaperBack)
## ME RMSE MAE MPE MAPE ACF1
## Test set 1.749509 34.79175 28.64424 -2.770157 16.56938 -0.1268119
## Theil's U
## Test set 0.6807692
accuracy(optAlphaOpt$fitted, PaperBack)
## ME RMSE MAE MPE MAPE ACF1 Theil's U
## Test set 7.176212 33.63769 27.8431 0.4737524 15.57782 -0.2117579 0.6685721
accuracy(PaperBackH$fitted, PaperBack)
## ME RMSE MAE MPE MAPE ACF1 Theil's U
## Test set 7.769844 39.54634 33.5377 1.633306 18.19621 -0.1088681 0.8763663
The RMSE and MAE are lowest with the simple exponential smoothing model that used the parameter initial=“optimal”.
Now, I will look at the Handcover time series. First, I will plot it.
autoplot(Hardcover) + xlab("Days") + autolayer(optAlphaSimpleS, PI=FALSE, series="SES simple") + autolayer(optAlphaOptS, PI=FALSE, series="SES optimal") + autolayer(HardcoverH, series="Holt", PI=FALSE)
From the chart above, it appears as though both SES optimal and SES simple are incredibly close.
accuracy(optAlphaSimpleS$fitted, Hardcover)
## ME RMSE MAE MPE MAPE ACF1 Theil's U
## Test set 9.72952 32.01982 26.34467 3.104211 13.05063 -0.1629042 0.8142204
accuracy(optAlphaOptS$fitted, Hardcover)
## ME RMSE MAE MPE MAPE ACF1 Theil's U
## Test set 9.166918 31.93101 26.7731 2.636328 13.39479 -0.1417817 0.8059213
accuracy(HardcoverH$fitted, Hardcover)
## ME RMSE MAE MPE MAPE ACF1
## Test set 7.193267 35.04383 27.99174 2.423793 14.18241 -0.07743714
## Theil's U
## Test set 0.9150588
The optimal model has the lowest RMSE = 31.931. The simple SES model has the lowest MAE = 26.344. Because the forecast produced by the models is very close, either of the models will work better than the Holt’s model.
Because the simple exponential smoothing model with the parameter initial=“optimal” was proven to be superior model in the previous question, I decided to use it for the purpose of this exercise.
PaperBackSESOpt <- ses(PaperBack, initial="optimal", h=1)
summary(PaperBackSESOpt)
##
## Forecast method: Simple exponential smoothing
##
## Model Information:
## Simple exponential smoothing
##
## Call:
## ses(y = PaperBack, h = 1, initial = "optimal")
##
## Smoothing parameters:
## alpha = 0.1685
##
## Initial states:
## l = 170.8257
##
## sigma: 33.6377
##
## AIC AICc BIC
## 318.9747 319.8978 323.1783
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 7.176212 33.63769 27.8431 0.4737524 15.57782 0.7021303
## ACF1
## Training set -0.2117579
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 31 207.1098 164.0013 250.2182 141.1811 273.0384
PaperBackHolt <- holt(PaperBack, initial="simple", h=1)
summary(PaperBackHolt)
##
## Forecast method: Holt's method
##
## Model Information:
## Holt's method
##
## Call:
## holt(y = PaperBack, h = 1, initial = "simple")
##
## Smoothing parameters:
## alpha = 0.2984
## beta = 0.4984
##
## Initial states:
## l = 199
## b = -27
##
## sigma: 39.5463
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 7.769844 39.54634 33.5377 1.633306 18.19621 0.8457332
## ACF1
## Training set -0.1088681
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 31 222.0201 171.3394 272.7007 144.5107 299.5295
The simple exponential smoothing model with the parameter initial=“optimal” exhibits the range from 141 to 273. The Holt’s method shows 145 to 300.
Let’s do the same for Hardcover time series:
HardCoverSESOpt <- ses(Hardcover, initial="optimal", h=1)
summary(HardCoverSESOpt)
##
## Forecast method: Simple exponential smoothing
##
## Model Information:
## Simple exponential smoothing
##
## Call:
## ses(y = Hardcover, h = 1, initial = "optimal")
##
## Smoothing parameters:
## alpha = 0.3283
##
## Initial states:
## l = 149.2836
##
## sigma: 31.931
##
## AIC AICc BIC
## 315.8506 316.7737 320.0542
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 9.166918 31.93101 26.7731 2.636328 13.39479 0.7987858
## ACF1
## Training set -0.1417817
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 31 239.5602 198.639 280.4815 176.9766 302.1439
HardCoverHolt <- holt(Hardcover, initial="simple", h=1)
summary(HardCoverHolt)
##
## Forecast method: Holt's method
##
## Model Information:
## Holt's method
##
## Call:
## holt(y = Hardcover, h = 1, initial = "simple")
##
## Smoothing parameters:
## alpha = 0.439
## beta = 0.1574
##
## Initial states:
## l = 139
## b = -11
##
## sigma: 35.0438
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 7.193267 35.04383 27.99174 2.423793 14.18241 0.8351445
## ACF1
## Training set -0.07743714
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 31 250.7889 205.8784 295.6993 182.1042 319.4735
The simple exponential smoothing model with the parameter initial=“optimal” exhibits the range from 177 to 302. The Holt’s method shows 182 to 319.