library(tidyr)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(knitr)
library(utils)
library(ggplot2)
library(forecast)
library(readxl)
library(fpp2)
## Loading required package: fma
## Loading required package: expsmooth
usnetelec_lambda <- BoxCox.lambda(usnetelec)
paste("Appropirate Box-Cox Transformation is", usnetelec_lambda)
## [1] "Appropirate Box-Cox Transformation is 0.516771443964645"
autoplot(BoxCox(usnetelec,usnetelec_lambda))
usgdp_lambda <- BoxCox.lambda(usgdp)
paste("Appropirate Box-Cox Transformation is", usgdp_lambda)
## [1] "Appropirate Box-Cox Transformation is 0.366352049520934"
autoplot(BoxCox(usgdp,usgdp_lambda))
mcopper_lambda <- BoxCox.lambda(mcopper)
paste("Appropirate Box-Cox Transformation is", mcopper_lambda)
## [1] "Appropirate Box-Cox Transformation is 0.191904709003829"
autoplot(BoxCox(mcopper,mcopper_lambda))
enplanements_lambda <- BoxCox.lambda(enplanements)
paste("Appropirate Box-Cox Transformation is", enplanements_lambda)
## [1] "Appropirate Box-Cox Transformation is -0.226946111237065"
autoplot(BoxCox(enplanements,enplanements_lambda))
cangas_lambda <- BoxCox.lambda(cangas)
paste("Appropirate Box-Cox Transformation is", cangas_lambda)
## [1] "Appropirate Box-Cox Transformation is 0.576775938228139"
autoplot(BoxCox(cangas,cangas_lambda))
autoplot(cangas)
A good value of labda is one which makes the size of the seasonal vaariation about the same across the whole series.
Read Retail Data
retaildata <- readxl::read_excel("retail2.xlsx", skip=1)
head(retaildata)
## # A tibble: 6 x 190
## `Series ID` A3349335T A3349627V A3349338X A3349398A A3349468W
## <dttm> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1982-04-01 00:00:00 303. 41.7 63.9 409. 65.8
## 2 1982-05-01 00:00:00 298. 43.1 64 405. 65.8
## 3 1982-06-01 00:00:00 298 40.3 62.7 401 62.3
## 4 1982-07-01 00:00:00 308. 40.9 65.6 414. 68.2
## 5 1982-08-01 00:00:00 299. 42.1 62.6 404. 66
## 6 1982-09-01 00:00:00 305. 42 64.4 412. 62.3
## # ... with 184 more variables: A3349336V <dbl>, A3349337W <dbl>,
## # A3349397X <dbl>, A3349399C <dbl>, A3349874C <dbl>, A3349871W <dbl>,
## # A3349790V <dbl>, A3349556W <dbl>, A3349791W <dbl>, A3349401C <dbl>,
## # A3349873A <dbl>, A3349872X <dbl>, A3349709X <dbl>, A3349792X <dbl>,
## # A3349789K <dbl>, A3349555V <dbl>, A3349565X <dbl>, A3349414R <dbl>,
## # A3349799R <dbl>, A3349642T <dbl>, A3349413L <dbl>, A3349564W <dbl>,
## # A3349416V <dbl>, A3349643V <dbl>, A3349483V <dbl>, A3349722T <dbl>,
## # A3349727C <dbl>, A3349641R <dbl>, A3349639C <dbl>, A3349415T <dbl>,
## # A3349349F <dbl>, A3349563V <dbl>, A3349350R <dbl>, A3349640L <dbl>,
## # A3349566A <dbl>, A3349417W <dbl>, A3349352V <dbl>, A3349882C <dbl>,
## # A3349561R <dbl>, A3349883F <dbl>, A3349721R <dbl>, A3349478A <dbl>,
## # A3349637X <dbl>, A3349479C <dbl>, A3349797K <dbl>, A3349477X <dbl>,
## # A3349719C <dbl>, A3349884J <dbl>, A3349562T <dbl>, A3349348C <dbl>,
## # A3349480L <dbl>, A3349476W <dbl>, A3349881A <dbl>, A3349410F <dbl>,
## # A3349481R <dbl>, A3349718A <dbl>, A3349411J <dbl>, A3349638A <dbl>,
## # A3349654A <dbl>, A3349499L <dbl>, A3349902A <dbl>, A3349432V <dbl>,
## # A3349656F <dbl>, A3349361W <dbl>, A3349501L <dbl>, A3349503T <dbl>,
## # A3349360V <dbl>, A3349903C <dbl>, A3349905J <dbl>, A3349658K <dbl>,
## # A3349575C <dbl>, A3349428C <dbl>, A3349500K <dbl>, A3349577J <dbl>,
## # A3349433W <dbl>, A3349576F <dbl>, A3349574A <dbl>, A3349816F <dbl>,
## # A3349815C <dbl>, A3349744F <dbl>, A3349823C <dbl>, A3349508C <dbl>,
## # A3349742A <dbl>, A3349661X <dbl>, A3349660W <dbl>, A3349909T <dbl>,
## # A3349824F <dbl>, A3349507A <dbl>, A3349580W <dbl>, A3349825J <dbl>,
## # A3349434X <dbl>, A3349822A <dbl>, A3349821X <dbl>, A3349581X <dbl>,
## # A3349908R <dbl>, A3349743C <dbl>, A3349910A <dbl>, A3349435A <dbl>,
## # A3349365F <dbl>, A3349746K <dbl>, ...
Set as Time Series
myts <- ts(retaildata[,"A3349338X"],
frequency=12, start=c(1982,4))
Autoplot
autoplot(myts)+ggtitle("Autoplot of A3349338X Sales")
## Warning in is.na(main): is.na() applied to non-(list or vector) of type
## 'NULL'
ggseasonplot(myts)+ggtitle("Seasonal Plot of A3349338X Sales")
## Warning in is.na(ylab): is.na() applied to non-(list or vector) of type
## 'NULL'
ggsubseriesplot(myts)+ggtitle("Subseries of A3349338X Sales")
gglagplot(myts)+ggtitle("Lag Plot of A3349338X Sales")
## Warning in is.na(xlab): is.na() applied to non-(list or vector) of type
## 'NULL'
## Warning in is.na(ylab): is.na() applied to non-(list or vector) of type
## 'NULL'
ggAcf(myts)+ggtitle("Autocorrelation Function of A3349338X Sales")
retail_lambda <- BoxCox.lambda(myts)
paste("Appropirate Box-Cox Transformation is", retail_lambda)
## [1] "Appropirate Box-Cox Transformation is -0.253607807164125"
autoplot(BoxCox(myts,retail_lambda))
autoplot(myts)
The reail data could use a Box-Cox transformation of -0.253.
Split the data into two parts using
myts.train <- window(myts, end=c(2010,12))
myts.test <- window(myts, start=2011)
Check that your data have been split appropriately by producing the following plot.
autoplot(myts) +
autolayer(myts.train, series="Training") +
autolayer(myts.test, series="Test")
## Warning in is.na(main): is.na() applied to non-(list or vector) of type
## 'NULL'
Calculate forecasts using snaive applied to myts.train.
fc <- snaive(myts.train)
Compare the accuracy of your forecasts against the actual values stored in myts.test.
accuracy(fc,myts.test)
## ME RMSE MAE MPE MAPE MASE
## Training set 5.502402 27.74935 19.33784 3.369450 10.447161 1.000000
## Test set -10.845833 24.12202 18.52083 -5.910245 9.201624 0.957751
## ACF1 Theil's U
## Training set 0.8703252 NA
## Test set 0.3564215 0.9855325
Check the residuals.
checkresiduals(fc)
##
## Ljung-Box test
##
## data: Residuals from Seasonal naive method
## Q* = 1256.8, df = 24, p-value < 2.2e-16
##
## Model df: 0. Total lags used: 24
The residuals look like it is normally distributed. There also seems to be a correlation among the residuals. The forecast may not be good.