PROYECTO SERIES DE TIEMPO DESEMPLEO-IPC

Catalina Vásquez, Larry Aguirre y Daniel Aguirre

2022-11-26

Introducción

Con base en la definición de desempleo descrita por Enrico Pugliese :”El término desempleo incluye a todas las personas por encima de una determinada edad (variable en cada país) que en el período de referencia estaban: a) sin trabajo, es decir, no trabajaban por cuenta ajena ni por cuenta propia b) disponibles para trabajar en la actualidad, es decir, disponibles para un trabajo por cuenta ajena o por cuenta propia, c) buscando trabajo, es decir, actuando para encontrarlo»” (Pugliese, 2000), se puede inferir que entonces el desempleo es un fenómeno social que tiene unas características que le brinda la sociedad y el entorno en el que se produce impactando directamente las economías.

Una de las grandes problemáticas sociales de Colombia es el incremento del desempleo, por ejemplo, según el DANE (Departamento administrativo nacional de estadística) el desempleo en Colombia entre el 2015 y el 2019 ha incrementado, este incremento es visible puesto que en octubre de 2018 fue 9.1% y en el mismo periodo del año 2019 fue de 10.3%, este incremento sostenido de la tasa de desempleo ha venido desde la apertura de mercado que realizó el país en el inicio de los años 90 (Uribe García et al., 2008), para dar explicación a este fenómeno es importante también tener en cuenta la diversificación económica del país y también si se cuenta con empleos pero no se tiene mano de obra calificada para ocupar estos puestos lo que en sí mismo ayuda al crecimiento de la tasa de desempleo y de qué manera nuevas políticas gubernamentales tienen una incidencia directa, es importante mencionar que la tasa ha sido afectada de manera importante en los ultimos 3 años debido a la pandemia del SARSCOV 2 que produce la enfermedad del COVID 19.

En el actual documento se encuentra consignado un estudio de la tasa de desempleo de manera cuantitativa desde el punto de análisis de las series de tiempo en estadística, donde se pretende realizar una estimación de la tasa de desempleo a partir de un modelo matemático que tiene en cuenta los registros históricos y también si el comportamiento de la tasa de desempleo tiene relación con el comportamiento de otros indicadores económicos del país.

Justificación

La presente investigación tiene un enfoque netamente académico, donde se pretende realizar el análisis del comportamiento de la tasa de desempleo en colombia, puesto que previo a la pandemia del COVID 19 el comportamiento se podría considerar “normal” y podría ser explicados a partir de políticas económicas con los cambios de gobiernos, se ofrecerá al lector una modelo matemático que explica el comportamiento y que tiene la capacidad de realizar estimaciones de la tasa de desempleo.

Marco Teórico

El desempleo es “la relación porcentual entre el número de personas que están buscando trabajo (DS), y el número de personas que integran la fuerza laboral (PEA)” (DANE, n.d.). En términos económicos se aborda como un desbalance del mercado laboral que impacta de manera negativa en el crecimiento económico, suponiendo problemas en materia económica relacionados con la disminución del nivel de consumo de los hogares, reducción en el nivel de competitividad de un país e incluso de manera prolongada puede afectar los niveles de deuda pública. En materia social, supone aumento en las desigualdades sociales, disminución en la calidad de vida de las personas y aumento en los niveles de pobreza (Contreras & Cano, 2011).

Existen varios tipos de desempleo que afectan de diferentes maneras los indicadores económicos y sociales; el desempleo estacional que varía de acuerdo a la época del año y la demanda de fuerza de trabajo de las empresas, el desempleo friccional que corresponde a la falta de empleo voluntaria, el desempleo encubierto el cual es la subutilización de las capacidades de la fuerza de trabajo, el desempleo estructural que responde a cambios en la demanda de fuerza de trabajo relacionados con las competencias solicitadas o el lugar de ubicación del empleador y el desempleo cíclico relacionado con las variaciones del empleo a lo largo del ciclo económico (expansión, auge, recesión, depresión, recuperación) (Contreras & Cano, 2011).

A su vez el índice de precios al consumidor “Es una medida del cambio (variación), en el precio de bienes y servicios representativos del consumo de los hogares del país conocido como canasta” (DANE, n.d.). Se utiliza como medida de comprensión de los períodos de inflación, hacer comparaciones frente a otras economías y realizar proyecciones. El IPC es consolidado desde los años 50 por el Departamento Administrativo Nacional de Estadística.

“En Colombia las metas de inflación son fijadas en términos del Índice de Precios al Consumidor” (Cárdenas, 2010). Desde los años noventa el Banco de la República tiene independencia para fijar las metas de inflación con el objetivo de mantener el poder adquisitivo de la moneda.

La relación entre desempleo e inflación fue estudiada por William Phillips en 1958, donde planteó que existe una relación inversamente proporcional entre la inflación y el desempleo, es decir que a medida que los precios aumentan por el incremento en los salarios nominales, el desempleo se reduce, a esta abstracción se le denomino la curva de Phillips. Esta relación se ha estudiado ampliamente y se han incluido extensiones en la curva de Phillips que permitan su aplicabilidad en diferentes economías. (Calvo, n.d.)

Actualmente, en Colombia “el equilibrio de alto desempleo con baja inflación, al que el país estaba acostumbrado, fue alterado por la crisis de 2020” (Hernandez, 2022). Por lo tanto, se requieren medidas de política monetaria y laboral que estabilicen dos de los principales indicadores económicos. De un lado, el Banco de la República ha subido las tasas de interés para controlar la inflación. Mientras que, los sindicatos, los empresarios y el gobierno se preparan para la negociación del aumento del salario mínimo.

Estado del Arte

En Latinoamérica, se han utilizado las series de tiempo para predecir la inflación. En Uruguay (Cuitiño, 2010) indica que se utilizaron los datos históricos entre marzo de 1997 y octubre 2009 para predecir los valores del IPC entre noviembre de 2009 y julio de 2010, el mejor modelo de proyección fue el modelo directo con la muestra truncada (M2). En Venezuela, (Guerra 2001) indica las características de la serie de tiempo del IPC venezolano, para posteriormente utilizar un modelo ARIMA. En México, (Chiquiar, 2007) analizan la serie de tiempo del IPC mexicano entre 1995 y 2006 donde indican que las cifras hasta el 2000 se comportó de forma no estacionaria, pero desde ahí se empieza a comportar de forma estacionaria.

Por su parte en Colombia, para analizar el IPC con series de tiempo, en Colombia se han realizado varias tesis, una de las últimas, es la de (Palacio, 2018) en la que se utilizó un modelo AR(2), la cual pretendía predecir los precios de octubre y noviembre y que luego fue ajustada con un VAR(1).

Para el estudio de la inflación también se están utilizando redes neuronales regularizadas para predecir la inflación colombiana. (Carmona, 2022) indica que se utilizaron 24 variables para hacer las proyecciones, de las cuales siete fueron finalmente seleccionadas mediante un modelo aditivo generalizado. Indica que se entrenaron y evaluaron 100 modelos de redes neuronales con perceptrón multicapa con el objetivo de comparar el desempeño de tres regularizadores, LASSO (Least absolute shrinkage and selection operator), Ridge Regression y ElNet (Elastic Net), se realizó una validación cruzada de los modelos y los candidatos finales fueron evaluados con la medida del error cuadrático medio y coeficiente de determinación.

Asimismo, se ha utilizado el análisis de las series de tiempo de la inflación para determinar otras variables, como el tipo de cambio en la economía de países como Perú. (Arocutipa 2022) para lo cual se utilizaron cifras entre 2015 y 2021. En esta se mencionan las pruebas de normalidad y el modelo de regresión lineal, ajustado con el filtro del Kalman, utilizan el coeficiente de correlación de Pearson (R), el coeficiente de determinación (R2), análisis de varianza (ANOVA) y, por último, el coeficiente de regresión.

En sentido contrario, se han utilizado otras variables para apoyar la predicción del comportamiento de la inflación con base en otras variables, tal com lo indica (Villegas, 2002) en la cual muestra la relación que existe entre la inflación y el desempleo, dando como resultado una acción conjunta de eficiencia económica en los análisis en el corto y largo plazo, este estudio se enfocó en la curva de Phillips, que representa una curva empírica de pendiente negativa que relaciona estas dos variables.

Objetivo General

  • Analizar el resultado histórico del comportamiento de la tasa de desempleo en Colombia 2007-2022

