Trabajo Tercer Parcial/Modelos de Regresion/ARIMA/VAR/Cointegracion

1.Breve referencia de la serie de tiempo elegida, asi como frecuencia, unidad de medida, fuente, etc

Esta serie es una serie extraida de la industria automotriz, la cual nos muestra la produccion total de vehículos automotores del pais desde el año de 1983 hasta julio del 2018.

Frecuencia: Mensual

Unidade de medida:Número de unidades producidas

Fuente:A partir del año 2017: INEGI. Estimación de cifras con base en las ventas reportadas por la Asociación Mexicana de la Industria Automotriz (AMIA) A.C. y la Encuesta Mensual de la Industria Manufacturera (EMIM)

Link: http://www.inegi.org.mx/sistemas/bie/

base<-read.csv(file.choose("file:///F:/Autos.csv"))

St<-ts(base$Dato,frequency = 12,start = c(1983,1))

2.Graficar la serie de tiempo, analizar patrones y observaciones atipicas. Apoye su analisis con una descomposicion clasica.

La grafica muestra un amuneto tendencial inmediato en la producción de automotores en la republica mexicana, con el paso del tiempo han aumntado cada año su produccion pero se puede ver que en ciertos años las empresas productorasde automotores tiene bajas en su produccion. Y como es una serie estaional tiene temporadas en las que pruducen mas automotores como son regularmente el primer trimestre y ultimo trimestre de cada año.

Una de las variaciones atipicas de la grafica es en el año de 2008 a 2009 podemos asumir esta gran caida de produccion de automotres a la crisis mundial gracias a las grandes especulaciones, aunque a inicios del siglo XXI vemos que hay caidas de produccion mas evidenes que en las decadas aneteriores pero que no son de gran importancia, debido a la entrada del PAN al gobierno. Despues de la crisis mundial vemos que hay caidas de la produccion de automotores mas grandes y continuas esto son las consecuencias de la crisis que aun no podemos superar. Puede ser que estas afectacciones sean porque cuando sucedio la crisis el gobierno de esa epoca no tomo las medidas contarestantes necesarias como lo hicieron otros paises.

3. Si es necesario, utilizar transformacion Box-Cox/logaritmos para estabilizar la varianza. Presentar grafica.

fit3

           Jan       Feb       Mar       Apr       May       Jun       Jul
1983 10.203629 10.297184 10.351661 10.128110 10.048929 10.081550  9.935519
1984 10.174240 10.141796 10.210126 10.082972 10.390656 10.398611 10.428660
1985 10.608884 10.614426 10.640077 10.551690 10.671858 10.516075 10.686635
1986 10.429044 10.285377 10.313177 10.513932 10.328461 10.155685 10.365396
1987 10.248318 10.254532 10.352842 10.221723 10.514367 10.644806 10.501912
1988 10.517673 10.618641 10.640843 10.480241 10.716016 10.743890 10.590264
1989 10.847549 10.798902 10.856168 10.889883 11.034244 11.137170 10.961069
1990 10.745744 10.752783 10.900639 10.866853 11.191300 11.279264 11.229727
1991 11.239777 11.136660 11.103844 11.291979 11.315218 11.283022 11.413414
1992 11.433828 11.297390 11.509028 11.372559 11.427803 11.524656 11.363985
1993 11.265002 11.424968 11.537950 11.442364 11.412276 11.375443 11.196803
1994 11.405563 11.418428 11.483898 11.501875 11.362823 11.518032 11.170196
1995 11.327343 11.272076 11.292653 11.148218 11.206509 11.234203 11.093691
1996 11.536427 11.546196 11.480960 11.470415 11.612843 11.594874 11.450443
1997 11.603552 11.534873 11.504026 11.601879 11.700856 11.695414 11.616763
1998 11.612182 11.649561 11.827824 11.685769 11.789610 11.771645 11.487772
1999 11.669510 11.696288 11.797924 11.724595 11.796712 11.869284 11.652992
2000 11.793099 11.873316 12.014900 11.898331 12.005607 12.094806 11.932675
2001 11.973605 11.901000 12.024029 11.882839 11.997140 12.005290 11.793960
2002 11.930431 11.888804 11.934198 12.050167 12.051522 12.008804 11.860104
2003 11.866564 11.789587 11.807466 11.734716 11.905542 11.886542 11.675410
2004 11.699538 11.709824 11.854385 11.733201 11.763653 11.891211 11.670895
2005 11.482724 11.787165 11.695572 11.856934 11.823648 11.801692 11.540424
2006 11.987176 12.113645 12.202170 11.834299 12.090589 12.210219 11.741311
2007 11.844105 11.962114 12.075753 11.940641 12.121946 12.195209 11.953281
2008 12.057196 12.101695 11.963874 12.177915 12.124233 12.185472 11.922708
2009 11.347449 11.607881 11.570977 11.550838 11.617511 11.566163 11.640166
2010 12.052362 12.057213 12.186880 12.079596 12.129785 12.270614 12.135677
2011 12.244283 12.223407 12.450316 12.029580 12.357630 12.413201 12.266758
2012 12.280090 12.444735 12.544129 12.299144 12.388865 12.544846 12.432455
2013 12.437700 12.451494 12.422316 12.436843 12.495625 12.536401 12.431130
2014 12.472440 12.468464 12.581085 12.473091 12.615805 12.614902 12.526579
2015 12.549935 12.606907 12.671717 12.613955 12.626045 12.686896 12.510678
2016 12.539093 12.556332 12.543316 12.558710 12.585663 12.713586 12.593520
2017 12.615400 12.673799 12.856307 12.617437 12.772301 12.793537 12.664958
2018 12.655851 12.738103 12.752945 12.698293 12.806630 12.807850 12.645746
           Aug       Sep       Oct       Nov       Dec
