Neural Nets - Week 7 Discussion
Timothy White
4/26/2022
The University of Michigan’s Consumer Sentiment Index offers a view into the attitudes of the consumer segment of GDP and serves as a signal, among others, of the health of the US economy. Therefore, being able to forecast the index with some level of predictive accuracy would offer some potentially useful insights into the direction of economic activity in the US. Of note, this write-up is connected to a similar one in which ARIMA and GARCH models are explored as potentially useful forecasting techniques (https://rpubs.com/twhite1992/ADEC7460_W6A1)
In this work, neural net models were constructed to compare against the previous work in which GARCH modeling provided the best results at forecasting future Consumer Sentiment values. A plot of the training time series is shown below.
Two neural net models were auto-generated, one with the square-root of consumer sentiment as the response variable and the other with the non-transformed value as the response. A summary of the models is below:
- NNAR(1,1,2)[12], transformed and non-transformed response - This model uses the prior months value and the value from 12 months ago to predict the next value of the square-root of the Consumer Sentiment Index. The value of \(2\) in the model configuration indicates there are two hidden nodes as part of the model.
The plotted results of the models’ forecasts are shown below, along with a table summarizing each model’s performance on the test dataset (106 future observations). For comparison purposes, the forecasts generated by a GARCH(1,1) model (see other RPubs post) are in a plot beside those generated under the neural net models. Generally, the forecasts demonstrate similar predicitve accuracy; although, the GARCH(1,1) model continues to best demonstrate the volatility in the Consumer Sentiment Index.
RMSE results are below for the neural net models and the GARCH(1,1) model, once again for comparison purposes. Overall, the neural net model on the non-transformed data performed the best with \(RMSE = 12.1\) vs. \(12.6\) for the neural net model on the transformed data and the GARCH(1,1) model.
| .model | RMSE | MAE | MPE | MAPE |
|---|---|---|---|---|
| NN_reg | 12.00182 | 10.84210 | 7.358747 | 12.05050 |
| NN_sqrt | 12.71878 | 11.47472 | 8.412090 | 12.68718 |
## [1] "RMSE of GARCH(1,1) model, Simulated Average: 12.58"R Code
knitr::opts_chunk$set(echo = FALSE)
local({
hook_source <- knitr::knit_hooks$get('source')
knitr::knit_hooks$set(source = function(x, options) {
x <- x[!grepl('# SECRET!!$', x)]
hook_source(x, options)
})
})
#INVOKE APPROPRIATE LIBRARIES
library("feasts")
library("seasonal")
library("tsibble")
library("tsibbledata")
library("dplyr")
library("ggplot2")
library("forecast")
library("fable")
library("fpp3")
library("sqldf")
library("psych")
library("PerformanceAnalytics")
library("car")
library("kableExtra")
library("glmnet")
library("ISLR")
library("leaps")
#For GARCH Modeling
library("lubridate")
library("quantmod")
library("xts")
library("rugarch")
#INVOKE APPROPRIATE LIBRARIES
library("feasts")
library("seasonal")
library("tsibble")
library("tsibbledata")
library("dplyr")
library("ggplot2")
library("forecast")
library("fable")
library("fpp3")
library("sqldf")
library("psych")
library("PerformanceAnalytics")
library("car")
library("kableExtra")
library("glmnet")
library("ISLR")
library("leaps")
library("lubridate")
library("quantmod")
library("xts")
library("rugarch")
#Import Consumer Sentiment Data (University of Michigan...UMCSENT)
csent_data <- read.csv(paste0(csv_path,
"CSENTIMENT.csv"))
csent_data_df <-
csent_data %>%
mutate(DATE = as.Date(DATE),
MONTH = yearmonth(DATE),
QTR = as.factor(yearquarter(DATE))) %>%
filter(DATE >= '1978-01-01') %>%
mutate(UMCSENT = as.numeric(UMCSENT)) %>%
data.frame() %>%
select(DATE,
QTR,
UMCSENT)
csent_data_df <-
csent_data_df %>%
mutate(UMCSENT_CHG = UMCSENT/lag(UMCSENT, 1L) - 1)
#Import Nominal GDP data -> explore potential relationship with CSENT and GDP
#Comparison will be at the level of changes in CSENT with changes in GDP
gdp_data <- read.csv(paste0(csv_path,
"GDP.csv"),
stringsAsFactors = TRUE)
gdp_data_df <-
gdp_data %>%
mutate(QTR = as.factor(yearquarter(as.Date(DATE))),
GDP = as.double(GDP),
GDP_CHG_PCT = (GDP/lag(GDP, n = 1L)-1)*100) %>%
filter(as.Date(DATE) >= '1978-01-01') %>%
data.frame() %>%
select(QTR,
GDP_CHG_PCT)
# gdp_data_df2 <-
# gdp_data_df %>%
# mutate(GDP_CHG82 = gdp_data_df2$GDP_CHG_PCT[gdp_data_df2$QTR == '1982 Q1'],
# GDP_IDX82 = abs(GDP_CHG_PCT)/abs(GDP_CHG82)*100)
#Combine Consumer Sentiment and GDP change data; convert to timeseries type
data_ts <- sqldf('
SELECT C.DATE
, C.QTR
, C.UMCSENT
, C.UMCSENT_CHG
, G.GDP_CHG_PCT AS QTR_GDP_CHG
FROM csent_data_df C
LEFT JOIN gdp_data_df G
ON G.QTR = C.QTR
')
data_ts2 <-
data_ts %>%
mutate(MONTH = yearmonth(DATE)) %>%
select(MONTH,
UMCSENT,
QTR_GDP_CHG,
UMCSENT_CHG) %>%
as_tsibble(index = MONTH)
train_end <- round(0.8*length(rownames(data_ts2)), 0)
test_start <- train_end + 1
test_end <- length(rownames(data_ts2))
data_ts_train <- data_ts2[1:train_end,]
data_ts_test <- data_ts2[test_start:test_end,]
#Plot of Consumer Sentiment values over time
data_ts_train %>%
autoplot(UMCSENT) +
labs(x = "Month",
y = "Level",
title = "Monthly Consumer Sentiment",
subtitle = "University of Michigan Compiled, 1982-1983 = 100") +
geom_line(aes(y = 100),
col = "red",
lty = "dashed")
#Neural Network of Consumer Sentiment Data
data_ts_NN <-
data_ts_train %>%
model(NN_sqrt = NNETAR(sqrt(UMCSENT)),
NN_reg = NNETAR(UMCSENT))
data_ts_NNfc <-
data_ts_NN %>%
forecast(h = length(rownames(data_ts_test)))
#NN Forecast Plot
data_ts_NNfc %>%
autoplot(data_ts2) +
labs(x = "Month",
y = "Level",
title = "Monthly Consumer Sentiment - w/ Forecast",
subtitle = "Neural Net Models") +
theme_classic()
#EXPLORE GARCH MODEL OPTIONS
#GARCH modeling
#ts format for garch modeling - not used until model construction
data_ts_train2 <-
data_ts_train %>%
filter(MONTH > yearmonth('1978-01-01')) %>%
select(MONTH,
UMCSENT_CHG) %>%
as.ts()
data_ts_test2 <-
data_ts_test %>%
select(MONTH,
UMCSENT_CHG) %>%
as.ts()
data_train_gspec <- ugarchspec(mean.model=list(armaOrder = c(1,1)))
data_train_gfit <- ugarchfit(data_train_gspec, data = data_ts_train2)
sfinal <- data_train_gspec
setfixed(sfinal) <- as.list(coef(data_train_gfit))
data_gfit_sim <- ugarchpath(spec = sfinal,
m.sim = 30,
n.sim = length(rownames(data_ts_test)),
rseed = 1234)
CSENT_fc_transform <- data_ts_train[length(rownames(data_ts_train)),]$UMCSENT *
apply(fitted(data_gfit_sim), 2, 'cumsum') +
data_ts_train[length(rownames(data_ts_train)),]$UMCSENT
CSENT_GARCH_sim <- data.frame(data_ts_test[,1],
CSENT_fc_transform)
sim_average <- c()
for(i in 1:length(rownames(CSENT_GARCH_sim))) {
vector_house <- as.vector(CSENT_fc_transform[i,])
sim_average[i] <- mean(vector_house)
}
CSENT_GARCH_simavg <- data.frame(data_ts_test[,1],
sim_average,
data_ts_test[,2],
(sim_average - data_ts_test[,2])^2)
colnames(CSENT_GARCH_simavg) <- c("MONTH", "sim_average", "UMCSENT", "SE")
ggplot(data = CSENT_GARCH_sim) +
geom_line(aes(x = MONTH,
y = X2),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X3),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X4),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X5),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X6),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X7),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X8),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X9),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X10),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X11),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X12),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X13),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X14),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X15),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X16),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X17),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X18),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X19),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X20),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X21),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X22),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X23),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X24),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X25),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X26),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X27),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X28),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X29),
col = "gray75") +
geom_line(aes(x = MONTH,
y = X30),
col = "gray75") +
geom_line(data = CSENT_GARCH_simavg,
aes(x = MONTH,
y = sim_average),
col = "black") +
geom_line(data = data_ts_train,
aes(x = MONTH,
y = UMCSENT),
col = "red") +
geom_line(data = data_ts_test,
aes(x = MONTH,
y = UMCSENT),
col = "red",
lty = "dashed") +
theme_classic() +
labs(x = "Month",
y = "Level",
title = "Monthly Consumer Sentiment - w/ Forecast",
subtitle = "University of Michigan, 1982-1983 = 100")
NN_fc_RMSE <- data_ts_NNfc %>%
accuracy(data_ts_test) %>% select(.model, RMSE:MAPE)
kable(NN_fc_RMSE) %>%
kable_styling(latex_options = "striped") %>%
kable_styling(latex_options = "HOLD_position")
print(paste("RMSE of GARCH(1,1) model, Simulated Average: ",
round(sqrt(mean(CSENT_GARCH_simavg$SE)), 2)))