Objetivos Específicos

  • Realizar el análisis general de la tendencia del desempleo de las mujeres en Colombia
  • Desarrollar el análisis de la tendencia del desempleo de las mujeres
  • Determinar el impacto del desempleo de las mujeres en el IPC

Obtención de los datos

Metodología Box-Jenkins

Implementación

1. Cargue de librerías

library(tseries)
library(ggplot2)
library(ggfortify)
library(dplyr)
library(plotly)
library(highcharter)
library(TSstudio)
library(astsa)
library(foreign)
library(forecast)
library(gridExtra)
library(seasonal)
library(lattice)
library(zoo)
library(urca)
library(dynlm)
library(readxl)
library(car)
library(highcharter)
library(vars)
library(TSA)
library(vars)
library(MTS)

2. Datos desempleo de las mujeres

Desempleo_Mujeres <- read_excel("C:/Users/RC/Desktop/TF-ST/Proyecto/D Mujeres.xlsx")
D_mujeres=ts(Desempleo_Mujeres[,2], start=c(2007,01), end=c(2022,02), frequency = 12)
D_mujeres
##            Jan       Feb       Mar       Apr       May       Jun       Jul
## 2007 19.008730 17.164641 16.221986 14.786790 15.626389 14.005873 14.572503
## 2008 17.378770 16.906553 14.667122 14.615468 13.383515 14.976876 15.721950
## 2009 18.903905 17.632435 15.499232 15.402948 14.729547 15.323113 16.561194
## 2010 18.655633 16.521885 16.074084 15.836794 15.652385 15.840337 16.429232
## 2011 18.548021 18.323087 14.598755 14.934495 14.456221 14.202905 15.421465
## 2012 17.626117 16.322720 13.541774 13.879872 14.224800 13.688870 14.380294
## 2013 16.283115 16.194874 13.063874 13.371389 12.177924 12.222705 13.630066
## 2014 15.676921 15.135007 12.565361 11.855642 11.627266 12.287298 11.827352
## 2015 14.858391 13.948747 11.798966 12.406208 11.616160 11.655249 11.446527
## 2016 16.676869 13.828488 13.298563 12.201732 11.854229 11.627736 13.098598
## 2017 15.279176 14.888958 13.120214 11.330733 12.974985 11.838625 13.411278
## 2018 15.966744 14.614039 12.903950 12.236868 12.845739 12.258731 12.933270
## 2019 17.028249 15.657076 14.246184 13.450591 14.016057 12.691467 14.109152
## 2020 16.904233 17.371813 16.611594 24.178375 25.908681 25.299708 26.867926
## 2021 21.733186 19.793681 19.008738 18.780411 18.829211 18.023557 17.303146
## 2022 19.395171 16.484428                                                  
##            Aug       Sep       Oct       Nov       Dec
## 2007 13.969634 13.797952 13.268100 12.622012 13.337300
## 2008 15.297004 14.615058 12.774204 13.673769 13.899675
## 2009 16.196524 15.843583 15.566436 14.680467 14.908416
## 2010 15.588060 14.572099 14.149807 14.595067 15.625090
## 2011 13.493849 13.337016 12.226297 12.452541 13.697060
## 2012 13.221176 12.702664 12.037954 12.323086 13.882432
## 2013 12.667993 11.774199 10.339314 11.416041 12.392851
## 2014 11.692678 11.016451 10.394963 10.958870 11.937213
## 2015 12.617254 11.418072 11.129715 10.166009 12.296861
## 2016 11.824199 11.484468 11.153980  9.817354 12.207863
## 2017 12.127152 12.392258 10.980225 11.581724 11.640468
## 2018 11.722536 12.142628 12.523949 11.993322 13.503447
## 2019 14.714965 13.729911 12.695464 12.613539 13.627145
## 2020 22.566182 20.881390 20.514106 18.673308 18.327839
## 2021 16.520367 15.079230 15.204980 14.913707 14.549509
## 2022
length(D_mujeres)
## [1] 182

3. Graficación General de los Datos

#Plot
par(mfrow=c(1,1))
plot(D_mujeres)

4. Definición de la Serie de Tiempo

z1=ts(Desempleo_Mujeres[,2], start=c(2007,01), end=c(2022,02), frequency = 12)
z1
##            Jan       Feb       Mar       Apr       May       Jun       Jul
## 2007 19.008730 17.164641 16.221986 14.786790 15.626389 14.005873 14.572503
## 2008 17.378770 16.906553 14.667122 14.615468 13.383515 14.976876 15.721950
## 2009 18.903905 17.632435 15.499232 15.402948 14.729547 15.323113 16.561194
## 2010 18.655633 16.521885 16.074084 15.836794 15.652385 15.840337 16.429232
## 2011 18.548021 18.323087 14.598755 14.934495 14.456221 14.202905 15.421465
## 2012 17.626117 16.322720 13.541774 13.879872 14.224800 13.688870 14.380294
## 2013 16.283115 16.194874 13.063874 13.371389 12.177924 12.222705 13.630066
## 2014 15.676921 15.135007 12.565361 11.855642 11.627266 12.287298 11.827352
## 2015 14.858391 13.948747 11.798966 12.406208 11.616160 11.655249 11.446527
## 2016 16.676869 13.828488 13.298563 12.201732 11.854229 11.627736 13.098598
## 2017 15.279176 14.888958 13.120214 11.330733 12.974985 11.838625 13.411278
## 2018 15.966744 14.614039 12.903950 12.236868 12.845739 12.258731 12.933270
## 2019 17.028249 15.657076 14.246184 13.450591 14.016057 12.691467 14.109152
## 2020 16.904233 17.371813 16.611594 24.178375 25.908681 25.299708 26.867926
## 2021 21.733186 19.793681 19.008738 18.780411 18.829211 18.023557 17.303146
## 2022 19.395171 16.484428                                                  
##            Aug       Sep       Oct       Nov       Dec
## 2007 13.969634 13.797952 13.268100 12.622012 13.337300
## 2008 15.297004 14.615058 12.774204 13.673769 13.899675
## 2009 16.196524 15.843583 15.566436 14.680467 14.908416
## 2010 15.588060 14.572099 14.149807 14.595067 15.625090
## 2011 13.493849 13.337016 12.226297 12.452541 13.697060
## 2012 13.221176 12.702664 12.037954 12.323086 13.882432
## 2013 12.667993 11.774199 10.339314 11.416041 12.392851
## 2014 11.692678 11.016451 10.394963 10.958870 11.937213
## 2015 12.617254 11.418072 11.129715 10.166009 12.296861
## 2016 11.824199 11.484468 11.153980  9.817354 12.207863
## 2017 12.127152 12.392258 10.980225 11.581724 11.640468
## 2018 11.722536 12.142628 12.523949 11.993322 13.503447
## 2019 14.714965 13.729911 12.695464 12.613539 13.627145
## 2020 22.566182 20.881390 20.514106 18.673308 18.327839
## 2021 16.520367 15.079230 15.204980 14.913707 14.549509
## 2022

5. Graficación Serie de Tiempo

# Gráfico 1
ts_plot(z1, slider = TRUE)
# Gráfico 2

hchart(z1)
# Gráfico 3
# Descomposiion Yt= Tt+ St+ Et

ts_decompose(z1)
# Gráfico 4
ts_heatmap(z1)
# Gráfico 5
ts_seasonal(z1, type="all")

6. Autocorrelaciones

# Serie original
par(mfrow=c(1,3))
plot(z1)
acf(z1, lag.max = 20)
pacf(z1, lag.max = 20)

# Diferencia ordinaria
par(mfrow=c(1,3))
plot(diff(z1), lag.max=20)
acf(diff(z1), lag.max = 20)
pacf(diff(z1), lag.max = 20)

# Diferencia estacional
par(mfrow=c(1,3))
plot(diff(z1,12), lag.max=20)
acf(diff(z1,12), lag.max = 20)
pacf(diff(z1, 12), lag.max = 20)

# Diferencia ordinaria y estacionaria
par(mfrow=c(1,3))
plot(diff(diff(z1,12)), lag.max=20)
acf(diff(diff(z1,12)), lag.max = 20)
pacf(diff(diff(z1,12)), lag.max = 20)

7. Prueba Dickey-Fuller

