Escuela Superior Politécnica del Litoral (ESPOL)
Taller Modelo VARMA
Integrantes: Cristian Tomalá, Víctor Avila, Marcelo Chávez
Maestría: Estadística Aplicada
Módulo III: Modelos de Pronóstico
Docente: Ph.D. Mariela González
Librerías a utilizar:
Las librerías empleadas en este trabajo son:
library(forecast)
library(marima)
library(astsa)
library(nortest)
library(openxlsx)
library(vars)
library(dplyr)
library(DT)Carga de la Base de Datos de Clima:
Base_Total=read.xlsx("C:/Users/marcelochavez/Documents/MASTER_ESPOL/MODULO_3/db/Base_Total.xlsx",sheet="Hoja1")
Base_Total <- Base_Total %>%
rename(ANIO_EGRESO = anio_egr,
MES = mes,
A09_DIARREGA_GASTROENTERITIS = A09.Diarrea.y.gastroenteritis.de.presunto.origen.infeccioso,
A90_FIEBRE_DENGUE = `A90.Fiebre.del.dengue.[dengue.clásico]`,
E14_DIABETES_MELLITUS = `E14.Diabetes.mellitus,.no.especificada`,
J18_NEUMONIA = `J18.Neumonia,.organismo.no.especificado`,
J34_TRASTORNOS_NARIZ = J34.Otros.trastornos.de.la.nariz.y.de.los.senos.paranasales,
PROMEDIO_TEMPERATURA = Promedio.de.la.Temperatura.Superficial.aire,
PRECIPITACION = Total.acumulado.de.Preciptación) %>%
mutate(across(where(is.numeric), round, digits = 2))
DT::datatable(Base_Total, options = list(scrollX = T))Creación de los objetos de tipo serie:
series<-ts(Base_Total[ , c(6,4,8,9)],frequency=12,start=2010)
par(mfrow=c(4,1))Gráfico:
plot(series, main = "Gráfico de las TS de las Variables Seleccionadas")
Selección de los parámetros según el criterio de AIC:
VARselect((series),lag.max=10,type="const")#este da mejor resultado R2 mayores## $selection
## AIC(n) HQ(n) SC(n) FPE(n)
## 4 2 1 4
##
## $criteria
## 1 2 3 4 5
## AIC(n) 2.565421e+01 2.531937e+01 2.527890e+01 2.523030e+01 2.534387e+01
## HQ(n) 2.584091e+01 2.565544e+01 2.576433e+01 2.586510e+01 2.612803e+01
## SC(n) 2.611388e+01 2.614679e+01 2.647406e+01 2.679319e+01 2.727450e+01
## FPE(n) 1.385355e+11 9.920418e+10 9.547665e+10 9.131644e+10 1.029711e+11
## 6 7 8 9 10
## AIC(n) 2.551801e+01 2.563537e+01 2.559433e+01 2.558879e+01 2.559095e+01
## HQ(n) 2.645154e+01 2.671826e+01 2.682659e+01 2.697041e+01 2.712194e+01
## SC(n) 2.781639e+01 2.830149e+01 2.862819e+01 2.899039e+01 2.936029e+01
## FPE(n) 1.237529e+11 1.410598e+11 1.378659e+11 1.403735e+11 1.449459e+11Interpretación:
El AIC es calculado a partir de la función de verosimilitud del modelo y se utiliza para balancear la bondad de ajuste del modelo con la cantidad de parámetros que este tiene. La idea es encontrar un modelo que tenga un buen ajuste a los datos pero que no sea demasiado complejo, evitando el sobre ajuste.
Cuando se obtiene un valor bajo de AIC, es indicativo de que el modelo es más apropiado y presenta una mejor calidad de ajuste en comparación con otros modelos con valores de AIC más altos. Por lo tanto, un AIC de 4 sería muy bajo y sugeriría que el modelo VARMA tiene un ajuste excelente y que es más adecuado para los datos que otros modelos con valores de AIC más altos.
Es importante tener en cuenta que el AIC por sí solo no es suficiente para tomar decisiones finales sobre la elección del modelo. Es recomendable también considerar otros criterios, como el criterio de información bayesiano: SC (Schwarz Bayesian Criterion).
Para elegir el orden adecuado del modelo VARMA, normalmente seleccionamos el orden que minimiza alguno de estos criterios, como el AIC o el HQ. En este caso, el modelo VARMA con orden 1 tiene el valor más bajo según el criterio Bayesiano, y por lo tanto, es el preferido según este criterio.
Implementación del Modelo VAR:
Para el desarrollo del siguiente modelo se ha considerado la recomendación AIC con el parámetro = 4, es así que tenemos el siguiente resultado:
modelo<-VAR((series),p=4,type=c("both")) #este dio mejores resultadoas
modelo##
## VAR Estimation Results:
## =======================
##
## Estimated coefficients for equation J18_NEUMONIA:
## =================================================
## Call:
## J18_NEUMONIA = J18_NEUMONIA.l1 + A90_FIEBRE_DENGUE.l1 + PROMEDIO_TEMPERATURA.l1 + PRECIPITACION.l1 + J18_NEUMONIA.l2 + A90_FIEBRE_DENGUE.l2 + PROMEDIO_TEMPERATURA.l2 + PRECIPITACION.l2 + J18_NEUMONIA.l3 + A90_FIEBRE_DENGUE.l3 + PROMEDIO_TEMPERATURA.l3 + PRECIPITACION.l3 + J18_NEUMONIA.l4 + A90_FIEBRE_DENGUE.l4 + PROMEDIO_TEMPERATURA.l4 + PRECIPITACION.l4 + const + trend
##
## J18_NEUMONIA.l1 A90_FIEBRE_DENGUE.l1 PROMEDIO_TEMPERATURA.l1
## 0.660422234 -0.155733849 -7.378178477
## PRECIPITACION.l1 J18_NEUMONIA.l2 A90_FIEBRE_DENGUE.l2
## 0.194963107 -0.069775315 0.139568565
## PROMEDIO_TEMPERATURA.l2 PRECIPITACION.l2 J18_NEUMONIA.l3
## 3.291567522 -0.117010330 -0.002931107
## A90_FIEBRE_DENGUE.l3 PROMEDIO_TEMPERATURA.l3 PRECIPITACION.l3
## -0.058074197 35.030623341 -0.039449562
## J18_NEUMONIA.l4 A90_FIEBRE_DENGUE.l4 PROMEDIO_TEMPERATURA.l4
## -0.013720434 -0.040259167 -33.224593596
## PRECIPITACION.l4 const trend
## 0.024261906 233.091677684 -0.748551678
##
##
## Estimated coefficients for equation A90_FIEBRE_DENGUE:
## ======================================================
## Call:
## A90_FIEBRE_DENGUE = J18_NEUMONIA.l1 + A90_FIEBRE_DENGUE.l1 + PROMEDIO_TEMPERATURA.l1 + PRECIPITACION.l1 + J18_NEUMONIA.l2 + A90_FIEBRE_DENGUE.l2 + PROMEDIO_TEMPERATURA.l2 + PRECIPITACION.l2 + J18_NEUMONIA.l3 + A90_FIEBRE_DENGUE.l3 + PROMEDIO_TEMPERATURA.l3 + PRECIPITACION.l3 + J18_NEUMONIA.l4 + A90_FIEBRE_DENGUE.l4 + PROMEDIO_TEMPERATURA.l4 + PRECIPITACION.l4 + const + trend
##
## J18_NEUMONIA.l1 A90_FIEBRE_DENGUE.l1 PROMEDIO_TEMPERATURA.l1
## 0.077342339 0.896027326 10.008067491
## PRECIPITACION.l1 J18_NEUMONIA.l2 A90_FIEBRE_DENGUE.l2
## 0.154267600 -0.060452542 -0.198972282
## PROMEDIO_TEMPERATURA.l2 PRECIPITACION.l2 J18_NEUMONIA.l3
## -11.418973498 -0.045389752 0.009748746
## A90_FIEBRE_DENGUE.l3 PROMEDIO_TEMPERATURA.l3 PRECIPITACION.l3
## 0.196092796 4.941042032 -0.045843700
## J18_NEUMONIA.l4 A90_FIEBRE_DENGUE.l4 PROMEDIO_TEMPERATURA.l4
## -0.077979758 -0.153496862 2.043887663
## PRECIPITACION.l4 const trend
## -0.032531493 -96.283946863 -0.280534440
##
##
## Estimated coefficients for equation PROMEDIO_TEMPERATURA:
## =========================================================
## Call:
## PROMEDIO_TEMPERATURA = J18_NEUMONIA.l1 + A90_FIEBRE_DENGUE.l1 + PROMEDIO_TEMPERATURA.l1 + PRECIPITACION.l1 + J18_NEUMONIA.l2 + A90_FIEBRE_DENGUE.l2 + PROMEDIO_TEMPERATURA.l2 + PRECIPITACION.l2 + J18_NEUMONIA.l3 + A90_FIEBRE_DENGUE.l3 + PROMEDIO_TEMPERATURA.l3 + PRECIPITACION.l3 + J18_NEUMONIA.l4 + A90_FIEBRE_DENGUE.l4 + PROMEDIO_TEMPERATURA.l4 + PRECIPITACION.l4 + const + trend
##
## J18_NEUMONIA.l1 A90_FIEBRE_DENGUE.l1 PROMEDIO_TEMPERATURA.l1
## -0.0002490444 -0.0006976786 0.8105144448
## PRECIPITACION.l1 J18_NEUMONIA.l2 A90_FIEBRE_DENGUE.l2
## 0.0009446136 -0.0001109551 0.0024745661
## PROMEDIO_TEMPERATURA.l2 PRECIPITACION.l2 J18_NEUMONIA.l3
## -0.2205904220 0.0012860729 -0.0002018143
## A90_FIEBRE_DENGUE.l3 PROMEDIO_TEMPERATURA.l3 PRECIPITACION.l3
## -0.0027614238 0.1832016310 -0.0005554908
## J18_NEUMONIA.l4 A90_FIEBRE_DENGUE.l4 PROMEDIO_TEMPERATURA.l4
## 0.0001646800 0.0011129459 -0.2609667669
## PRECIPITACION.l4 const trend
## -0.0017866981 12.9042652038 0.0010170906
##
##
## Estimated coefficients for equation PRECIPITACION:
## ==================================================
## Call:
## PRECIPITACION = J18_NEUMONIA.l1 + A90_FIEBRE_DENGUE.l1 + PROMEDIO_TEMPERATURA.l1 + PRECIPITACION.l1 + J18_NEUMONIA.l2 + A90_FIEBRE_DENGUE.l2 + PROMEDIO_TEMPERATURA.l2 + PRECIPITACION.l2 + J18_NEUMONIA.l3 + A90_FIEBRE_DENGUE.l3 + PROMEDIO_TEMPERATURA.l3 + PRECIPITACION.l3 + J18_NEUMONIA.l4 + A90_FIEBRE_DENGUE.l4 + PROMEDIO_TEMPERATURA.l4 + PRECIPITACION.l4 + const + trend
##
## J18_NEUMONIA.l1 A90_FIEBRE_DENGUE.l1 PROMEDIO_TEMPERATURA.l1
## 0.06508728 0.15486984 27.07361469
## PRECIPITACION.l1 J18_NEUMONIA.l2 A90_FIEBRE_DENGUE.l2
## 0.52098093 -0.07253605 -0.19986785
## PROMEDIO_TEMPERATURA.l2 PRECIPITACION.l2 J18_NEUMONIA.l3
## 26.94267008 -0.06996156 -0.06722020
## A90_FIEBRE_DENGUE.l3 PROMEDIO_TEMPERATURA.l3 PRECIPITACION.l3
## 0.01850571 -33.23636139 -0.28002988
## J18_NEUMONIA.l4 A90_FIEBRE_DENGUE.l4 PROMEDIO_TEMPERATURA.l4
## -0.02420778 0.03128483 0.47027435
## PRECIPITACION.l4 const trend
## 0.04494145 -447.10687557 -0.27389069summary(modelo)##
## VAR Estimation Results:
## =========================
## Endogenous variables: J18_NEUMONIA, A90_FIEBRE_DENGUE, PROMEDIO_TEMPERATURA, PRECIPITACION
## Deterministic variables: both
## Sample size: 128
## Log Likelihood: -2257.494
## Roots of the characteristic polynomial:
## 0.9341 0.9341 0.73 0.7155 0.7155 0.6722 0.6722 0.6533 0.6533 0.623 0.623 0.609 0.4602 0.4602 0.4215 0.4215
## Call:
## VAR(y = (series), p = 4, type = c("both"))
##
##
## Estimation results for equation J18_NEUMONIA:
## =============================================
## J18_NEUMONIA = J18_NEUMONIA.l1 + A90_FIEBRE_DENGUE.l1 + PROMEDIO_TEMPERATURA.l1 + PRECIPITACION.l1 + J18_NEUMONIA.l2 + A90_FIEBRE_DENGUE.l2 + PROMEDIO_TEMPERATURA.l2 + PRECIPITACION.l2 + J18_NEUMONIA.l3 + A90_FIEBRE_DENGUE.l3 + PROMEDIO_TEMPERATURA.l3 + PRECIPITACION.l3 + J18_NEUMONIA.l4 + A90_FIEBRE_DENGUE.l4 + PROMEDIO_TEMPERATURA.l4 + PRECIPITACION.l4 + const + trend
##
## Estimate Std. Error t value Pr(>|t|)
## J18_NEUMONIA.l1 0.660422 0.089647 7.367 3.42e-11 ***
## A90_FIEBRE_DENGUE.l1 -0.155734 0.131605 -1.183 0.239224
## PROMEDIO_TEMPERATURA.l1 -7.378178 9.577221 -0.770 0.442721
## PRECIPITACION.l1 0.194963 0.066726 2.922 0.004224 **
## J18_NEUMONIA.l2 -0.069775 0.103790 -0.672 0.502819
## A90_FIEBRE_DENGUE.l2 0.139569 0.178608 0.781 0.436231
## PROMEDIO_TEMPERATURA.l2 3.291568 12.739421 0.258 0.796599
## PRECIPITACION.l2 -0.117010 0.076893 -1.522 0.130947
## J18_NEUMONIA.l3 -0.002931 0.100926 -0.029 0.976884
## A90_FIEBRE_DENGUE.l3 -0.058074 0.177463 -0.327 0.744103
## PROMEDIO_TEMPERATURA.l3 35.030623 12.645228 2.770 0.006577 **
## PRECIPITACION.l3 -0.039450 0.076689 -0.514 0.607997
## J18_NEUMONIA.l4 -0.013720 0.080533 -0.170 0.865031
## A90_FIEBRE_DENGUE.l4 -0.040259 0.123002 -0.327 0.744059
## PROMEDIO_TEMPERATURA.l4 -33.224594 9.322452 -3.564 0.000542 ***
## PRECIPITACION.l4 0.024262 0.074155 0.327 0.744153
## const 233.091678 233.199490 1.000 0.319728
## trend -0.748552 0.245296 -3.052 0.002853 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 68.98 on 110 degrees of freedom
## Multiple R-Squared: 0.7109, Adjusted R-squared: 0.6662
## F-statistic: 15.91 on 17 and 110 DF, p-value: < 2.2e-16
##
##
## Estimation results for equation A90_FIEBRE_DENGUE:
## ==================================================
## A90_FIEBRE_DENGUE = J18_NEUMONIA.l1 + A90_FIEBRE_DENGUE.l1 + PROMEDIO_TEMPERATURA.l1 + PRECIPITACION.l1 + J18_NEUMONIA.l2 + A90_FIEBRE_DENGUE.l2 + PROMEDIO_TEMPERATURA.l2 + PRECIPITACION.l2 + J18_NEUMONIA.l3 + A90_FIEBRE_DENGUE.l3 + PROMEDIO_TEMPERATURA.l3 + PRECIPITACION.l3 + J18_NEUMONIA.l4 + A90_FIEBRE_DENGUE.l4 + PROMEDIO_TEMPERATURA.l4 + PRECIPITACION.l4 + const + trend
##
## Estimate Std. Error t value Pr(>|t|)
## J18_NEUMONIA.l1 0.077342 0.063468 1.219 0.22560
## A90_FIEBRE_DENGUE.l1 0.896027 0.093173 9.617 2.96e-16 ***
## PROMEDIO_TEMPERATURA.l1 10.008067 6.780450 1.476 0.14280
## PRECIPITACION.l1 0.154268 0.047241 3.266 0.00146 **
## J18_NEUMONIA.l2 -0.060453 0.073481 -0.823 0.41246
## A90_FIEBRE_DENGUE.l2 -0.198972 0.126450 -1.574 0.11847
## PROMEDIO_TEMPERATURA.l2 -11.418973 9.019215 -1.266 0.20816
## PRECIPITACION.l2 -0.045390 0.054439 -0.834 0.40621
## J18_NEUMONIA.l3 0.009749 0.071454 0.136 0.89173
## A90_FIEBRE_DENGUE.l3 0.196093 0.125639 1.561 0.12145
## PROMEDIO_TEMPERATURA.l3 4.941042 8.952528 0.552 0.58213
## PRECIPITACION.l3 -0.045844 0.054294 -0.844 0.40030
## J18_NEUMONIA.l4 -0.077980 0.057015 -1.368 0.17419
## A90_FIEBRE_DENGUE.l4 -0.153497 0.087083 -1.763 0.08074 .
## PROMEDIO_TEMPERATURA.l4 2.043888 6.600079 0.310 0.75739
## PRECIPITACION.l4 -0.032531 0.052500 -0.620 0.53677
## const -96.283947 165.099826 -0.583 0.56096
## trend -0.280534 0.173664 -1.615 0.10909
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 48.84 on 110 degrees of freedom
## Multiple R-Squared: 0.7925, Adjusted R-squared: 0.7604
## F-statistic: 24.71 on 17 and 110 DF, p-value: < 2.2e-16
##
##
## Estimation results for equation PROMEDIO_TEMPERATURA:
## =====================================================
## PROMEDIO_TEMPERATURA = J18_NEUMONIA.l1 + A90_FIEBRE_DENGUE.l1 + PROMEDIO_TEMPERATURA.l1 + PRECIPITACION.l1 + J18_NEUMONIA.l2 + A90_FIEBRE_DENGUE.l2 + PROMEDIO_TEMPERATURA.l2 + PRECIPITACION.l2 + J18_NEUMONIA.l3 + A90_FIEBRE_DENGUE.l3 + PROMEDIO_TEMPERATURA.l3 + PRECIPITACION.l3 + J18_NEUMONIA.l4 + A90_FIEBRE_DENGUE.l4 + PROMEDIO_TEMPERATURA.l4 + PRECIPITACION.l4 + const + trend
##
## Estimate Std. Error t value Pr(>|t|)
## J18_NEUMONIA.l1 -0.0002490 0.0008396 -0.297 0.76731
## A90_FIEBRE_DENGUE.l1 -0.0006977 0.0012325 -0.566 0.57251
## PROMEDIO_TEMPERATURA.l1 0.8105144 0.0896951 9.036 6.29e-15 ***
## PRECIPITACION.l1 0.0009446 0.0006249 1.512 0.13351
## J18_NEUMONIA.l2 -0.0001110 0.0009720 -0.114 0.90933
## A90_FIEBRE_DENGUE.l2 0.0024746 0.0016727 1.479 0.14191
## PROMEDIO_TEMPERATURA.l2 -0.2205904 0.1193106 -1.849 0.06716 .
## PRECIPITACION.l2 0.0012861 0.0007201 1.786 0.07688 .
## J18_NEUMONIA.l3 -0.0002018 0.0009452 -0.214 0.83132
## A90_FIEBRE_DENGUE.l3 -0.0027614 0.0016620 -1.661 0.09946 .
## PROMEDIO_TEMPERATURA.l3 0.1832016 0.1184284 1.547 0.12475
## PRECIPITACION.l3 -0.0005555 0.0007182 -0.773 0.44093
## J18_NEUMONIA.l4 0.0001647 0.0007542 0.218 0.82757
## A90_FIEBRE_DENGUE.l4 0.0011129 0.0011520 0.966 0.33610
## PROMEDIO_TEMPERATURA.l4 -0.2609668 0.0873091 -2.989 0.00345 **
## PRECIPITACION.l4 -0.0017867 0.0006945 -2.573 0.01142 *
## const 12.9042652 2.1840212 5.908 3.93e-08 ***
## trend 0.0010171 0.0022973 0.443 0.65883
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 0.646 on 110 degrees of freedom
## Multiple R-Squared: 0.7705, Adjusted R-squared: 0.735
## F-statistic: 21.72 on 17 and 110 DF, p-value: < 2.2e-16
##
##
## Estimation results for equation PRECIPITACION:
## ==============================================
## PRECIPITACION = J18_NEUMONIA.l1 + A90_FIEBRE_DENGUE.l1 + PROMEDIO_TEMPERATURA.l1 + PRECIPITACION.l1 + J18_NEUMONIA.l2 + A90_FIEBRE_DENGUE.l2 + PROMEDIO_TEMPERATURA.l2 + PRECIPITACION.l2 + J18_NEUMONIA.l3 + A90_FIEBRE_DENGUE.l3 + PROMEDIO_TEMPERATURA.l3 + PRECIPITACION.l3 + J18_NEUMONIA.l4 + A90_FIEBRE_DENGUE.l4 + PROMEDIO_TEMPERATURA.l4 + PRECIPITACION.l4 + const + trend
##
## Estimate Std. Error t value Pr(>|t|)
## J18_NEUMONIA.l1 0.06509 0.12935 0.503 0.6158
## A90_FIEBRE_DENGUE.l1 0.15487 0.18988 0.816 0.4165
## PROMEDIO_TEMPERATURA.l1 27.07361 13.81823 1.959 0.0526 .
## PRECIPITACION.l1 0.52098 0.09627 5.411 3.69e-07 ***
## J18_NEUMONIA.l2 -0.07254 0.14975 -0.484 0.6291
## A90_FIEBRE_DENGUE.l2 -0.19987 0.25770 -0.776 0.4397
## PROMEDIO_TEMPERATURA.l2 26.94267 18.38072 1.466 0.1456
## PRECIPITACION.l2 -0.06996 0.11094 -0.631 0.5296
## J18_NEUMONIA.l3 -0.06722 0.14562 -0.462 0.6453
## A90_FIEBRE_DENGUE.l3 0.01851 0.25605 0.072 0.9425
## PROMEDIO_TEMPERATURA.l3 -33.23636 18.24481 -1.822 0.0712 .
## PRECIPITACION.l3 -0.28003 0.11065 -2.531 0.0128 *
## J18_NEUMONIA.l4 -0.02421 0.11619 -0.208 0.8353
## A90_FIEBRE_DENGUE.l4 0.03128 0.17747 0.176 0.8604
## PROMEDIO_TEMPERATURA.l4 0.47027 13.45064 0.035 0.9722
## PRECIPITACION.l4 0.04494 0.10699 0.420 0.6753
## const -447.10688 336.46540 -1.329 0.1867
## trend -0.27389 0.35392 -0.774 0.4407
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 99.52 on 110 degrees of freedom
## Multiple R-Squared: 0.544, Adjusted R-squared: 0.4735
## F-statistic: 7.718 on 17 and 110 DF, p-value: 2.875e-12
##
##
##
## Covariance matrix of residuals:
## J18_NEUMONIA A90_FIEBRE_DENGUE PROMEDIO_TEMPERATURA
## J18_NEUMONIA 4758.067 8.507 -4.1665
## A90_FIEBRE_DENGUE 8.507 2384.891 -2.7395
## PROMEDIO_TEMPERATURA -4.166 -2.739 0.4173
## PRECIPITACION 846.773 -272.024 -6.2330
## PRECIPITACION
## J18_NEUMONIA 846.773
## A90_FIEBRE_DENGUE -272.024
## PROMEDIO_TEMPERATURA -6.233
## PRECIPITACION 9905.038
##
## Correlation matrix of residuals:
## J18_NEUMONIA A90_FIEBRE_DENGUE PROMEDIO_TEMPERATURA
## J18_NEUMONIA 1.000000 0.002525 -0.09350
## A90_FIEBRE_DENGUE 0.002525 1.000000 -0.08683
## PROMEDIO_TEMPERATURA -0.093500 -0.086834 1.00000
## PRECIPITACION 0.123346 -0.055969 -0.09694
## PRECIPITACION
## J18_NEUMONIA 0.12335
## A90_FIEBRE_DENGUE -0.05597
## PROMEDIO_TEMPERATURA -0.09694
## PRECIPITACION 1.00000Cálculo del módulo de los eigenvalues de la matriz de coeficientes.
r=roots(modelo)
r## [1] 0.9340546 0.9340546 0.7300060 0.7155017 0.7155017 0.6721875 0.6721875
## [8] 0.6532739 0.6532739 0.6230142 0.6230142 0.6089799 0.4602051 0.4602051
## [15] 0.4215167 0.4215167Interpretación:
En los resultados obtenidos sobres las raíces unitarias se evidencia que están dentro del círculo unitario (< a 1), esto se puede interpretar que el modelo planteado es es estacionario y estable.
par(mfrow=c(2,2))
plot(modelo)
Interpretación:
Serie: J18_NEUMONIA
En los gráficos se puede ver que el modelo planteado para la serie J18_NEUMONIA el modelo si trata de ajustarse al comportamiento de la serie original, aunque parece tener cierta tendencia decreciente.
Adicionalmente, los errores presentan cierta variabilidad, y esto lo podemos observar en las Autocorrelaciones ACF, que existe un rezago en el sexto mes, y podría indicar que el modelo VARMA no está capturando toda la información relevante en los datos.
También es importante mencionar que en los ACF y PACF no se observa un decaimiento gradual, por lo que el modelo VARMA no está capturando correctamente la autocorrelación en los datos y que los términos autorregresivos y de media móvil no son apropiados.
Serie: A90_FIEBRE_DENGUE
En la serie A_90_FIEBRE_DENGUE se observa que los casos reportados como Neumonía tienen un componente estacionario, y en conjunto con los picos estacionales puede causar que el modelo no pueda ajustarse a su tendencia o comportamiento.
Los valores dentro de estos límites sugieren que las correlaciones son estadísticamente significativas.
Serie: PROMEDIO_TEMPERATURA
El modelo en al serie está ajustándonse lo bastante bien en su comportamiento y esto puede ser porque visualmente se puede ver que es una serie estacionaria.
Mientras que los residuales tienen un comportamiento aleatorio y esto es consecuente con la línea de pronóstico. Sin embargo, hay rezagos en los periodos 4 y 8 que no son significativos estadísticamente pero esto sucede con una cierta periodicidad y esto puede sugerir la presencia de un componente estacional.
Serie: PRECIPITACIÓN
La variable precipitación no está sujeta a predecir su comportamiento
Variables Endógenas:
DT::datatable(modelo$datamat, options = list(scrollX = T))Variables reales de las series:
DT::datatable(modelo$y, options = list(scrollX = T))Variables reales de las series:
acf(residuals(modelo)[,])
Interpretación:
En la interpretación de los gráficos del ACF de los errores entre los pronósticos y valores reales de las variables o series utilizadas, vemos que no existen correlaciones estadísticamente significativos en la mayoría de rezagos, esto es muy bueno dado que el modelo con el número de parámetros planteados inicialmente con el criterio de AIC, está recogiendo la mayor variabilidad en cada TS (Time Serie).
Prueba de Autocorelación de los residuales:
serial.test(modelo,lags.pt=12)##
## Portmanteau Test (asymptotic)
##
## data: Residuals of VAR object modelo
## Chi-squared = 132.46, df = 128, p-value = 0.3756serial.test(modelo,lags.bg=12)##
## Portmanteau Test (asymptotic)
##
## data: Residuals of VAR object modelo
## Chi-squared = 197.96, df = 192, p-value = 0.3687Interpretación:
Hipótesis nula (H0): Los residuos del modelo de series de tiempo son independientes, lo que significa que no hay correlaciones significativas entre ellos. En otras palabras, no hay autocorrelación residual presente.
Hipótesis alternativa (H1): Existen correlaciones residuales significativas entre los residuos del modelo. Esto indicaría que los residuos no son independientes.
En este caso tanto el test de Test Portmanteau y el Test Breusch-Godfrey presentan valores p que son mayores que el nivel de significancia, no se puede rechazar la hipótesis nula, lo que sugiere que hay suficiente evidencia estadística de que los residuos son independientes y que el modelo es adecuado para los datos.
Prueba de Normalidad en los residuales:
normality.test(modelo, multivariate.only=F)## $J18_NEUMONIA
##
## JB-Test (univariate)
##
## data: Residual of J18_NEUMONIA equation
## Chi-squared = 7.3031, df = 2, p-value = 0.02595
##
##
## $A90_FIEBRE_DENGUE
##
## JB-Test (univariate)
##
## data: Residual of A90_FIEBRE_DENGUE equation
## Chi-squared = 98.331, df = 2, p-value < 2.2e-16
##
##
## $PROMEDIO_TEMPERATURA
##
## JB-Test (univariate)
##
## data: Residual of PROMEDIO_TEMPERATURA equation
## Chi-squared = 0.22363, df = 2, p-value = 0.8942
##
##
## $PRECIPITACION
##
## JB-Test (univariate)
##
## data: Residual of PRECIPITACION equation
## Chi-squared = 71.334, df = 2, p-value = 3.331e-16
##
##
## $JB
##
## JB-Test (multivariate)
##
## data: Residuals of VAR object modelo
## Chi-squared = 154.8, df = 8, p-value < 2.2e-16
##
##
## $Skewness
##
## Skewness only (multivariate)
##
## data: Residuals of VAR object modelo
## Chi-squared = 36.693, df = 4, p-value = 2.084e-07
##
##
## $Kurtosis
##
## Kurtosis only (multivariate)
##
## data: Residuals of VAR object modelo
## Chi-squared = 118.11, df = 4, p-value < 2.2e-16Interpretación:
Serie: J18_NEUMONIA
Para la variable J_18_NEUMONIA existe la suficiente evidencia estadística de no rechazar la H0, es decir los residuales del modelo presentan ruido blanco.
Para la variable A90_FIEBRE_DENGUE existe la suficiente evidencia estadística de no rechazar la H0, es decir los residuales del modelo presentan ruido blanco.
Para la variable A90_FIEBRE_DENGUE NO existe la suficiente evidencia estadística para rechazar la H0, es decir los residuales del modelo no presentan ruido blanco. Sin embargo, esta variables no es objeto de predicción en este modelo
Pero si analizamos el contexto del Test de Jarque-Bera todas las variables en conjunto para el modelo VARMA, sí presentan Ruido Blanco, es decir hay sufienciente evidencia estadística para no rechazar la H0
Matriz de datos para ajustar el modelo
DT::datatable(modelo$datamat, options = list(scrollX=T))Obtención de los Residuales
residuales <- as.data.frame(modelo$varresult$J18_NEUMONIA[[2]])
residuales <- residuales %>%
rename(RESIDUALES_NEUMONIA= "modelo$varresult$J18_NEUMONIA[[2]]") %>%
mutate(RESIDUALES_NEUMONIA = round(RESIDUALES_NEUMONIA, 2))
DT::datatable(residuales, options = list(scrollX=T))Test de Lilliefors
lillie.test(modelo$varresult$J18_NEUMONIA[[2]])##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: modelo$varresult$J18_NEUMONIA[[2]]
## D = 0.094149, p-value = 0.007314Interpretación:
El valor p (0.007314) es menor que el nivel de significancia típico de 0.05 (o 5%). Esto significa que hay suficiente evidencia para rechazar la hipótesis nula de normalidad. En otras palabras, los residuos del modelo VARMA no siguen una distribución normal
Calculamos la Suma del Error Cuadrático Medio
SSEneumonia = sum(modelo$varresult$J18_NEUMONIA[[2]]^2)
SSEneumonia## [1] 523387.3Gráfico de los Residuales de la Variable J_18_NEUMONIA
par(mfrow=c(1,1))
plot(modelo$varresult$J18_NEUMONIA[[2]],type="l", xlab="Mes",ylab="J18_NEUMONIA", main="Comportamiento de los Residuales")
Interpretación:
El valor p (0.007314) es menor que el nivel de significancia típico de 0.05 (o 5%). Esto significa que hay suficiente evidencia para rechazar la hipótesis nula de normalidad. En otras palabras, los residuos del modelo VARMA no siguen una distribución normal. De hecho presentan una variabilidad muy alta (Coef. de Variación = -4.18).
Predicción
fc <- forecast(modelo, h = 12)
plot(fc, type = "l")
Visualización de las predicciones del modelo y sus intervalos de confianza
fanchart(predict(modelo,n.ahead = 12, ci = 0.95))
Gráfico del ACF en los residuales hasta el rezago 52
acf(resid( modelo), 52)
Test de Pormanteau
serial.test(modelo, lags.pt=12, type="PT.adjusted")##
## Portmanteau Test (adjusted)
##
## data: Residuals of VAR object modelo
## Chi-squared = 141.04, df = 128, p-value = 0.2032Interpretacion
Los p-valores son mayores que el nivel de significancia (por ejemplo, 0.05), entonces no hay suficiente evidencia para rechazar la hipótesis nula de no autocorrelación. Esto significa que los residuos no muestran autocorrelación significativa en los rezagos evaluados.
Resultados del Modelo
modelo$varresult## $J18_NEUMONIA
##
## Call:
## lm(formula = y ~ -1 + ., data = datamat)
##
## Coefficients:
## J18_NEUMONIA.l1 A90_FIEBRE_DENGUE.l1 PROMEDIO_TEMPERATURA.l1
## 0.660422 -0.155734 -7.378178
## PRECIPITACION.l1 J18_NEUMONIA.l2 A90_FIEBRE_DENGUE.l2
## 0.194963 -0.069775 0.139569
## PROMEDIO_TEMPERATURA.l2 PRECIPITACION.l2 J18_NEUMONIA.l3
## 3.291568 -0.117010 -0.002931
## A90_FIEBRE_DENGUE.l3 PROMEDIO_TEMPERATURA.l3 PRECIPITACION.l3
## -0.058074 35.030623 -0.039450
## J18_NEUMONIA.l4 A90_FIEBRE_DENGUE.l4 PROMEDIO_TEMPERATURA.l4
## -0.013720 -0.040259 -33.224594
## PRECIPITACION.l4 const trend
## 0.024262 233.091678 -0.748552
##
##
## $A90_FIEBRE_DENGUE
##
## Call:
## lm(formula = y ~ -1 + ., data = datamat)
##
## Coefficients:
## J18_NEUMONIA.l1 A90_FIEBRE_DENGUE.l1 PROMEDIO_TEMPERATURA.l1
## 0.077342 0.896027 10.008067
## PRECIPITACION.l1 J18_NEUMONIA.l2 A90_FIEBRE_DENGUE.l2
## 0.154268 -0.060453 -0.198972
## PROMEDIO_TEMPERATURA.l2 PRECIPITACION.l2 J18_NEUMONIA.l3
## -11.418973 -0.045390 0.009749
## A90_FIEBRE_DENGUE.l3 PROMEDIO_TEMPERATURA.l3 PRECIPITACION.l3
## 0.196093 4.941042 -0.045844
## J18_NEUMONIA.l4 A90_FIEBRE_DENGUE.l4 PROMEDIO_TEMPERATURA.l4
## -0.077980 -0.153497 2.043888
## PRECIPITACION.l4 const trend
## -0.032531 -96.283947 -0.280534
##
##
## $PROMEDIO_TEMPERATURA
##
## Call:
## lm(formula = y ~ -1 + ., data = datamat)
##
## Coefficients:
## J18_NEUMONIA.l1 A90_FIEBRE_DENGUE.l1 PROMEDIO_TEMPERATURA.l1
## -0.0002490 -0.0006977 0.8105144
## PRECIPITACION.l1 J18_NEUMONIA.l2 A90_FIEBRE_DENGUE.l2
## 0.0009446 -0.0001110 0.0024746
## PROMEDIO_TEMPERATURA.l2 PRECIPITACION.l2 J18_NEUMONIA.l3
## -0.2205904 0.0012861 -0.0002018
## A90_FIEBRE_DENGUE.l3 PROMEDIO_TEMPERATURA.l3 PRECIPITACION.l3
## -0.0027614 0.1832016 -0.0005555
## J18_NEUMONIA.l4 A90_FIEBRE_DENGUE.l4 PROMEDIO_TEMPERATURA.l4
## 0.0001647 0.0011129 -0.2609668
## PRECIPITACION.l4 const trend
## -0.0017867 12.9042652 0.0010171
##
##
## $PRECIPITACION
##
## Call:
## lm(formula = y ~ -1 + ., data = datamat)
##
## Coefficients:
## J18_NEUMONIA.l1 A90_FIEBRE_DENGUE.l1 PROMEDIO_TEMPERATURA.l1
## 0.06509 0.15487 27.07361
## PRECIPITACION.l1 J18_NEUMONIA.l2 A90_FIEBRE_DENGUE.l2
## 0.52098 -0.07254 -0.19987
## PROMEDIO_TEMPERATURA.l2 PRECIPITACION.l2 J18_NEUMONIA.l3
## 26.94267 -0.06996 -0.06722
## A90_FIEBRE_DENGUE.l3 PROMEDIO_TEMPERATURA.l3 PRECIPITACION.l3
## 0.01851 -33.23636 -0.28003
## J18_NEUMONIA.l4 A90_FIEBRE_DENGUE.l4 PROMEDIO_TEMPERATURA.l4
## -0.02421 0.03128 0.47027
## PRECIPITACION.l4 const trend
## 0.04494 -447.10688 -0.27389Ajuste del Modelo
model = define.model(kvar=3, ar=c(1,2,3,4), ma=c(1))# (ar:genera autorregresion para los lags 1 y 2) y (ma:define terminos de promedios moviles al lag 1)
arp = model$ar.pattern#matriz de ceros y unos que definen el polinomio de la matriz
map = model$ma.pattern#matriz de ceros y unos que definen el polinomio de la matriz
J18_NEUMONIA = resid(detr <- lm(series[,1]~ time(series[,1]), na.action=NULL))
plot(J18_NEUMONIA)
xdata = matrix(cbind(J18_NEUMONIA, series[,3], series[,4]), ncol=3)
fit = marima(xdata, ar.pattern=arp, ma.pattern=map, means=1,penalty=1)## All cases in data, 1 to 132 accepted for completeness.
## 132 3 = MARIMA - dimension of datasummary(fit)## Length Class Mode
## N 1 -none- numeric
## DATA 396 -none- numeric
## kvar 1 -none- numeric
## ar.estimates 45 -none- numeric
## ma.estimates 18 -none- numeric
## Constant 3 -none- numeric
## ar.fvalues 45 -none- numeric
## ma.fvalues 18 -none- numeric
## ar.pvalues 45 -none- numeric
## ma.pvalues 18 -none- numeric
## ar.stdv 45 -none- numeric
## ma.stdv 18 -none- numeric
## residuals 396 -none- numeric
## fitted 396 -none- numeric
## resid.cov 9 -none- numeric
## data.cov 9 -none- numeric
## averages 3 -none- numeric
## mean.pattern 3 -none- numeric
## call.ar.pattern 45 -none- numeric
## call.ma.pattern 18 -none- numeric
## out.ar.pattern 45 -none- numeric
## out.ma.pattern 18 -none- numeric
## max.iter 1 -none- numeric
## penalty 1 -none- numeric
## weight 1 -none- numeric
## used.cases 128 -none- numeric
## trace 50 -none- numeric
## log.det 50 -none- numeric
## randoms 3 -none- numeric
## one.step 3 -none- numericinnov = t(resid(fit)) plot.ts(innov) 
acf(innov, na.action=na.pass,lag.max=12)
pred = ts(t(fitted(fit))[,1], start=start(series[,1]), freq=frequency(series[,1])) +
detr$coef[1] + detr$coef[2]*time(series[,1])
par(mfrow=c(1,1))
plot(pred, ylab="Casos de Neumonía", lwd=2, col=4); points(series[,1], xlab="Mes", main="Valores Reales vs Pronósticos")
Matriz de Covarianza
fit$resid.cov## u1 u2 u3
## u1 4251.716147 -2.1226047 754.766690
## u2 -2.122605 0.3722444 -6.426366
## u3 754.766690 -6.4263660 8231.803469Forecast de los Casos de Neumonía
forecast(pred,h=12)## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2021 104.66368 74.17441 135.1530 58.034360 151.2930
## Feb 2021 155.56472 109.37900 201.7504 84.929753 226.1997
## Mar 2021 223.57176 156.51161 290.6319 121.012114 326.1314
## Apr 2021 236.19924 163.03180 309.3667 124.299300 348.0992
## May 2021 157.24482 101.34524 213.1444 71.753781 242.7359
## Jun 2021 155.66686 98.51290 212.8208 68.257421 243.0763
## Jul 2021 151.92007 94.04366 209.7965 63.405738 240.4344
## Aug 2021 117.31452 65.04274 169.5863 37.371740 197.2573
## Sep 2021 98.16538 48.27938 148.0514 21.871333 174.4594
## Oct 2021 73.05493 26.14330 119.9666 1.309785 144.8001
## Nov 2021 91.07758 41.09969 141.0555 14.642989 167.5122
## Dec 2021 112.56432 58.37129 166.7573 29.683234 195.4454plot(forecast(pred,h=12),main="VARMA (4,1) - Casos de Neumonía")