Algoritmos de Alisamiento Exponencial

Los mtoédos 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 problema principal es distinguir este patrón de posibles ruidos. 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.

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 parametro 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(readxl)
IPC <- read_excel("IPC.xlsx")

Damos formato de serie de tiempo

z1=ts(IPC, start = c(2000,1), end=c(2018,12),frequency = 12)
length(z1)

## [1] 228

Realizamos la gráfica de los datos

ts_plot(z1, title = "IPC")

autoplot(decompose(z1))

ts_decompose(z1)

ts_decompose(z1,type="multiplicative")

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.
Ahora vamos a desarrollar con este dataset un modelo de suavizado exponencial usando la función ets con los parámetros por defecto. Luego vamos a realizar la predicción de los proximos 12 meses y representaremos graficamente nuestra predicción, asi mismo visualizaremos los valores estimados y el grado de certeza del 95% en los que se muestra los intervalos inferior y superior de los mismos.
En primer lugar vamos a aplicar el modelo y ver visualmente la representacion de los residuos del mismo y vemos que se encuentran practicamente todos dentro de los limites de significancia del 2%, a excepcion de uno de los niveles (grafica ACF), y en general tienden a centrarse en 0, y van teniendo una distribucion normal(grafica residuals).

fit_ets_default <- ets(z1)
checkresiduals(fit_ets_default)

## 
##  Ljung-Box test
## 
## data:  Residuals from ETS(A,Ad,A)
## Q* = 59.913, df = 7, p-value = 1.571e-10
## 
## Model df: 17.   Total lags used: 24

mod2 <- forecast(fit_ets_default, 12, level = 95)
plot(mod2)

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.

autoplot(mod2)+
  autolayer(fitted(mod2), series="Ajuste")

print(summary(mod2))

## 
## 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.

pronostico <- as.data.frame(mod2)
pronostico

##          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.

Graficando nuevamente nuestros datos

ts_plot(z1)

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.

m1 = HoltWinters(z1, seasonal = "additive")

plot(m1)

hchart(forecast(m1,12))

A posterori realizaremos las predicciones a 12 meses vista y las graficaremos:

mod3=predict(m1, 12, prediction.interval = TRUE)
mod3

##                    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

plot(m1, mod3)

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:

set.seed(42)
neural_network <- nnetar(z1)

class(neural_network)

## [1] "nnetar"

Una vez hecho esto vamos a comprobar los residuos que presenta nuestro modelo.

checkresiduals(neural_network)

## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

Una vez hecho esto realizamos la predicción a 12 meses de los datos, con una significancia del 95% de los mismos.

mod4 <- forecast(neural_network, h=12, level = 95)
mod4

##              Jan         Feb         Mar         Apr         May         Jun
## 2019 0.001885196 0.004454993 0.003886488 0.003540138 0.002410783 0.001614344
##              Jul         Aug         Sep         Oct         Nov         Dec
## 2019 0.001094972 0.001680258 0.002113772 0.002082864 0.001714575 0.001891870

Luego realizamos un gráfico de nuestro pronostico.

autoplot(mod4)

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.

autoplot(mod4)+
  autolayer(fitted(mod4), series="Ajuste")

## Warning: Removed 12 row(s) containing missing values (geom_path).

Ahora vamos a determinar los resultados de este modelo creando un dataframe

pronostico <- as.data.frame(mod4)
pronostico

##              Jan         Feb         Mar         Apr         May         Jun
## 2019 0.001885196 0.004454993 0.003886488 0.003540138 0.002410783 0.001614344
##              Jul         Aug         Sep         Oct         Nov         Dec
## 2019 0.001094972 0.001680258 0.002113772 0.002082864 0.001714575 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

library(RSNNS)
library(quantmod)

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”.

