Daniel RG

11/11/2020

Series: Consumer Price Index for All Urban Consumers: All Items in U.S. City Average (CPIAUCNS)

Source: FRED, Federal Reserve Bank of St. Louis

library(fpp2)
library(ggplot2)
library(ggthemes)
library(tidyverse)
library(kableExtra)

cpi <- read.csv("F:/MSAE/2020fall_PredictiveAnalytics/Discussions/CPIAUCNS.csv")
cpi <- cpi[order(cpi$DATE),]


cpits <- ts(cpi[,2],start=c(1980,1),end=c(2020,9),frequency=12)

cpits <- window(cpits,start=2000)

plot1 <- autoplot(cpits) + geom_line() +
  xlab("Year") + ylab("") + ggtitle("Consumer Price Index for All Urban Consumers (1982-1984 = 100)") + theme_classic()

plot1

plot2 <- ggseasonplot(cpits)

Decompositions

decadd <- decompose(cpits, type = "additive")
decmul <- decompose(cpits, type = "multiplicative")

autoplot(decadd)

autoplot(decmul)

Simple Exponential Smoothing

ses <- ses(cpits, h=39)

plotses <- autoplot(ses) + autolayer(ses$fitted)
plotses

sesacc <- data.frame(round(accuracy(ses),2))

kable(sesacc, caption = "Simple Exponential Smoothing") %>% 
  kable_classic(full_width = F)
Simple Exponential Smoothing
ME RMSE MAE MPE MAPE MASE ACF1
Training set 0.37 0.88 0.69 0.17 0.32 0.15 0.49

Holt-Winters Seasonal Method

hw1 <- hw(cpits, seasonal="additive", h=39)
hw2 <- hw(cpits, seasonal="multiplicative", h=39)

plothw1 <- autoplot(hw1) + autolayer(hw1$fitted)
plothw1

hw1acc <- data.frame(round(accuracy(hw1),2))

kable(hw1acc, caption = "Holt-Winters (additive)") %>% 
  kable_classic(full_width = F)
Holt-Winters (additive)
ME RMSE MAE MPE MAPE MASE ACF1
Training set 0.01 0.67 0.5 0.01 0.23 0.11 0.44 
plothw2 <- autoplot(hw2) + autolayer(hw2$fitted)
plothw2

hw2acc <- data.frame(round(accuracy(hw2),2))


kable(hw2acc, caption = "Holt-Winters (multiplicative)") %>% 
  kable_classic(full_width = F)
Holt-Winters (multiplicative)
ME RMSE MAE MPE MAPE MASE ACF1
Training set -0.01 0.96 0.69 -0.01 0.32 0.15 0.61

ETS

ets1 <- ets(cpits, model = "ZZZ")

summary(ets1)
## ETS(M,A,A) 
## 
## Call:
##  ets(y = cpits, model = "ZZZ") 
## 
##   Smoothing parameters:
##     alpha = 0.9998 
##     beta  = 0.077 
##     gamma = 2e-04 
## 
##   Initial states:
##     l = 169.7995 
##     b = 0.1814 
##     s = -1.4918 -0.5744 0.1962 0.5359 0.5175 0.6143
##            0.7896 0.6547 0.5216 0.1901 -0.7359 -1.2178
## 
##   sigma:  0.0031
## 
##      AIC     AICc      BIC 
## 1192.332 1194.982 1252.129 
## 
## Training set error measures:
##                      ME      RMSE       MAE         MPE      MAPE      MASE
## Training set 0.00823446 0.6548741 0.4654178 0.005077334 0.2160803 0.1030192
##                   ACF1
## Training set 0.4126148
autoplot(ets1)

ets1 %>% forecast(h=39) %>%
  autoplot() + autolayer(ts(ets1$fitted, start=c(2000,1),end=c(2020,9),frequency=12), series="Fitted Values")

kable(round(accuracy(ets1),2), caption = "ETS") %>% 
  kable_classic(full_width = F)
ETS
ME RMSE MAE MPE MAPE MASE ACF1
Training set 0.01 0.65 0.47 0.01 0.22 0.1 0.41

Selection Summary

c1 <- c("SES", "H-W (Additive)", "H-W (Multiplicative)", "ETS Selection (M,A,A)")
c2 <- c(ses$model$aic, hw1$model$aic, hw2$model$aic, ets1$aic)
c3 <- c(ses$model$aicc, hw1$model$aicc, hw2$model$aicc, ets1$aicc)
c4 <- c(ses$model$bic, hw1$model$bic, hw2$model$bic, ets1$bic)

table1 <- data.frame(c1,c2,c3,c4)
colnames(table1) <- c("Model", "AIC", "AICc", "BIC" )

kable(table1, caption = "Summary Table") %>% kable_classic()
Summary Table
Model AIC AICc BIC
SES 1315.865 1315.963 1326.418
H-W (Additive) 1208.652 1211.301 1268.449
H-W (Multiplicative) 1383.870 1386.519 1443.666
ETS Selection (M,A,A) 1192.332 1194.982 1252.129

The ETS Selection model has the lowest values of AIC, AICc and BIC, which suggest the better fit.