Existen numerosas ocasiones en las cuales las variables guardan relaciones bidireccionales entre sí. Es decir, no solo \(Y\) afecta a \(X\), sino que \(X\) también afecta a \(Y\). Los modelos empleados hasta ahora, no son capaces de capturar dicho comportamiento.
Sin embargo, el modelo de Vectores Autorregresivos o VAR, si que lo permite:
\[ Y_t = \alpha_0 + \alpha_1Y_{t-1} + \alpha_2X_{t-1} + \epsilon_{t}\\ X_t = \beta_0 + \beta_1X_{t-1} + \beta_2Y_{t-1} + u_t \]
donde se ha escogido un número de variables \(k=2\) y de retardos \(p=1\) por sencillez, pero siendo el modelo generalizable a cualquier conjunto \(k=1,\ldots,K\) de variables aleatorias y \(p=1,\ldots,P\) retardos.
library(ggplot2, quietly=T)
library(forecast, quietly=T)
data("economics")
consumo = economics$pce %>% log %>% diff %>% ts(start=c(1967, 07), frequency=12)
desempleo = economics$unemploy %>% log %>% diff %>% ts(start=c(1967, 07), frequency=12)
datos <- ts.union(consumo, desempleo)
autoplot(datos) + xlab("") + ylab("") + theme_bw()
library(vars, quietly=T)
VARselect(datos, lag.max = 13, type=c("const")) #Selección de orden del VAR$selection
AIC(n) HQ(n) SC(n) FPE(n)
12 6 3 12
$criteria
1 2 3 4 5
AIC(n) -1.764123e+01 -1.770928e+01 -1.776039e+01 -1.777839e+01 -1.780951e+01
HQ(n) -1.762313e+01 -1.767910e+01 -1.771814e+01 -1.772407e+01 -1.774312e+01
SC(n) -1.759486e+01 -1.763200e+01 -1.765219e+01 -1.763928e+01 -1.763949e+01
FPE(n) 2.180266e-08 2.036843e-08 1.935365e-08 1.900834e-08 1.842598e-08
6 7 8 9 10
AIC(n) -1.782655e+01 -1.782352e+01 -1.784221e+01 -1.784945e+01 -1.785167e+01
HQ(n) -1.774809e+01 -1.773298e+01 -1.773961e+01 -1.773478e+01 -1.772492e+01
SC(n) -1.762561e+01 -1.759166e+01 -1.757945e+01 -1.755577e+01 -1.752707e+01
FPE(n) 1.811488e-08 1.817007e-08 1.783369e-08 1.770536e-08 1.766650e-08
11 12 13
AIC(n) -1.785775e+01 -1.786676e+01 -1.786633e+01
HQ(n) -1.771894e+01 -1.771587e+01 -1.770337e+01
SC(n) -1.750224e+01 -1.748034e+01 -1.744900e+01
FPE(n) 1.755968e-08 1.740272e-08 1.741063e-08modeloVAR <- VAR(datos, p=12, type=c("const")) #Estimación del modelo
summary(modeloVAR)#Resumen
VAR Estimation Results:
=========================
Endogenous variables: consumo, desempleo
Deterministic variables: const
Sample size: 561
Log Likelihood: 3469.588
Roots of the characteristic polynomial:
0.9744 0.876 0.876 0.8687 0.8687 0.8497 0.8497 0.8473 0.8473 0.8385 0.8385 0.8334 0.8334 0.8286 0.8286 0.824 0.824 0.8148 0.8148 0.7878 0.7878 0.729 0.729 0.5135
Call:
VAR(y = datos, p = 12, type = c("const"))
Estimation results for equation consumo:
========================================
consumo = consumo.l1 + desempleo.l1 + consumo.l2 + desempleo.l2 + consumo.l3 + desempleo.l3 + consumo.l4 + desempleo.l4 + consumo.l5 + desempleo.l5 + consumo.l6 + desempleo.l6 + consumo.l7 + desempleo.l7 + consumo.l8 + desempleo.l8 + consumo.l9 + desempleo.l9 + consumo.l10 + desempleo.l10 + consumo.l11 + desempleo.l11 + consumo.l12 + desempleo.l12 + const
Estimate Std. Error t value Pr(>|t|)
consumo.l1 -0.1917412 0.0432314 -4.435 1.12e-05 ***
desempleo.l1 -0.0150701 0.0085397 -1.765 0.07818 .
consumo.l2 -0.0055244 0.0445757 -0.124 0.90142
desempleo.l2 -0.0076812 0.0084468 -0.909 0.36357
consumo.l3 0.0641227 0.0447336 1.433 0.15232
desempleo.l3 -0.0122587 0.0084621 -1.449 0.14802
consumo.l4 0.0626403 0.0445335 1.407 0.16013
desempleo.l4 -0.0027378 0.0084704 -0.323 0.74666
consumo.l5 0.0792834 0.0439719 1.803 0.07194 .
desempleo.l5 0.0102157 0.0084667 1.207 0.22813
consumo.l6 0.0997613 0.0439380 2.271 0.02357 *
desempleo.l6 0.0014219 0.0085310 0.167 0.86769
consumo.l7 0.0475148 0.0437779 1.085 0.27825
desempleo.l7 0.0216564 0.0085378 2.537 0.01148 *
consumo.l8 0.1403817 0.0436131 3.219 0.00137 **
desempleo.l8 0.0164071 0.0085382 1.922 0.05518 .
consumo.l9 0.1412484 0.0442244 3.194 0.00149 **
desempleo.l9 0.0051179 0.0084911 0.603 0.54694
consumo.l10 0.0876676 0.0443292 1.978 0.04848 *
desempleo.l10 -0.0052164 0.0083954 -0.621 0.53464
consumo.l11 0.1336436 0.0446833 2.991 0.00291 **
desempleo.l11 0.0044546 0.0082578 0.539 0.58980
consumo.l12 0.0582583 0.0438372 1.329 0.18442
desempleo.l12 0.0105982 0.0081193 1.305 0.19234
const 0.0014107 0.0005789 2.437 0.01514 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.005018 on 536 degrees of freedom
Multiple R-Squared: 0.1635, Adjusted R-squared: 0.126
F-statistic: 4.365 on 24 and 536 DF, p-value: 7.645e-11
Estimation results for equation desempleo:
==========================================
desempleo = consumo.l1 + desempleo.l1 + consumo.l2 + desempleo.l2 + consumo.l3 + desempleo.l3 + consumo.l4 + desempleo.l4 + consumo.l5 + desempleo.l5 + consumo.l6 + desempleo.l6 + consumo.l7 + desempleo.l7 + consumo.l8 + desempleo.l8 + consumo.l9 + desempleo.l9 + consumo.l10 + desempleo.l10 + consumo.l11 + desempleo.l11 + consumo.l12 + desempleo.l12 + const
Estimate Std. Error t value Pr(>|t|)
consumo.l1 -1.0139801 0.2179173 -4.653 4.13e-06 ***
desempleo.l1 -0.0418458 0.0430464 -0.972 0.331435
consumo.l2 -0.7896301 0.2246937 -3.514 0.000478 ***
desempleo.l2 0.1177857 0.0425778 2.766 0.005864 **
consumo.l3 -0.4793588 0.2254893 -2.126 0.033971 *
desempleo.l3 0.1175444 0.0426549 2.756 0.006056 **
consumo.l4 -0.2097369 0.2244811 -0.934 0.350560
desempleo.l4 0.1105201 0.0426971 2.588 0.009902 **
consumo.l5 0.3617449 0.2216500 1.632 0.103255
desempleo.l5 0.1270671 0.0426783 2.977 0.003039 **
consumo.l6 0.1628471 0.2214791 0.735 0.462496
desempleo.l6 0.1151596 0.0430026 2.678 0.007634 **
consumo.l7 0.3460996 0.2206723 1.568 0.117381
desempleo.l7 0.0596034 0.0430364 1.385 0.166643
consumo.l8 0.5643426 0.2198412 2.567 0.010527 *
desempleo.l8 0.0746248 0.0430387 1.734 0.083511 .
consumo.l9 0.3576799 0.2229229 1.605 0.109193
desempleo.l9 0.0731534 0.0428014 1.709 0.088005 .
consumo.l10 0.4932116 0.2234512 2.207 0.027720 *
desempleo.l10 -0.0241842 0.0423191 -0.571 0.567919
consumo.l11 0.3282575 0.2252362 1.457 0.145594
desempleo.l11 0.0232047 0.0416252 0.557 0.577441
consumo.l12 -0.0022385 0.2209711 -0.010 0.991921
desempleo.l12 -0.1289334 0.0409270 -3.150 0.001722 **
const -0.0001761 0.0029182 -0.060 0.951911
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.0253 on 536 degrees of freedom
Multiple R-Squared: 0.2166, Adjusted R-squared: 0.1815
F-statistic: 6.176 on 24 and 536 DF, p-value: < 2.2e-16
Covariance matrix of residuals:
consumo desempleo
consumo 2.518e-05 -1.283e-05
desempleo -1.283e-05 6.399e-04
Correlation matrix of residuals:
consumo desempleo
consumo 1.000 -0.101
desempleo -0.101 1.000Una vez estimado un modelo VAR, se pueden hacer predicciones. Habitualmente, debido a las relaciones de endogeneidad entre variables que permite, el modelo VAR supera a la mayoría de los modelos en la predicción.
predicciones <- predict(modeloVAR, h=12)
forecast(modeloVAR, h=12) %>% autoplot() + xlab("") + theme_bw()
Además, se puede realizar un análisis estructural del modelo. En primer lugar, se pueden obtener las funciones de respuesta al impulso, que miden cuanto responderá una variable ante una innovación de una desviación típica en la otra.
impulsosconsumo <- irf(modeloVAR, impulse = "consumo", response = "desempleo", n.ahead=12, ortho=TRUE, cumulative=TRUE, boot = TRUE, runs=100)
plot(impulsosconsumo)
impulsosdesempleo <- irf(modeloVAR, impulse = "desempleo", response = "consumo", n.ahead=12, ortho=TRUE, cumulative=TRUE, boot = TRUE, runs=100)
plot(impulsosdesempleo) 
También se puede ejecutar una descomposición de la varianza predicha, con lo que se obtiene una idea de cuanto afecta la varianza del error de una variable en la otra.
descomposicion <- fevd(modeloVAR, n.ahead=24)
plot(descomposicion, ylab="", xlab="")
Si dos series temporales están cointegradas, en el largo plazo tenderán a coincidir. Sin embargo, en el corto plazo, existirán desviaciones. El modelo de vector de corrección de error VECM, explota este hecho, incluyendo coeficientes a largo plazo, y desviaciones a corto plazo.
\[ Y_t = \alpha_0 + \alpha_1(Y_{t-1} - \alpha_2X_{t-1}) + \gamma_1\Delta Y_{t-1} + \gamma_2 \Delta X_{t-1} + \epsilon_{t}\\ X_t = \beta_0 + \beta_1(X_{t-1} - \beta_2Y_{t-1}) + \delta_1 \Delta X_{t-1} + \delta_2 \Delta Y_{t-1} + u_t \]
consumo2 = economics$pce %>% ts(start=c(1967, 07), frequency=12)
desempleo2 = economics$unemploy %>% ts(start=c(1967, 07), frequency=12)
datos2 <- ts.union(consumo2, desempleo2)
autoplot(datos2) + xlab("") + ylab("") + theme_classic() #A priori el análisis gráfico no parece detectar cointegración
test1 <- ur.df(consumo2)
summary(test1)#Serie no es I(0)
###############################################
# Augmented Dickey-Fuller Test Unit Root Test #
###############################################
Test regression none
Call:
lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)
Residuals:
Min 1Q Median 3Q Max
-173.072 -4.184 3.631 13.383 172.732
Coefficients:
Estimate Std. Error t value Pr(>|t|)
z.lag.1 0.0035417 0.0002348 15.084 <2e-16 ***
z.diff.lag 0.0204848 0.0420327 0.487 0.626
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 25.53 on 570 degrees of freedom
Multiple R-squared: 0.4185, Adjusted R-squared: 0.4164
F-statistic: 205.1 on 2 and 570 DF, p-value: < 2.2e-16
Value of test-statistic is: 15.0842
Critical values for test statistics:
1pct 5pct 10pct
tau1 -2.58 -1.95 -1.62test2 <- ur.df(diff(consumo2))
summary(test2)#Pero si es I(1)
###############################################
# Augmented Dickey-Fuller Test Unit Root Test #
###############################################
Test regression none
Call:
lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)
Residuals:
Min 1Q Median 3Q Max
-122.508 -3.863 5.044 17.788 205.334
Coefficients:
Estimate Std. Error t value Pr(>|t|)
z.lag.1 -0.33426 0.04099 -8.154 2.26e-15 ***
z.diff.lag -0.40846 0.03847 -10.617 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 27.61 on 569 degrees of freedom
Multiple R-squared: 0.402, Adjusted R-squared: 0.3999
F-statistic: 191.2 on 2 and 569 DF, p-value: < 2.2e-16
Value of test-statistic is: -8.1539
Critical values for test statistics:
1pct 5pct 10pct
tau1 -2.58 -1.95 -1.62test3 <- ur.df(desempleo2)
summary(test3)#Serie no es I(0)
###############################################
# Augmented Dickey-Fuller Test Unit Root Test #
###############################################
Test regression none
Call:
lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)
Residuals:
Min 1Q Median 3Q Max
-840.67 -126.91 -0.81 125.19 789.87
Coefficients:
Estimate Std. Error t value Pr(>|t|)
z.lag.1 0.0002688 0.0010842 0.248 0.804
z.diff.lag 0.1833904 0.0412105 4.450 1.03e-05 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 212.8 on 570 degrees of freedom
Multiple R-squared: 0.0339, Adjusted R-squared: 0.03051
F-statistic: 10 on 2 and 570 DF, p-value: 5.382e-05
Value of test-statistic is: 0.2479
Critical values for test statistics:
1pct 5pct 10pct
tau1 -2.58 -1.95 -1.62test4 <- ur.df(diff(desempleo2))
summary(test4) #Pero si es I(1)
###############################################
# Augmented Dickey-Fuller Test Unit Root Test #
###############################################
Test regression none
Call:
lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)
Residuals:
Min 1Q Median 3Q Max
-792.17 -118.18 -0.02 123.88 695.86
Coefficients:
Estimate Std. Error t value Pr(>|t|)
z.lag.1 -0.59759 0.05161 -11.580 < 2e-16 ***
z.diff.lag -0.26782 0.04040 -6.629 7.85e-11 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 205.2 on 569 degrees of freedom
Multiple R-squared: 0.4505, Adjusted R-squared: 0.4486
F-statistic: 233.3 on 2 and 569 DF, p-value: < 2.2e-16
Value of test-statistic is: -11.5795
Critical values for test statistics:
1pct 5pct 10pct
tau1 -2.58 -1.95 -1.62johansen <- ca.jo(datos2, type="eigen", K=2) #Test de cointegración de johansen.
summary(johansen) #Eltest indica al menos una relación de cointegración.
######################
# Johansen-Procedure #
######################
Test type: maximal eigenvalue statistic (lambda max) , with linear trend
Eigenvalues (lambda):
[1] 0.107137493 0.005512336
Values of teststatistic and critical values of test:
test 10pct 5pct 1pct
r <= 1 | 3.16 6.50 8.18 11.65
r = 0 | 64.82 12.91 14.90 19.19
Eigenvectors, normalised to first column:
(These are the cointegration relations)
consumo2.l2 desempleo2.l2
consumo2.l2 1.0000000 1.000000
desempleo2.l2 -0.1984701 -2.602472
Weights W:
(This is the loading matrix)
consumo2.l2 desempleo2.l2
consumo2.d 0.002732568 -6.749625e-05
desempleo2.d 0.002403782 2.819766e-03modeloVECM <- cajorls(johansen, r=1)
modeloVECM$rlm
Call:
lm(formula = substitute(form1), data = data.mat)
Coefficients:
consumo2.d desempleo2.d
ect1 0.002733 0.002404
constant 12.507717 34.467272
consumo2.dl1 -0.037815 -1.672301
desempleo2.dl1 -0.020429 0.158024
$beta
ect1
consumo2.l2 1.0000000
desempleo2.l2 -0.1984701