Z <- as.ts(z1,F)
S <- (Z-min(Z))/(max(Z)-min(Z))  
plot(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.

tamano_total <- length(S)
tamano_total

## [1] 228

tamano_train <- round(tamano_total*0.75, digits = 0)
train <- 0:(tamano_train-1)
train

##   [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

test <- (tamano_train):tamano_total
test

##  [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)

DT::datatable(slogN)

Show entries

Search:

y	Lag.1	Lag.2	Lag.3	Lag.4	Lag.5	Lag.6	Lag.7	Lag.8	Lag.9
0.614503816793893
1	0.614503816793893
0.774809160305344	1	0.614503816793893
0.50381679389313	0.774809160305344	1	0.614503816793893
0.320610687022901	0.50381679389313	0.774809160305344	1	0.614503816793893
0.114503816793893	0.320610687022901	0.50381679389313	0.774809160305344	1	0.614503816793893
0.106870229007634	0.114503816793893	0.320610687022901	0.50381679389313	0.774809160305344	1	0.614503816793893
0.244274809160305	0.106870229007634	0.114503816793893	0.320610687022901	0.50381679389313	0.774809160305344	1	0.614503816793893
0.286259541984733	0.244274809160305	0.106870229007634	0.114503816793893	0.320610687022901	0.50381679389313	0.774809160305344	1	0.614503816793893
0.179389312977099	0.286259541984733	0.244274809160305	0.106870229007634	0.114503816793893	0.320610687022901	0.50381679389313	0.774809160305344	1	0.614503816793893

Showing 1 to 10 of 228 entries

Previous1 2 3 4 5…23Next

A continuacion eliminaremos los valores NA producidos al desplazar la serie:

slogN1 <- slogN[-(1:12),]
DT::datatable(slogN1)

Show entries

Search:

y	Lag.1	Lag.2	Lag.3	Lag.4	Lag.5	Lag.6	Lag.7	Lag.8	Lag.9	Lag.10	Lag.11	Lag.12
0.522900763358779	0.297709923664122	0.248091603053435	0.179389312977099	0.286259541984733	0.244274809160305	0.106870229007634	0.114503816793893	0.320610687022901	0.50381679389313	0.774809160305344	1	0.614503816793893
0.843511450381679	0.522900763358779	0.297709923664122	0.248091603053435	0.179389312977099	0.286259541984733	0.244274809160305	0.106870229007634	0.114503816793893	0.320610687022901	0.50381679389313	0.774809160305344	1
0.687022900763359	0.843511450381679	0.522900763358779	0.297709923664122	0.248091603053435	0.179389312977099	0.286259541984733	0.244274809160305	0.106870229007634	0.114503816793893	0.320610687022901	0.50381679389313	0.774809160305344
0.561068702290076	0.687022900763359	0.843511450381679	0.522900763358779	0.297709923664122	0.248091603053435	0.179389312977099	0.286259541984733	0.244274809160305	0.106870229007634	0.114503816793893	0.320610687022901	0.50381679389313
0.282442748091603	0.561068702290076	0.687022900763359	0.843511450381679	0.522900763358779	0.297709923664122	0.248091603053435	0.179389312977099	0.286259541984733	0.244274809160305	0.106870229007634	0.114503816793893	0.320610687022901
0.137404580152672	0.282442748091603	0.561068702290076	0.687022900763359	0.843511450381679	0.522900763358779	0.297709923664122	0.248091603053435	0.179389312977099	0.286259541984733	0.244274809160305	0.106870229007634	0.114503816793893
0.16412213740458	0.137404580152672	0.282442748091603	0.561068702290076	0.687022900763359	0.843511450381679	0.522900763358779	0.297709923664122	0.248091603053435	0.179389312977099	0.286259541984733	0.244274809160305	0.106870229007634
0.221374045801527	0.16412213740458	0.137404580152672	0.282442748091603	0.561068702290076	0.687022900763359	0.843511450381679	0.522900763358779	0.297709923664122	0.248091603053435	0.179389312977099	0.286259541984733	0.244274809160305
0.263358778625954	0.221374045801527	0.16412213740458	0.137404580152672	0.282442748091603	0.561068702290076	0.687022900763359	0.843511450381679	0.522900763358779	0.297709923664122	0.248091603053435	0.179389312977099	0.286259541984733
0.194656488549618	0.263358778625954	0.221374045801527	0.16412213740458	0.137404580152672	0.282442748091603	0.561068702290076	0.687022900763359	0.843511450381679	0.522900763358779	0.297709923664122	0.248091603053435	0.179389312977099

Showing 1 to 10 of 216 entries

Previous1 2 3 4 5…22Next

Luego definimos los valores de entrada y salida de la red neuronal:

inputs <- slogN1[,2:13]
outputs <- slogN1[,1]

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(7,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.

plotIterativeError(fit, main = "Iterative Error for 7,3 Neuron")

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.

predictions <- predict(fit,inputs[-train])
predictions

##                  [,1]
## mar. 2015  0.39472723
## abr. 2015  0.10397440
## may. 2015  0.19374275
## jun. 2015  0.18986328
## jul. 2015  0.12616295
## ago. 2015  0.18467408
## sept. 2015 0.16877146
## oct. 2015  0.20727716
## nov. 2015  0.18229540
## dic. 2015  0.20007998
## ene. 2016  0.30409372
## feb. 2016  1.24939060
## mar. 2016  1.22419739
## abr. 2016  0.50824922
## may. 2016  0.09520617
## jun. 2016  0.06936610
## jul. 2016  0.11139320
## ago. 2016  0.23795283
## sept. 2016 0.11234613
## oct. 2016  0.39679304
## nov. 2016  0.16949309
## dic. 2016  0.15842894
## ene. 2017  0.45507777
## feb. 2017  0.36827588
## mar. 2017  0.28984523
## abr. 2017  0.53109425
## may. 2017  0.25178891
## jun. 2017  0.34522510
## jul. 2017  0.79791200
## ago. 2017  0.03507949
## sept. 2017 0.16841722
## oct. 2017  0.24666004
## nov. 2017  0.26968348
## dic. 2017  0.89389551
## ene. 2018  0.29529381
## feb. 2018  0.09504437
## mar. 2018  0.41798824
## abr. 2018  0.27401382
## may. 2018  0.23980191
## jun. 2018  0.19724900
## jul. 2018  0.14100437
## ago. 2018  0.12808338
## sept. 2018 0.16470850
## oct. 2018  0.13536534
## nov. 2018  0.13359818
## dic. 2018  0.27180153

posteriori desnormalizaremos los datos:

mod5 <- predictions*(max(Z)-min(Z))+min(Z)
mod5

##                     [,1]
## mar. 2015   0.0071418534
## abr. 2015  -0.0004758707
## may. 2015   0.0018760601
## jun. 2015   0.0017744179
## jul. 2015   0.0001054692
## ago. 2015   0.0016384610
## sept. 2015  0.0012218123
## oct. 2015   0.0022306617
## nov. 2015   0.0015761394
## dic. 2015   0.0020420954
## ene. 2016   0.0047672554
## feb. 2016   0.0295340338
## mar. 2016   0.0288739716
## abr. 2016   0.0101161296
## may. 2016  -0.0007055983
## jun. 2016  -0.0013826082
## jul. 2016  -0.0002814982
## ago. 2016   0.0030343641
## sept. 2016 -0.0002565315
## oct. 2016   0.0071959776
## nov. 2016   0.0012407191
## dic. 2016   0.0009508382
## ene. 2017   0.0087230375
## feb. 2017   0.0064488281
## mar. 2017   0.0043939450
## abr. 2017   0.0107146694
## may. 2017   0.0033968696
## jun. 2017   0.0058448975
## jul. 2017   0.0177052944
## ago. 2017  -0.0022809173
## sept. 2017  0.0012125310
## oct. 2017   0.0032624930
## nov. 2017   0.0038657072
## dic. 2017   0.0202200623
## ene. 2018   0.0045366978
## feb. 2018  -0.0007098374
## mar. 2018   0.0077512919
## abr. 2018   0.0039791620
## may. 2018   0.0030828101
## jun. 2018   0.0019679237
## jul. 2018   0.0004943145
## ago. 2018   0.0001557845
## sept. 2018  0.0011153626
## oct. 2018   0.0003465718
## nov. 2018   0.0003002723
## dic. 2018   0.0039212001

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")

length(y)

## [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")

predictions <- predict(fit,inputs[-train])
mod6 <- predictions*(max(Z)-min(Z))+min(Z)
mod6

##                     [,1]
## mar. 2015   8.355755e-03
## abr. 2015   9.040808e-03
## may. 2015   6.627859e-03
## jun. 2015   2.397538e-03
## jul. 2015   1.219352e-03
## ago. 2015   6.075879e-03
## sept. 2015  5.101200e-03
## oct. 2015   9.087287e-03
## nov. 2015   3.202870e-03
## dic. 2015   1.664908e-03
## ene. 2016   3.266637e-03
## feb. 2016   8.346270e-03
## mar. 2016   3.010594e-03
## abr. 2016   9.085028e-04
## may. 2016   4.412913e-04
## jun. 2016  -1.033119e-03
## jul. 2016  -6.355353e-04
## ago. 2016  -3.661844e-06
## sept. 2016  2.084711e-03
## oct. 2016  -7.009399e-04
## nov. 2016  -2.087439e-04
## dic. 2016   4.123759e-02
## ene. 2017   2.074247e-02
## feb. 2017   2.795494e-02
## mar. 2017   1.974303e-02
## abr. 2017   9.533419e-03
## may. 2017   1.062336e-02
## jun. 2017   8.969974e-04
## jul. 2017   2.229517e-03
## ago. 2017   2.585415e-03
## sept. 2017  1.881098e-03
## oct. 2017   1.469833e-03
## nov. 2017   1.782007e-03
## dic. 2017   4.321510e-03
## ene. 2018   6.076722e-03
## feb. 2018   8.067360e-03
## mar. 2018   5.400895e-03
## abr. 2018   2.697297e-03
## may. 2018   4.485113e-03
## jun. 2018   1.304372e-03
## jul. 2018   1.358473e-03
## ago. 2018   1.581437e-03
## sept. 2018  3.030000e-03
## oct. 2018   2.434152e-03
## nov. 2018   6.245578e-03
## dic. 2018   3.973446e-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:

accuracy(mod2,data_real)

##                        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:

accuracy(mod3,data_real)

##                    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:

accuracy(mod4,data_real)

##                         ME        RMSE         MAE      MPE     MAPE      MASE
## Training set -2.325692e-06 0.001970607 0.001521731     -Inf      Inf 0.6325901
## Test set      7.524789e-04 0.001459090 0.001082095 7.408974 38.79763 0.4498317
##                   ACF1 Theil's U
## Training set 0.1286471        NA
## Test set     0.2242558 0.4869344

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:

mod5[1:12]

##  [1]  0.0071418534 -0.0004758707  0.0018760601  0.0017744179  0.0001054692
##  [6]  0.0016384610  0.0012218123  0.0022306617  0.0015761394  0.0020420954
## [11]  0.0047672554  0.0295340338

m5 <- mod5[1:12]
mod5c <- ts(m5, frequency=12,start=c(2019,1))
mod5c

##                Jan           Feb           Mar           Apr           May
## 2019  0.0071418534 -0.0004758707  0.0018760601  0.0017744179  0.0001054692
##                Jun           Jul           Aug           Sep           Oct
## 2019  0.0016384610  0.0012218123  0.0022306617  0.0015761394  0.0020420954
##                Nov           Dec
## 2019  0.0047672554  0.0295340338

m6 <- mod6[1:12]
mod6c <- ts(m6, frequency=12,start=c(2019,1))
mod6c

##              Jan         Feb         Mar         Apr         May         Jun
## 2019 0.008355755 0.009040808 0.006627859 0.002397538 0.001219352 0.006075879
##              Jul         Aug         Sep         Oct         Nov         Dec
## 2019 0.005101200 0.009087287 0.003202870 0.001664908 0.003266637 0.008346270

ELMAN(RNN):

accuracy(mod5c,data_real)

##                    ME       RMSE         MAE       MPE     MAPE     ACF1
## Test set -0.001336032 0.00821026 0.004266618 -97.17357 170.6869 0.183454
##          Theil's U
## Test set  11.20776

JORDAN(RNN):

accuracy(mod6c,data_real)

##                    ME        RMSE         MAE      MPE     MAPE      ACF1
## Test set -0.002248864 0.003631586 0.002996049 -141.407 160.1929 0.1514591
##          Theil's U
## Test set  3.016676

Alisamiento Exponencial

Wilson Sandoval R

2021-08-26