#Cargamos los paquetes y los datos que se utilizarán en el examen

library(tidyverse); library(dynlm); library(dLagM); library(AER); library(xts)

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0      ✔ purrr   1.0.1 
## ✔ tibble  3.1.8      ✔ dplyr   1.0.10
## ✔ tidyr   1.3.0      ✔ stringr 1.5.0 
## ✔ readr   2.1.3      ✔ forcats 0.5.2 
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## Loading required package: zoo
## 
## 
## Attaching package: 'zoo'
## 
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## 
## Loading required package: nardl
## 
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo 
## 
## Loading required package: car
## 
## Loading required package: carData
## 
## 
## Attaching package: 'car'
## 
## 
## The following object is masked from 'package:dplyr':
## 
##     recode
## 
## 
## The following object is masked from 'package:purrr':
## 
##     some
## 
## 
## Loading required package: lmtest
## 
## Loading required package: sandwich
## 
## Loading required package: survival
## 
## 
## Attaching package: 'xts'
## 
## 
## The following objects are masked from 'package:dplyr':
## 
##     first, last

library(ecm); library(openxlsx); library(urca); library(fpp3); library(hunspell);

## ── Attaching packages ────────────────────────────────────────────── fpp3 0.5 ──
## ✔ lubridate   1.9.1     ✔ feasts      0.3.0
## ✔ tsibble     1.1.3     ✔ fable       0.3.2
## ✔ tsibbledata 0.4.1     ✔ fabletools  0.3.2
## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date()      masks base::date()
## ✖ dplyr::filter()        masks stats::filter()
## ✖ xts::first()           masks dplyr::first()
## ✖ fabletools::forecast() masks dLagM::forecast()
## ✖ tsibble::index()       masks zoo::index()
## ✖ tsibble::intersect()   masks base::intersect()
## ✖ tsibble::interval()    masks lubridate::interval()
## ✖ dplyr::lag()           masks stats::lag()
## ✖ xts::last()            masks dplyr::last()
## ✖ fabletools::MAPE()     masks dLagM::MAPE()
## ✖ fabletools::MASE()     masks dLagM::MASE()
## ✖ car::recode()          masks dplyr::recode()
## ✖ tsibble::setdiff()     masks base::setdiff()
## ✖ car::some()            masks purrr::some()
## ✖ tsibble::union()       masks base::union()

library(tidyverse); library(tseries); library(lmtest); library(forecast); library(stats);

## 
## Attaching package: 'forecast'
## 
## The following objects are masked from 'package:fabletools':
## 
##     accuracy, forecast
## 
## The following object is masked from 'package:dLagM':
## 
##     forecast

library(zoo); library(urca); library(googlesheets4); library(ggplot2); library(dplyr);
library(feasts); library(lubridate); library(Hmisc); library(nortest); library(orcutt);

## Loading required package: lattice
## Loading required package: Formula
## 
## Attaching package: 'Hmisc'
## 
## The following objects are masked from 'package:dplyr':
## 
##     src, summarize
## 
## The following objects are masked from 'package:base':
## 
##     format.pval, units

library(patchwork); library(tidytext);library(ggpubr)

## 
## Attaching package: 'ggpubr'
## 
## The following object is masked from 'package:forecast':
## 
##     gghistogram

library(tidyverse); library(dynlm); library(dLagM); library(AER); library(xts)
library(ecm); library(openxlsx); library(urca)
library(vars)

## Loading required package: MASS
## 
## Attaching package: 'MASS'
## 
## The following object is masked from 'package:patchwork':
## 
##     area
## 
## The following object is masked from 'package:dplyr':
## 
##     select
## 
## Loading required package: strucchange
## 
## Attaching package: 'strucchange'
## 
## The following object is masked from 'package:stringr':
## 
##     boundary
## 
## 
## Attaching package: 'vars'
## 
## The following object is masked from 'package:fable':
## 
##     VAR

library(dplyr)
library(MASS)
library(fpp3); library(tidyverse); library(vars); library(urca); library(forecast)

Procedemos a subir la base

Filtramos la base para trabajar unicamente con los datos de enero de 2010 a enero 2023

#Filtrar para trabajar unicamente con los datos de enero de 2010 a enero 2023

subdata <- data |>
  filter(date>="ene. 2010" & date<="ene. 2023")

Descripción de los datos