# Para z1
#H0 No es estacionaria
#Ha Es estacionaria
adf.test(z1)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  z1
## Dickey-Fuller = -2.3383, Lag order = 5, p-value = 0.4348
## alternative hypothesis: stationary
# para diff(z1)   d=1
#H0 No es estacionaria
#Ha Es estacionaria
adf.test(diff(z1))
## 
##  Augmented Dickey-Fuller Test
## 
## data:  diff(z1)
## Dickey-Fuller = -6.089, Lag order = 5, p-value = 0.01
## alternative hypothesis: stationary
# df para diff(z1,12)    D=1
#H0 No es estacionaria
#Ha Es estacionaria
adf.test(diff(z1,12))
## 
##  Augmented Dickey-Fuller Test
## 
## data:  diff(z1, 12)
## Dickey-Fuller = -3.4479, Lag order = 5, p-value = 0.04935
## alternative hypothesis: stationary
# df para diff(diff(z1,12))    d= 1 D=1
#H0 No es estacionaria
#Ha Es estacionaria
adf.test(diff(diff(z1,12)))
## 
##  Augmented Dickey-Fuller Test
## 
## data:  diff(diff(z1, 12))
## Dickey-Fuller = -5.5368, Lag order = 5, p-value = 0.01
## alternative hypothesis: stationary
ts_cor(diff(diff(z1,12)), lag.max = 50)

8. Elección del modelo

# SARIMA (10,1,10) X (1,1,1)
modelo1<-stats::arima(z1,order=c(10,1,10), 
                      seasonal=list(order=c(1,1,1), period=12), 
                      fixed = c(NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,
                                NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,
                                NA,NA))
modelo1
## 
## Call:
## stats::arima(x = z1, order = c(10, 1, 10), seasonal = list(order = c(1, 1, 1), 
##     period = 12), fixed = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
##     NA, NA, NA, NA, NA, NA, NA, NA, NA, NA))
## 
## Coefficients:
##           ar1      ar2      ar3      ar4      ar5      ar6     ar7      ar8
##       -0.1120  -0.5685  -0.3509  -0.2487  -0.6507  -0.3141  0.2325  -0.4350
## s.e.   0.3059   0.2200   0.2559   0.3068   0.2967   0.2825  0.2839   0.3046
##          ar9     ar10     ma1     ma2     ma3     ma4     ma5     ma6      ma7
##       0.1161  -0.4585  0.0391  0.8318  0.2780  0.1647  0.7760  0.1059  -0.2645
## s.e.  0.1925   0.1922  0.3144  0.2162  0.3321  0.3405  0.3407  0.3403   0.3395
##          ma8      ma9    ma10     sar1     sma1
##       0.3907  -0.5051  0.5175  -0.1358  -0.8153
## s.e.  0.3544   0.2186  0.2916   0.1413   0.1194
## 
## sigma^2 estimated as 0.8658:  log likelihood = -240.87,  aic = 527.74
BIC(modelo1)
## [1] 599.7244
tt <- modelo1$coef[which(modelo1$coef!=0)]/sqrt(diag(modelo1$var.coef))
1 - pt(abs(tt),(modelo1$nobs - length(modelo1$coef[which(modelo1$coef!=0)])))
##          ar1          ar2          ar3          ar4          ar5          ar6 
## 3.573693e-01 5.364892e-03 8.616973e-02 2.094929e-01 1.495459e-02 1.339329e-01 
##          ar7          ar8          ar9         ar10          ma1          ma2 
## 2.070797e-01 7.771250e-02 2.737123e-01 9.155389e-03 4.505722e-01 8.856820e-05 
##          ma3          ma4          ma5          ma6          ma7          ma8 
## 2.019589e-01 3.146073e-01 1.210131e-02 3.780244e-01 2.186311e-01 1.360187e-01 
##          ma9         ma10         sar1         sma1 
## 1.112253e-02 3.901937e-02 1.689687e-01 1.056497e-10

Primer ajuste del modelo:

modelo1<-stats::arima(z1,order=c(10,1,10), 
                      seasonal=list(order=c(0,1,1), period=12), 
                      fixed = c(0,NA,0,0,NA,0,0,0,0,NA,
                                0,NA,0,0,NA,0,0,0,NA,NA,NA))
## Warning in stats::arima(z1, order = c(10, 1, 10), seasonal = list(order = c(0, :
## some AR parameters were fixed: setting transform.pars = FALSE
modelo1
## 
## Call:
## stats::arima(x = z1, order = c(10, 1, 10), seasonal = list(order = c(0, 1, 1), 
##     period = 12), fixed = c(0, NA, 0, 0, NA, 0, 0, 0, 0, NA, 0, NA, 0, 0, NA, 
##     0, 0, 0, NA, NA, NA))
## 
## Coefficients:
##       ar1      ar2  ar3  ar4      ar5  ar6  ar7  ar8  ar9     ar10  ma1     ma2
##         0  -0.5071    0    0  -0.2614    0    0    0    0  -0.2679    0  0.8118
## s.e.    0   0.1199    0    0   0.1469    0    0    0    0   0.1026    0  0.1235
##       ma3  ma4     ma5  ma6  ma7  ma8      ma9    ma10     sma1
##         0    0  0.2844    0    0    0  -0.1231  0.2132  -0.8762
## s.e.    0    0  0.1440    0    0    0   0.1084  0.0905   0.1026
## 
## sigma^2 estimated as 1.02:  log likelihood = -253.21,  aic = 524.43
BIC(modelo1)
## [1] 552.5959
tt <- modelo1$coef[which(modelo1$coef!=0)]/sqrt(diag(modelo1$var.coef))
1 - pt(abs(tt),(modelo1$nobs - length(modelo1$coef[which(modelo1$coef!=0)])))
##          ar2          ar5         ar10          ma2          ma5          ma9 
## 1.946389e-05 3.858342e-02 4.936721e-03 3.236179e-10 2.499181e-02 1.289861e-01 
##         ma10         sma1 
## 9.874817e-03 4.662937e-15

Segundo ajuste del modelo:

modelo1<-stats::arima(z1,order=c(10,1,10), 
                      seasonal=list(order=c(0,1,1), period=12), 
                      fixed = c(0,NA,0,0,NA,0,0,0,0,NA,
                                0,NA,0,0,0,0,0,0,0,NA,NA))
## Warning in stats::arima(z1, order = c(10, 1, 10), seasonal = list(order = c(0, :
## some AR parameters were fixed: setting transform.pars = FALSE
modelo1
## 
## Call:
## stats::arima(x = z1, order = c(10, 1, 10), seasonal = list(order = c(0, 1, 1), 
##     period = 12), fixed = c(0, NA, 0, 0, NA, 0, 0, 0, 0, NA, 0, NA, 0, 0, 0, 
##     0, 0, 0, 0, NA, NA))
## 
## Coefficients:
##       ar1      ar2  ar3  ar4     ar5  ar6  ar7  ar8  ar9     ar10  ma1     ma2
##         0  -0.3616    0    0  0.0406    0    0    0    0  -0.2210    0  0.6594
## s.e.    0   0.1748    0    0  0.0695    0    0    0    0   0.1417    0  0.1424
##       ma3  ma4  ma5  ma6  ma7  ma8  ma9    ma10     sma1
##         0    0    0    0    0    0    0  0.1767  -0.8412
## s.e.    0    0    0    0    0    0    0  0.1216   0.1000
## 
## sigma^2 estimated as 1.069:  log likelihood = -253.86,  aic = 521.72
BIC(modelo1)
## [1] 543.6295
tt <- modelo1$coef[which(modelo1$coef!=0)]/sqrt(diag(modelo1$var.coef))
1 - pt(abs(tt),(modelo1$nobs - length(modelo1$coef[which(modelo1$coef!=0)])))
##          ar2          ar5         ar10          ma2         ma10         sma1 
## 2.008385e-02 2.798195e-01 6.033170e-02 3.688925e-06 7.400609e-02 9.547918e-15

Tercer ajuste del modelo:

modelo1<-stats::arima(z1,order=c(2,1,2), 
                      seasonal=list(order=c(0,1,1), period=12), 
                      fixed = c(0,NA,0,NA,NA))
## Warning in stats::arima(z1, order = c(2, 1, 2), seasonal = list(order = c(0, :
## some AR parameters were fixed: setting transform.pars = FALSE
modelo1
## 
## Call:
## stats::arima(x = z1, order = c(2, 1, 2), seasonal = list(order = c(0, 1, 1), 
##     period = 12), fixed = c(0, NA, 0, NA, NA))
## 
## Coefficients:
##       ar1      ar2  ma1     ma2     sma1
##         0  -0.2940    0  0.5795  -1.1222
## s.e.    0   0.2181    0  0.1883   0.1231
## 
## sigma^2 estimated as 0.849:  log likelihood = -254.93,  aic = 517.87
BIC(modelo1)
## [1] 530.3892
tt <- modelo1$coef[which(modelo1$coef!=0)]/sqrt(diag(modelo1$var.coef))
1 - pt(abs(tt),(modelo1$nobs - length(modelo1$coef[which(modelo1$coef!=0)])))
##          ar2          ma2         sma1 
## 8.976749e-02 1.223096e-03 1.110223e-16

