TRABAJO FINAL TERCER PARCIAL

1- breve introduccion

1. El ingreso público, es toda cantidad de dinero percibida por el Estado y demás entes públicos, cuyo objetivo esencial es financiar los gastos públicos. Las notas características del ingreso público son: El ingreso público es siempre una suma de dinero. No obstante, en algunas ocasiones el ingreso público que inicialmente se cuantifica en una cantidad de dinero, se hace efectivo en especie; como por ejemplo en aquellos casos en que la deuda tributaria se extinguen con la entrega de bienes del patrimonio histórico.
2. Percibida por un Ente público.
3. Tiene como objetivo esencial financiar el gasto público unidad de medida: millones de pesos a precios corrientes periodicidad: mensual fuente: “(”http://www.inegi.org.mx/sistemas/bie/?idserPadre=11400090“)”

en la grafica podemos observar que presenta estacionalidad, serie temporal ya que la variación periódica y predecible de la misma con un periodo inferior o igual a un año.

Descomposicion clasica

La estacionalidad es un fenómeno que aparece cuando uno se da cuenta que en determinados períodos y con regularidad se repiten patrones de comportamiento de un hecho, como el que se esta observando en primera instancia.

La tendencia se torna estocastica

Los residuos estan elevados, dado a las fluctuaciones de las salidas de capital y/o de las entradas del mismo.

Si es necesario, utilizar transformacion Box-Cox / logaritmos para estabilizar la varianza

podemos notar que con la prueba aun se ve la estacionalidad y la tendencia

5 En caso de estacionalidad, aplicar diferencias estacionales

se muestra mas estabilizada la varianza es constante

5 Usar prueba Dickey-Fuller para evaluar el orden de integracion de la serie. Diferenciar hasta que la serie sea estacionaria.

summary(ur.df(diff.ITGF))

############################################### 
# 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 
-451.00  -21.69   -1.07   95.32  230.07 

Coefficients:
           Estimate Std. Error t value Pr(>|t|)    
z.lag.1    -1.99041    0.08317 -23.931  < 2e-16 ***
z.diff.lag  0.33249    0.04814   6.907 2.06e-11 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 132.7 on 384 degrees of freedom
Multiple R-squared:  0.7748,    Adjusted R-squared:  0.7736 
F-statistic: 660.4 on 2 and 384 DF,  p-value: < 2.2e-16


Value of test-statistic is: -23.9308 

Critical values for test statistics: 
      1pct  5pct 10pct
tau1 -2.58 -1.95 -1.62

podemos observar que el valor de value of test-statistic es de -23.9308 el cual pasa los tres valores criticos, con lo cual podemos decir que la serie ya es estacional

6. Usar herramientas ACF, PACF, EACF y criterios de Akaike/ Bayes para construir propuestas de modelos.

Mostrados los procesos anteriores con sus debidos criterios , podemos empezar a proponer una serie de cambios en el “ARIMA” para estructurar un modelo correcto que ayuda al buen modelaje y presentacion del modelo “ingreso al sector publico”

la prueba nos propone un modelo MA 1 estacional con un AR 5 estacional

eacf(diff(diff(ITGF)))

AR/MA
  0 1 2 3 4 5 6 7 8 9 10 11 12 13
0 x o o o o o o o o o x  x  x  o 
1 x x o o o o o o o o o  x  x  o 
2 x x o o o o o o o o o  x  x  o 
3 x x o o o o o o o o o  x  x  o 
4 x o x x o o o o o o o  x  x  o 
5 x x o x o o o o o o o  x  x  o 
6 x x o o o o o o o o o  x  x  x 
7 x o o o o o o o o o o  x  x  o 

nos propone un un AR 2 y un MA 3 #Propuesta 1

propuesta1

Series: ITGF 
ARIMA(0,1,0)(2,1,1)[12] 

Coefficients:
        sar1    sar2    sma1
      0.3755  0.0291  -1.000
s.e.  0.0532  0.0541   0.061

sigma^2 estimated as 10334:  log likelihood=-2291.66
AIC=4591.32   AICc=4591.43   BIC=4607.05

checkresiduals(propuesta1)

    Ljung-Box test

data:  Residuals from ARIMA(0,1,0)(2,1,1)[12]
Q* = 103.21, df = 21, p-value = 7.762e-13

Model df: 3.   Total lags used: 24

el AICc es elevado y los rezagos se siguen saliendo no es el mejor modelo

Propuesta 2

propuesta2

Series: ITGF 
ARIMA(0,1,2)(2,1,1)[12] 

Coefficients:
          ma1      ma2    sar1    sar2     sma1
      -0.6959  -0.2994  0.5714  0.0146  -1.0000
s.e.   0.0663   0.0533  0.0579  0.0548   0.0465

sigma^2 estimated as 7055:  log likelihood=-2219.73
AIC=4451.46   AICc=4451.69   BIC=4475.05

checkresiduals(propuesta2)

    Ljung-Box test

data:  Residuals from ARIMA(0,1,2)(2,1,1)[12]
Q* = 167.22, df = 19, p-value < 2.2e-16

Model df: 5.   Total lags used: 24

los residuos estan dentro de las bandas de confianza y el resultado del AICc es menor que el de la propuesta 1

Propuesta 3

propuesta3

Series: ITGF 
ARIMA(2,1,3)(0,0,2)[12] 

Coefficients:
         ar1      ar2      ma1     ma2      ma3    sma1    sma2
      1.6853  -0.9802  -2.6049  2.4550  -0.8309  0.3861  0.1432
s.e.  0.0124   0.0117   0.0402  0.0805   0.0449  0.0557  0.0600

sigma^2 estimated as 5736:  log likelihood=-2235.54
AIC=4487.09   AICc=4487.47   BIC=4518.8

checkresiduals(propuesta3)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,3)(0,0,2)[12]
Q* = 87.071, df = 17, p-value = 2.073e-11