1983  9.996249  9.737197 10.117792 10.053888  9.792724
1984 10.356695 10.204444 10.406745 10.507503 10.237958
1985 10.462303 10.402686 10.651809 10.461388 10.258571
1986 10.112248  9.958828 10.322921 10.169116  9.933677
1987 10.079162 10.358441 10.530895 10.447584 10.526561
1988 10.673411 10.584790 10.723686 10.808697 10.625781
1989 10.827131 10.591547 10.900307 10.844061 10.585523
1990 11.297279 11.068746 11.432377 11.289232 11.000882
1991 11.286552 11.164063 11.529665 11.421424 11.215274
1992 11.233145 11.344069 11.479627 11.303820 11.219386
1993 11.149226 11.335639 11.356950 11.533904 11.497395
1994 11.384558 11.395515 11.453897 11.554326 11.380662
1995 11.176977 11.223829 11.476023 11.386296 11.269133
1996 11.586427 11.521588 11.650372 11.510763 11.350830
1997 11.547366 11.726439 11.807973 11.706706 11.523677
1998 11.706121 11.708426 11.860811 11.673785 11.672712
1999 11.833014 11.840840 11.784089 11.763241 11.727771
2000 12.107125 12.052304 12.167223 12.017379 11.805102
2001 11.952786 11.962962 12.073484 12.018562 11.678253
2002 12.000161 11.900790 12.049892 11.884675 11.414960
2003 11.771174 11.790383 11.896574 11.740467 11.506414
2004 11.884903 11.867799 11.904623 11.695722 11.583356
2005 11.955314 11.932478 12.075246 12.105738 11.849112
2006 12.137628 12.056052 12.145314 12.214036 11.818010
2007 12.310041 12.132297 12.232028 12.159405 11.784554
2008 12.257474 12.182128 12.301942 12.076755 11.753862
2009 11.847210 11.924479 12.158090 12.124651 11.976483
2010 12.263029 12.226140 12.339217 12.282992 12.093145
2011 12.360085 12.373873 12.443715 12.397763 12.165683
2012 12.470523 12.480544 12.591410 12.522648 12.154437
2013 12.510081 12.442555 12.604312 12.496288 12.081931
2014 12.566220 12.497525 12.707345 12.559599 12.247685
2015 12.632369 12.596120 12.748487 12.643120 12.369738
2016 12.759656 12.614596 12.740095 12.703381 12.444944
2017 12.856137 12.732926 12.895192 12.750476 12.482488
2018 12.821226 12.726095 12.849943                    