Para el presente parcial se utilizarán varias series de tiempo extraídas de un archivo de xlsx específico. En la serie de tiempo se podrán encontrar las siguientes variables, todas con una incidencia mensual desde enero de 2010 hasta enero de 2023.

Inflación de la población pobre (infla_pobres)
Inflación de la población rica (infla_calta)
Depreciación del peso colombiano frente al dólar (depreciación)
Inflaicón de los Estados Unidos (infla_is)

Punto 1: Análisis gráfico de las series infla_pobres, infla_calta y depreciacion

plot.ts(subdata[, c("infla_pobres", "infla_calta", "depreciacion")], main = "Análisis gráfico")

La pregunta planteada es ¿Por qué la devaluación afecta más a los pobres?. Desde un punto de vista meramente económico, podemos decir que la devaluación es antipobre básicamente debido a que los pobres gasta una fracción más alta de sus ingresos en categorías de productos comerciables, es decir, productos que pueden ser vendidos en lugares o países diferentes que en el que fueron producidos. Debido a esto, productos de origen extranjero que bien pueden ser afectados por la devaluación del peso frente al dólar y que a su mismo tiempo hacen parte de la canasta familiar, afectan más fuertemente a la poblaicón pobre debido a que estos bienes toman una parte mayor de sus ingresos en comparación proporcional con la población rica.

Lo anterior es posible notarlo en el gráfico. A simple vista es posible observar una posible relación entre la depreciación y la inflación de pobres y ricos puesto que se comportan de maneras similares, no obstante, es notable que el comportamiento, las pendientes y los picos en la inflaicón de la clase alta son más achatados que para la clase pobre. Así pues, se podría inferir que la inflación tiene un efecto más templado o suave en los ricos que en los pobres.

Punto 2: Estimar 2 modelos VAR(1)

Primero se revisará si las series son estacionarias

DF.infla_pobres <- ur.df(subdata$infla_pobres, type = "trend", selectlags = "AIC")
summary(DF.infla_pobres)

## 
## ############################################### 
## # Augmented Dickey-Fuller Test Unit Root Test # 
## ############################################### 
## 
## Test regression trend 
## 
## 
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.50524 -0.20168 -0.03555  0.19027  1.54906 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.0186656  0.0680105  -0.274    0.784    
## z.lag.1     -0.0068754  0.0126720  -0.543    0.588    
## tt           0.0011272  0.0007531   1.497    0.137    
## z.diff.lag   0.5047631  0.0745767   6.768  2.7e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3738 on 151 degrees of freedom
## Multiple R-squared:  0.2741, Adjusted R-squared:  0.2597 
## F-statistic: 19.01 on 3 and 151 DF,  p-value: 1.64e-10
## 
## 
## Value of test-statistic is: -0.5426 1.2993 1.1232 
## 
## Critical values for test statistics: 
##       1pct  5pct 10pct
## tau3 -3.99 -3.43 -3.13
## phi2  6.22  4.75  4.07
## phi3  8.43  6.49  5.47

DF.infla_calta <- ur.df(subdata$infla_calta, type = "trend", selectlags = "AIC")
summary(DF.infla_calta)

## 
## ############################################### 
## # Augmented Dickey-Fuller Test Unit Root Test # 
## ############################################### 
## 
## Test regression trend 
## 
## 
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.72363 -0.14564 -0.00418  0.14094  0.91797 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.0201832  0.0455855  -0.443    0.659    
## z.lag.1     -0.0024921  0.0104037  -0.240    0.811    
## tt           0.0007267  0.0004837   1.502    0.135    
## z.diff.lag   0.5994163  0.0685436   8.745 4.05e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2413 on 151 degrees of freedom
## Multiple R-squared:  0.3852, Adjusted R-squared:  0.373 
## F-statistic: 31.53 on 3 and 151 DF,  p-value: 6.939e-16
## 
## 
## Value of test-statistic is: -0.2395 1.4126 1.207 
## 
## Critical values for test statistics: 
##       1pct  5pct 10pct
## tau3 -3.99 -3.43 -3.13
## phi2  6.22  4.75  4.07
## phi3  8.43  6.49  5.47

DF.depreciacion <- ur.df(subdata$depreciacion, type = "trend", selectlags = "AIC")
summary(DF.depreciacion)

