PA Discussion 2
Cameron Turner
2024-03-20
Predictive Analytics Discussion 2: ETS Models
Setup
# Clear the workspace
rm(list = ls()) # Clear environment
gc() # Clear unused memory## used (Mb) gc trigger (Mb) limit (Mb) max used (Mb)
## Ncells 521271 27.9 1154700 61.7 NA 669291 35.8
## Vcells 958634 7.4 8388608 64.0 16384 1840004 14.1 cat("\f") # Clear the console dev.off # Clear the charts## function (which = dev.cur())
## {
## if (which == 1)
## stop("cannot shut down device 1 (the null device)")
## .External(C_devoff, as.integer(which))
## dev.cur()
## }
## <bytecode: 0x7fd803f3cd50>
## <environment: namespace:grDevices>#make vector containing the packages
packages <- c("ggplot2",
"knitr",
"fpp3",
"forecast",
"dplyr",
"fable")
#Install packages
for (i in 1:length(packages)) {# Iterate through each package in the 'packages' vector.
if (!packages[i] %in% rownames(installed.packages())) {#check if package is installed
install.packages(packages[i], #install package if it isn't already
repos = "http://cran.rstudio.com/",
dependencies = TRUE)}
library(packages[i], character.only = TRUE)} # Load the package into the R session.## ── Attaching packages ────────────────────────────────────────────── fpp3 0.5 ──## ✔ tibble 3.2.1 ✔ tsibbledata 0.4.1
## ✔ dplyr 1.1.1 ✔ feasts 0.3.2
## ✔ tidyr 1.3.0 ✔ fable 0.3.3
## ✔ lubridate 1.9.2 ✔ fabletools 0.4.1
## ✔ tsibble 1.1.4## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date() masks base::date()
## ✖ dplyr::filter() masks stats::filter()
## ✖ tsibble::intersect() masks base::intersect()
## ✖ tsibble::interval() masks lubridate::interval()
## ✖ dplyr::lag() masks stats::lag()
## ✖ tsibble::setdiff() masks base::setdiff()
## ✖ tsibble::union() masks base::union()## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo# Remove unnecessary values from environment
rm(i,packages)
### Data related
# Import the data
unem <- read.csv("/Users/cam/Desktop/PREDICTIVE ANALYTICS/Discussions/Data/UNRATE.csv")
# Adjust variable formats
unem$DATE <- as.Date(unem$DATE)
unem <- unem %>%
filter(DATE >= '2000-01-01')Observing the Data - US Unemployment Rate
The dataset used in this discussion comes from FRED and contains monthly data from 1948 to Feb 2024. The data has since been filtered to start January 2000
# Show summary stats
summary(unem)## DATE UNRATE
## Min. :2000-01-01 Min. : 3.400
## 1st Qu.:2006-01-08 1st Qu.: 4.300
## Median :2012-01-16 Median : 5.200
## Mean :2012-01-15 Mean : 5.750
## 3rd Qu.:2018-01-24 3rd Qu.: 6.675
## Max. :2024-02-01 Max. :14.800#Show head of table
head(unem)## DATE UNRATE
## 1 2000-01-01 4.0
## 2 2000-02-01 4.1
## 3 2000-03-01 4.0
## 4 2000-04-01 3.8
## 5 2000-05-01 4.0
## 6 2000-06-01 4.0# Show plot of data
ggplot(unem, aes(x = DATE, y = UNRATE)) +
geom_line() +
labs(x = "Date",
y = "Unemployment Rate (%)",
title = "US Unemployment Rate")
Modeling
# Create time series obj
unem_ts <- ts(unem$UNRATE,
start = c(2000,1), #start year, start month
frequency = 12)Model 1: A,N,N
Looking at the graph above, there is no clear trend or seasonality to unemployment. There appear to appear be occassional spikes in unemployment followed by a gradual decline towards 4% Thus, A,N,N seemed like the logical first model.
# Conduct ANN
ANN <- ets(unem_ts, model = "ANN")
# Show summary of model
summary(ANN)## ETS(A,N,N)
##
## Call:
## ets(y = unem_ts, model = "ANN")
##
## Smoothing parameters:
## alpha = 0.9999
##
## Initial states:
## l = 4.0021
##
## sigma: 0.6697
##
## AIC AICc BIC
## 1415.729 1415.813 1426.738
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -0.0003522278 0.6673947 0.1838038 -0.2574648 2.781142 0.167918
## ACF1
## Training set 0.02114344# Show decomposition
autoplot(ANN)
# Forecast from model
ANN_f <- forecast(ANN, h = 12)
autoplot(unem_ts) +
autolayer(ANN_f)
Model 2: A,A,A
Despite no clear trend or seasonality, it seemed ideal that the second model should at least humor the idea that some exists. Given the shape of the plot, it seemed logical that the additive method should be more accurate.
# Conduct AAN
AAA <- ets(unem_ts, model = "AAA")
# Show summary of model
summary(AAA)## ETS(A,A,A)
##
## Call:
## ets(y = unem_ts, model = "AAA")
##
## Smoothing parameters:
## alpha = 0.9999
## beta = 1e-04
## gamma = 1e-04
##
## Initial states:
## l = 3.7196
## b = -0.0134
## s = -0.1024 -0.0559 -0.05 -0.0342 -0.0114 0.0248
## 0.0568 0.132 0.2501 -0.0619 -0.0379 -0.1099
##
## sigma: 0.6752
##
## AIC AICc BIC
## 1434.039 1436.289 1496.427
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 0.01378502 0.6563378 0.2057707 0.02502069 3.242582 0.1879864
## ACF1
## Training set 0.02439113# Show decomposition
autoplot(AAA)
# Forecast from model
AAA_f <- forecast(AAA, h = 12)
autoplot(unem_ts) +
autolayer(AAA_f)
Conclusion
The range of predicted values appeared to be near identical between ANN and AAA, but there was a key difference. While ANN predicted unemployment would stay the same, AAA predicted a decline in the unemployment rate. I believe that this is the case for AAA because unemployment rate usually moves downward and, thus, there may be a negative sloping trend within this data. This might be accurate for predicting the rest of 2024 as it is an election year and there will likely be much focus from the current administration to keep unemployment low (although this is not accounted for in the model. ANN seems like it would generally be the ideal prediction because, as the data shows, unemployment is generally pushed towards the level at which it is currently sitting. Thus, all else equal, it should make sense that there would be no changes in unemployment.