Model df: 7.   Total lags used: 24

el resultado de AICc es menor que en la propuesta 1, pero mayor que la propuesta 2

Propuesta 4

propuesta4

Series: ITGF 
ARIMA(2,1,3)(0,1,3)[12] 

Coefficients:
         ar1      ar2     ma1     ma2      ma3     sma1     sma2     sma3
      1.6841  -0.9783  -2.593  2.4303  -0.8167  -0.6151  -0.2348  -0.1497
s.e.  0.0134   0.0125   0.042  0.0836   0.0461   0.1036   0.0745   0.0625

sigma^2 estimated as 5804:  log likelihood=-2183.32
AIC=4384.63   AICc=4385.12   BIC=4420.02

checkresiduals(propuesta4)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,3)(0,1,3)[12]
Q* = 81.855, df = 16, p-value = 7.693e-11

Model df: 8.   Total lags used: 24

el AICc es mucho mayor a los anteriores, no es el mejor modelo

Propuesta 5

propuesta5

Series: ITGF 
ARIMA(1,1,1)(0,1,0)[12] 

Coefficients:
         ar1      ma1
      0.1882  -1.0000
s.e.  0.0507   0.0079

sigma^2 estimated as 8829:  log likelihood=-2249.38
AIC=4504.76   AICc=4504.82   BIC=4516.55

checkresiduals(propuesta5)

    Ljung-Box test

data:  Residuals from ARIMA(1,1,1)(0,1,0)[12]
Q* = 151.28, df = 22, p-value < 2.2e-16

Model df: 2.   Total lags used: 24

el AICc es bueno aunque ligeramente mayor que la propuesta 2

7. Como parte del diagn´ostico del modelo, analizar los residuos y aplicar la prueba Ljung-Box.

los resultados confirman que la mejor propuesta es la numero 2

propuesta.auto

Series: ITGF 
ARIMA(2,1,3)(0,0,2)[12] 

Coefficients:
         ar1      ar2      ma1     ma2      ma3    sma1    sma2
      1.6853  -0.9802  -2.6049  2.4550  -0.8309  0.3861  0.1432
s.e.  0.0124   0.0117   0.0402  0.0805   0.0449  0.0557  0.0600

sigma^2 estimated as 5736:  log likelihood=-2235.54
AIC=4487.09   AICc=4487.47   BIC=4518.8

checkresiduals(propuesta.auto)

    Ljung-Box test

data:  Residuals from ARIMA(2,1,3)(0,0,2)[12]
Q* = 87.071, df = 17, p-value = 2.073e-11

Model df: 7.   Total lags used: 24

el auto arima nos da un mejor resultado del AICc ya que es mas alto, por ello nos quedamos con la propuesta 2

9. Presente la ecuacion final y describa

$$ INGRESO DEL GOBIERNO=0.0256 +0.0058{_(12)}

$$

10. Crear un pronostico a dos años.

La proyeccion de nuestro pronostico muestra que nuestro ingreso al sector , se va a mantener constante, dado que la condiciones economicas que nos estamos enfrentando no son muy distintas a las politicas monetaria y gubernamentales de antes.

11. Realizar el pronostico ARIMA para dos años.

getrmse(diff.ITGF,h=12,order=c(2,1,3),seasonal=c(0,1,3))

[1] 114.3297

getrmse(diff.ITGF,h=12,order=c(0,1,2),seasonal=c(2,1,1))

[1] 116.811

getrmse(diff.ITGF,h=12,order=c(1,1,1),seasonal=c(0,1,0))

[1] 36.94563

getrmse(diff.ITGF,h=12,order=c(2,1,2),seasonal=c(1,1,2))

[1] 101.6726

getrmse(diff.ITGF,h=12,order=c(2,1,1),seasonal=c(1,1,0))

[1] 50.32122

getrmse(diff.ITGF,h=12,order=c(2,1,1),seasonal=c(1,1,1))

[1] 113.1242

getrmse(diff.ITGF,h=12,order=c(2,1,1),seasonal=c(0,1,1))

[1] 66.08332

getrmse(diff.ITGF,h=12,order=c(1,1,0),seasonal=c(1,1,2))

[1] 142.3332

getrmse(diff.ITGF,h=12,order=c(1,0,1),seasonal=c(1,1,0))

[1] 42.83948

getrmse(diff.ITGF,h=12,order=c(1,0,1),seasonal=c(1,1,1))

[1] 105.2729

getrmse(diff.ITGF,h=12,order=c(2,1,1),seasonal=c(2,1,1))

[1] 111.587

getrmse(diff.ITGF,h=12,order=c(1,1,0),seasonal=c(1,0,0))

[1] 139.3919

getrmse(diff.ITGF,h=12,order=c(1,1,1),seasonal=c(0,0,1))

[1] 138.1087

getrmse(diff.ITGF,h=12,order=c(2,1,1),seasonal=c(0,0,1))

[1] 133.9418

la raiz del error media mas pequeño es la opcion 3 el 36.94563

12. Utilizando metodos de pronosticos simples y/o suavizamiento exponencial generar un pronostico para dos años. Elegir el metodo que presente la raiz del error medio al cuadrado mas pequeno.

auto.arima(ITGF)

Series: ITGF 
ARIMA(2,1,3)(0,0,2)[12] 

Coefficients:
         ar1      ar2      ma1     ma2      ma3    sma1    sma2
      1.6853  -0.9802  -2.6049  2.4550  -0.8309  0.3861  0.1432
s.e.  0.0124   0.0117   0.0402  0.0805   0.0449  0.0557  0.0600

sigma^2 estimated as 5736:  log likelihood=-2235.54
AIC=4487.09   AICc=4487.47   BIC=4518.8

se toman primeras diferencias de los datos, dado que ya son estacionarios no se necesitarán diferencias adicionales.