Cuatro ajuste del modelo:

modelo1<-stats::arima(z1,order=c(0,1,2), 
                      seasonal=list(order=c(0,1,1), period=12), 
                      fixed = c(0,NA,NA))
modelo1
## 
## Call:
## stats::arima(x = z1, order = c(0, 1, 2), seasonal = list(order = c(0, 1, 1), 
##     period = 12), fixed = c(0, NA, NA))
## 
## Coefficients:
##       ma1     ma2     sma1
##         0  0.3204  -0.8775
## s.e.    0  0.0818   0.0918
## 
## sigma^2 estimated as 1.09:  log likelihood = -255.93,  aic = 517.86
BIC(modelo1)
## [1] 527.2536
tt <- modelo1$coef[which(modelo1$coef!=0)]/sqrt(diag(modelo1$var.coef))
1 - pt(abs(tt),(modelo1$nobs - length(modelo1$coef[which(modelo1$coef!=0)])))
##         ma2        sma1 
## 6.55872e-05 0.00000e+00

9. Análisis de los residuales

et=residuals(modelo1)
yfit=fitted(modelo1)

par(mfrow=c(3,2))
plot(yfit, col="red")
lines(z1)

plot(et)
acf(et)
pacf(et)

hist(et)
qqPlot(et)

## [1] 160 164

10. Pruebas

# Test de autocorrelación
#L Jun-Box

Box.test(et, lag=6, type="Ljung-Box")
## 
##  Box-Ljung test
## 
## data:  et
## X-squared = 7.952, df = 6, p-value = 0.2416
tsdiag(modelo1, gof.lag=20)

Ho. no hay autocorrelación serial, es necesario que no sean significativos r1=r2=r3=0 Ha. Hay presencia de correlación serial, al menos uno diferente Resultado 0.24 entonces No se rechaza la hipotesis nula

# Test de normalidad
# Jarque bera
jarque.bera.test(et)
## 
##  Jarque Bera Test
## 
## data:  et
## X-squared = 2063.1, df = 2, p-value < 2.2e-16

Ho. los residuales tiene distribución normal Ha. los residuales no tienen una distribución normal Resultado muy pequeño p-value < 2.2e-16 entonces rechazamos Ho y definimos que los residuales no tienen distribución normal

#Prueba de aleatoriedad
(sign(et))
##      Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 2007   1   1   1  -1   1  -1  -1  -1  -1  -1  -1  -1
## 2008  -1   1  -1   1  -1   1   1  -1  -1  -1   1   1
## 2009   1  -1  -1   1  -1   1   1   1  -1   1  -1  -1
## 2010  -1  -1   1   1  -1  -1  -1  -1  -1   1   1   1
## 2011  -1   1  -1   1   1  -1   1  -1   1   1   1   1
## 2012  -1  -1  -1   1   1  -1  -1  -1   1   1   1   1
## 2013  -1   1  -1   1  -1   1   1  -1  -1  -1   1   1
## 2014  -1   1  -1  -1   1   1  -1   1   1   1   1   1
## 2015  -1   1   1   1  -1  -1  -1   1  -1  -1  -1   1
## 2016   1  -1   1  -1  -1  -1   1  -1   1   1  -1   1
## 2017  -1   1   1  -1   1  -1   1  -1   1  -1   1  -1
## 2018   1   1   1  -1   1  -1  -1  -1   1   1  -1  -1
## 2019   1  -1   1  -1   1  -1   1   1  -1  -1   1   1
## 2020  -1   1   1   1   1  -1   1  -1  -1   1  -1  -1
## 2021   1  -1   1  -1  -1  -1  -1   1  -1   1   1  -1
## 2022   1  -1
runs.test(as.factor(sign(et)))
## 
##  Runs Test
## 
## data:  as.factor(sign(et))
## Standard Normal = 1.7839, p-value = 0.07443
## alternative hypothesis: two.sided

Ho.: Los residuales son aleatorios Ha : exhiben comportamiento

11. Pronóstico

Nos muestra el pronóstico de seis lags adelante y con bandas-ragos al 95% y al 80%

forecast(modelo1, h=6)
##          Point Forecast    Lo 80    Hi 80     Lo 95    Hi 95
## Mar 2022       15.26037 13.91889 16.60185 13.208751 17.31198
## Apr 2022       15.27126 13.37417 17.16834 12.369919 18.17259
## May 2022       15.50875 12.91337 18.10414 11.539454 19.47805
## Jun 2022       15.08421 11.94206 18.22636 10.278703 19.88972
## Jul 2022       15.84225 12.23528 19.44922 10.325871 21.35864
## Aug 2022       14.80613 10.78776 18.82451  8.660562 20.95171
z2=ts(Desempleo_Mujeres[,2], start=c(2007,01), end=c(2022,08), frequency = 12)
z2
##            Jan       Feb       Mar       Apr       May       Jun       Jul
## 2007 19.008730 17.164641 16.221986 14.786790 15.626389 14.005873 14.572503
## 2008 17.378770 16.906553 14.667122 14.615468 13.383515 14.976876 15.721950
## 2009 18.903905 17.632435 15.499232 15.402948 14.729547 15.323113 16.561194
## 2010 18.655633 16.521885 16.074084 15.836794 15.652385 15.840337 16.429232
## 2011 18.548021 18.323087 14.598755 14.934495 14.456221 14.202905 15.421465
## 2012 17.626117 16.322720 13.541774 13.879872 14.224800 13.688870 14.380294
## 2013 16.283115 16.194874 13.063874 13.371389 12.177924 12.222705 13.630066
## 2014 15.676921 15.135007 12.565361 11.855642 11.627266 12.287298 11.827352
## 2015 14.858391 13.948747 11.798966 12.406208 11.616160 11.655249 11.446527
## 2016 16.676869 13.828488 13.298563 12.201732 11.854229 11.627736 13.098598
## 2017 15.279176 14.888958 13.120214 11.330733 12.974985 11.838625 13.411278
## 2018 15.966744 14.614039 12.903950 12.236868 12.845739 12.258731 12.933270
## 2019 17.028249 15.657076 14.246184 13.450591 14.016057 12.691467 14.109152
## 2020 16.904233 17.371813 16.611594 24.178375 25.908681 25.299708 26.867926
## 2021 21.733186 19.793681 19.008738 18.780411 18.829211 18.023557 17.303146
## 2022 19.395171 16.484428 15.579611 14.211668 13.673532 14.107083 13.915318
##            Aug       Sep       Oct       Nov       Dec
## 2007 13.969634 13.797952 13.268100 12.622012 13.337300
## 2008 15.297004 14.615058 12.774204 13.673769 13.899675
## 2009 16.196524 15.843583 15.566436 14.680467 14.908416
## 2010 15.588060 14.572099 14.149807 14.595067 15.625090
## 2011 13.493849 13.337016 12.226297 12.452541 13.697060
## 2012 13.221176 12.702664 12.037954 12.323086 13.882432
## 2013 12.667993 11.774199 10.339314 11.416041 12.392851
## 2014 11.692678 11.016451 10.394963 10.958870 11.937213
## 2015 12.617254 11.418072 11.129715 10.166009 12.296861
## 2016 11.824199 11.484468 11.153980  9.817354 12.207863
## 2017 12.127152 12.392258 10.980225 11.581724 11.640468
## 2018 11.722536 12.142628 12.523949 11.993322 13.503447
## 2019 14.714965 13.729911 12.695464 12.613539 13.627145
## 2020 22.566182 20.881390 20.514106 18.673308 18.327839
## 2021 16.520367 15.079230 15.204980 14.913707 14.549509
## 2022 13.313088
par(mfrow=c(1,1))
plot(forecast(modelo1, h=6))
lines(yfit, col="red")
lines(z2, col="green")

12. Otras metodologías

REDES NEURONALES DE RETROALIMENTACION (nntear)

#Construimos la red de retroalimentación
set.seed(42)
neural_network <- nnetar(z1)
#Clase
class(neural_network)
## [1] "nnetar"
#Revisamos nuestros residuales
checkresiduals(neural_network)
## Warning in modeldf.default(object): Could not find appropriate degrees of
## freedom for this model.

