Feed-forward neural networks with a single hidden layer and lagged inputs for forecasting univariate time series.The nnetar function in the forecast package for R fits a neural network model to a time series with lagged values of the time series as inputs (and possibly some other exogenous inputs). So it is a nonlinear autogressive model, and it is not possible to analytically derive prediction intervals. Therefore we use simulation.The neural networks is fit by the function:

nnetar(y, p, P = 1, size, repeats = 20, xreg = NULL, lambda = NULL, model = NULL, subset = NULL, scale.inputs = TRUE, x = y, …)

Suppose we fit a NNETAR model to the famous Canadian lynx data:

library(ggthemes)
library(forecast)
library(tidyverse)
library(tseries)
library(lubridate)
library(timetk)
library(readxl)
library(tidyquant)
library(scales)
library(forecast)   #  forecasting pkg
library(sweep)   # Broom tidiers for forecast pkg
library(broom)
library(tibble)
library(stringr)
library(highcharter)
library(knitr)
theme_set(theme_bw())
modeldat=read_excel("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actvsfcdatajuly311.xlsx",sheet = "Sheet1")%>%na.omit()%>%dplyr::rename(Date=Week)
modeldat%>%head()
modeldat%>%ggplot(aes(Date,Actual))+geom_line()+
geom_point(alpha = 0.5, color = palette_light()[[1]], shape=20,size=2) +
   labs(title = "Durability Vehicles Forecasting", x = "Time", y = "Number of \n Durability Vehicles",
       subtitle = "data from 2016 & 2017") +
    theme_tq()

#Data has to be numeric for the tsclean function to work
dat=read_excel("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actvsfcdatajuly311.xlsx",sheet = "Sheet1")%>%dplyr::rename(Date=Week)%>%na.omit()
dat_ts = ts(dat["Actual"])
(fit <- nnetar(dat_ts, lambda=0.5))
Series: dat_ts 
Model:  NNAR(1,1) 
Call:   nnetar(y = dat_ts, lambda = 0.5)

Average of 20 networks, each of which is
a 1-1-1 network with 4 weights
options were - linear output units 

sigma^2 estimated as 0.2705

I’ve used a Box-Cox transformation with \(\lambda=0.5\)

to ensure the residuals will be roughly homoscedastic.

The model can be written as

\(y_{i}=f(y_{t-i})+\epsilon_{t}\)

where \(\textbf{y}_{t-1}=(y_{t-1},y_{t-2},\cdots,y_{t-8})\prime\) is a vector containing lagged values of the series, and \(f\) is a neural network with 4 hidden nodes in a single layer.\

The error series \(\{\epsilon_{t} \}\) is assumed to be homoscedastic (and possibly also normally distributed).

We can simulate future sample paths of this model iteratively, by randomly generating a value for \(\epsilon_{t}\), either from a normal distribution, or by resampling from the historical values.

So if \(\{\epsilon_{T+1}^{*} \}\) is a random draw from the distribution of errors at time \(T+1\) , then

\(y_{T+1}^{*}=f(\textbf{y}_{T+1})+\epsilon_{T+1}^{*}\)

is one possible draw from the forecast distribution for \(\textbf{y}_{T+1}\). Setting

\(\textbf{y}_{T+1}^{*}=(y^{*}_{T+1},y_{T},\cdots,y_{T-6})\prime\) we can then repeat the process to get

\(y_{T+2}=f(\textbf{y}_{T+1}^{*})+\epsilon_{T+1}^{*}\)

In this way, we can iteratively simulate a future sample path. By repeatedly simulating sample paths, we build up knowledge of the distribution for all future values based on the fitted neural network. Here is a simulation of 9 possible future sample paths for the lynx data. Each sample path covers the next 20 years after the observed data.

sim <- ts(matrix(0, nrow=20, ncol=5), start=end(dat_ts)[1]+1)
for(i in seq(5))
  sim[,i] <- simulate(fit, nsim=20)
