R Markdown

Go to Data Market (https://datamarket.com/data/list/?q=cat:ecc%20provider:tsdl (Links to an external site.)Links to an external site.). Pick a time series of interest to you. For the time series data you selected, use neural nets to build forecasts. Interpret.

For this weeks discussion I used the Personal Savings as Percentage of Disposable Income data from 1955-1980. I constructed both a neural net and ARIMA model for comparison, using both nnetar() and auto.arima() functions. The neural net model has better ME, RMSE, MAE, MPE, MAPE, and MASE statistics than the ARIMA model.

#Load Library
library(readxl)
library(forecast)
## Warning: package 'forecast' was built under R version 3.4.2
## Warning in as.POSIXlt.POSIXct(Sys.time()): unknown timezone 'zone/tz/2018c.
## 1.0/zoneinfo/America/New_York'
library(fpp)
## Loading required package: fma
## Loading required package: expsmooth
## Loading required package: lmtest
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## Loading required package: tseries
library(caret)
## Warning: package 'caret' was built under R version 3.4.3
## Loading required package: lattice
## Loading required package: ggplot2
dataset <- read_excel("~/Desktop/personal-savings-as-of-disposabl.xls")

Create Time Series

In the time series plot below we can see that savings decreases drastically after 1976.

myts=ts(dataset[,2],frequency=4,start=c(1955,1),end=c(1980,4))
plot(myts, xlab= "Time", ylab= "Savings Percent", main="Personal savings as % of disposable income 1955-1980")

Create 80% Training set, 20% Test.

train=ts(dataset[1:84,2],frequency=4 ,start=c(1955,1), end=c(1975,4))
plot(train, xlab= "Time", ylab= "Savings Percent", main="Personal savings as % of disposable income 1955-1975")

test=ts(dataset[85:104,2],frequency=4 ,start=c(1976,1), end=c(1980,4))
plot(test, xlab= "Time", ylab= "Savings Percent", main="Personal savings as % of disposable income 1976-1980")

Forecast the next 4 years usinf neural network autoregression

#NNAR(5,1,3)[4] 
fit=nnetar(train)
fit 
## Series: train 
## Model:  NNAR(5,1,3)[4] 
## Call:   nnetar(y = train)
## 
## Average of 20 networks, each of which is
## a 5-3-1 network with 22 weights
## options were - linear output units 
## 
## sigma^2 estimated as 0.1389
hist(residuals(fit))

fcast=forecast(fit, h=20)
plot(fcast, xlab= "Time", ylab= "Savings Percent")
lines(test,col="green")

net_accuracy=accuracy(fcast,test)
net_accuracy
##                         ME      RMSE       MAE         MPE      MAPE
## Training set -0.0004955841 0.3726467 0.2819542  -0.5350996  4.554644
## Test set     -1.2754948802 1.8015248 1.6132271 -28.7123651 32.434198
##                   MASE        ACF1 Theil's U
## Training set 0.2888136 0.007689208        NA
## Test set     1.6524733 0.630431427  2.216455

Forecast the next 4 years using ARIMA

#ARIMA(1,1,1)(1,0,2)[4] 
fit2=auto.arima(train)
fit2
## Series: train 
## ARIMA(1,1,1)(1,0,2)[4] 
## 
## Coefficients:
##           ar1     ma1     sar1    sma1     sma2
##       -0.7805  0.5817  -0.5923  0.2425  -0.5290
## s.e.   0.2263  0.2636   0.1806  0.1852   0.1234
## 
## sigma^2 estimated as 0.3115:  log likelihood=-67.92
## AIC=147.85   AICc=148.95   BIC=162.36
hist(residuals(fit2))

fcast2=forecast(fit2, h=20)
plot(fcast2, xlab= "Time", ylab= "Presonal Savings as %")
lines(test,col="green")

net_accuracy2=accuracy(fcast2,test)
net_accuracy2
##                       ME      RMSE      MAE         MPE      MAPE
## Training set  0.06304994 0.5378504 0.428993   0.4328396  6.784321
## Test set     -1.76328845 2.2068438 2.018348 -38.0111791 40.763798
##                   MASE       ACF1 Theil's U
## Training set 0.4394295 0.01044375        NA
## Test set     2.0674502 0.63395047  2.703424