#Predicción
mod1 <- forecast(neural_network, h=6, level = 95)
mod1
##           Mar      Apr      May      Jun      Jul      Aug
## 2022 16.00543 17.01049 15.57153 15.88010 16.00760 15.15607
#Gráfico con pronóstico
autoplot(mod1)

#Ajuste entre los datos de la serie y el pronostico
autoplot(mod1, series="pronostico")+
  autolayer(fitted(mod1), series="modelo")+
  autolayer(z2, series="datos")
## Warning: Removed 12 row(s) containing missing values (geom_path).

#Determinar resultados creando dataframe
pronostico <- as.data.frame(mod1)
pronostico
##           Mar      Apr      May      Jun      Jul      Aug
## 2022 16.00543 17.01049 15.57153 15.88010 16.00760 15.15607

13. Comparación

pron = forecast(modelo1, h=6)
pron
##          Point Forecast    Lo 80    Hi 80     Lo 95    Hi 95
## Mar 2022       15.26037 13.91889 16.60185 13.208751 17.31198
## Apr 2022       15.27126 13.37417 17.16834 12.369919 18.17259
## May 2022       15.50875 12.91337 18.10414 11.539454 19.47805
## Jun 2022       15.08421 11.94206 18.22636 10.278703 19.88972
## Jul 2022       15.84225 12.23528 19.44922 10.325871 21.35864
## Aug 2022       14.80613 10.78776 18.82451  8.660562 20.95171
mod1
##           Mar      Apr      May      Jun      Jul      Aug
## 2022 16.00543 17.01049 15.57153 15.88010 16.00760 15.15607
datosreales = window(z2, c(2022,03) , c(2022,8))
datosreales
##           Mar      Apr      May      Jun      Jul      Aug
## 2022 15.57961 14.21167 13.67353 14.10708 13.91532 13.31309

Analisis Bivariado

Para el analisis viabriado se va a intentar explicar el desemplo con la variacion del IPC, el Índice de Precios al Consumidor (IPC) es un indicador económico elaborado y publicado por el DANE, que mide mes a mes la variación conjunta de los precios de una canasta de bienes y servicios representativa del consumo de los hogares del país.

Como hipotesis se espera que la serie de tiempo del desempelo en mujeres tiene alguna relacion con la variacion del IPC.

Antedecendentes

  • UN ANÁLISIS VAR ESTRUCTURAL DE POLÍTICA MONETARIA EN COLOMBIA
  • INFLACIÓN BÁSICA: Una Estimación Basada en Modelos VAR Estructurales
  • MODELO VEC PARA EL ANÁLISIS DEL DESEMPLEO EN COLOMBIA PARA EL PERIODO COMPRENDIDO ENTRE ENERO DE 2011 A JUNIO DE 2016

Modelo VAR

El primer modelo para la realización del análisis es el modelo VAR.

data <- read_excel("C:/Users/RC/Desktop/TF-ST/Proyecto/Bivariado2.xlsx")
head(data)
## # A tibble: 6 × 3
##   Fecha                 TDM   IPC
##   <dttm>              <dbl> <dbl>
## 1 2007-01-01 00:00:00  19.0  61.8
## 2 2007-02-01 00:00:00  17.2  62.5
## 3 2007-03-01 00:00:00  16.2  63.3
## 4 2007-04-01 00:00:00  14.8  63.8
## 5 2007-05-01 00:00:00  15.6  64.0
## 6 2007-06-01 00:00:00  14.0  64.1

Gráfica de las series.

# Grafica de las series de tiempo 
layout(matrix(2:1, nrow = 2, ncol = 1))
plot.ts(data$TDM, main = "Desempleo Mujeres", ylab = "", xlab = "")
plot.ts(data$IPC, main = "IPC", ylab = "", xlab = "")

Creación del modelo VAR.

var_model<-ts(data[,c(2,3)],frequency = 12)
head(var_model)
##            TDM   IPC
## Jan 1 19.00873 61.80
## Feb 1 17.16464 62.53
## Mar 1 16.22199 63.29
## Apr 1 14.78679 63.85
## May 1 15.62639 64.05
## Jun 1 14.00587 64.12

Gráfica del modelo.

plot.ts(var_model)

Pruebas de estacionariedad de las series

Ho: Los residuos no son estacionarios >0.05 Ha: los residuos son estacionarios <0.05

Serie Desempleo en mujeres (TDM).

Test Augmented Dickey-Fuller:

Desempleo (TDM)

adf.test(var_model[,1])
## 
##  Augmented Dickey-Fuller Test
## 
## data:  var_model[, 1]
## Dickey-Fuller = -2.3874, Lag order = 5, p-value = 0.4141
## alternative hypothesis: stationary
  • La serie no es estacional.

IPC:

adf.test(var_model[,2])
## Warning in adf.test(var_model[, 2]): p-value greater than printed p-value
## 
##  Augmented Dickey-Fuller Test
## 
## data:  var_model[, 2]
## Dickey-Fuller = 0.59575, Lag order = 5, p-value = 0.99
## alternative hypothesis: stationary
  • La serie es estacional.

Realizando las pruebas con una diferencia ordinaria y una estacional.

Desempleo (TDM)

adf.test(diff(diff(var_model[,1],12)))
## Warning in adf.test(diff(diff(var_model[, 1], 12))): p-value smaller than
## printed p-value
## 
##  Augmented Dickey-Fuller Test
## 
## data:  diff(diff(var_model[, 1], 12))
## Dickey-Fuller = -5.6947, Lag order = 5, p-value = 0.01
## alternative hypothesis: stationary

IPC :

adf.test(diff(diff(var_model[,2],12)))
## 
##  Augmented Dickey-Fuller Test
## 
## data:  diff(diff(var_model[, 2], 12))
## Dickey-Fuller = -3.0379, Lag order = 5, p-value = 0.1427
## alternative hypothesis: stationary

Test de raíz unitaria

Test Philip - Perron.

Desempleo :

pp.test(var_model[,1])
## Warning in pp.test(var_model[, 1]): p-value smaller than printed p-value
## 
##  Phillips-Perron Unit Root Test
## 
## data:  var_model[, 1]
## Dickey-Fuller Z(alpha) = -29.538, Truncation lag parameter = 4, p-value
## = 0.01
## alternative hypothesis: stationary

Se rechaza Ho. tiene raices unitarias. IPC :

pp.test(var_model[,2])
## Warning in pp.test(var_model[, 2]): p-value greater than printed p-value
## 
##  Phillips-Perron Unit Root Test
## 
## data:  var_model[, 2]
## Dickey-Fuller Z(alpha) = 2.6848, Truncation lag parameter = 4, p-value
## = 0.99
## alternative hypothesis: stationary

No se rechaza Ho. tiene raices unitarias.

Con base en las pruebas la series de tiempo se trabajaran con una diferencia ordinaria y una diferencia estacional y su gráfica se aprecia a continuación:

var_dif<-diff(diff(var_model[,c(1,2)],12)) # diferencia de todas las variables
hchart(var_dif)
## Warning: Deprecated function. Use the `create_axis` function.

Estimación del modelo VAR

Se realiza la estimación del modelo var:

VARselect(var_dif,lag.max=12, type = "const")
## $selection
## AIC(n)  HQ(n)  SC(n) FPE(n) 
##     12      1      1     12 
## 
## $criteria
##                 1          2          3          4          5          6
## AIC(n) -1.9764236 -1.9795897 -1.9531547 -1.9859219 -1.9739978 -1.9400772
## HQ(n)  -1.9301894 -1.9025327 -1.8452749 -1.8472194 -1.8044724 -1.7397291
## SC(n)  -1.8625432 -1.7897890 -1.6874338 -1.6442808 -1.5564364 -1.4465956
## FPE(n)  0.1385651  0.1381312  0.1418409  0.1372849  0.1389575  0.1437905
##                 7          8          9         10         11         12
## AIC(n) -1.8998345 -1.8987609 -1.9011246 -1.9216792 -1.9078317 -2.2026878
## HQ(n)  -1.6686636 -1.6367671 -1.6083081 -1.5980399 -1.5533697 -1.8174029
## SC(n)  -1.3304326 -1.2534387 -1.1798822 -1.1245166 -1.0347489 -1.2536846
## FPE(n)  0.1497497  0.1499823  0.1497189  0.1467831  0.1489655  0.1110463

Segun la estimación el modelo se trabaja con 12 resagos y la construción del modelo se ve a continuación:

var_ID<-vars::VAR(var_dif, p=12, type = "both")
summary(var_ID)
## 
## VAR Estimation Results:
## ========================= 
## Endogenous variables: TDM, IPC 
## Deterministic variables: both 
## Sample size: 163 
## Log Likelihood: -231.272 
## Roots of the characteristic polynomial:
## 0.9649 0.9649 0.9615 0.9615 0.9576 0.9576 0.9525 0.9525 0.9485 0.9485 0.9321 0.9321 0.9272 0.9272 0.9248 0.9248 0.9248 0.9248 0.9143 0.9143 0.9064 0.9064 0.8313 0.8313
## Call:
## vars::VAR(y = var_dif, p = 12, type = "both")
## 
## 
## Estimation results for equation TDM: 
## ==================================== 
## TDM = TDM.l1 + IPC.l1 + TDM.l2 + IPC.l2 + TDM.l3 + IPC.l3 + TDM.l4 + IPC.l4 + TDM.l5 + IPC.l5 + TDM.l6 + IPC.l6 + TDM.l7 + IPC.l7 + TDM.l8 + IPC.l8 + TDM.l9 + IPC.l9 + TDM.l10 + IPC.l10 + TDM.l11 + IPC.l11 + TDM.l12 + IPC.l12 + const + trend 
## 
##          Estimate Std. Error t value Pr(>|t|)    
## TDM.l1  -0.031635   0.077648  -0.407   0.6843    
## IPC.l1   0.029712   0.437694   0.068   0.9460    
## TDM.l2   0.153760   0.080041   1.921   0.0568 .  
## IPC.l2  -0.021498   0.475998  -0.045   0.9640    
## TDM.l3   0.029249   0.081010   0.361   0.7186    
## IPC.l3  -0.921075   0.480615  -1.916   0.0574 .  
## TDM.l4  -0.257523   0.080906  -3.183   0.0018 ** 
## IPC.l4   0.123532   0.492702   0.251   0.8024    
## TDM.l5  -0.019006   0.084043  -0.226   0.8214    
## IPC.l5  -0.038770   0.488760  -0.079   0.9369    
## TDM.l6  -0.127849   0.083558  -1.530   0.1283    
## IPC.l6   0.458104   0.489343   0.936   0.3508    
## TDM.l7  -0.014041   0.082893  -0.169   0.8657    
## IPC.l7   0.373992   0.489956   0.763   0.4466    
## TDM.l8   0.025350   0.081992   0.309   0.7577    
## IPC.l8  -0.009081   0.514513  -0.018   0.9859    
## TDM.l9   0.035155   0.082789   0.425   0.6718    
## IPC.l9  -0.411553   0.520408  -0.791   0.4304    
## TDM.l10 -0.100885   0.084504  -1.194   0.2346    
## IPC.l10  0.600927   0.531573   1.130   0.2603    
## TDM.l11  0.052270   0.084238   0.621   0.5360    
## IPC.l11 -0.120722   0.538518  -0.224   0.8230    
## TDM.l12 -0.449784   0.082804  -5.432 2.47e-07 ***
## IPC.l12  0.092238   0.471249   0.196   0.8451    
## const    0.062102   0.230595   0.269   0.7881    
## trend   -0.001097   0.002271  -0.483   0.6297    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 1.258 on 137 degrees of freedom
## Multiple R-Squared: 0.3577,  Adjusted R-squared: 0.2405 
## F-statistic: 3.052 on 25 and 137 DF,  p-value: 1.761e-05 
## 
## 
## Estimation results for equation IPC: 
## ==================================== 
## IPC = TDM.l1 + IPC.l1 + TDM.l2 + IPC.l2 + TDM.l3 + IPC.l3 + TDM.l4 + IPC.l4 + TDM.l5 + IPC.l5 + TDM.l6 + IPC.l6 + TDM.l7 + IPC.l7 + TDM.l8 + IPC.l8 + TDM.l9 + IPC.l9 + TDM.l10 + IPC.l10 + TDM.l11 + IPC.l11 + TDM.l12 + IPC.l12 + const + trend 
## 
##           Estimate Std. Error t value Pr(>|t|)    
## TDM.l1  -0.0417488  0.0142405  -2.932  0.00395 ** 
## IPC.l1   0.4079044  0.0802726   5.081 1.20e-06 ***
## TDM.l2  -0.0082738  0.0146794  -0.564  0.57393    
## IPC.l2   0.0873603  0.0872974   1.001  0.31873    
## TDM.l3   0.0031513  0.0148572   0.212  0.83234    
## IPC.l3  -0.0128711  0.0881441  -0.146  0.88412    
## TDM.l4  -0.0129366  0.0148381  -0.872  0.38482    
## IPC.l4   0.0833598  0.0903609   0.923  0.35788    
## TDM.l5   0.0073003  0.0154133   0.474  0.63651    
## IPC.l5   0.0744513  0.0896379   0.831  0.40766    
## TDM.l6   0.0174307  0.0153245   1.137  0.25734    
## IPC.l6   0.1083100  0.0897449   1.207  0.22956    
## TDM.l7  -0.0002724  0.0152024  -0.018  0.98573    
## IPC.l7  -0.0750186  0.0898572  -0.835  0.40525    
## TDM.l8  -0.0318130  0.0150373  -2.116  0.03619 *  
## IPC.l8   0.1522961  0.0943610   1.614  0.10883    
## TDM.l9  -0.0270096  0.0151834  -1.779  0.07748 .  
## IPC.l9   0.1267968  0.0954422   1.329  0.18622    
## TDM.l10  0.0141468  0.0154979   0.913  0.36294    
## IPC.l10 -0.1021794  0.0974898  -1.048  0.29644    
## TDM.l11 -0.0022017  0.0154491  -0.143  0.88688    
## IPC.l11  0.0686055  0.0987635   0.695  0.48845    
## TDM.l12 -0.0067701  0.0151861  -0.446  0.65644    
## IPC.l12 -0.3700991  0.0864264  -4.282 3.46e-05 ***
## const   -0.0494153  0.0422909  -1.168  0.24465    
## trend    0.0007171  0.0004165   1.722  0.08739 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## Residual standard error: 0.2308 on 137 degrees of freedom
## Multiple R-Squared: 0.5917,  Adjusted R-squared: 0.5172 
## F-statistic: 7.941 on 25 and 137 DF,  p-value: < 2.2e-16 
## 
## 
## 
## Covariance matrix of residuals:
##          TDM      IPC
## TDM  1.58358 -0.03849
## IPC -0.03849  0.05326
## 
## Correlation matrix of residuals:
##         TDM     IPC
## TDM  1.0000 -0.1325
## IPC -0.1325  1.0000
  • Gráfica del modelo en IPC:
plot(var_ID , names = 'IPC')

  • Gráfica del modelo en TDM:
plot(var_ID , names = 'TDM')

Zoom a residuales:

TDM :

acf(residuals(var_ID)[,1])

IPC :

acf(residuals(var_ID)[,2])

Pruebas al modelo VAR.

  1. Estacionariedad de múltiples variables:
roots(var_ID)
##  [1] 0.9648986 0.9648986 0.9615220 0.9615220 0.9575739 0.9575739 0.9525212
##  [8] 0.9525212 0.9485396 0.9485396 0.9321379 0.9321379 0.9272256 0.9272256
## [15] 0.9248408 0.9248408 0.9248245 0.9248245 0.9142877 0.9142877 0.9064076
## [22] 0.9064076 0.8312517 0.8312517

Al ser todas menores a 1 este modelo cumple el supuesto de estacionariedad.

Para probar la correlación serial, se aplica la prueba de Portmanteau, donde:

H0: Los residuales no estan correlacionados >0.05 Ha: Los residuales estan correlacionados <0.05

bv.serial <- serial.test(var_ID, lags.pt = 12, type = "PT.asymptotic")
bv.serial$serial
## 
##  Portmanteau Test (asymptotic)
## 
## data:  Residuals of VAR object var_ID
## Chi-squared = 30.943, df = 0, p-value < 2.2e-16
  • Se rechaza la hipotesis nula, existe evidencia de correlacion serial.
  1. Prueba de heterocedasticidad autorregresiva condicional automática (ARCH)

Ho: La varianza de los residuales es constante >0.05 Ha: La varianza de los residuales no es constante <0.05

bv.arch <- arch.test(var_ID, lags.multi = 12, multivariate.only = TRUE)
bv.arch
## 
##  ARCH (multivariate)
## 
## data:  Residuals of VAR object var_ID
## Chi-squared = 117.55, df = 108, p-value = 0.2494
  • Se rechaza la hipotesis nula, hay evidencia de homocedasticidad.
  1. Test de normalidad.