library(ggplot2)
autoplot(dat_ts) + forecast::autolayer(sim)
For a multivariate timeseries, specify a seriesname for each timeseries. Defaulting to column names.

If we do this a few hundred or thousand times, we can get a very good picture of the forecast distributions. This is how the forecast.nnetar function produces prediction intervals:

fcast <- forecast(fit, PI=TRUE, h=20)
autoplot(fcast)

Because it is a little slow, PI=FALSE is the default, so prediction intervals are not computed unless requested. The npaths argument in forecast.nnetar controls how many simulations are done (default 1000). By default, the errors are drawn from a normal distribution. The bootstrap argument allows the errors to be “bootstrapped” (i.e., randomly drawn from the historical errors).

sweep::sw_tidy(fit)
sweep::sw_glance(fit) 
sweep::sw_augment(fit )%>%head()
#fcast%>%head()%>%kable()
forecast::forecast(fit,h=12,level = c(90, 95))%>%tk_tbl()
LS0tCnRpdGxlOiAiTmV1cmFsIE5ldHdvcmsgTW9kZWxzIGZvciBUaW1lIFNlcmllcyBQcmVkaWN0aW9uIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKYXV0aG9yOiBOYW5hIEJvYXRlbmcKZGZfcHJpbnQ6IHBhZ2VkClRpbWU6ICdgciBTeXMudGltZSgpYCcKZGF0ZTogImByIGZvcm1hdChTeXMudGltZSgpLCAnJUIgJWQsICVZJylgIgotLS0KCkZlZWQtZm9yd2FyZCBuZXVyYWwgbmV0d29ya3Mgd2l0aCBhIHNpbmdsZSBoaWRkZW4gbGF5ZXIgYW5kIGxhZ2dlZCBpbnB1dHMgZm9yIGZvcmVjYXN0aW5nIHVuaXZhcmlhdGUgdGltZSBzZXJpZXMuVGhlIG5uZXRhciBmdW5jdGlvbiBpbiB0aGUgZm9yZWNhc3QgcGFja2FnZSBmb3IgUiBmaXRzIGEgbmV1cmFsIG5ldHdvcmsgbW9kZWwgdG8gYSB0aW1lIHNlcmllcyB3aXRoIGxhZ2dlZCB2YWx1ZXMgb2YgdGhlIHRpbWUgc2VyaWVzIGFzIGlucHV0cyAoYW5kIHBvc3NpYmx5IHNvbWUgb3RoZXIgZXhvZ2Vub3VzIGlucHV0cykuIFNvIGl0IGlzIGEgbm9ubGluZWFyIGF1dG9ncmVzc2l2ZSBtb2RlbCwgYW5kIGl0IGlzIG5vdCBwb3NzaWJsZSB0byBhbmFseXRpY2FsbHkgZGVyaXZlIHByZWRpY3Rpb24gaW50ZXJ2YWxzLiBUaGVyZWZvcmUgd2UgdXNlIHNpbXVsYXRpb24uVGhlIG5ldXJhbCBuZXR3b3JrcyBpcyBmaXQgYnkgdGhlIGZ1bmN0aW9uOgoKbm5ldGFyKHksIHAsIFAgPSAxLCBzaXplLCByZXBlYXRzID0gMjAsIHhyZWcgPSBOVUxMLCBsYW1iZGEgPSBOVUxMLAogIG1vZGVsID0gTlVMTCwgc3Vic2V0ID0gTlVMTCwgc2NhbGUuaW5wdXRzID0gVFJVRSwgeCA9IHksIC4uLikKClN1cHBvc2Ugd2UgZml0IGEgTk5FVEFSIG1vZGVsIHRvIHRoZSBmYW1vdXMgQ2FuYWRpYW4gbHlueCBkYXRhOgoKYGBge3IsbWVzc2FnZT1GQUxTRSx3YXJuaW5nPUZBTFNFfQpsaWJyYXJ5KGdndGhlbWVzKQpsaWJyYXJ5KGZvcmVjYXN0KQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeSh0c2VyaWVzKQpsaWJyYXJ5KGx1YnJpZGF0ZSkKbGlicmFyeSh0aW1ldGspCmxpYnJhcnkocmVhZHhsKQpsaWJyYXJ5KHRpZHlxdWFudCkKbGlicmFyeShzY2FsZXMpCmxpYnJhcnkoZm9yZWNhc3QpICAgIyAgZm9yZWNhc3RpbmcgcGtnCmxpYnJhcnkoc3dlZXApICAgIyBCcm9vbSB0aWRpZXJzIGZvciBmb3JlY2FzdCBwa2cKbGlicmFyeShicm9vbSkKbGlicmFyeSh0aWJibGUpCmxpYnJhcnkoc3RyaW5ncikKbGlicmFyeShoaWdoY2hhcnRlcikKbGlicmFyeShrbml0cikKCnRoZW1lX3NldCh0aGVtZV9idygpKQoKCgpgYGAKCgoKCmBgYHtyfQptb2RlbGRhdD1yZWFkX2V4Y2VsKCIvVXNlcnMvbmFuYWFrd2FzaWFiYXlpZWJvYXRlbmcvRG9jdW1lbnRzL21lbXBoaXNjbGFzc2VzYm9va3MvVGltZSBzZXJpZXMvTWFucG93ZXIvYWN0dnNmY2RhdGFqdWx5MzExLnhsc3giLHNoZWV0ID0gIlNoZWV0MSIpJT4lbmEub21pdCgpJT4lZHBseXI6OnJlbmFtZShEYXRlPVdlZWspCm1vZGVsZGF0JT4laGVhZCgpCmBgYAoKYGBge3J9Cm1vZGVsZGF0JT4lZ2dwbG90KGFlcyhEYXRlLEFjdHVhbCkpK2dlb21fbGluZSgpKwoKZ2VvbV9wb2ludChhbHBoYSA9IDAuNSwgY29sb3IgPSBwYWxldHRlX2xpZ2h0KClbWzFdXSwgc2hhcGU9MjAsc2l6ZT0yKSArCiAgIGxhYnModGl0bGUgPSAiRHVyYWJpbGl0eSBWZWhpY2xlcyBGb3JlY2FzdGluZyIsIHggPSAiVGltZSIsIHkgPSAiTnVtYmVyIG9mIFxuIER1cmFiaWxpdHkgVmVoaWNsZXMiLAogICAgICAgc3VidGl0bGUgPSAiZGF0YSBmcm9tIDIwMTYgJiAyMDE3IikgKwogICAgdGhlbWVfdHEoKQpgYGAKCgpgYGB7cn0KCiNEYXRhIGhhcyB0byBiZSBudW1lcmljIGZvciB0aGUgdHNjbGVhbiBmdW5jdGlvbiB0byB3b3JrCmRhdD1yZWFkX2V4Y2VsKCIvVXNlcnMvbmFuYWFrd2FzaWFiYXlpZWJvYXRlbmcvRG9jdW1lbnRzL21lbXBoaXNjbGFzc2VzYm9va3MvVGltZSBzZXJpZXMvTWFucG93ZXIvYWN0dnNmY2RhdGFqdWx5MzExLnhsc3giLHNoZWV0ID0gIlNoZWV0MSIpJT4lZHBseXI6OnJlbmFtZShEYXRlPVdlZWspJT4lbmEub21pdCgpCgoKZGF0X3RzID0gdHMoZGF0WyJBY3R1YWwiXSkKCmBgYAoKCmBgYHtyfQooZml0IDwtIG5uZXRhcihkYXRfdHMsIGxhbWJkYT0wLjUpKQpgYGAKCknigJl2ZSB1c2VkIGEgQm94LUNveCB0cmFuc2Zvcm1hdGlvbiB3aXRoICRcbGFtYmRhPTAuNSQKCiB0byBlbnN1cmUgdGhlIHJlc2lkdWFscyB3aWxsIGJlIHJvdWdobHkgaG9tb3NjZWRhc3RpYy4KClRoZSBtb2RlbCBjYW4gYmUgd3JpdHRlbiBhcwoKJHlfe2l9PWYoeV97dC1pfSkrXGVwc2lsb25fe3R9JAoKCndoZXJlICRcdGV4dGJme3l9X3t0LTF9PSh5X3t0LTF9LHlfe3QtMn0sXGNkb3RzLHlfe3QtOH0pXHByaW1lJCAgaXMgYSB2ZWN0b3IgY29udGFpbmluZyBsYWdnZWQgdmFsdWVzIG9mIHRoZSBzZXJpZXMsIGFuZCAkZiQgaXMgYSBuZXVyYWwgbmV0d29yayB3aXRoIDQgaGlkZGVuIG5vZGVzIGluIGEgc2luZ2xlIGxheWVyLlxcCgpUaGUgZXJyb3Igc2VyaWVzICRce1xlcHNpbG9uX3t0fSBcfSQgIGlzIGFzc3VtZWQgdG8gYmUgaG9tb3NjZWRhc3RpYyAoYW5kIHBvc3NpYmx5IGFsc28gbm9ybWFsbHkgZGlzdHJpYnV0ZWQpLgoKCldlIGNhbiBzaW11bGF0ZSBmdXR1cmUgc2FtcGxlIHBhdGhzIG9mIHRoaXMgbW9kZWwgaXRlcmF0aXZlbHksIGJ5IHJhbmRvbWx5IGdlbmVyYXRpbmcgYSB2YWx1ZSBmb3IgJFxlcHNpbG9uX3t0fSQsIGVpdGhlciBmcm9tIGEgbm9ybWFsIGRpc3RyaWJ1dGlvbiwgb3IgYnkgcmVzYW1wbGluZyBmcm9tIHRoZSBoaXN0b3JpY2FsIHZhbHVlcy4gCgpTbyBpZiAkXHtcZXBzaWxvbl97VCsxfV57Kn0gXH0kICBpcyBhIHJhbmRvbSBkcmF3IGZyb20gdGhlIGRpc3RyaWJ1dGlvbiBvZiBlcnJvcnMgYXQgdGltZSAgJFQrMSQKLCB0aGVuCgokeV97VCsxfV57Kn09ZihcdGV4dGJme3l9X3tUKzF9KStcZXBzaWxvbl97VCsxfV57Kn0kCgppcyBvbmUgcG9zc2libGUgZHJhdyBmcm9tIHRoZSBmb3JlY2FzdCBkaXN0cmlidXRpb24gZm9yICRcdGV4dGJme3l9X3tUKzF9JC4gU2V0dGluZyAKCgokXHRleHRiZnt5fV97VCsxfV57Kn09KHleeyp9X3tUKzF9LHlfe1R9LFxjZG90cyx5X3tULTZ9KVxwcmltZSQgd2UgY2FuIHRoZW4gcmVwZWF0IHRoZSBwcm9jZXNzIHRvIGdldAoKJHlfe1QrMn09ZihcdGV4dGJme3l9X3tUKzF9XnsqfSkrXGVwc2lsb25fe1QrMX1eeyp9JAoKCkluIHRoaXMgd2F5LCB3ZSBjYW4gaXRlcmF0aXZlbHkgc2ltdWxhdGUgYSBmdXR1cmUgc2FtcGxlIHBhdGguIEJ5IHJlcGVhdGVkbHkgc2ltdWxhdGluZyBzYW1wbGUgcGF0aHMsIHdlIGJ1aWxkIHVwIGtub3dsZWRnZSBvZiB0aGUgZGlzdHJpYnV0aW9uIGZvciBhbGwgZnV0dXJlIHZhbHVlcyBiYXNlZCBvbiB0aGUgZml0dGVkIG5ldXJhbCBuZXR3b3JrLiBIZXJlIGlzIGEgc2ltdWxhdGlvbiBvZiA5IHBvc3NpYmxlIGZ1dHVyZSBzYW1wbGUgcGF0aHMgZm9yIHRoZSBseW54IGRhdGEuIEVhY2ggc2FtcGxlIHBhdGggY292ZXJzIHRoZSBuZXh0IDIwIHllYXJzIGFmdGVyIHRoZSBvYnNlcnZlZCBkYXRhLgoKCmBgYHtyfQpzaW0gPC0gdHMobWF0cml4KDAsIG5yb3c9MjAsIG5jb2w9NSksIHN0YXJ0PWVuZChkYXRfdHMpWzFdKzEpCmZvcihpIGluIHNlcSg1KSkKICBzaW1bLGldIDwtIHNpbXVsYXRlKGZpdCwgbnNpbT0yMCkKCmxpYnJhcnkoZ2dwbG90MikKYXV0b3Bsb3QoZGF0X3RzKSArIGZvcmVjYXN0OjphdXRvbGF5ZXIoc2ltKQpgYGAKCgpJZiB3ZSBkbyB0aGlzIGEgZmV3IGh1bmRyZWQgb3IgdGhvdXNhbmQgdGltZXMsIHdlIGNhbiBnZXQgYSB2ZXJ5IGdvb2QgcGljdHVyZSBvZiB0aGUgZm9yZWNhc3QgZGlzdHJpYnV0aW9ucy4gVGhpcyBpcyBob3cgdGhlIGZvcmVjYXN0Lm5uZXRhciBmdW5jdGlvbiBwcm9kdWNlcyBwcmVkaWN0aW9uIGludGVydmFsczoKCmBgYHtyfQpmY2FzdCA8LSBmb3JlY2FzdChmaXQsIFBJPVRSVUUsIGg9MjApCmF1dG9wbG90KGZjYXN0KQpgYGAKCgpCZWNhdXNlIGl0IGlzIGEgbGl0dGxlIHNsb3csIFBJPUZBTFNFIGlzIHRoZSBkZWZhdWx0LCBzbyBwcmVkaWN0aW9uIGludGVydmFscyBhcmUgbm90IGNvbXB1dGVkIHVubGVzcyByZXF1ZXN0ZWQuIFRoZSBucGF0aHMgYXJndW1lbnQgaW4gZm9yZWNhc3Qubm5ldGFyIGNvbnRyb2xzIGhvdyBtYW55IHNpbXVsYXRpb25zIGFyZSBkb25lIChkZWZhdWx0IDEwMDApLiBCeSBkZWZhdWx0LCB0aGUgZXJyb3JzIGFyZSBkcmF3biBmcm9tIGEgbm9ybWFsIGRpc3RyaWJ1dGlvbi4gVGhlIGJvb3RzdHJhcCBhcmd1bWVudCBhbGxvd3MgdGhlIGVycm9ycyB0byBiZSDigJxib290c3RyYXBwZWTigJ0gKGkuZS4sIHJhbmRvbWx5IGRyYXduIGZyb20gdGhlIGhpc3RvcmljYWwgZXJyb3JzKS4KCgoKCmBgYHtyfQoKc3dlZXA6OnN3X3RpZHkoZml0KQoKc3dlZXA6OnN3X2dsYW5jZShmaXQpIAoKc3dlZXA6OnN3X2F1Z21lbnQoZml0ICklPiVoZWFkKCkKCgojZmNhc3QlPiVoZWFkKCklPiVrYWJsZSgpCgpmb3JlY2FzdDo6Zm9yZWNhc3QoZml0LGg9MTIsbGV2ZWwgPSBjKDkwLCA5NSkpJT4ldGtfdGJsKCkKYGBgCgo=