Mod 12: Time Series

• Show All Code
• Hide All Code

Set environment

env <- c("tidyverse","forecast")
lapply(env, library, character.only = 1)

The credit card charges data

A quick EDA of the data.

visa <- c(31.9,27,31.3,31,39.4,40.7,42.3,49.5,45,50,50.9,58.5,39.4,
            36.2,40.5,44.6,46.8,44.7,52.2,54,48.8 ,55.8,58.7,63.4)
visaTS <- ts(visa, frequency=12, start=c(2018,1) )
visaTS

##       Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
## 2018 31.9 27.0 31.3 31.0 39.4 40.7 42.3 49.5 45.0 50.0 50.9 58.5
## 2019 39.4 36.2 40.5 44.6 46.8 44.7 52.2 54.0 48.8 55.8 58.7 63.4

summary( visaTS )

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   27.00   39.40   44.85   45.11   51.23   63.40

autoplot( visaTS )

Apply smoothing

We will use simple exponential smoothing by using the HoltWinters function. The EDA hinted at an intuitive seasonal pattern where more charges occur during the typical holiday seasons so, we’ll “turn on” the gamma argument.

visaXMA <- HoltWinters(visaTS, beta=FALSE, gamma=TRUE)
visaXMA

## Holt-Winters exponential smoothing without trend and with additive seasonal component.
## 
## Call:
## HoltWinters(x = visaTS, beta = FALSE, gamma = TRUE)
## 
## Smoothing parameters:
##  alpha: 0.7968385
##  beta : FALSE
##  gamma: TRUE
## 
## Coefficients:
##           [,1]
## a    50.969996
## s1   -5.935159
## s2  -10.380978
## s3   -6.609654
## s4   -2.935796
## s5   -1.273913
## s6   -3.904898
## s7    1.003746
## s8    6.025743
## s9    1.427207
## s10   6.198728
## s11   6.355076
## s12  12.430004

autoplot( visaXMA$x, size=1 ) +
    autolayer( visaXMA$fitted, color="Red" ) +
    labs(title = "Visa Charges",
         subtitle = "(With HoltWinter Seasonal Smoothing)",
         x = "Year", y = "Charges $" ) +
    theme_classic() + 
    theme(legend.position = "none") +
    theme( plot.title = element_text(hjust=0.5),
           plot.subtitle = element_text(hjust=0.5, color="Red"),
           axis.title.x = element_text(vjust=-1),
           axis.title.y = element_text(angle = 0, vjust=0.5)
           )

Forecasting

Let’s forecast the next 12 months using a confidence level of 50%, 75%, and 90%.

visaFC <- forecast(visaXMA, h=12, level=c(50,75,90) )
visaFC

##          Point Forecast    Lo 50    Hi 50    Lo 75    Hi 75    Lo 90    Hi 90
## Jan 2020       45.03484 43.39425 46.67542 42.23680 47.83287 41.03400 49.03567
## Feb 2020       40.58902 38.49128 42.68676 37.01130 44.16673 35.47334 45.70470
## Mar 2020       44.36034 41.88860 46.83208 40.14477 48.57592 38.33260 50.38808
## Apr 2020       48.03420 45.23805 50.83035 43.26533 52.80307 41.21532 54.85308
## May 2020       49.69608 46.60942 52.78274 44.43175 54.96041 42.16876 57.22340
## Jun 2020       47.06510 43.71302 50.41718 41.34809 52.78211 38.89050 55.23969
## Jul 2020       51.97374 48.37577 55.57172 45.83736 58.11013 43.19949 60.74799
## Aug 2020       56.99574 53.16763 60.82385 50.46686 63.52462 47.66027 66.33121
## Sep 2020       52.39720 48.35203 56.44237 45.49812 59.29628 42.53239 62.26201
## Oct 2020       57.16872 52.91756 61.41989 49.91832 64.41913 46.80157 67.53588
## Nov 2020       57.32507 52.87745 61.77270 49.73960 64.91054 46.47881 68.17133
## Dec 2020       63.40000 58.76423 68.03577 55.49365 71.30635 52.09492 74.70508

autoplot( visaFC ) +
    labs(title = "Charge Prediction for 2020",
         subtitle = "(50%, 75%, 90%)", x = "Year", y = "Charges $" ) +
    theme_classic() + 
    theme(legend.position = "none") +
    theme( plot.title = element_text(hjust=0.5),
           plot.subtitle = element_text(hjust=0.5, color="Blue"),
           axis.title.x = element_text(vjust=-1),
           axis.title.y = element_text(angle = 0, vjust=0.5)
           )

GitHub

Related file(s) can be found at Git Me