## 
## ############################################### 
## # Augmented Dickey-Fuller Test Unit Root Test # 
## ############################################### 
## 
## Test regression trend 
## 
## 
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -14.942  -2.455  -0.173   2.211  13.028 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.446190   0.703783   0.634 0.527048    
## z.lag.1     -0.088256   0.027116  -3.255 0.001401 ** 
## tt           0.003879   0.008122   0.478 0.633604    
## z.diff.lag   0.289736   0.076128   3.806 0.000205 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.313 on 151 degrees of freedom
## Multiple R-squared:  0.1258, Adjusted R-squared:  0.1084 
## F-statistic: 7.243 on 3 and 151 DF,  p-value: 0.0001425
## 
## 
## Value of test-statistic is: -3.2548 3.7425 5.4368 
## 
## Critical values for test statistics: 
##       1pct  5pct 10pct
## tau3 -3.99 -3.43 -3.13
## phi2  6.22  4.75  4.07
## phi3  8.43  6.49  5.47

Dado que no es posible rechazar la hipótesis de raíz unitaria para ninguna de las 3 variables, debido a que los estadísticos respectivos son menores para todos los niveles de significancia de phi3, se procede a diferenciar las series.

#Diferencias series


#Diferenciar tasa de desempleo
subdata <- subdata |>
  mutate(dinfla_pobres = c(NA, diff(subdata$infla_pobres)),
         dinfla_calta = c(NA, diff(subdata$infla_calta)),
         d_depreciacion = c(NA, diff(subdata$infla_pobres)))

Probar que el test de Dickey-Fuller par alas nuevas variables diferenciadas sí rechaza la hipótesis nula de raíz unitaria

DF.dinfla_pobres <- ur.df(subdata[!is.na(subdata$dinfla_pobres),]$dinfla_pobres, type = "trend", selectlags = "AIC")
summary(DF.dinfla_pobres)

## 
## ############################################### 
## # Augmented Dickey-Fuller Test Unit Root Test # 
## ############################################### 
## 
## Test regression trend 
## 
## 
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.56220 -0.20280 -0.00821  0.19099  1.62339 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.0254584  0.0611817  -0.416    0.678    
## z.lag.1     -0.4420410  0.0817847  -5.405  2.5e-07 ***
## tt           0.0008016  0.0006946   1.154    0.250    
## z.diff.lag  -0.1298540  0.0817934  -1.588    0.114    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3721 on 150 degrees of freedom
## Multiple R-squared:  0.2647, Adjusted R-squared:   0.25 
## F-statistic:    18 on 3 and 150 DF,  p-value: 4.964e-10
## 
## 
## Value of test-statistic is: -5.4049 9.7451 14.6164 
## 
## Critical values for test statistics: 
##       1pct  5pct 10pct
## tau3 -3.99 -3.43 -3.13
## phi2  6.22  4.75  4.07
## phi3  8.43  6.49  5.47

DF.dinfla_calta <- ur.df(subdata[!is.na(subdata$dinfla_calta),]$dinfla_calta, type = "trend", selectlags = "AIC")
summary(DF.dinfla_calta)

## 
## ############################################### 
## # Augmented Dickey-Fuller Test Unit Root Test # 
## ############################################### 
## 
## Test regression trend 
## 
## 
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -0.7248 -0.1448  0.0094  0.1325  0.8704 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.0122046  0.0389265  -0.314   0.7543    
## z.lag.1     -0.3381510  0.0725391  -4.662 6.88e-06 ***
## tt           0.0005021  0.0004416   1.137   0.2573    
## z.diff.lag  -0.1533993  0.0803460  -1.909   0.0581 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2371 on 150 degrees of freedom
## Multiple R-squared:  0.2202, Adjusted R-squared:  0.2046 
## F-statistic: 14.12 on 3 and 150 DF,  p-value: 3.748e-08
## 
## 
## Value of test-statistic is: -4.6616 7.2821 10.868 
## 
## Critical values for test statistics: 
##       1pct  5pct 10pct
## tau3 -3.99 -3.43 -3.13
## phi2  6.22  4.75  4.07
## phi3  8.43  6.49  5.47

DF.d_depreciacion <- ur.df(subdata[!is.na(subdata$d_depreciacion),]$d_depreciacion, type = "trend", selectlags = "AIC")
summary(DF.d_depreciacion)

