Chapter 9 - Neural Networks
Ashley Chase
April 27, 2017
library(forecast)## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric## Loading required package: timeDate## This is forecast 7.3library(caret)## Warning: package 'caret' was built under R version 3.3.3## Loading required package: lattice## Loading required package: ggplot2library(readxl)
AustralianWines <- read_excel("~/rProjects/Assignment_8/AustralianWines.xlsx")Question 1
I would consider using neural networks for this task because there could be more complicated patterns within the data that are not easily detected. Wine sales are not like ice cream sales for example, where temperature plays a major role in sales and aids in forecasting future ice cream sales. Wine sales could be affected by various attributes, which complicate pattern recognition; neural networks could be used to identify these patterns using layering. Also, wine sale data can be recorded on a high frequency basis (hourly or daily) which would increase the accuracy of a neural network as opposed to use low frequency data.
Question 2
First, display the time series…
# Create a time series object out of it
wineTS <- ts(AustralianWines$Fortified, start=c(1980, 1), frequency=12)
yrange = range(wineTS)
# Set up the plot
plot(c(1980, 1995), yrange, type="n", main = "Fortified Wine Sales", xlab="Year", ylab="Sales ($)", bty="l", xaxt="n", yaxt="n")
# Add the time series wine
lines(wineTS, bty="l")
# Add the x-axis
axis(1, at=seq(1980,1995,1), labels=format(seq(1980,1995,1)))
# Add the y-axis
axis(2, at=seq(1000,6000,500), las=2)
A)
Below is the time plot for the actual and forecasted series over the training and validation periods, along with the plot for forecast errors.
# Set the validation and training period lengths
validLength <- 12
trainLength <- length(wineTS) - validLength
# Partition the time series into training and validation periods.
wineTrain <- window(wineTS, end=c(1993, validLength))
wineValid <- window(wineTS, start=c(1993,validLength+1))
# Use nnetar to fit the neural network.
# Use parameter p=11
# This parameter will include 11 non-seasonal lags
# By default it will use P=1 (1 seasonal lag)
set.seed(227)
wineNN <- nnetar(wineTrain, p=11)
# See what what it looks like
wineNN## Series: wineTrain
## Model: NNAR(11,1,6)[12]
## Call: nnetar(y = wineTrain, p = 11)
##
## Average of 20 networks, each of which is
## a 12-6-1 network with 85 weights
## options were - linear output units
##
## sigma^2 estimated as 5890# Make predications
wineNN.pred <- forecast(wineNN, h = validLength)
# View accuracy of predictions
accuracy(wineNN.pred, wineValid)## ME RMSE MAE MPE MAPE
## Training set -0.6090169 76.74597 59.36259 -0.2592981 2.136517
## Test set 151.1756784 304.45191 244.44397 4.5804373 11.344995
## MASE ACF1 Theil's U
## Training set 0.2133377 0.02309619 NA
## Test set 0.8784846 -0.10732151 0.6476594# Set up the plot
plot(wineTrain, ylim = c(1000, 6000), main = "Fortified Wine Sales", ylab = "Sales ($)", xlab = "Year", bty = "l", xaxt = "n", xlim =c(1980,1995), lty = 1)
axis(1, at = seq(1980,2005,1), labels = format(seq(1980,2005,1)))
# Add lines
lines(wineNN.pred$fitted, lwd = 2, col = "red")
lines(wineNN.pred$mean, lwd = 2, col = "red", lty = 2)
lines(wineValid)
# Add line to separte the training period from the validation period and include labels
abline(v = 1994, col = "black", lty = 1, lwd = 1)
abline(h = 6000, col = "black", lty = 2, lwd = 1)
mtext("Training", line = -.5, at = c(1986,6500))
mtext("Validation", line = -.5, at = c(1995.25,6500))
Interpretation of plot: Looking at the residuals plot below, you notice a wave pattern in the data; this indicates that trend was not captured well in our model or at least not as good as it could have been. The highs and lows show that the model over predicts during some periods and under predicts at other times.
# Plot the errors for the trianing period
plot(wineNN.pred$residuals, main = "Residual Plot for Training Period")
B)
The output for 1994 predictions are printed below:
# Output of 1994 predictions
wineNN.pred## Jan Feb Mar Apr May Jun Jul
## 1994 1529.958 1451.431 1780.471 2051.525 2161.742 2281.665 2504.856
## Aug Sep Oct Nov Dec
## 1994 2477.169 2226.127 2016.483 2244.395 2458.071Question 3
A)
Allowing R to auto-select the best Holt-Winter’s exponential smoothing model results in a M, A, M model indicating multiplicative error, additive trend and multiplicative seasonality.
# Apply Holt-Winter's exponential smoothing
wineETS <- ets(wineTrain, model="ZZZ", restrict=FALSE)
# see what it found
wineETS## ETS(M,A,M)
##
## Call:
## ets(y = wineTrain, model = "ZZZ", restrict = FALSE)
##
## Smoothing parameters:
## alpha = 0.0555
## beta = 9e-04
## gamma = 1e-04
##
## Initial states:
## l = 4040.0811
## b = -6.7983
## s=1.1316 1.0399 0.8877 0.9505 1.2722 1.3862
## 1.1463 1.1097 0.9345 0.8513 0.6996 0.5903
##
## sigma: 0.0859
##
## AIC AICc BIC
## 2755.038 2759.118 2808.145B)
Below are the forcasted sales for 1994 using the MAM exponential smoothing model generated above.
# Generate the forecasts
wineForecast <- forecast(wineETS, h=validLength)
# See what the forecasts look like
wineForecast## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 1994 1289.829 1147.913 1431.745 1072.788 1506.871
## Feb 1994 1521.475 1353.802 1689.148 1265.041 1777.909
## Mar 1994 1842.645 1639.237 2046.054 1531.559 2153.732
## Apr 1994 2013.011 1790.409 2235.614 1672.571 2353.452
## May 1994 2379.117 2115.554 2642.679 1976.033 2782.201
## Jun 1994 2445.906 2174.435 2717.376 2030.728 2861.083
## Jul 1994 2943.532 2616.195 3270.870 2442.913 3444.151
## Aug 1994 2688.471 2388.895 2988.047 2230.309 3146.633
## Sep 1994 1998.782 1775.592 2221.971 1657.443 2340.120
## Oct 1994 1857.773 1649.880 2065.666 1539.829 2175.717
## Nov 1994 2165.635 1922.749 2408.521 1794.173 2537.097
## Dec 1994 2344.995 2081.384 2608.606 1941.836 2748.153C)
It looks as though the neural network outperformed the ETS model on the training set, however the ETS model performs slightly better in the validation period.
The tables below summarize the performance metrics of each model for the training and validation periods:
Training Period
| Metric | Neural Network | ETS Model | Who Outperformed? |
|---|---|---|---|
| ME | -0.61 | -25.32 | Neural Network |
| RMSE | 76.75 | 287.87 | Neural Network |
| MAE | 59.36 | 224.65 | Neural Network |
| MPE | -0.26% | -1.32% | Neural Network |
| MAPE | 2.14% | 7.23% | Neural Network |
Validation Period
| Metric | Neural Network | ETS Model | Who Outperformed? |
|---|---|---|---|
| ME | 151.18 | 125.57 | ETS |
| RMSE | 304.45 | 328.92 | Neural Network |
| MAE | 244.44 | 256.39 | Neural Network |
| MPE | 4.58% | 4.44% | ETS |
| MAPE | 11.34% | 10.86% | ETS |
You can visually compare the two models in the plot below. It would be difficult to choose between these two models at this point. I would like to test other ETS models to see if we could get a better fit for the validation period.
# Print performance measure from ETS model
accuracy(wineForecast, wineValid)## ME RMSE MAE MPE MAPE MASE
## Training set -25.32466 287.8687 224.6507 -1.317643 7.229271 0.8073515
## Test set 125.56906 328.9246 256.3940 4.443793 10.858860 0.9214307
## ACF1 Theil's U
## Training set 0.05168201 NA
## Test set -0.01105575 0.7140459# Set up the plot
plot(c(1994, 1995), c(1000,3500), type="n", main = "Prediction Comparison", xlab="Year - 1994", ylab="Sales ($)", bty="l", xaxt="n", yaxt="n")
# Add the time series air
lines(wineValid, bty="l")
# Add the x-axis
axis(1, at=seq(1994,1995,1/11), labels=c("Jan","Feb","Mar","Apr","May","Jun","Jul", "Aug","Sep","Oct","Nov","Dec"))
# Add the y-axis
axis(2, at=seq(1000,3500,500), labels=format(seq(1000,3500,500)), las=2)
# Add the forecasts from the neural network
lines(wineNN.pred$mean, col="red", lwd=2)
# Add the forecasts from the ets model
lines(wineForecast$mean, col="blue", lty=2)
# Add the legend
legend(1994, 3500, c("Actual Wine Sales", "Neural Network", "Smoothing"), lty=c(1,1,2), col=c("black", "red", "blue"), lwd=c(1,2,1), bty="n")