los resultados de PACF muestran tendencia, aplicaremos 2 diferncias

no mejoró el PACF podríamos comenzar con un ma 2 y un ar 3 se estima un modelo ARIMA order=c(1,1,1), seasonal=c(0,1,0)

summary(fit1)

Series: seasonal_adj 
ARIMA(1,1,1)(0,1,0)[12] 

Coefficients:
         ar1      ma1
      0.1882  -1.0000
s.e.  0.0507   0.0079

sigma^2 estimated as 8829:  log likelihood=-2249.38
AIC=4504.76   AICc=4504.82   BIC=4516.55

Training set error measures:
                    ME     RMSE      MAE       MPE     MAPE      MASE       ACF1
Training set -4.302547 92.13595 44.09444 -126.0436 169.8846 0.8779866 0.01815651

checkresiduals(fit1)

    Ljung-Box test

data:  Residuals from ARIMA(1,1,1)(0,1,0)[12]
Q* = 151.28, df = 22, p-value < 2.2e-16

Model df: 2.   Total lags used: 24

los reciduales no quedan dentro de las bandas de confianza sin embargo aún así existe la presencia de un ruido blanco

forecast(auto)

         Point Forecast      Lo 80    Hi 80      Lo 95    Hi 95
Jul 2018       200.3841  91.563240 309.2050  33.956957 366.8112
Aug 2018       191.4489  74.180853 308.7169  12.102901 370.7949
Sep 2018       201.2869  82.607868 319.9659  19.782986 382.7908
Oct 2018       207.8236  88.854986 326.7922  25.876821 389.7703
Nov 2018       205.9617  86.911559 325.0118  23.890228 388.0331
Dec 2018       198.7882  79.703134 317.8733  16.663301 380.9131
Jan 2019       206.1986  87.091526 325.3057  24.040035 388.3572
Feb 2019       219.9750 100.850144 339.0999  37.789242 402.1608
Mar 2019       113.0565  -6.084663 232.1976 -69.154161 295.2671
Apr 2019       131.5411  12.384364 250.6979 -50.693423 313.7757
May 2019       173.9204  54.748241 293.0927  -8.337714 356.1786
Jun 2019       174.4768  55.289204 293.6643  -7.804873 356.7584
Jul 2019       177.3539  49.028822 305.6790 -18.902377 373.6102
Aug 2019       178.4786  48.566996 308.3902 -20.204053 377.1613
Sep 2019       178.9182  48.655144 309.1813 -20.301976 378.1385
Oct 2019       179.0901  48.715588 309.4646 -20.300511 378.4807
Nov 2019       179.1573  48.728650 309.5859 -20.316098 378.6307
Dec 2019       179.1835  48.717624 309.6495 -20.346861 378.7139
Jan 2020       179.1938  48.696337 309.6913 -20.384852 378.7725
Feb 2020       179.1978  48.670911 309.7247 -20.425861 378.8215
Mar 2020       179.1994  48.643852 309.7549 -20.468076 378.8669
Apr 2020       179.2000  48.616154 309.7839 -20.510760 378.9108
May 2020       179.2002  48.588210 309.8123 -20.553624 378.9541
Jun 2020       179.2003  48.560174 309.8405 -20.596551 378.9972

 checkresiduals(auto)

    Ljung-Box test

data:  Residuals from ARIMA(1,1,1)(0,0,1)[12]
Q* = 200.21, df = 21, p-value < 2.2e-16

Model df: 3.   Total lags used: 24

a pesar de que la propuesta auto y la propuesta anterior son la misma, en la primera propuesta lucen mejor los reciduos

para continuar con el analísis procederemos a cortar la serie en los ultimos años

ITGF. <- window(diff.ITGF,start=c(1997,1),end=c(2016,6))
autoplot(ITGF.)

autoplot(ITGF.) + 
  forecast::autolayer(meanf(ITGF., h=11), PI=FALSE, series="Mean") +
  forecast::autolayer(naive(ITGF., h=11), PI=FALSE, series="Naïve") +
  forecast::autolayer(snaive(ITGF., h=11), PI=FALSE, series="Seasonal naïve") +
  ggtitle("INGRESOS DEL SECTOR PUBLICO") + xlab("AÑOS") +
  ylab("MILLONES DE PESOS") + guides(colour=guide_legend(title="Forecast"))

autoplot(ITGF.) + 
  forecast::autolayer(meanf(ITGF., h=42), PI=FALSE, series="Mean") + 
  forecast::autolayer(rwf(ITGF., h=42), PI=FALSE, series="Naïve") + 
   forecast::autolayer(rwf(ITGF., drift=TRUE, h=42), PI=FALSE, series="Drift") + 
   ggtitle("INGRESOS DEL SECTOR PUBLICO)") + 
   xlab("AÑOS") + ylab("MILLONES DE PESOS") + 
   guides(colour=guide_legend(title="Forecast"))

procedemos a verificar si los errores de los pronósticos se basan en la misma escala que los datos

ITGF1 <- meanf(ITGF.,h=10)
ITGF2 <- rwf(ITGF.,h=10)
ITGF3 <- snaive(ITGF.,h=10)
autoplot(window(diff.ITGF, start=1997)) + 
  forecast::autolayer(ITGF1, series="Mean", PI=FALSE) +
  forecast::autolayer(ITGF2, series="Naïve", PI=FALSE) +
  forecast::autolayer(ITGF3, series="Seasonal naïve", PI=FALSE) + 
  xlab("AÑOS") + ylab("MILLONES DE PESOS") + 
  guides(colour=guide_legend(title="Forecast"))

el Mean y Naïve no se alcanzan a apreciar muy bien pero se percibe que el pronostico se acerco

ITGF.1 <- window(diff.ITGF, start=2000) 
accuracy(ITGF1, ITGF.1)

                        ME     RMSE       MAE      MPE     MAPE     MASE