## 
## ############################################### 
## # Augmented Dickey-Fuller Test Unit Root Test # 
## ############################################### 
## 
## Test regression trend 
## 
## 
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.56220 -0.20280 -0.00821  0.19099  1.62339 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.0254584  0.0611817  -0.416    0.678    
## z.lag.1     -0.4420410  0.0817847  -5.405  2.5e-07 ***
## tt           0.0008016  0.0006946   1.154    0.250    
## z.diff.lag  -0.1298540  0.0817934  -1.588    0.114    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3721 on 150 degrees of freedom
## Multiple R-squared:  0.2647, Adjusted R-squared:   0.25 
## F-statistic:    18 on 3 and 150 DF,  p-value: 4.964e-10
## 
## 
## Value of test-statistic is: -5.4049 9.7451 14.6164 
## 
## Critical values for test statistics: 
##       1pct  5pct 10pct
## tau3 -3.99 -3.43 -3.13
## phi2  6.22  4.75  4.07
## phi3  8.43  6.49  5.47

Ahora que las series son estacionarias es posible trabajar con ellas.

Primero se convertiran las variables en series de tiempo

# Convirtiendo las variables a series de tiempo

infla_pobres <- ts(subdata$dinfla_pobres)
infla_pobres1 <- ts(subdata$infla_pobres)

infla_calta <- ts(subdata$dinfla_calta)
infla_calta1 <- ts(subdata$infla_calta)

depreciacion <- ts(subdata$d_depreciacion)
depreciacion1 <- ts(subdata$depreciacion)

Plantear modelo VAR entre infla_pobres y depreciación

#Seleccionar el orden del rezago del VAR

data.var11 <- cbind(infla_pobres1, depreciacion1)
colnames(data.var11) <- c("infla_pobres1", "depreciacion1")

select.var11 <- VARselect(data.var11, lag.max = 12, type = "const")
select.var11$selection

## AIC(n)  HQ(n)  SC(n) FPE(n) 
##      3      2      2      3

var11.est <- VAR(data.var11, p = 1, type = "const", season = NULL, exog = NULL)
summary(var11.est)

## 
## VAR Estimation Results:
## ========================= 
## Endogenous variables: infla_pobres1, depreciacion1 
## Deterministic variables: const 
## Sample size: 156 
## Log Likelihood: -539.458 
## Roots of the characteristic polynomial:
##  1.01 0.949
## Call:
## VAR(y = data.var11, p = 1, type = "const", exogen = NULL)
## 
## 
## Estimation results for equation infla_pobres1: 
## ============================================== 
## infla_pobres1 = infla_pobres1.l1 + depreciacion1.l1 + const 
## 
##                   Estimate Std. Error t value Pr(>|t|)    
## infla_pobres1.l1  1.015817   0.013075  77.693  < 2e-16 ***
## depreciacion1.l1  0.007215   0.002672   2.700  0.00772 ** 
## const            -0.032967   0.062913  -0.524  0.60103    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 0.418 on 153 degrees of freedom
## Multiple R-Squared: 0.9796,  Adjusted R-squared: 0.9793 
## F-statistic:  3671 on 2 and 153 DF,  p-value: < 2.2e-16 
## 
## 
## Estimation results for equation depreciacion1: 
## ============================================== 
## depreciacion1 = infla_pobres1.l1 + depreciacion1.l1 + const 
## 
##                  Estimate Std. Error t value Pr(>|t|)    
## infla_pobres1.l1 -0.05270    0.14326  -0.368    0.713    
## depreciacion1.l1  0.94327    0.02928  32.217   <2e-16 ***
## const             0.77446    0.68934   1.123    0.263    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 4.58 on 153 degrees of freedom
## Multiple R-Squared: 0.8883,  Adjusted R-squared: 0.8868 
## F-statistic: 608.3 on 2 and 153 DF,  p-value: < 2.2e-16 
## 
## 
## 
## Covariance matrix of residuals:
##               infla_pobres1 depreciacion1
## infla_pobres1        0.1747        0.2687
## depreciacion1        0.2687       20.9792
## 
## Correlation matrix of residuals:
##               infla_pobres1 depreciacion1
## infla_pobres1        1.0000        0.1403
## depreciacion1        0.1403        1.0000

var51.est <- VAR(data.var11, p = 5, type = "const", season = NULL, exog = NULL)
summary(var51.est)