Ho: Los residuos se distribuyen normal >0.05 Ha: Los residuos no se distribuyen normal <0.05

bv.norm <- normality.test(var_ID, multivariate.only = FALSE)
bv.norm
## $TDM
## 
##  JB-Test (univariate)
## 
## data:  Residual of TDM equation
## Chi-squared = 792.89, df = 2, p-value < 2.2e-16
## 
## 
## $IPC
## 
##  JB-Test (univariate)
## 
## data:  Residual of IPC equation
## Chi-squared = 10.25, df = 2, p-value = 0.005946
## 
## 
## $JB
## 
##  JB-Test (multivariate)
## 
## data:  Residuals of VAR object var_ID
## Chi-squared = 814.29, df = 4, p-value < 2.2e-16
## 
## 
## $Skewness
## 
##  Skewness only (multivariate)
## 
## data:  Residuals of VAR object var_ID
## Chi-squared = 61.279, df = 2, p-value = 4.94e-14
## 
## 
## $Kurtosis
## 
##  Kurtosis only (multivariate)
## 
## data:  Residuals of VAR object var_ID
## Chi-squared = 753.01, df = 2, p-value < 2.2e-16
  • Se rechaza la hipotesis nula, los errores no son normales.

Ruptura estructural en los residuos

Aplicación de la prueba CUSUM que muestra si existen tendencias significativas del modelo.

bv.cusum <- stability(var_ID, type = "OLS-CUSUM")
plot(bv.cusum)

  • La prueba CUSUM indica que no existen tendencias significativas en el modelo, ya que fuctuan dentro de los margenes alrededor de 0.

Causalidad de Granger.

Desempleo causado en el sentido de Granger a IPC en el sentido de Granger:

grangertest(var_dif[,1]~var_dif[,2],data = var_dif)
## Granger causality test
## 
## Model 1: var_dif[, 1] ~ Lags(var_dif[, 1], 1:1) + Lags(var_dif[, 2], 1:1)
## Model 2: var_dif[, 1] ~ Lags(var_dif[, 1], 1:1)
##   Res.Df Df      F Pr(>F)
## 1    171                 
## 2    172 -1 0.2802 0.5973
  • El desempleo no esta explicado por el IPC en el sentido de Granger

IPC causado en el sentido de Granger a Desempleo en el sentido de Granger:

grangertest(var_dif[,2]~var_dif[,1],data = var_dif)
## Granger causality test
## 
## Model 1: var_dif[, 2] ~ Lags(var_dif[, 2], 1:1) + Lags(var_dif[, 1], 1:1)
## Model 2: var_dif[, 2] ~ Lags(var_dif[, 2], 1:1)
##   Res.Df Df      F   Pr(>F)   
## 1    171                      
## 2    172 -1 9.1337 0.002895 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
  • El IPC esta explicado por el desempleo en el sentido de Granger

Causalidad

H0: No existe causalidad instantanea

bv.cause.une <- causality(var_ID, cause = "IPC")
bv.cause.une
## $Granger
## 
##  Granger causality H0: IPC do not Granger-cause TDM
## 
## data:  VAR object var_ID
## F-Test = 0.81026, df1 = 12, df2 = 274, p-value = 0.6398
## 
## 
## $Instant
## 
##  H0: No instantaneous causality between: IPC and TDM
## 
## data:  VAR object var_ID
## Chi-squared = 2.8134, df = 1, p-value = 0.09348

No se rechaza la hipotesis nula

bv.cause.une <- causality(var_ID, cause = "TDM")
bv.cause.une
## $Granger
## 
##  Granger causality H0: TDM do not Granger-cause IPC
## 
## data:  VAR object var_ID
## F-Test = 1.7684, df1 = 12, df2 = 274, p-value = 0.05325
## 
## 
## $Instant
## 
##  H0: No instantaneous causality between: TDM and IPC
## 
## data:  VAR object var_ID
## Chi-squared = 2.8134, df = 1, p-value = 0.09348

No se rechaza la hipotesis nula ### Analisis de impulso y respuesta Impulso IPC respuesta TDM

irf.TDM <- vars::irf(var_ID, impulse = "IPC", response = "TDM",boot = TRUE)
plot(irf.TDM) 

Impulso TDM respuesta IPC

irf.IPC <- vars::irf(var_ID, impulse = "TDM", response = "IPC", boot = TRUE)
plot(irf.IPC)

Impulso TDM respuesta TDM

irf.TDM2 <- vars::irf(var_ID, impulse = "TDM", response = "TDM", boot = TRUE)
plot(irf.TDM2, ylab = "TDM", main = "Shock from TDM")

Impulso IPC respuesta IPC

irf.IPC2 <- vars::irf(var_ID, impulse = "IPC", response = "IPC", boot = TRUE)
plot(irf.IPC2, ylab = "IPC", main = "Shock from IPC")

Descomposición de La varianza

bv.vardec <- vars::fevd(var_ID, n.ahead = 10)
plot(bv.vardec)

Pronósticos

Datos de prueba

TDM<-ts(data[,c(2)],start=c(2007,01), end=c(2022,08), frequency = 12)
IPC<-ts(data[,c(3)],start=c(2007,01), end=c(2022,08), frequency = 12)
predictions <- predict(var_ID, n.ahead = 8, ci = 0.95)
plot(predictions, names = "TDM")

plot(TDM)

plot(predictions, names = "IPC")

plot(IPC)

fanchart(predictions, names = "TDM")

fanchart(predictions, names = "IPC")

Modelo VEC

Johansen - Procedure Test

vec_model<-ts(data[,c(2,3)],frequency = 12)
plot.ts(vec_model)

hchart(vec_model)
## Warning: Deprecated function. Use the `create_axis` function.

Pruebas de estacionariedad Ho: los residuos no son estacionarios >0.05 Ha: los residuos son estacionarios <0.05

adf.desempleo <- ur.df(vec_model[,1], type = "trend", selectlags = "BIC")
summary(adf.desempleo) 
## 
## ############################################### 
## # 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 
## -2.9378 -0.9689 -0.1728  0.5492  7.9100 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.474056   0.638547   3.875 0.000149 ***
## z.lag.1     -0.181349   0.042718  -4.245 3.48e-05 ***
## tt           0.001533   0.002187   0.701 0.484124    
## z.diff.lag   0.063886   0.073368   0.871 0.385033    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.586 on 182 degrees of freedom
## Multiple R-squared:  0.09062,    Adjusted R-squared:  0.07563 
## F-statistic: 6.045 on 3 and 182 DF,  p-value: 0.0006029
## 
## 
## Value of test-statistic is: -4.2453 6.0234 9.0183 
## 
## 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
plot(adf.desempleo)

adf.test(vec_model[,1])
## 
##  Augmented Dickey-Fuller Test
## 
## data:  vec_model[, 1]
## Dickey-Fuller = -2.3874, Lag order = 5, p-value = 0.4141
## alternative hypothesis: stationary
adf.IPC <- ur.df(vec_model[,2], type = "trend", selectlags = "BIC")
summary(adf.IPC)
## 
## ############################################### 
## # 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.97112 -0.13936 -0.00596  0.12906  1.12575 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.145060   0.505309   0.287    0.774    
## z.lag.1     -0.001917   0.008362  -0.229    0.819    
## tt           0.001228   0.002295   0.535    0.593    
## z.diff.lag   0.705718   0.056369  12.520   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2445 on 182 degrees of freedom
## Multiple R-squared:  0.527,  Adjusted R-squared:  0.5192 
## F-statistic: 67.58 on 3 and 182 DF,  p-value: < 2.2e-16
## 
## 
## Value of test-statistic is: -0.2292 5.8252 2.1387 
## 
## 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
plot(adf.IPC)

adf.test(vec_model[,2])
## Warning in adf.test(vec_model[, 2]): p-value greater than printed p-value
## 
##  Augmented Dickey-Fuller Test
## 
## data:  vec_model[, 2]
## Dickey-Fuller = 0.59575, Lag order = 5, p-value = 0.99
## alternative hypothesis: stationary

Hacemos una diferencia de ambas variables

vec_dif<-diff(diff(vec_model[,c(1,2)],12))

Pruebas de estacionariedad Ho: los residuos no son estacionarios >0.05 Ha: los residuos son estacionarios <0.05