Training set -1.473292e-15 160.6571  91.99511      Inf      Inf 1.029900
Test set     -9.572650e-02 173.5658 104.90085 100.0731 100.0731 1.174382
                   ACF1 Theil's U
Training set -0.4848773        NA
Test set     -0.6382013 0.9847316

accuracy(ITGF2, ITGF.1)

                      ME     RMSE      MAE      MPE     MAPE     MASE       ACF1
Training set -0.06008584 277.4525 174.1803      NaN      Inf 1.949976 -0.6614785
Test set      9.90000000 173.8479 108.3000 271.1076 317.7743 1.212436 -0.6382013
             Theil's U
Training set        NA
Test set     0.9277136

accuracy(ITGF3, ITGF.1)

                     ME      RMSE      MAE      MPE     MAPE     MASE       ACF1
Training set -0.4504505 190.27171 89.32432      NaN      Inf 1.000000 -0.6247847
Test set      0.8000000  66.87152 50.40000 441.0509 1566.285 0.564236 -0.3285331
             Theil's U
Training set        NA
Test set     0.2914753

el Seasonal naïve tal como se percibio en la grafíca fue el mejor pronostico con el RMSE más bajo #Suavizamiento exponencial

ITGF.2 <- window(diff.ITGF, start=1986)

'start' value not changed

fc <- ses(ITGF.2, h=5) 
round(accuracy(fc),2)

               ME   RMSE   MAE MPE MAPE MASE  ACF1
Training set 0.02 161.03 91.01 Inf  Inf 0.91 -0.49

el parametro se encuentra entre 0 y uno eso significa que se le da más valor a los periodos anteriores

autoplot(fc) + 
  autolayer(fitted(fc), series="Fitted") + 
  ylab("MILLONES DE PESOS") + xlab("AÑOS")

aplicamos este suavizamiento ya que la serie es simple no tiene tendencia

13. Usando el an´alisis de transferencia, modelar observaciones cambios estructurales y/o observaciones at´ipicas en el contexto ARIMAX (punto extra, opcional).

Analisis de intervencion

Las intervenciones pueden ser naturales o hechas por el ser humano 1- el ingreso al sector publico puede aumentar debido a un cobro mas elevado de impuestos 2- puede disminuir debido a una fuga de capital

acf(as.vector(diff(diff(window((ITGF),end=c(2018,06)),12))),lag.max=48,main='')

air.m1=arimax(log(ITGF),order=c(0,1,1),seasonal=list(order=c(0,1,1),period=12),
xtransf=data.frame(I911=1*(seq(ITGF)==69),I911=1*(seq(ITGF)==69)),
transfer=list(c(0,0),c(1,0)),xreg=data.frame(Dec96=1*(seq(ITGF)==12),          Jan97=1*(seq(ITGF)==13),Dec02=1*(seq(ITGF)==84)),method='ML')
air.m1

Call:
arimax(x = log(ITGF), order = c(0, 1, 1), seasonal = list(order = c(0, 1, 1), 
    period = 12), xreg = data.frame(Dec96 = 1 * (seq(ITGF) == 12), Jan97 = 1 * 
    (seq(ITGF) == 13), Dec02 = 1 * (seq(ITGF) == 84)), method = "ML", xtransf = data.frame(I911 = 1 * 
    (seq(ITGF) == 69), I911 = 1 * (seq(ITGF) == 69)), transfer = list(c(0, 0), 
    c(1, 0)))

Coefficients:
          ma1     sma1    Dec96   Jan97    Dec02  I911-MA0  I911.1-AR1
      -1.0000  -0.2327  -0.1174  0.3395  -0.0050    1.7246      0.0432
s.e.   0.0104   0.0645   0.7965  0.6281   0.6202   35.5800      0.7596
      I911.1-MA0
         -1.8474
s.e.     35.5747

sigma^2 estimated as 0.624:  log likelihood = -449.58,  aic = 915.17

plot(log(ITGF),ylab='Log(ITGF)')+
points(fitted(air.m1))

integer(0)

Nine11p=1*(seq(ITGF)==69) 
plot(ts(Nine11p*(1.7246)+filter(Nine11p,filter=0.0432,method='recursive', side=1)*(-1.8474),frequency=12,start=1986),ylab="PIB", type='h') 
abline(h=0)

library(readr)
library(gridExtra)
library(forecast)
library(fpp2)
library(lmtest)
library(TSA)
library(urca)
library(ggplot2)
library(rmarkdown)
library(zoo)
library(vars)

14. Analizar un VAR, necesita incluir los puntos siguientes a)Buscar otra variable (incluso mas variables) y redactar la teoria que se encuentra detras de la relacion entre variables que propone.

La segunda variable es gasto de gobierno

se relaciona con el ingreso al sector publico mediante el PIB o las Politicas monetarias Todas las funciones que realiza el sector público requieren la realización de un gasto, por lo que para financiarlas será necesario obtener ingresos. Para poder financiar sus gastos, el sector público tiene que conseguir ingresos. Dichos ingresos los logra, entre otras vías, estableciendo impuestos, es decir, pagos obligatorios que obtiene de las economías domésticas y las empresas. El conjunto de procedimientos y normas que regulan la contribución de impuestos se denomina sistema tributario. A su vez, los impuestos también pueden cumplir una importante función redistributiva a través de la progresividad, de la que hablaremos en el apartado relativo a ingresos públicos. Cada vez que el sector público decide aplicar una política fiscal expansiva se produce un efecto negativo sobre el saldo presupuestario (SP = T - G - TR), ya que los incrementos de los gastos del sector público (gasto público y transferencias) o las reducciones de sus ingresos provocan un incremento del déficit público. Como sabemos, en una economía cerrada, la reducción del ahorro público supone una reducción de los recursos para financiar la inversión, por lo que, para evitar la caída de la inversión interna el ahorro privado debe compensar el incremento del déficit público. b) Evaluar la estacionalidad de la nueva variable.