## 
## VAR Estimation Results:
## ========================= 
## Endogenous variables: infla_pobres1, depreciacion1 
## Deterministic variables: const 
## Sample size: 152 
## Log Likelihood: -488.653 
## Roots of the characteristic polynomial:
## 0.9454 0.9454 0.8019 0.6453 0.6453 0.6015 0.6015 0.5347 0.4935 0.4935
## Call:
## VAR(y = data.var11, p = 5, type = "const", exogen = NULL)
## 
## 
## Estimation results for equation infla_pobres1: 
## ============================================== 
## infla_pobres1 = infla_pobres1.l1 + depreciacion1.l1 + infla_pobres1.l2 + depreciacion1.l2 + infla_pobres1.l3 + depreciacion1.l3 + infla_pobres1.l4 + depreciacion1.l4 + infla_pobres1.l5 + depreciacion1.l5 + const 
## 
##                   Estimate Std. Error t value Pr(>|t|)    
## infla_pobres1.l1  1.419903   0.083700  16.964  < 2e-16 ***
## depreciacion1.l1  0.020102   0.007164   2.806  0.00572 ** 
## infla_pobres1.l2 -0.315004   0.145009  -2.172  0.03150 *  
## depreciacion1.l2 -0.018254   0.011524  -1.584  0.11545    
## infla_pobres1.l3 -0.157016   0.149103  -1.053  0.29411    
## depreciacion1.l3  0.006690   0.011978   0.559  0.57735    
## infla_pobres1.l4  0.178530   0.148151   1.205  0.23020    
## depreciacion1.l4 -0.013329   0.011489  -1.160  0.24797    
## infla_pobres1.l5 -0.139607   0.086566  -1.613  0.10904    
## depreciacion1.l5  0.007968   0.007225   1.103  0.27200    
## const             0.062790   0.062513   1.004  0.31689    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 0.3675 on 141 degrees of freedom
## Multiple R-Squared: 0.9852,  Adjusted R-squared: 0.9841 
## F-statistic: 937.6 on 10 and 141 DF,  p-value: < 2.2e-16 
## 
## 
## Estimation results for equation depreciacion1: 
## ============================================== 
## depreciacion1 = infla_pobres1.l1 + depreciacion1.l1 + infla_pobres1.l2 + depreciacion1.l2 + infla_pobres1.l3 + depreciacion1.l3 + infla_pobres1.l4 + depreciacion1.l4 + infla_pobres1.l5 + depreciacion1.l5 + const 
## 
##                   Estimate Std. Error t value Pr(>|t|)    
## infla_pobres1.l1  1.640558   0.976168   1.681 0.095053 .  
## depreciacion1.l1  1.250727   0.083547  14.970  < 2e-16 ***
## infla_pobres1.l2 -3.775323   1.691201  -2.232 0.027170 *  
## depreciacion1.l2 -0.490631   0.134406  -3.650 0.000368 ***
## infla_pobres1.l3  2.076855   1.738939   1.194 0.234357    
## depreciacion1.l3  0.213848   0.139691   1.531 0.128044    
## infla_pobres1.l4  1.588459   1.727837   0.919 0.359491    
## depreciacion1.l4 -0.038760   0.133994  -0.289 0.772801    
## infla_pobres1.l5 -1.610455   1.009600  -1.595 0.112919    
## depreciacion1.l5 -0.008813   0.084266  -0.105 0.916850    
## const             0.904969   0.729071   1.241 0.216569    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 4.286 on 141 degrees of freedom
## Multiple R-Squared: 0.9006,  Adjusted R-squared: 0.8936 
## F-statistic: 127.8 on 10 and 141 DF,  p-value: < 2.2e-16 
## 
## 
## 
## Covariance matrix of residuals:
##               infla_pobres1 depreciacion1
## infla_pobres1        0.1350        0.1048
## depreciacion1        0.1048       18.3692
## 
## Correlation matrix of residuals:
##               infla_pobres1 depreciacion1
## infla_pobres1       1.00000       0.06651
## depreciacion1       0.06651       1.00000

Procedemos a calcular la estabilidad del VAR

# Estabilidad del VAR
barplot(roots(var51.est), ylim = c(0,1),
        main = "Estabilidad: Raíces de Polinomio Característico",
        names.arg = as.character(1:10))
abline(h = 1, col = "red", lty = 2, lwd = 2)