4. Modelar la serie de tiempo elegida como funcion de una tendencia, tendencua cuadrati??ca y/o medias estacionales. Presente el diagnostico del modelo elegido.

data(fit3)

data set <U+393C><U+3E31>fit3<U+393C><U+3E32> not found

modelo1<-lm(St~time(rwalk))

summary(modelo1)

5. En caso de estacionalidad de la serie de tiempo, aplicar diferencias estacionales.Presentar grafica.

fit1<-diff(fit3,1)

fit2<-diff(fit3,2)

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

summary(ur.df(St))

############################################### 
# 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 
-104504   -7278    3148   12949   71363 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
z.lag.1     0.001104   0.006729   0.164     0.87    
z.diff.lag -0.430101   0.044188  -9.733   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 23520 on 426 degrees of freedom
Multiple R-squared:  0.1831,    Adjusted R-squared:  0.1793 
F-statistic: 47.75 on 2 and 426 DF,  p-value: < 2.2e-16


Value of test-statistic is: 0.1641 

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

7. Usar herramientas ACF, PACF, EACF y/o criterios de Akaike/ Bayes para construirpropuestas de modelos.

eacf(St)

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

Etapa:Estimación

Propuesta 1

p1

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

Coefficients:
         ar1     ar2     ar3
      0.3956  0.3438  0.1014
s.e.  0.0486  0.0495  0.0485

sigma^2 estimated as 283457859:  log likelihood=-4659.82
AIC=9327.64   AICc=9327.73   BIC=9343.78

p2

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

Coefficients:
         ar1     ar2      ma1     sma1     sma2
      0.7322  0.2386  -0.3134  -0.6181  -0.0869
s.e.  0.0855  0.0806   0.0804   0.0525   0.0482

sigma^2 estimated as 209410634:  log likelihood=-4599.16
AIC=9210.32   AICc=9210.53   BIC=9234.53

p3

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

Coefficients:
         ar1      ma1     ma2     sma1     sma2
      0.9693  -0.5702  0.1922  -0.6108  -0.0833
s.e.  0.0145   0.0494  0.0559   0.0531   0.0486

sigma^2 estimated as 207653975:  log likelihood=-4597.34
AIC=9206.67   AICc=9206.88   BIC=9230.89

8. Como parte del diagnostico del modelo, analizar los residuos y aplicar la prueba Ljung-Box

Residuales

checkresiduals(p1)

    Ljung-Box test

data:  Residuals from ARIMA(3,0,0)(0,1,0)[12]
Q* = 102.63, df = 21, p-value = 9.877e-13

Model df: 3.   Total lags used: 24

checkresiduals(p2)

    Ljung-Box test

data:  Residuals from ARIMA(2,0,1)(0,1,2)[12]
Q* = 47.036, df = 19, p-value = 0.0003529

Model df: 5.   Total lags used: 24

  checkresiduals(p3)

    Ljung-Box test

data:  Residuals from ARIMA(1,0,2)(0,1,2)[12]
Q* = 42.321, df = 19, p-value = 0.001604

Model df: 5.   Total lags used: 24

9. Usar la funcion auto.arima() y compare sus resultados con el inciso anterior.

p5

Series: St 
ARIMA(1,0,2)(0,1,2)[12] with drift 

Coefficients:
         ar1      ma1     ma2     sma1     sma2     drift
      0.9197  -0.5482  0.2128  -0.6017  -0.0943  728.7277
s.e.  0.0246   0.0519  0.0565   0.0523   0.0491  152.7401

sigma^2 estimated as 203547525:  log likelihood=-4592.6
AIC=9199.2   AICc=9199.47   BIC=9227.44

checkresiduals(p5)

    Ljung-Box test

data:  Residuals from ARIMA(1,0,2)(0,1,2)[12] with drift
Q* = 37.372, df = 18, p-value = 0.004686

Model df: 6.   Total lags used: 24

10. Presente la ecuacion final y describa.

\[ PA= B_0 +B_1_t-12\]

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

pronostico <- plot(forecast(propuesta.auto, h=24))

Error in forecast(propuesta.auto, h = 24) : 
  could not find function "forecast"

12. Utilizando metodos de pronosticos simples y/o suavizamiento exponencial generar un pronostico para dos años. Elegir el m ~etodo que presente la raiz del error medioal cuadrado mas pequeños