base2 <- read.csv("C:/Users/usuario/Desktop/ingresoalsector 1.3.csv", sep = ";")

ts.i <- ts(base2$itgf, start = c(1986,1), frequency = 12)
ts.g <- ts(base2$gg, start = c(1986,1), frequency = 12)

autoplot(ts.i,) + 
  ggtitle("INGRESOS DEL SECTOR PUBLICO") +
  ylab("MILLONES DE PESOS") + xlab("AÑOS")

como la habia descrito anteriormente cuenta con estacionalidad y un poco de tendencia

autoplot(ts.g) +
  ggtitle("GASTO DE GOBIERNO") +
  ylab("MILLONES DE PESOS") + xlab("AÑOS")

podemos observar en el gasto similar a los ingresos

ggseasonplot(ts.i)

aqui se puede ver claramente que la serie de ingresos es estacional

ggseasonplot(ts.g)

la serie de gasto es evidente que es estacional

mes. <- season(ts.i)
reg.i <- lm(ts.i ~ time(ts.i) + mes.)
summary(reg.i)

Call:
lm(formula = ts.i ~ time(ts.i) + mes.)

Residuals:
     Min       1Q   Median       3Q      Max 
-220.860  -95.939   -1.307   85.590  219.883 

Coefficients:
               Estimate Std. Error t value Pr(>|t|)    
(Intercept)   3951.7943  1188.8964   3.324 0.000975 ***
time(ts.i)      -1.8803     0.5938  -3.167 0.001668 ** 
mes.February    55.4294    27.0805   2.047 0.041367 *  
mes.March       61.1013    27.0806   2.256 0.024626 *  
mes.April       27.3185    27.0808   1.009 0.313728    
mes.May        -11.5248    27.0811  -0.426 0.670668    
mes.June       -17.9741    27.0815  -0.664 0.507285    
mes.July       -19.1714    27.2912  -0.702 0.482815    
mes.August      -6.6710    27.2912  -0.244 0.807026    
mes.September   -5.3893    27.2913  -0.197 0.843565    
mes.October      0.9862    27.2916   0.036 0.971194    
mes.November    -1.6384    27.2919  -0.060 0.952162    
mes.December    16.0495    27.2923   0.588 0.556843    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 110 on 377 degrees of freedom
Multiple R-squared:  0.07716,   Adjusted R-squared:  0.04779 
F-statistic: 2.627 on 12 and 377 DF,  p-value: 0.002211

mes. <- season(ts.g)
reg.g <- lm(ts.g ~ time(ts.g) + mes.)
summary(reg.g)

Call:
lm(formula = ts.g ~ time(ts.g) + mes.)

Residuals:
     Min       1Q   Median       3Q      Max 
-210.076  -93.145   -2.283   93.548  220.042 

Coefficients:
               Estimate Std. Error t value Pr(>|t|)   
(Intercept)   2931.4625  1193.5255   2.456  0.01449 * 
time(ts.g)      -1.3775     0.5961  -2.311  0.02138 * 
mes.February    84.3572    27.1859   3.103  0.00206 **
mes.March       54.1690    27.1860   1.993  0.04703 * 
mes.April       46.1929    27.1863   1.699  0.09012 . 
mes.May          7.6713    27.1866   0.282  0.77797   
mes.June        -6.0018    27.1870  -0.221  0.82540   
mes.July         9.3333    27.3974   0.341  0.73355   
mes.August      -6.4894    27.3975  -0.237  0.81289   
mes.September    3.5942    27.3976   0.131  0.89570   
mes.October     13.4277    27.3978   0.490  0.62435   
mes.November    22.0425    27.3981   0.805  0.42160   
mes.December    35.4698    27.3985   1.295  0.19626   
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 110.4 on 377 degrees of freedom
Multiple R-squared:  0.06996,   Adjusted R-squared:  0.04036 
F-statistic: 2.363 on 12 and 377 DF,  p-value: 0.006114

aplicamos diferencias estacionales a ambas series

ts.ddi <- diff(diff(ts.i,12))
ts.dgg <- diff(diff(ts.g,12)) 

ggtsdisplay(ts.ddi)

ggtsdisplay(ts.dgg)

podemos notar que en tanto en los ingresos como en el gasto los resagos de la prueba PACF denotan estacionalidad

summary(ur.df(ts.ddi))

############################################### 
# 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 
-380.98  -13.55    0.50   16.56  357.61 

Coefficients:
           Estimate Std. Error t value Pr(>|t|)    
z.lag.1    -1.73430    0.08143 -21.299  < 2e-16 ***
z.diff.lag  0.28684    0.04959   5.784 1.54e-08 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 109.8 on 373 degrees of freedom
Multiple R-squared:  0.7007,    Adjusted R-squared:  0.6991 
F-statistic: 436.6 on 2 and 373 DF,  p-value: < 2.2e-16


Value of test-statistic is: -21.2986 

Critical values for test statistics: 
      1pct  5pct 10pct
tau1 -2.58 -1.95 -1.62

el resultado de esta prueba respecto al ingreso son es de (-21.2986) pasa por mucho los valores criticos esto quiere decir que la serie ya es estacionaria

summary(ur.df(ts.dgg))

############################################### 
# 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 
-399.10  -10.59    0.22   16.07  282.12 

Coefficients:
           Estimate Std. Error t value Pr(>|t|)    
z.lag.1    -1.76334    0.08101 -21.768  < 2e-16 ***
z.diff.lag  0.28438    0.04898   5.806 1.37e-08 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 101.2 on 373 degrees of freedom
Multiple R-squared:  0.718, Adjusted R-squared:  0.7165 
F-statistic: 474.8 on 2 and 373 DF,  p-value: < 2.2e-16