Chequear los residules del VAR

# Chequeando los residuales del VAR
plot(var51.est, names = "infla_pobres1")

plot(var51.est, names = "depreciacion1")

Test de No correlacion serial

# H0: No correlación serial
var51.serial <- serial.test(var51.est, lags.pt = 12, type = "PT.asymptotic")
var51.serial

## 
##  Portmanteau Test (asymptotic)
## 
## data:  Residuals of VAR object var51.est
## Chi-squared = 77.073, df = 28, p-value = 1.806e-06

plot(var51.serial, names="infla_pobres1")

plot(var51.serial, names="depreciacion1")

Test de homoscedasticidad

## H0: homoscedasticidad
var51.arch <- arch.test(var51.est, lags.multi = 5, 
                        multivariate.only = TRUE)
var51.arch

## 
##  ARCH (multivariate)
## 
## data:  Residuals of VAR object var51.est
## Chi-squared = 57.621, df = 45, p-value = 0.0982

Test de normalidad

# H0: normalidad
var51.norm <- normality.test(var51.est, multivariate.only = TRUE)
var51.norm

## $JB
## 
##  JB-Test (multivariate)
## 
## data:  Residuals of VAR object var51.est
## Chi-squared = 161.66, df = 4, p-value < 2.2e-16
## 
## 
## $Skewness
## 
##  Skewness only (multivariate)
## 
## data:  Residuals of VAR object var51.est
## Chi-squared = 9.5893, df = 2, p-value = 0.008274
## 
## 
## $Kurtosis
## 
##  Kurtosis only (multivariate)
## 
## data:  Residuals of VAR object var51.est
## Chi-squared = 152.07, df = 2, p-value < 2.2e-16

Test de Estabilidad estructural del VAR

# Estabilidad estructural del VAR
reccusum51 <- stability(var51.est, type = "OLS-CUSUM")
plot(reccusum51)

fluctuation51 <- stability(var51.est, type = "fluctuation")
plot(fluctuation51)

Test de causalidad de Granger

# Test de causalidad de Granger
var.cause.infla_pobres1.51 <- causality(var51.est, cause = "infla_pobres1")
var.cause.infla_pobres1.51

## $Granger
## 
##  Granger causality H0: infla_pobres1 do not Granger-cause depreciacion1
## 
## data:  VAR object var51.est
## F-Test = 1.4112, df1 = 5, df2 = 282, p-value = 0.2202
## 
## 
## $Instant
## 
##  H0: No instantaneous causality between: infla_pobres1 and depreciacion1
## 
## data:  VAR object var51.est
## Chi-squared = 0.66946, df = 1, p-value = 0.4132

var.cause.depreciacion1.511 <- causality(var51.est, cause = "depreciacion1")
var.cause.depreciacion1.511

## $Granger
## 
##  Granger causality H0: depreciacion1 do not Granger-cause infla_pobres1
## 
## data:  VAR object var51.est
## F-Test = 2.0409, df1 = 5, df2 = 282, p-value = 0.07308
## 
## 
## $Instant
## 
##  H0: No instantaneous causality between: depreciacion1 and infla_pobres1
## 
## data:  VAR object var51.est
## Chi-squared = 0.66946, df = 1, p-value = 0.4132

Realizar predicción

# Predicción 
predictions <- predict(var51.est, n.ahead = 8, ci = 0.95)
plot(predictions, names = "infla_pobres1")

plot(predictions, names = "depreciacion1")

fanchart(predictions, names = "depreciacion1")

predict_infla_pobres1 <- ts(c(rep(NA, length(infla_pobres1) - 1), infla_pobres1[length(infla_pobres1)], 
                       predictions$fcst$infla_pobres1[1:6,1]), start=c(1970, 1), 
                     end=c(2020, 4), frequency = 4)
lower_infla_pobres1 <- ts(c(rep(NA, length(infla_pobres1) - 1), infla_pobres1[length(infla_pobres1)], 
                     predictions$fcst$infla_pobres1[1:6,2]), start=c(1970, 1), 
                   end=c(2020, 4), frequency = 4)
upper_infla_pobres1 <- ts(c(rep(NA, length(infla_pobres1) - 1), infla_pobres1[length(infla_pobres1)], 
                     predictions$fcst$infla_pobres1[1:6,3]), start=c(1970, 1), 
                   end=c(2020, 4), frequency = 4) 