fit4<-window(St,start=1983,end=c(2018,10))

Graficas

autoplot(fit4)+
forecast::autolayer(meanf(fit4,h=24),PI=FALSE,series="Mean")+
forecast::autolayer(naive(fit4,h=24),PI=FALSE,series="Naïve")+
forecast::autolayer(snaive(fit4,h=24),PI=FALSE,series="Seasonal  naïve")+ggtitle("Produccion de automotores")+xlab("Year")+ylab("Megalitres")+guides(colour=guide_legend(title="Forecast"))

Error: Objects of type ts not supported by autoplot.

Pronosticos Simples

fit5 <- meanf(fit4,h=10) 

Error in meanf(fit4, h = 10) : could not find function "meanf"

autoplot(window(galletas, start=1994)) + forecast::autolayer(fit5, series="Mean", PI=FALSE) + forecast::autolayer(fit6, series="Naïve", PI=FALSE) + forecast::autolayer(fit7, series="Seasonal naïve", PI=FALSE) + xlab("Year") + ylab("Produccion") + guides(colour=guide_legend(title="Forecast"))

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

14. Analizar un VAR, necesita incluir los puntos siguientes:

a) Buscar otra variable (incluso mas variables) y redactar la teoria que se encuen-tra detras de la relaci ??on entre variables que propone.

Utilizaremos la serie de ventas de automotores por que es lo que es la serie que tiene afectaciones con la produccion de de automotores y esta es debido a su estacionalidad.

b) Evaluar la estacionalidad de la nueva variable.

autoplot(St2)

Error: Objects of type ts not supported by autoplot.

ggseasonplot(St1)
ggseasonplot(St2)

mes. <- season(St1)
reg.produccion <- lm(St1 ~ time(St1) + mes.)
summary(St1)

mes. <- season(St2)
reg.ventas <- lm(St2 ~ time(St2) + mes.)
summary(reg.inflacion)

Aplicamos las transformaciones

St1dd <- diff(diff(St1,12))
St2dd <- diff(St2,12)

ggtsdisplay(ts.ddgalletas)
ggtsdisplay(ts.dinflacion)

summary(ur.df(St1))
summary(ur.df(St2))

Guardar ambas variables en un unico objeto.

base2 <- cbind.zoo(St = St1dd, inflacion = St2dd)
View(base2)
autoplot(base2) 

Las variables no tienen la misma longitud

base3 <- base2[-1,]
View(base3)
autoplot(base3)

Ocupamos base 3

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

var1 <- VAR(base3, p=1, type = "both")
summary(var1)
causality(var1, cause='Produccion')$Granger
causality(var1, cause='Ventas')$Granger

plot(irf(var1, impulse='Produccion', response = 'Ventas'))
plot(irf(var1, impulse='Ventas', response = 'Produccion'))

var.serial <- serial.test(var1, lags.pt = 12)
var.serial
plot(var.serial)

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

Declaramos ambas variables como series de tiempo.

ts.w <- ts(base\(w, start = c(2005,1), frequency = 12) ts.U <- ts(base\)U, start = c(2005,1), frequency = 12)

Aplicamos las transformaciones necesarios (ej. diferencias y log)

ts.ddlw <- diff(diff(log(ts.w),12)) # diferencia de la diferencia estacional del log de salarios ts.dlU <- diff(ts.U) # diferencia de la tasa de desempleo

Se deben guardar ambas variables en un único objeto.

base2 <- cbind.zoo(w = ts.ddlw, U = ts.dlU) # ocupamos función ‘zoo’ del paquete del mismo nombre. View(base2) # la serie está cortada por las diferencias plot(base2) # la serie está cortada por las diferencias

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

Las variables no tienen la misma longitud, por lo que hay que restringir la muestra

base3 <- base2[-c(1:12),] # note el signo (-) View(base3) plot(base3)

Ocupamos ‘base3’ para comenzar nuestro análisis VAR.

VARselect(base3, lag.max = 24) var14 <- VAR(base3, p=14) causality(var14, cause=‘w’)$Granger plot(irf(var14, impulse=‘w’, response = ‘U’))