Value of test-statistic is: -21.7677 

Critical values for test statistics: 
      1pct  5pct 10pct
tau1 -2.58 -1.95 -1.62

la prueba aplicada al gasto de gobierno nos dice que el resultado (-21.7677) parecido a la serie de ingresos aunque no igual es evidente que también pasa los valores criticos, por tanto ya es una serie estacionaria

base3 <- cbind.zoo(i = ts.ddi, g = ts.dgg) 
View(base3) 
autoplot(base3) 

nos corto exactos los datos por tanto no hicimos ningún ajuste

3. Proponga el orden de rezagos optimo para el VAR y presentar la estimacion.

VARselect(base3, lag.max = 24, type = "const")[["selection"]]

AIC(n)  HQ(n)  SC(n) FPE(n) 
    24     23     11     23 

VARselect(base3, lag.max = 24, type = "const")

$`selection`
AIC(n)  HQ(n)  SC(n) FPE(n) 
    24     23     11     23 

$criteria
                  1            2            3            4            5
AIC(n) 1.834359e+01 1.815005e+01 1.804701e+01 1.798998e+01 1.795420e+01
HQ(n)  1.836974e+01 1.819363e+01 1.810803e+01 1.806843e+01 1.805009e+01
SC(n)  1.840931e+01 1.825958e+01 1.820035e+01 1.818714e+01 1.819517e+01
FPE(n) 9.258064e+07 7.628980e+07 6.882110e+07 6.500682e+07 6.272329e+07
                  6            7            8            9           10
AIC(n) 1.793303e+01 1.791329e+01 1.789077e+01 1.778757e+01 1.730104e+01
HQ(n)  1.804635e+01 1.804404e+01 1.803896e+01 1.795319e+01 1.748409e+01
SC(n)  1.821781e+01 1.824189e+01 1.826318e+01 1.820379e+01 1.776107e+01
FPE(n) 6.141078e+07 6.021269e+07 5.887466e+07 5.310467e+07 3.264879e+07
                 11           12           13           14           15
AIC(n) 1.712550e+01 1.710861e+01 1.709296e+01 1.706918e+01 1.707786e+01
HQ(n)  1.732598e+01 1.732652e+01 1.732831e+01 1.732197e+01 1.734808e+01
SC(n)  1.762934e+01 1.765626e+01 1.768443e+01 1.770446e+01 1.775696e+01
FPE(n) 2.739485e+07 2.693888e+07 2.652397e+07 2.590436e+07 2.613454e+07
                 16           17           18           19           20
AIC(n) 1.709530e+01 1.705398e+01 1.705155e+01 1.703899e+01 1.703012e+01
HQ(n)  1.738295e+01 1.735906e+01 1.737407e+01 1.737894e+01 1.738751e+01
SC(n)  1.781821e+01 1.782070e+01 1.786208e+01 1.789334e+01 1.792828e+01
FPE(n) 2.659931e+07 2.552798e+07 2.547204e+07 2.516086e+07 2.494605e+07
                 21           22           23           24
AIC(n) 1.699602e+01 1.693770e+01 1.688818e+01 1.688783e+01
HQ(n)  1.737084e+01 1.732996e+01 1.729786e+01 1.731495e+01
SC(n)  1.793799e+01 1.792349e+01 1.791777e+01 1.796124e+01
FPE(n) 2.411760e+07 2.275945e+07 2.166822e+07 2.166990e+07

nos propone rezagos del 1 hasta el 23

Propuesta 1 con 2 rezagos

Rezago 2

var1 <- VAR(base3, p=1, type = "both")
summary(var1)

VAR Estimation Results:
========================= 
Endogenous variables: i, g 
Deterministic variables: both 
Sample size: 376 
Log Likelihood: -4561.727 
Roots of the characteristic polynomial:
0.4131 0.4131
Call:
VAR(y = base3, p = 1, type = "both")


Estimation results for equation i: 
================================== 
i = i.l1 + g.l1 + const + trend 

       Estimate Std. Error t value Pr(>|t|)    
i.l1  -0.425016   0.050530  -8.411 8.81e-16 ***
g.l1   0.235438   0.053497   4.401 1.41e-05 ***
const -0.833179  11.608057  -0.072    0.943    
trend  0.002407   0.053155   0.045    0.964    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1


Residual standard error: 111.9 on 372 degrees of freedom
Multiple R-Squared: 0.1645, Adjusted R-squared: 0.1577 
F-statistic: 24.41 on 3 and 372 DF,  p-value: 1.928e-14 


Estimation results for equation g: 
================================== 
g = i.l1 + g.l1 + const + trend 

       Estimate Std. Error t value Pr(>|t|)    
i.l1  -0.146558   0.047953  -3.056   0.0024 ** 
g.l1  -0.320311   0.050768  -6.309 7.97e-10 ***
const -2.201661  11.015908  -0.200   0.8417    
trend  0.009853   0.050444   0.195   0.8452    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1


Residual standard error: 106.2 on 372 degrees of freedom
Multiple R-Squared: 0.1606, Adjusted R-squared: 0.1538 
F-statistic: 23.72 on 3 and 372 DF,  p-value: 4.569e-14 



Covariance matrix of residuals:
      i     g
i 12515  4493
g  4493 11270

Correlation matrix of residuals:
       i      g
i 1.0000 0.3783
g 0.3783 1.0000

nos encontramos 2 variables significativas con un resultado de p-value bajo

Rezago 2

var2 <- VAR(base3, p=2, type = "both")
summary(var2)

VAR Estimation Results:
========================= 
Endogenous variables: i, g 
Deterministic variables: both 
Sample size: 375 
Log Likelihood: -4504.622 
Roots of the characteristic polynomial:
0.5874 0.5874 0.5162 0.5162
Call:
VAR(y = base3, p = 2, type = "both")