observed_infla_pobres1 <- ts(c(infla_pobres1, rep(NA, 6)), start=c(1970, 1), 
                      end=c(2020, 4), frequency = 4)

data_infla_pobres1 <- data.frame(date = as.yearqtr(seq(as.Date("1970-01-01"), by="quarter", length.out = 204), "%Y, %Q"),
                          actual = observed_infla_pobres1, 
                          predicho = predict_infla_pobres1, 
                          ic_l = lower_infla_pobres1, 
                          ic_u = upper_infla_pobres1)

ggplot(data_infla_pobres1[data_infla_pobres1$date>"2015 Q1",]) + 
  geom_line(aes(x = date, y = actual, color = "Observada"), linewidth = 0.6) + 
  geom_line(aes(x = date, y = predicho, color = "Predicha"), linewidth = 0.6) + 
  geom_ribbon(aes(x = date, y = predicho, ymin = ic_l, ymax = ic_u, fill="IC"), alpha = 0.1) +
  theme(legend.text = element_text(size = 6), text = element_text(size=7), legend.spacing.y = unit(-0.3, "cm"), legend.background=element_blank()) + 
  guides(shape = guide_legend(order = 2),col = guide_legend(order = 1)) + scale_color_manual(name = "", values = c("Observada" = "darkblue", "Predicha" = "red")) + 
  scale_fill_manual(values = c(IC = "steelblue"), labels = c(IC = "IC 95%")) + 
  labs(title = "Predicción del infla_pobres1o", x = "Años", y ="", fill = "") + 
  scale_x_continuous(n.breaks = 8)

## Warning: Removed 23 rows containing missing values (`geom_line()`).

## Warning in max(ids, na.rm = TRUE): ningun argumento finito para max; retornando
## -Inf

MODELO VAR 2 INFLA_CALTA - DEPRECIACION

Plantear modelo VAR entre infla_calta y depreciación

#Seleccionar el orden del rezago del VAR

data.var22 <- cbind(infla_calta1, depreciacion1)
colnames(data.var22) <- c("infla_calta1", "depreciacion1")

select.var22 <- VARselect(data.var22, lag.max = 12, type = "const")
select.var22$selection

## AIC(n)  HQ(n)  SC(n) FPE(n) 
##      3      2      2      3

var22.est <- VAR(data.var22, p = 1, type = "const", season = NULL, exog = NULL)
summary(var22.est)

## 
## VAR Estimation Results:
## ========================= 
## Endogenous variables: infla_calta1, depreciacion1 
## Deterministic variables: const 
## Sample size: 156 
## Log Likelihood: -481.721 
## Roots of the characteristic polynomial:
## 1.012 0.9488
## Call:
## VAR(y = data.var22, p = 1, type = "const", exogen = NULL)
## 
## 
## Estimation results for equation infla_calta1: 
## ============================================= 
## infla_calta1 = infla_calta1.l1 + depreciacion1.l1 + const 
## 
##                   Estimate Std. Error t value Pr(>|t|)    
## infla_calta1.l1   1.017191   0.011842  85.893  < 2e-16 ***
## depreciacion1.l1  0.005710   0.001884   3.031  0.00286 ** 
## const            -0.034200   0.047050  -0.727  0.46841    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 0.2887 on 153 degrees of freedom
## Multiple R-Squared: 0.984,   Adjusted R-squared: 0.9837 
## F-statistic:  4692 on 2 and 153 DF,  p-value: < 2.2e-16 
## 
## 
## Estimation results for equation depreciacion1: 
## ============================================== 
## depreciacion1 = infla_calta1.l1 + depreciacion1.l1 + const 
## 
##                  Estimate Std. Error t value Pr(>|t|)    
## infla_calta1.l1  -0.06387    0.18793  -0.340    0.734    
## depreciacion1.l1  0.94345    0.02989  31.559   <2e-16 ***
## const             0.78230    0.74664   1.048    0.296    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 4.581 on 153 degrees of freedom
## Multiple R-Squared: 0.8883,  Adjusted R-squared: 0.8868 
## F-statistic: 608.2 on 2 and 153 DF,  p-value: < 2.2e-16 
## 
## 
## 
## Covariance matrix of residuals:
##               infla_calta1 depreciacion1
## infla_calta1       0.08332        0.1842
## depreciacion1      0.18419       20.9820
## 
## Correlation matrix of residuals:
##               infla_calta1 depreciacion1
## infla_calta1        1.0000        0.1393
## depreciacion1       0.1393        1.0000

