Algoritmos de Alisamiento Exponencial
Los métodos de previsión se basan en la idea de que las observaciones pasadas contienen información sobre el patrón de comportamiento de la serie de tiempo.
El algoritmo de alisamiento exponencial intenta tratar este problema.
Los algoritmos no tienen un desarrollo probabilĆstico que pruebe su eficiencia, pero en la prĆ”ctica son muy Ćŗtiles por su simplicidad y eficiencia computacional.
Suavizado exponencial:
Técnica para suavizar datos de series de tiempo utilizando una función de ventana exponencial.
Difiere del promedio móvil simple, con el tiempo las funciones exponenciales asignan pesos exponencialmente decrecientes.
- Los pesos mayores se asignan a los valores u observaciones recientes, mientras que los pesos menores se asignan a los valores u observaciones mƔs antiguos.
Entre muchas funciones de ventana, en el procesamiento de señales, la función de suavizado exponencial generalmente se aplica para suavizar datos donde actúa como un filtro de paso bajo para eliminar el ruido de alta frecuencia.
Suaviamiento exponencial simple - SES (simple exponencial smoothing)
Este procedimiento es adecuado cuando los datos no tienen tendencia o patrón estacional. Los pesos de cada observación son determinados por un parÔmetro de suavizamiento \(\alpha\).
Para un conjunto de datos con \(T\) observaciones , calculamos el valor predicho \(\hat{y}_{t+1}\), el cual estarƔ basado en \(y_1\) a travƩs de \(y_t\) de la siguiente forma:
\[\hat{y}_{t+1}=\alpha y_t+\alpha(1-\alpha)y_{tā1}+...+\alpha(1ā\alpha)^{tā1}y_1\]
Donde:
\(0< \alpha < 1\).
\(\alpha\) puede ser visto como una tasa de aprendizaje.
Valores cercanos a cero son considerados como aprendizaje lento ya que se da mÔs peso a información histórica
Valores cercanos a 1 son considerados como aprendizaje rƔpido porque el algoritmo da mƔs peso a las observaciones recientes.
library(tseries)
#library(FitAR)
library(urca)
library(highcharter)
library(readxl)
library(ggplot2)
library(TSstudio)
library(forecast)
library(car)
library(rio)library(readxl)
IPC <- rio::import("https://github.com/Wilsonsr/Series-de-Tiempo/raw/main/bases/IPC%20(4).xlsx")
head(IPC)## Inflación mensual
## 1 0.0129
## 2 0.0230
## 3 0.0171
## 4 0.0100
## 5 0.0052
## 6 -0.0002
## Jan Feb Mar Apr May Jun Jul Aug Sep
## 2000 0.0129 0.0230 0.0171 0.0100 0.0052 -0.0002 -0.0004 0.0032 0.0043
## 2001 0.0105 0.0189 0.0148 0.0115 0.0042 0.0004 0.0011 0.0026 0.0037
## 2002 0.0080 0.0126 0.0071 0.0092 0.0060 0.0043 0.0002 0.0009 0.0036
## 2003 0.0117 0.0111 0.0105 0.0115 0.0049 -0.0005 -0.0014 0.0031 0.0022
## 2004 0.0089 0.0120 0.0098 0.0046 0.0038 0.0060 -0.0003 0.0003 0.0030
## 2005 0.0082 0.0102 0.0077 0.0044 0.0041 0.0040 0.0005 0.0000 0.0043
## 2006 0.0054 0.0066 0.0070 0.0045 0.0033 0.0030 0.0041 0.0039 0.0029
## 2007 0.0077 0.0117 0.0121 0.0090 0.0030 0.0012 0.0017 -0.0013 0.0008
## 2008 0.0106 0.0151 0.0081 0.0071 0.0093 0.0086 0.0048 0.0019 -0.0019
## 2009 0.0059 0.0084 0.0050 0.0032 0.0001 -0.0006 -0.0004 0.0004 -0.0011
## 2010 0.0069 0.0083 0.0025 0.0046 0.0010 0.0011 -0.0004 0.0011 -0.0014
## 2011 0.0091 0.0060 0.0027 0.0012 0.0028 0.0032 0.0014 -0.0003 0.0031
## 2012 0.0073 0.0061 0.0012 0.0014 0.0030 0.0008 -0.0002 0.0004 0.0029
## 2013 0.0030 0.0044 0.0021 0.0025 0.0028 0.0023 0.0004 0.0008 0.0029
## 2014 0.0049 0.0063 0.0039 0.0046 0.0048 0.0009 0.0015 0.0020 0.0014
## 2015 0.0064 0.0115 0.0059 0.0054 0.0026 0.0010 0.0019 0.0048 0.0072
## 2016 0.0129 0.0128 0.0094 0.0050 0.0051 0.0048 0.0052 -0.0032 -0.0005
## 2017 0.0102 0.0101 0.0047 0.0047 0.0023 0.0011 -0.0005 0.0014 0.0004
## 2018 0.0063 0.0071 0.0024 0.0046 0.0025 0.0015 -0.0013 0.0012 0.0016
## 2019 0.0060 0.0057 0.0043 0.0050 0.0031 0.0027 0.0022 0.0009 0.0023
## 2020 0.0042 0.0067
## Oct Nov Dec
## 2000 0.0015 0.0033 0.0046
## 2001 0.0019 0.0012 0.0034
## 2002 0.0056 0.0078 0.0027
## 2003 0.0006 0.0035 0.0061
## 2004 -0.0001 0.0028 0.0030
## 2005 0.0023 0.0011 0.0007
## 2006 -0.0014 0.0024 0.0023
## 2007 0.0001 0.0047 0.0049
## 2008 0.0035 0.0028 0.0044
## 2009 -0.0013 -0.0007 0.0008
## 2010 -0.0009 0.0019 0.0065
## 2011 0.0019 0.0014 0.0042
## 2012 0.0016 -0.0014 0.0009
## 2013 -0.0026 -0.0022 0.0026
## 2014 0.0016 0.0013 0.0027
## 2015 0.0068 0.0060 0.0062
## 2016 -0.0006 0.0011 0.0042
## 2017 0.0002 0.0018 0.0038
## 2018 0.0012 0.0012 0.0030
## 2019 0.0016 0.0010 0.0026
## 2020
Damos formato de serie de tiempo
## [1] 228
Realizamos la grƔfica de los datos
SES(Suavizado Exponencial Simple)
- Datos que no tienen tendencia o patrón estacional.
## āā Attaching core tidyverse packages āāāāāāāāāāāāāāāāāāāāāāāā tidyverse 2.0.0 āā
## ā dplyr 1.1.2 ā readr 2.1.4
## ā forcats 1.0.0 ā stringr 1.5.0
## ā lubridate 1.9.2 ā tibble 3.2.1
## ā purrr 1.0.2 ā tidyr 1.3.0
## āā Conflicts āāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāā tidyverse_conflicts() āā
## ā dplyr::filter() masks stats::filter()
## ā dplyr::lag() masks stats::lag()
## ā dplyr::recode() masks car::recode()
## ā purrr::some() masks car::some()
## ā¹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
El pronóstico del perĆodo \(t\) \((F_{t})\) serĆ” igual al pronóstico del perĆodo anterior, es decir, del perĆodo \(t-1\) \((F_{t-1})\) mĆ”s alfa \((\alpha)\) por el error del perĆodo anterior \((A_{t-1}-F_{t-1})\)
##
## Forecast method: Simple exponential smoothing
##
## Model Information:
## Simple exponential smoothing
##
## Call:
## ses(y = z1, h = 12, alpha = 0.2)
##
## Smoothing parameters:
## alpha = 0.2
##
## Initial states:
## l = 0.011
##
## sigma: 0.0039
##
## AIC AICc BIC
## -1291.502 -1291.448 -1284.643
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set -0.0001984582 0.003865419 0.002975794 -Inf Inf 1.237051 0.6173737
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2019 0.001937618 -0.003037987 0.006913222 -0.005671913 0.009547148
## Feb 2019 0.001937618 -0.003136523 0.007011759 -0.005822611 0.009697847
## Mar 2019 0.001937618 -0.003233182 0.007108418 -0.005970439 0.009845674
## Apr 2019 0.001937618 -0.003328067 0.007203303 -0.006115553 0.009990788
## May 2019 0.001937618 -0.003421273 0.007296508 -0.006258098 0.010133333
## Jun 2019 0.001937618 -0.003512884 0.007388119 -0.006398206 0.010273441
## Jul 2019 0.001937618 -0.003602981 0.007478216 -0.006535997 0.010411232
## Aug 2019 0.001937618 -0.003691636 0.007566872 -0.006671583 0.010546819
## Sep 2019 0.001937618 -0.003778917 0.007654152 -0.006805067 0.010680303
## Oct 2019 0.001937618 -0.003864885 0.007740120 -0.006936544 0.010811779
## Nov 2019 0.001937618 -0.003949597 0.007824832 -0.007066100 0.010941336
## Dec 2019 0.001937618 -0.004033108 0.007908343 -0.007193819 0.011069054
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2019 0.001937618 -0.003037987 0.006913222 -0.005671913 0.009547148
## Feb 2019 0.001937618 -0.003136523 0.007011759 -0.005822611 0.009697847
## Mar 2019 0.001937618 -0.003233182 0.007108418 -0.005970439 0.009845674
## Apr 2019 0.001937618 -0.003328067 0.007203303 -0.006115553 0.009990788
## May 2019 0.001937618 -0.003421273 0.007296508 -0.006258098 0.010133333
## Jun 2019 0.001937618 -0.003512884 0.007388119 -0.006398206 0.010273441
## Jul 2019 0.001937618 -0.003602981 0.007478216 -0.006535997 0.010411232
## Aug 2019 0.001937618 -0.003691636 0.007566872 -0.006671583 0.010546819
## Sep 2019 0.001937618 -0.003778917 0.007654152 -0.006805067 0.010680303
## Oct 2019 0.001937618 -0.003864885 0.007740120 -0.006936544 0.010811779
## Nov 2019 0.001937618 -0.003949597 0.007824832 -0.007066100 0.010941336
## Dec 2019 0.001937618 -0.004033108 0.007908343 -0.007193819 0.011069054
## [1] 242
## [1] 228
ETS (Error tenndencia y estacionalidad)
El algoritmo ETS es especialmente Ćŗtil para conjuntos de datos con estacionalidad y otras suposiciones previas sobre los datos.
ETS calcula un promedio ponderado sobre todas las observaciones en el conjunto de datos de las series temporales de entrada como su predicción.
Las ponderaciones disminuyen exponencialmente con el tiempo, en lugar de las ponderaciones constantes en los métodos de promedio móvil simple.
Las ponderaciones dependen de un parƔmetro constante, conocido como parƔmetro de suavizamiento.
##
## Ljung-Box test
##
## data: Residuals from ETS(A,Ad,A)
## Q* = 59.913, df = 24, p-value = 6.57e-05
##
## Model df: 0. Total lags used: 24
- Veamos el ajuste entre los datos de la serie y el pronóstico del
modelo en la siguiente representación grÔfica, usando la función
fitted()que obtiene un ajuste con la data historica.
##
## Forecast method: ETS(A,Ad,A)
##
## Model Information:
## ETS(A,Ad,A)
##
## Call:
## ets(y = z1)
##
## Smoothing parameters:
## alpha = 0.4864
## beta = 1e-04
## gamma = 2e-04
## phi = 0.9771
##
## Initial states:
## l = 0.0113
## b = -3e-04
## s = 2e-04 -0.0014 -0.0023 -0.0017 -0.0031 -0.0036
## -0.0021 -5e-04 0.0015 0.0028 0.0062 0.004
##
## sigma: 0.0024
##
## AIC AICc BIC
## -1495.301 -1492.029 -1433.573
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 4.010303e-05 0.002304734 0.001780198 -Inf Inf 0.7400362 0.2217259
##
## Forecasts:
## Point Forecast Lo 95 Hi 95
## Jan 2019 0.0069225819 2.226938e-03 0.011618225
## Feb 2019 0.0091664671 3.944585e-03 0.014388349
## Mar 2019 0.0057379159 3.798047e-05 0.011437851
## Apr 2019 0.0044307943 -1.710268e-03 0.010571856
## May 2019 0.0024238671 -4.128853e-03 0.008976587
## Jun 2019 0.0008133985 -6.126753e-03 0.007753550
## Jul 2019 -0.0006307583 -7.937967e-03 0.006676450
## Aug 2019 -0.0001912126 -7.848031e-03 0.007465606
## Sep 2019 0.0012354958 -6.755773e-03 0.009226765
## Oct 2019 0.0006180184 -7.694368e-03 0.008930405
## Nov 2019 0.0015067935 -7.114866e-03 0.010128453
## Dec 2019 0.0030864219 -5.833896e-03 0.012006739
Y podemos representar solo los resultados a través de un dataframe, asignando la ejecución del mismo a la variable pronóstico.
## Point Forecast Lo 95 Hi 95
## Jan 2019 0.0069225819 2.226938e-03 0.011618225
## Feb 2019 0.0091664671 3.944585e-03 0.014388349
## Mar 2019 0.0057379159 3.798047e-05 0.011437851
## Apr 2019 0.0044307943 -1.710268e-03 0.010571856
## May 2019 0.0024238671 -4.128853e-03 0.008976587
## Jun 2019 0.0008133985 -6.126753e-03 0.007753550
## Jul 2019 -0.0006307583 -7.937967e-03 0.006676450
## Aug 2019 -0.0001912126 -7.848031e-03 0.007465606
## Sep 2019 0.0012354958 -6.755773e-03 0.009226765
## Oct 2019 0.0006180184 -7.694368e-03 0.008930405
## Nov 2019 0.0015067935 -7.114866e-03 0.010128453
## Dec 2019 0.0030864219 -5.833896e-03 0.012006739
SUAVIZADO EXPONENCIAL(HOLT-WINTERS)
El método se basa en un algoritmo iterativo que a cada tiempo realiza un pronóstico sobre el comportamiento de la serie en base a promedios debidamente ponderados de los datos obtenidos anteriormente.
A este particular hay que reseƱar los 2 diferentes tipos de estacionalidad que se pueden dar en las grƔficas, que son estacionalidad aditiva o estacionalidad multiplicativa.
El modelo multiplicativo se usa cuando la magnitud del patron estacional en los datos depende de la magnitud de los datos. En otras palabras, la magnitud del patron estacional aumenta a medida que los valores de los datos se incrementan y disminuye a medida que los valores de los datos decrecen.
El modelo aditivo se usa cuando la magnitud del patron estacional en los datos no dependa de la magnitud de los datos. En otras palabras, la magnitud del patron estacional no cambia cuando la serie sube o baja.
El método de Holt-Winters es una técnica de suavizado que utiliza un conjunto de estimaciones recursivas a partir de la serie histórica. Estas estimaciones utilizan
Una constante de nivel \(\alpha\)
Una constante de tendencia \(\beta\)
Una constante estacional multiplicativa \(\gamma\)
Las estimaciones recursivas se basan en las siguientes ecuaciones:
\[\hat Y_t=\alpha(\hat Y_{t-1}-T_{t-1})+(1-\alpha)\frac{Y_t}{F_{t-s}}\ \ \ 0< \alpha <1\]
\[T_t=\beta T_{t-1}+(1-\beta)(\hat Y_{t}-\hat Y_{t-1})\ \ \ 0< \beta <1\]
\[F_t=\gamma F_{t-s}+(1-\gamma)\frac{Y_t}{\hat Y_{t}}\ \ \ 0< \gamma <1\]
donde \(s=4\) en el caso de datos trimestrales y \(s=12\) en el caso de datos mensuales.
\(\hat{Y}_t\) serĆa el nivel suavizado de la serie,
\(T_t\) la tendencia suavizada de la serie y
\(F_t\) el ajuste estacional suavizado de la serie.
HoltWinters(x, alpha = NULL, beta = NULL, gamma = NULL, seasonal = c(āadditiveā,multiplicativeā), start.periods = 2, l.start = NULL, b.start = NULL, s.start = NULL, optim.start = c(alpha = 0.3, beta = 0.1, gamma = 0.1), optim.control = list())
Graficando nuevamente nuestros datos
`
- Ahora realizaremos una grÔfica donde se vea la serie del modelo (linea negra) y el ajuste con la predicción(linea roja), asà mismo aparecerÔ la descomposición de la grÔfica para evaluar los datos.
## Holt-Winters exponential smoothing with trend and additive seasonal component.
##
## Call:
## HoltWinters(x = z1, seasonal = "additive")
##
## Smoothing parameters:
## alpha: 0.2553878
## beta : 0
## gamma: 0.4959211
##
## Coefficients:
## [,1]
## a 2.349466e-03
## b -3.293998e-05
## s1 4.969355e-03
## s2 5.727923e-03
## s3 1.202672e-03
## s4 1.449009e-03
## s5 -2.826090e-04
## s6 -1.331098e-03
## s7 -2.638474e-03
## s8 -1.885080e-03
## s9 -1.275333e-03
## s10 -1.633277e-03
## s11 -1.117777e-03
## s12 8.382107e-04
##
## Ljung-Box test
##
## data: Residuals from HoltWinters
## Q* = 44.307, df = 24, p-value = 0.007027
##
## Model df: 0. Total lags used: 24
- A posterori realizaremos las predicciones a 12 meses vista y las graficaremos:
## fit upr lwr
## Jan 2019 0.0072858818 0.012048061 0.002523703
## Feb 2019 0.0080115091 0.012926537 0.003096481
## Mar 2019 0.0034533181 0.008516583 -0.001609946
## Apr 2019 0.0036667152 0.008873998 -0.001540568
## May 2019 0.0019021574 0.007249582 -0.003445267
## Jun 2019 0.0008207284 0.006304714 -0.004663257
## Jul 2019 -0.0005195878 0.005097640 -0.006136815
## Aug 2019 0.0002008662 0.005948248 -0.005546515
## Sep 2019 0.0007776736 0.006652326 -0.005096979
## Oct 2019 0.0003867899 0.006386014 -0.005612434
## Nov 2019 0.0008693493 0.006990610 -0.005251912
## Dec 2019 0.0027923973 0.009033310 -0.003448515
REDES NEURONALES DE RETROALIMENTACION (nntear)
Son redes con una sola capa oculta y entradas retrasadas para pronosticar series de tiempo univariadas.
Vamos a elaborar entonces el modelo de red neuronal con nuestros datos:
## [1] "nnetar"
- Una vez hecho esto vamos a comprobar los residuos que presenta nuestro modelo.
##
## Ljung-Box test
##
## data: Residuals from NNAR(4,1,3)[12]
## Q* = 23.644, df = 24, p-value = 0.4821
##
## Model df: 0. Total lags used: 24
Una vez hecho esto realizamos la predicción a 12 meses de los datos, con una significancia del 95% de los mismos.
## Jan Feb Mar Apr May Jun
## 2019 0.001885194 0.004454989 0.003886486 0.003540136 0.002410782 0.001614345
## Jul Aug Sep Oct Nov Dec
## 2019 0.001094972 0.001680259 0.002113773 0.002082866 0.001714576 0.001891870
- Luego realizamos un grƔfico de nuestro pronostico.
- Ahora vamos a ver representado el ajuste entre lo datos de la serie
y el pronóstico del modelo en la siguiente representación grÔfica, para
ello utilizamos la función
fitted()que obtiene un ajuste con la data histórica.
## Warning: Removed 12 rows containing missing values (`geom_line()`).
Ahora vamos a determinar los resultados de este modelo creando un dataframe
## Jan Feb Mar Apr May Jun
## 2019 0.001885194 0.004454989 0.003886486 0.003540136 0.002410782 0.001614345
## Jul Aug Sep Oct Nov Dec
## 2019 0.001094972 0.001680259 0.002113773 0.002082866 0.001714576 0.001891870
REDES NEURONALES RECURRENTES (Modelos Elman y Jordan).
Una red neuronal recurrente no tiene una estructura de capas definida, sino que permiten conexiones arbitrarias entre las neuronas, incluso pudiendo crear ciclos, con esto se consigue crear la temporalidad, permitiendo que la red tenga memoria.
Los RNN se denominan recurrentes porque realizan la misma tarea para cada elemento de una secuencia, y la salida depende de los cƔlculos anteriores.
Modelo Elman.
En las redes de Elman, las entradas de estas neuronas, se toman desde las salidas de las neuronas de una de las capas ocultas, y sus salidas se conectan de nuevo en las entradas de esta misma capa, lo que proporciona una especie de memoria sobre el estado anterior de dicha capa.
Para desarrollar este modelo junto con el de Jordan, se cargan las librerĆas
Vamos pronosticar 12 meses de nuestros datos con esta red.
- En primer lugar para actuar en dicho proceso con redes neuronales tenemos que normalizar nuestros datos para que tomen valores entre 0 y 1. Para ello hemos asociado a nuestro dataset de base una variable āZā y a partir de esta hemos realizar la normalización a travĆ©s de la variable āSā.
A continuación comprobamos el numero de filas totales que contiene nuestro dataset y dividiremos los conjuntos de entrenamiento en un 75% y prueba en un 25% respectivamente.
## [1] 228
## [1] 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
## [19] 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
## [37] 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
## [55] 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
## [73] 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
## [91] 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
## [109] 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
## [127] 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
## [145] 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
## [163] 162 163 164 165 166 167 168 169 170
## [1] 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
## [20] 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208
## [39] 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227
## [58] 228
- Ahora crearemos un dataframe con \(n\) columnas, cada una de las cuales adelantara un valor de la serie en el futuro, a travƩs de una variable tipo zoo, equivalente al periodo de retardo de la serie.
y <- as.zoo(S)
x1 <- Lag(y, k = 1)
x2 <- Lag(y, k = 2)
x3 <- Lag(y, k = 3)
x4 <- Lag(y, k = 4)
x5 <- Lag(y, k = 5)
x6 <- Lag(y, k = 6)
x7 <- Lag(y, k = 7)
x8 <- Lag(y, k = 8)
x9 <- Lag(y, k = 9)
x10 <- Lag(y, k = 10)
x11 <- Lag(y, k = 11)
x12 <- Lag(y, k = 12)
slogN <- cbind(y,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12)- A continuacion eliminaremos los valores NA producidos al desplazar la serie:
- Luego definimos los valores de entrada y salida de la red neuronal:
- Ahora crearemos la red de Elman, probando diferentes tipos de combinaciones de neuronas en las capas ocultas e iteraciones mÔximas, ademas del ritmo de aprendizaje aunque este último apenas lo hemos tocado, para ajustar lo mejor posible la curva de predicción a la del modelo de la serie. De esta forma hemos llegado a estos valores a la hora de crear nuestra red. Asi mismo ponemos una semilla para que el resultado sea reproducible.
set.seed(42)
fit<-elman(inputs[train],outputs[train],size=c(10,3),learnFuncParams=c(0.1),
maxit=64000)- En la grƔfica siguiente vemos como evoluciona el error de la red con el numero de iteraciones para los parƔmetros expuestos.
Observamos que el error converge a 0 muy rapidamente.
Ahora realizamos la predicción con el resto de los términos de la serie que son los datos seleccionados para
test, pasamos pues una vez entrenada a probarla y a representarla graficamente para ver el ajuste del modelo.
y <- as.vector(outputs[-test])
plot(y,type="l")
pred <- predict(fit, inputs[-test])
lines(pred,col = "red")El ajuste que predice bastante bien con los parametros elegidos, pues la curva del modelo de la serie y la de la prediccion parecen bastante ajustadas.
Esta representacion grafica se puede utilizar para ir ajustando la prediccion y el modelo a medida que vamos probando diferentes parametros de la red de Elman, de forma que la curva del modelo y de la prediccion queden lo mas ajustados posibles.
Ahora gracias al efecto memoria vamos a adelantarle a la serie al menos en un valor con una precision muy buena. Para ello volveremos a introducir los datos de entrenamiento.
## [,1]
## Mar 2015 0.34287089
## Apr 2015 0.42560601
## May 2015 0.20535362
## Jun 2015 0.25980479
## Jul 2015 0.11165993
## Aug 2015 0.19485514
## Sep 2015 0.03163630
## Oct 2015 0.06255832
## Nov 2015 0.05122411
## Dec 2015 0.22957855
## Jan 2016 0.68483299
## Feb 2016 0.90195239
## Mar 2016 0.64090347
## Apr 2016 0.39495099
## May 2016 0.07180335
## Jun 2016 0.07419004
## Jul 2016 0.28000736
## Aug 2016 0.11032754
## Sep 2016 -0.24422857
## Oct 2016 -0.11019516
## Nov 2016 0.44549102
## Dec 2016 0.18790153
## Jan 2017 0.57058644
## Feb 2017 0.89353001
## Mar 2017 0.79368675
## Apr 2017 0.35494488
## May 2017 0.25065106
## Jun 2017 0.20474343
## Jul 2017 0.46699345
## Aug 2017 -0.03953356
## Sep 2017 0.04635978
## Oct 2017 -0.09643587
## Nov 2017 -0.06307691
## Dec 2017 0.35087645
## Jan 2018 0.45331717
## Feb 2018 0.28481832
## Mar 2018 0.07885304
## Apr 2018 0.19831201
## May 2018 0.23532809
## Jun 2018 0.24468547
## Jul 2018 0.13511980
## Aug 2018 0.11410458
## Sep 2018 0.29595640
## Oct 2018 0.23477662
## Nov 2018 0.17375576
## Dec 2018 0.39652300
- posteriori desnormalizaremos los datos:
## [,1]
## Mar 2015 0.0057832173
## Apr 2015 0.0079508775
## May 2015 0.0021802648
## Jun 2015 0.0036068854
## Jul 2015 -0.0002745099
## Aug 2015 0.0019052046
## Sep 2015 -0.0023711290
## Oct 2015 -0.0015609719
## Nov 2015 -0.0018579283
## Dec 2015 0.0028149581
## Jan 2016 0.0147426243
## Feb 2016 0.0204311525
## Mar 2016 0.0135916710
## Apr 2016 0.0071477158
## May 2016 -0.0013187523
## Jun 2016 -0.0012562211
## Jul 2016 0.0041361929
## Aug 2016 -0.0003094184
## Sep 2016 -0.0095987886
## Oct 2016 -0.0060871132
## Nov 2016 0.0084718646
## Dec 2016 0.0017230200
## Jan 2017 0.0117493648
## Feb 2017 0.0202104863
## Mar 2017 0.0175945928
## Apr 2017 0.0060995560
## May 2017 0.0033670578
## Jun 2017 0.0021642779
## Jul 2017 0.0090352284
## Aug 2017 -0.0042357792
## Sep 2017 -0.0019853738
## Oct 2017 -0.0057266199
## Nov 2017 -0.0048526151
## Dec 2017 0.0059929630
## Jan 2018 0.0086769097
## Feb 2018 0.0042622400
## Mar 2018 -0.0011340503
## Apr 2018 0.0019957748
## May 2018 0.0029655960
## Jun 2018 0.0032107593
## Jul 2018 0.0003401386
## Aug 2018 -0.0002104601
## Sep 2018 0.0045540578
## Oct 2018 0.0029511473
## Nov 2018 0.0013524010
## Dec 2018 0.0071889026
- Ahora veamos la representación de los valores predecidos para el siguiente periodo.
x <- 1:(tamano_total+length(mod5))
y <- c(as.vector(Z),mod5)
plot(x[1:tamano_total], y[1:tamano_total],col = "blue", type="l")
lines( x[(tamano_total):length(x)], y[(tamano_total):length(x)], col="red")## [1] 274
- Aquà vemos la grÔfica con los valores predecidos con la linea roja.
-Los valores que adelantamos en el tiempo corresponden a
mod5, de los cuales adelantaremos 12 meses a futuro para
nuestro estudio.
Modelo Jordan
En las redes Jordan, la diferencia esta en que la entrada de las neuronas de la capa de contexto se toma desde la salida de la red.
Realizamos las mismas operaciones que con la red Elman, sustituyendo el modelo, obtenemos el resultado para la red Jordan.
set.seed(42)
fit <-jordan(inputs[train],outputs[train],size=6,learnFuncParams=c(0.3),
maxit=78000)
plotIterativeError(fit, main = "Iterative Error for 6 Neuron")y <- as.vector(outputs[-test])
plot(y,type="l")
pred <- predict(fit, inputs[-test])
lines(pred,col = "red")## [,1]
## Mar 2015 8.356027e-03
## Apr 2015 9.040188e-03
## May 2015 6.627689e-03
## Jun 2015 2.397062e-03
## Jul 2015 1.219208e-03
## Aug 2015 6.075835e-03
## Sep 2015 5.101195e-03
## Oct 2015 9.087083e-03
## Nov 2015 3.202661e-03
## Dec 2015 1.665009e-03
## Jan 2016 3.267486e-03
## Feb 2016 8.347225e-03
## Mar 2016 3.011390e-03
## Apr 2016 9.088597e-04
## May 2016 4.415583e-04
## Jun 2016 -1.032922e-03
## Jul 2016 -6.350545e-04
## Aug 2016 -3.511731e-06
## Sep 2016 2.084550e-03
## Oct 2016 -7.010381e-04
## Nov 2016 -2.075223e-04
## Dec 2016 4.124171e-02
## Jan 2017 2.074871e-02
## Feb 2017 2.796732e-02
## Mar 2017 1.974752e-02
## Apr 2017 9.540181e-03
## May 2017 1.062435e-02
## Jun 2017 8.969732e-04
## Jul 2017 2.229772e-03
## Aug 2017 2.585686e-03
## Sep 2017 1.881212e-03
## Oct 2017 1.469792e-03
## Nov 2017 1.782364e-03
## Dec 2017 4.321295e-03
## Jan 2018 6.076782e-03
## Feb 2018 8.067465e-03
## Mar 2018 5.400921e-03
## Apr 2018 2.697154e-03
## May 2018 4.485050e-03
## Jun 2018 1.304361e-03
## Jul 2018 1.358508e-03
## Aug 2018 1.581382e-03
## Sep 2018 3.029937e-03
## Oct 2018 2.434016e-03
## Nov 2018 6.245761e-03
## Dec 2018 3.972846e-03
x <- 1:(tamano_total+length(mod6))
y <- c(as.vector(Z),mod6)
plot(x[1:tamano_total], y[1:tamano_total],col = "blue", type="l")
lines( x[(tamano_total):length(x)], y[(tamano_total):length(x)], col="red")La anterior grafica con los valores predecidos con la linea roja.
Los valores que adelantamos en el tiempo corresponden a mod6, de los cuales adelantaremos 12 meses a futuro para nuestro estudio
Estimación del error Comparativo de los modelos con los valores actuales observados.
data=IPC[229:241,]
data_real <- ts(data, start = c(2019,1), end=c(2019,12), frequency = 12)
data_real## Jan Feb Mar Apr May Jun Jul Aug Sep Oct
## 2019 0.0060 0.0057 0.0043 0.0050 0.0031 0.0027 0.0022 0.0009 0.0023 0.0016
## Nov Dec
## 2019 0.0010 0.0026
Ahora haremos la comparacion de nuestros modelos con la data_real(valor de test en RMSE).
- ETS:
## ME RMSE MAE MPE MAPE MASE
## Training set 4.010303e-05 0.002304734 0.001780198 -Inf Inf 0.7400362
## Test set 1.900180e-04 0.001609099 0.001326715 23.46858 53.30514 0.5515211
## ACF1 Theil's U
## Training set 0.2217259 NA
## Test set 0.6094793 0.834022
- HOLT-WINTERS:
## ME RMSE MAE MPE MAPE ACF1
## Test set 0.0006460168 0.001477215 0.001277648 36.79939 48.36339 0.4565426
## Theil's U
## Test set 0.923831
- NNTEAR:
## ME RMSE MAE MPE MAPE MASE
## Training set -2.326001e-06 0.001970607 0.001521731 -Inf Inf 0.6325901
## Test set 7.524794e-04 0.001459091 0.001082096 7.408959 38.79766 0.4498322
## ACF1 Theil's U
## Training set 0.1286471 NA
## Test set 0.2242569 0.4869346
- Para Elman y Jordan al no ser modelos con forecast, lo convertimos en series de tiempo para que lo acepte el comando accuracy.De tal forma que:
## [1] 0.0057832173 0.0079508775 0.0021802648 0.0036068854 -0.0002745099
## [6] 0.0019052046 -0.0023711290 -0.0015609719 -0.0018579283 0.0028149581
## [11] 0.0147426243 0.0204311525
## Jan Feb Mar Apr May
## 2019 0.0057832173 0.0079508775 0.0021802648 0.0036068854 -0.0002745099
## Jun Jul Aug Sep Oct
## 2019 0.0019052046 -0.0023711290 -0.0015609719 -0.0018579283 0.0028149581
## Nov Dec
## 2019 0.0147426243 0.0204311525
## Jan Feb Mar Apr May Jun
## 2019 0.008356027 0.009040188 0.006627689 0.002397062 0.001219208 0.006075835
## Jul Aug Sep Oct Nov Dec
## 2019 0.005101195 0.009087083 0.003202661 0.001665009 0.003267486 0.008347225
- ELMAN(RNN):
## ME RMSE MAE MPE MAPE ACF1
## Test set -0.00132922 0.006928758 0.004510715 -107.8698 254.7136 0.5178112
## Theil's U
## Test set 8.458994
- JORDAN(RNN):
## ME RMSE MAE MPE MAPE ACF1
## Test set -0.002248889 0.003631703 0.002996177 -141.4128 160.2011 0.151485
## Theil's U
## Test set 3.016997