adf.desempleo <- ur.df(vec_dif[,1], type = "trend", selectlags = "BIC")
summary(adf.desempleo) 
## 
## ############################################### 
## # 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 
## -7.2917 -0.6380 -0.0359  0.6686  8.1753 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.0663832  0.2180885   0.304   0.7612    
## z.lag.1     -0.9520689  0.1153743  -8.252 4.24e-14 ***
## tt          -0.0008631  0.0021568  -0.400   0.6895    
## z.diff.lag  -0.1814218  0.0753757  -2.407   0.0172 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.415 on 169 degrees of freedom
## Multiple R-squared:  0.5972, Adjusted R-squared:   0.59 
## F-statistic: 83.51 on 3 and 169 DF,  p-value: < 2.2e-16
## 
## 
## Value of test-statistic is: -8.252 22.6994 34.0479 
## 
## 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
plot(adf.desempleo)

adf.test(vec_dif[,1])
## Warning in adf.test(vec_dif[, 1]): p-value smaller than printed p-value
## 
##  Augmented Dickey-Fuller Test
## 
## data:  vec_dif[, 1]
## Dickey-Fuller = -5.6947, Lag order = 5, p-value = 0.01
## alternative hypothesis: stationary
adf.IPC <- ur.df(vec_dif[,2], type = "trend", selectlags = "BIC")
summary(adf.IPC)  
## 
## ############################################### 
## # 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.93550 -0.15023 -0.01576  0.10591  1.10582 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -0.041841   0.040509  -1.033   0.3031    
## z.lag.1     -0.371165   0.071088  -5.221 5.17e-07 ***
## tt           0.000716   0.000410   1.747   0.0825 .  
## z.diff.lag  -0.102664   0.076621  -1.340   0.1821    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.259 on 169 degrees of freedom
## Multiple R-squared:  0.212,  Adjusted R-squared:  0.198 
## F-statistic: 15.16 on 3 and 169 DF,  p-value: 8.847e-09
## 
## 
## Value of test-statistic is: -5.2212 9.1579 13.6878 
## 
## 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
plot(adf.IPC)

adf.test(vec_dif[,2])
## 
##  Augmented Dickey-Fuller Test
## 
## data:  vec_dif[, 2]
## Dickey-Fuller = -3.0379, Lag order = 5, p-value = 0.1427
## alternative hypothesis: stationary

Selección del modelo:

VARselect(vec_model, lag.max = 12,type  = "none")
## $selection
## AIC(n)  HQ(n)  SC(n) FPE(n) 
##     12      2      2     12 
## 
## $criteria
##                 1          2          3          4          5          6
## AIC(n) -1.1337628 -1.8932489 -1.8812964 -1.8487275 -1.8413580 -1.8330060
## HQ(n)  -1.1045371 -1.8347974 -1.7936192 -1.7318245 -1.6952293 -1.6576515
## SC(n)  -1.0617064 -1.7491360 -1.6651270 -1.5605017 -1.4810757 -1.4006673
## FPE(n)  0.3218207  0.1505841  0.1524005  0.1574571  0.1586408  0.1599999
##                 7          8         9         10         11        12
## AIC(n) -1.8726359 -1.8344421 -1.813755 -1.8138387 -1.9473433 -2.146721
## HQ(n)  -1.6680557 -1.6006361 -1.550723 -1.5215813 -1.6258602 -1.796012
## SC(n)  -1.3682407 -1.2579904 -1.165246 -1.0932742 -1.1547223 -1.282043
## FPE(n)  0.1538215  0.1598634  0.163275  0.1633489  0.1430281  0.117267
VARorder(vec_model,maxp=12)
## selected order: aic =  12 
## selected order: bic =  2 
## selected order: hq =  12 
## Summary table:  
##        p     AIC     BIC      HQ      M(p) p-value
##  [1,]  0  7.4484  7.4484  7.4484    0.0000  0.0000
##  [2,]  1 -1.1911 -1.1222 -1.1632 1497.6429  0.0000
##  [3,]  2 -1.9272 -1.7895 -1.8714  132.7734  0.0000
##  [4,]  3 -1.9140 -1.7074 -1.8303    4.9371  0.2938
##  [5,]  4 -1.8813 -1.6059 -1.7697    1.6460  0.8005
##  [6,]  5 -1.8726 -1.5283 -1.7331    5.5728  0.2334
##  [7,]  6 -1.8670 -1.4539 -1.6996    6.0049  0.1988
##  [8,]  7 -1.9195 -1.4375 -1.7242   15.2489  0.0042
##  [9,]  8 -1.8850 -1.3341 -1.6618    1.2810  0.8646
## [10,]  9 -1.8662 -1.2464 -1.6151    3.7051  0.4474
## [11,] 10 -1.8732 -1.1845 -1.5942    7.6561  0.1050
## [12,] 11 -2.0073 -1.2499 -1.7004   26.9530  0.0000
## [13,] 12 -2.2324 -1.4060 -1.8976   40.2694  0.0000

Prueba de cointegración:

johansen<-ca.jo(vec_model, type="eigen",ecdet="none", spec="longrun", K=12, season=12)
summary(johansen)
## 
## ###################### 
## # Johansen-Procedure # 
## ###################### 
## 
## Test type: maximal eigenvalue statistic (lambda max) , with linear trend 
## 
## Eigenvalues (lambda):
## [1] 0.04071497 0.01734170
## 
## Values of teststatistic and critical values of test:
## 
##          test 10pct  5pct  1pct
## r <= 1 | 3.08  6.50  8.18 11.65
## r = 0  | 7.32 12.91 14.90 19.19
## 
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
## 
##           TDM.l12   IPC.l12
## TDM.l12 1.0000000  1.000000
## IPC.l12 0.1022397 -0.236263
## 
## Weights W:
## (This is the loading matrix)
## 
##           TDM.l12      IPC.l12
## TDM.d -0.03901610 -0.031988658
## IPC.d  0.01156758 -0.003434625
  • No hay ecuaciones cointegradas.

Transformación del VEC a VAR.

vardm<-vec2var(johansen,r=1)

Pruebas al modelo VEC..

  1. Autocorrelación serial Pormanteau
ser11 <- serial.test(vardm, lags.pt = 12, type = "PT.asymptotic")
ser11$serial
## 
##  Portmanteau Test (asymptotic)
## 
## data:  Residuals of VAR object vardm
## Chi-squared = 5.5776, df = 2, p-value = 0.06149
  • Hay evidencia de correlación serial.
  1. Normalidad.
norm1 <-normality.test(vardm)
norm1$jb.mul
## $JB
## 
##  JB-Test (multivariate)
## 
## data:  Residuals of VAR object vardm
## Chi-squared = 2496.9, df = 4, p-value < 2.2e-16
## 
## 
## $Skewness
## 
##  Skewness only (multivariate)
## 
## data:  Residuals of VAR object vardm
## Chi-squared = 206.34, df = 2, p-value < 2.2e-16
## 
## 
## $Kurtosis
## 
##  Kurtosis only (multivariate)
## 
## data:  Residuals of VAR object vardm
## Chi-squared = 2290.5, df = 2, p-value < 2.2e-16
  • Los residuos no se distribuyen normalmente.
  1. Prueba de heterocedasticidad autorregresiva condicional automática (ARCH).
arch1 <- arch.test(vardm, lags.multi = 6)
arch1$arch.mul
## 
##  ARCH (multivariate)
## 
## data:  Residuals of VAR object vardm
## Chi-squared = 72.257, df = 54, p-value = 0.04915
  • La varianza de los residuales es constante.

IPC:

plot(arch1, names = "IPC")
## Warning in plot.varcheck(arch1, names = "IPC"): 
## Invalid residual name(s) supplied, using residuals of first variable.

TDM

  plot(arch1, names = "TDM")
## Warning in plot.varcheck(arch1, names = "TDM"): 
## Invalid residual name(s) supplied, using residuals of first variable.

### Análisis de impulso y respuesta Impulso TDM respuesta IPC

ir <- vars::irf(vardm, n.ahead = 20, impulse = "TDM", response = "IPC")
plot(ir)

Impulso IPC respuesta TDM

ir <- vars::irf(vardm, n.ahead = 20, impulse = "IPC", response = "TDM")
plot(ir)

- SVEC - FEVD Variance decomposition of forecast errors

fevd.R <- vars::fevd(vardm, n.ahead = 24)
plot(fevd.R)

Pronóstico VEC.

predictions <- predict(vardm, n.ahead = 8, ci = 0.95)
plot(predictions)

plot(TDM)

plot(IPC)

Bibliografía