var52.est <- VAR(data.var22, p = 5, type = "const", season = NULL, exog = NULL)
summary(var52.est)

## 
## VAR Estimation Results:
## ========================= 
## Endogenous variables: infla_calta1, depreciacion1 
## Deterministic variables: const 
## Sample size: 152 
## Log Likelihood: -423.888 
## Roots of the characteristic polynomial:
## 0.9535 0.9535 0.7982 0.4349 0.4349 0.4227 0.4227 0.2128 0.2128 0.1601
## Call:
## VAR(y = data.var22, p = 5, type = "const", exogen = NULL)
## 
## 
## Estimation results for equation infla_calta1: 
## ============================================= 
## infla_calta1 = infla_calta1.l1 + depreciacion1.l1 + infla_calta1.l2 + depreciacion1.l2 + infla_calta1.l3 + depreciacion1.l3 + infla_calta1.l4 + depreciacion1.l4 + infla_calta1.l5 + depreciacion1.l5 + const 
## 
##                    Estimate Std. Error t value Pr(>|t|)    
## infla_calta1.l1   1.4851896  0.0843210  17.614   <2e-16 ***
## depreciacion1.l1  0.0027361  0.0047359   0.578   0.5644    
## infla_calta1.l2  -0.3738320  0.1504839  -2.484   0.0142 *  
## depreciacion1.l2  0.0033146  0.0075612   0.438   0.6618    
## infla_calta1.l3  -0.0330159  0.1557579  -0.212   0.8324    
## depreciacion1.l3 -0.0032252  0.0078046  -0.413   0.6801    
## infla_calta1.l4  -0.0860425  0.1531659  -0.562   0.5752    
## depreciacion1.l4 -0.0010998  0.0074268  -0.148   0.8825    
## infla_calta1.l5   0.0012767  0.0875825   0.015   0.9884    
## depreciacion1.l5  0.0001139  0.0046667   0.024   0.9806    
## const             0.0340093  0.0437679   0.777   0.4384    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 0.2409 on 141 degrees of freedom
## Multiple R-Squared: 0.9894,  Adjusted R-squared: 0.9886 
## F-statistic:  1316 on 10 and 141 DF,  p-value: < 2.2e-16 
## 
## 
## Estimation results for equation depreciacion1: 
## ============================================== 
## depreciacion1 = infla_calta1.l1 + depreciacion1.l1 + infla_calta1.l2 + depreciacion1.l2 + infla_calta1.l3 + depreciacion1.l3 + infla_calta1.l4 + depreciacion1.l4 + infla_calta1.l5 + depreciacion1.l5 + const 
## 
##                  Estimate Std. Error t value Pr(>|t|)    
## infla_calta1.l1   2.93144    1.49799   1.957 0.052333 .  
## depreciacion1.l1  1.24206    0.08413  14.763  < 2e-16 ***
## infla_calta1.l2  -6.12924    2.67340  -2.293 0.023346 *  
## depreciacion1.l2 -0.46814    0.13433  -3.485 0.000656 ***
## infla_calta1.l3   3.85384    2.76709   1.393 0.165890    
## depreciacion1.l3  0.15109    0.13865   1.090 0.277714    
## infla_calta1.l4   1.01496    2.72105   0.373 0.709706    
## depreciacion1.l4  0.01639    0.13194   0.124 0.901324    
## infla_calta1.l5  -1.78047    1.55593  -1.144 0.254435    
## depreciacion1.l5 -0.01954    0.08291  -0.236 0.814043    
## const             0.95410    0.77755   1.227 0.221849    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 4.28 on 141 degrees of freedom
## Multiple R-Squared: 0.9009,  Adjusted R-squared: 0.8939 
## F-statistic: 128.2 on 10 and 141 DF,  p-value: < 2.2e-16 
## 
## 
## 
## Covariance matrix of residuals:
##               infla_calta1 depreciacion1
## infla_calta1       0.05804       0.09928
## depreciacion1      0.09928      18.31811
## 
## Correlation matrix of residuals:
##               infla_calta1 depreciacion1
## infla_calta1       1.00000       0.09628
## depreciacion1      0.09628       1.00000