Estimation results for equation i: 
================================== 
i = i.l1 + g.l1 + i.l2 + g.l2 + const + trend 

       Estimate Std. Error t value Pr(>|t|)    
i.l1  -0.564074   0.053394 -10.564  < 2e-16 ***
g.l1   0.269733   0.056325   4.789 2.43e-06 ***
i.l2  -0.326200   0.052572  -6.205 1.47e-09 ***
g.l2   0.203097   0.057113   3.556 0.000425 ***
const -1.041531  11.125632  -0.094 0.925465    
trend  0.003029   0.050878   0.060 0.952558    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1


Residual standard error: 106.6 on 369 degrees of freedom
Multiple R-Squared: 0.2468, Adjusted R-squared: 0.2366 
F-statistic: 24.18 on 5 and 369 DF,  p-value: < 2.2e-16 


Estimation results for equation g: 
================================== 
g = i.l1 + g.l1 + i.l2 + g.l2 + const + trend 

       Estimate Std. Error t value Pr(>|t|)    
i.l1  -0.129034   0.050442  -2.558   0.0109 *  
g.l1  -0.435393   0.053210  -8.182 4.55e-15 ***
i.l2  -0.094376   0.049665  -1.900   0.0582 .  
g.l2  -0.223060   0.053954  -4.134 4.41e-05 ***
const  1.108288  10.510346   0.105   0.9161    
trend -0.002889   0.048065  -0.060   0.9521    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1


Residual standard error: 100.7 on 369 degrees of freedom
Multiple R-Squared: 0.2298, Adjusted R-squared: 0.2193 
F-statistic: 22.02 on 5 and 369 DF,  p-value: < 2.2e-16 



Covariance matrix of residuals:
      i     g
i 11373  4394
g  4394 10150

Correlation matrix of residuals:
      i     g
i 1.000 0.409
g 0.409 1.000

tenemos igual 2 variables significativas y un resultado p-value mas bajo que el anterior

Rezago 3

var3 <- VAR(base3, p=3, type = "both")
summary(var3)

VAR Estimation Results:
========================= 
Endogenous variables: i, g 
Deterministic variables: both 
Sample size: 374 
Log Likelihood: -4470.29 
Roots of the characteristic polynomial:
 0.65  0.65  0.62  0.62 0.5537 0.5537
Call:
VAR(y = base3, p = 3, type = "both")


Estimation results for equation i: 
================================== 
i = i.l1 + g.l1 + i.l2 + g.l2 + i.l3 + g.l3 + const + trend 

      Estimate Std. Error t value Pr(>|t|)    
i.l1  -0.63602    0.05528 -11.506  < 2e-16 ***
g.l1   0.26951    0.05855   4.603 5.76e-06 ***
i.l2  -0.46265    0.05930  -7.802 6.45e-14 ***
g.l2   0.25121    0.06458   3.890 0.000119 ***
i.l3  -0.23633    0.05357  -4.412 1.35e-05 ***
g.l3   0.15790    0.05899   2.677 0.007772 ** 
const  1.53777   10.83798   0.142 0.887247    
trend -0.00726    0.04949  -0.147 0.883465    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1


Residual standard error: 103.3 on 366 degrees of freedom
Multiple R-Squared: 0.2826, Adjusted R-squared: 0.2689 
F-statistic: 20.59 on 7 and 366 DF,  p-value: < 2.2e-16 


Estimation results for equation g: 
================================== 
g = i.l1 + g.l1 + i.l2 + g.l2 + i.l3 + g.l3 + const + trend 

       Estimate Std. Error t value Pr(>|t|)    
i.l1  -0.118130   0.052740  -2.240  0.02570 *  
g.l1  -0.510976   0.055867  -9.146  < 2e-16 ***
i.l2  -0.098845   0.056581  -1.747  0.08148 .  
g.l2  -0.331797   0.061620  -5.385  1.3e-07 ***
i.l3  -0.096804   0.051107  -1.894  0.05899 .  
g.l3  -0.145999   0.056287  -2.594  0.00987 ** 
const  2.444956  10.340659   0.236  0.81322    
trend -0.007931   0.047223  -0.168  0.86672    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1


Residual standard error: 98.59 on 366 degrees of freedom
Multiple R-Squared: 0.2684, Adjusted R-squared: 0.2544 
F-statistic: 19.18 on 7 and 366 DF,  p-value: < 2.2e-16 



Covariance matrix of residuals:
      i    g
i 10678 4188
g  4188 9720

Correlation matrix of residuals:
       i      g
i 1.0000 0.4111
g 0.4111 1.0000

solo se aumentoo una variable significativa y contionuó el mismo p-value que en el rezago pasado #Rezago 4

var4 <- VAR(base3, p=4, type = "both")
summary(var4)

VAR Estimation Results:
========================= 
Endogenous variables: i, g 
Deterministic variables: both 
Sample size: 373 
Log Likelihood: -4440.044 
Roots of the characteristic polynomial:
0.685 0.685 0.6804 0.6804 0.6257 0.6257 0.6153 0.6153
Call:
VAR(y = base3, p = 4, type = "both")


Estimation results for equation i: 
================================== 
i = i.l1 + g.l1 + i.l2 + g.l2 + i.l3 + g.l3 + i.l4 + g.l4 + const + trend 

      Estimate Std. Error t value Pr(>|t|)    
i.l1  -0.69812    0.05612 -12.440  < 2e-16 ***
g.l1   0.28113    0.05886   4.777 2.59e-06 ***
i.l2  -0.56772    0.06363  -8.922  < 2e-16 ***
g.l2   0.28706    0.06929   4.143 4.27e-05 ***
i.l3  -0.38229    0.06287  -6.081 3.03e-09 ***
g.l3   0.22869    0.06930   3.300  0.00106 ** 
i.l4  -0.21518    0.05380  -3.999 7.70e-05 ***
g.l4   0.15772    0.05957   2.648  0.00846 ** 
const  2.84302   10.66504   0.267  0.78995    
trend -0.01256    0.04864  -0.258  0.79645    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1


Residual standard error: 101.1 on 363 degrees of freedom
Multiple R-Squared: 0.3185, Adjusted R-squared: 0.3016 
F-statistic: 18.85 on 9 and 363 DF,  p-value: < 2.2e-16 


Estimation results for equation g: 
================================== 
g = i.l1 + g.l1 + i.l2 + g.l2 + i.l3 + g.l3 + i.l4 + g.l4 + const + trend 

       Estimate Std. Error t value Pr(>|t|)    
i.l1  -0.116097   0.053746  -2.160  0.03142 *  
g.l1  -0.535269   0.056368  -9.496  < 2e-16 ***
i.l2  -0.127490   0.060944  -2.092  0.03714 *  
g.l2  -0.351932   0.066362  -5.303 1.98e-07 ***
i.l3  -0.133274   0.060213  -2.213  0.02749 *  
g.l3  -0.197445   0.066373  -2.975  0.00313 ** 
i.l4  -0.126831   0.051530  -2.461  0.01431 *  
g.l4  -0.056680   0.057052  -0.993  0.32113    
const -0.263287  10.214277  -0.026  0.97945    
trend  0.002938   0.046582   0.063  0.94974    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1


Residual standard error: 96.86 on 363 degrees of freedom
Multiple R-Squared: 0.278,  Adjusted R-squared: 0.2601 
F-statistic: 15.53 on 9 and 363 DF,  p-value: < 2.2e-16 



Covariance matrix of residuals:
      i    g
i 10228 4109
g  4109 9381

Correlation matrix of residuals:
       i      g
i 1.0000 0.4195
g 0.4195 1.0000

tenemos mejor significancia, aunque el p-value no bajo más nos quedaremos con este número de rezagos

var4.serial <- serial.test(var4, lags.pt=10, type="PT.asymptotic") 
plot(var4.serial, names = "i")

plot(var4.serial, names = "g")

4. Probar la correlacion serial y normalidad en los residuos.

var.norm<-normality.test(var4,multivariate.only=TRUE)
var.norm

$`JB`

    JB-Test (multivariate)

data:  Residuals of VAR object var4
Chi-squared = 1965.2, df = 4, p-value < 2.2e-16


$Skewness

    Skewness only (multivariate)

data:  Residuals of VAR object var4
Chi-squared = 456.46, df = 2, p-value < 2.2e-16


$Kurtosis

    Kurtosis only (multivariate)

data:  Residuals of VAR object var4
Chi-squared = 1508.7, df = 2, p-value < 2.2e-16

cusum<-stability(var4,type="OLS-CUSUM")
plot(cusum)

la media es estable

rec.cusum<-stability(var4,type="Rec-CUSUM")
plot(rec.cusum)

se puede observar estabilidad estructural y que las fluctuaciones son minimas

5. Resultados de la prueba de causalidad de Granger

causality(var4, cause='i')$Granger

    Granger causality H0: i do not Granger-cause g

data:  VAR object var4
F-Test = 2.3564, df1 = 4, df2 = 726, p-value = 0.05232

se acepta la H0 y se puede decir que el ingreso no causa al gasto de gobierno

causality(var4, cause='g')$Granger

    Granger causality H0: g do not Granger-cause i

data:  VAR object var4
F-Test = 6.9989, df1 = 4, df2 = 726, p-value = 1.57e-05

se acepta la H0, lo cual quiere decir que el gasto de gobierno si causa al ingreso

6. Crear un pronostico para dos años usando el VAR especificado.

predictions<-predict(var4,n.ahead=10,ci=0.95)
class(predictions)

[1] "varprd"

plot(predictions,names="i")

fanchart(predictions,names="g")

7. Interpretar las funciones impulso-respuesta.

plot(irf(var4,impulse="i",response="g",ortho=T))

plot(irf(var4,impulse="g",response="i",ortho=T))

El gasto de gobierno tiene relacion a las altas y bajas en respecto al ingreso de gobierno.

Descomposicion de varianza de error

fevd.var <- fevd(var4, n.ahead = 10) 
fevd.var

$`i`
              i          g
 [1,] 1.0000000 0.00000000
 [2,] 0.9573955 0.04260449
 [3,] 0.9561460 0.04385401
 [4,] 0.9536735 0.04632655
 [5,] 0.9536495 0.04635053
 [6,] 0.9509420 0.04905801
 [7,] 0.9456956 0.05430441
 [8,] 0.9456880 0.05431204
 [9,] 0.9454089 0.05459107
[10,] 0.9453300 0.05466997

$g
              i         g
 [1,] 0.1759514 0.8240486
 [2,] 0.2179726 0.7820274
 [3,] 0.2170573 0.7829427
 [4,] 0.2170615 0.7829385
 [5,] 0.2167630 0.7832370
 [6,] 0.2226580 0.7773420
 [7,] 0.2247071 0.7752929
 [8,] 0.2249946 0.7750054
 [9,] 0.2250030 0.7749970
[10,] 0.2250610 0.7749390

plot(fevd.var,addbars=2)

los ingresos si depende del gasto y el gasto no depende tanto de los ingresos esto se debe a que ambas variables forman el PIB

15. Evaluar la potencial cointegracion usando la metodologia de Engle-Granger y Johan-sen.

po.test(base3[,1:2])

p-value smaller than printed p-value

    Phillips-Ouliaris Cointegration Test

data:  base3[, 1:2]
Phillips-Ouliaris demeaned = -428.97, Truncation lag parameter = 3,
p-value = 0.01

con H0 las variables no estan cointegradas