Analisis de la demanda de pasajeros en EEUU

Punto A

GRAFICO

En la serie de tiempo de la demanda mensual de pasajeros en Estados Unidos entre 1949 y 1960, se puede observar de manera a priori que la gráfica muestra una tendencia creciente, la cual, la serie de tiempo presenta un efecto calendario de manera repetitiva. Según los datos, desde 1950 se evidencia que la demanda fue de 100 mil pasajeros llegando a 1960 con 600 mil pasajeros, esta tendencia se refleja por el crecimiento económico que tuvo Estados Unidos después de la Segunda Guerra Mundial donde las familias tenían mayor poder adquisitivo, lo que facilitó facilitó pudiera adquirir vuelos aéreos, así también esto se vio impulsado por los avances tecnológicos enfocados en la aeronáutica lo cual dio paso a ser el transporte comercial mas seguro producto de nuevas conexiones y rutas de transporte hacia diferente países.

De esta manera, la estacionalidad de la serie se eviencia en los meses de verano (junio, julio y agosto) donde coinciden con las vacaciones incrementando el turismo. Sin embargo, en los meses de invierno se evidencia una disminución en la demanda debido a los altos costos y condiciones climáticas.

Una vez descompuesta la serie en su forma aditiva y multiplicativa, se puede confirmar la estacionalidad de la serie de manera ascendente, con oscilaciones continuas, así también se puede evidenciar que los efectos estacionales se amplían con el crecimiento de la serie, donde a mayor numero de pasajeros, los picos de la serie son mayores.


#                                 graficar la serie 

ts_plot(AirPassengers, slider = TRUE,
        title = "Demanda promedio mensual de pasajeros en usa de 1949-1960",
        Ytitle = "pasajeros",
        Xtitle = "years" ) 

#                                    descomponer 

ts_decompose(AirPassengers, type = "both")

Punto B

Desestacionalizar

Al desestacionalizar la serie de la demanda de pasajeros en USA desde 1949 hasta 1960, se redujo significativamente el efecto calendario que se presenta cuando estacionalidad, provocando una línea más estable. Esto da a entender que la demanda no depende de los efectos calendarios sino de factores como el uso del transporte aéreo.

#                                    desestacionalizar 

demanda_descom <- decompose(AirPassengers, type = "additive")

demanda_des <- AirPassengers - demanda_descom$seasonal

demanda <- data.frame("demanda_ob" = as.numeric(AirPassengers)) %>% 
 mutate(demanda_des = as.numeric(demanda_des), 
          fecha = demanda_air$fecha)

ts_plot(demanda, slider = TRUE,
        title = "Demanda promedio mensual de pasajeros en usa \n normal y desestacionalizada de 1949-1960",
        Ytitle = "pasajeros",
        Xtitle = "years")

Punto c

Estacionariedad (a priori y pruebas)

A priori se puede inferir que la serie de tiempo no es estacionaria, ya este presenta una tendencia creciente y en ella se presente una creciente demanda con picos altos incrementando a lo largo de los años, presentando fluctuaciones constantes

Sin embargo, se puede observar que la serie de tiempo sí es estacionaria ya que el rezago es significativo siendo menor al 1%

En el test de correlogramas (ARC), se evidencia que hay presencia de un AR, debido a que la serie presenta un un comportamiento parsimonioso, que decrece lentamente y presencia de un AR (2), observado en la gráfica parcial.

De esta manera, una vez realizada la prueba de Dickey- Fuller Aumentada, el p-value es superior a 0,05, dando un valor de 0,6172, lo que significa que se puede rechachar la hipotesis nula, en esto se comprueba que la serie no presenta estacionariedad debido a que no hay suficiente evidencia estadística para inferir que se rechaza la hipotesis nula.

#                          Probar si la serie es estacionaria o no
#                                  test de Dickey Fuller

df <- ur.df(AirPassengers, type = "trend", lags = 1)
summary(df)

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 -64.98 -20.02 0.50 18.51 85.51

Coefficients: Estimate Std. Error t value Pr(>|t|)
(Intercept) 36.56047 6.53666 5.593 1.15e-07 z.lag.1 -0.41315 0.05399 -7.652 3.08e-12 tt 1.11017 0.15534 7.147 4.69e-11 z.diff.lag 0.52003 0.07380 7.046 7.99e-11 — Signif. codes: 0 ‘’ 0.001 ’’ 0.01 ’’ 0.05 ‘.’ 0.1 ’ ’ 1

Residual standard error: 27.33 on 138 degrees of freedom Multiple R-squared: 0.363, Adjusted R-squared: 0.3491 F-statistic: 26.21 on 3 and 138 DF, p-value: 1.767e-13

Value of test-statistic is: -7.6523 19.6836 29.279

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

dwtest(df@testreg)
Durbin-Watson test

data: DW = 2.0808, p-value = 0.6172 alternative hypothesis: true autocorrelation is greater than 0

#                                      test de correlogramas

par(mfcol = c(1,2 ))
acf(AirPassengers,)
pacf(AirPassengers)

Pasar la serie a estacionaria

Una vez, identificado lo anterior, se aplica un operador diferencia, con el fin de pasar la serie no estacionaria a estacionaria, realizando un test de correlograma en dicha serie, en ella, se analizó que existe suficiente evidencia estadistisca para aceptar la hipótesis nula.

Los resultados arrojan un ARIMA (2,1,1) (0,1,0)

#                         pasar una serie no estacionaria a estacionaria

AirPassengersdiff <- diff(AirPassengers)


#                          test de correlograma en serie estacionaria

ts_plot(AirPassengersdiff, slider = T,
        title = "Correlograma de la Serie Corregida",
        Ytitle = "pasajeros",
        Xtitle = "Años")
modelo_Ar <- auto.arima(AirPassengers)
summary(modelo_Ar)

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

Coefficients: ar1 ar2 ma1 0.5960 0.2143 -0.9819 s.e. 0.0888 0.0880 0.0292

sigma^2 = 132.3: log likelihood = -504.92 AIC=1017.85 AICc=1018.17 BIC=1029.35

Training set error measures: ME RMSE MAE MPE MAPE MASE ACF1 Training set 1.3423 10.84619 7.86754 0.420698 2.800458 0.245628 -0.00124847

checkresiduals(modelo_Ar)

Ljung-Box test

data: Residuals from ARIMA(2,1,1)(0,1,0)[12] Q* = 37.784, df = 21, p-value = 0.01366

Model df: 3. Total lags used: 24

PUNTO D

Identificador de ARIMA

Los correlogramas de la serie estacionaria sugieren un ARIMA (2,1,1), donde el histograma y Jaque Bera muestra que los residuos presentan normalidad.

#                                           ARIMA manual
#                            estimar el modelo ARIMA(2, 1, 1) 

arima_ar2 <- arima(AirPassengers, c(2, 1, 1))

stargazer(arima_ar2, type = "html")
Dependent variable:
AirPassengers
ar1 1.091***
(0.078)
ar2 -0.489***
(0.074)
ma1 -0.844***
(0.043)
Observations 143
Log Likelihood -685.169
sigma2 844.608
Akaike Inf. Crit. 1,378.338
Note: p<0.1; p<0.05; p<0.01 
demanda <- demanda %>% mutate(resid = arima_ar2$residuals, demanda_est = as.numeric(demanda_ob-resid)) %>% select(demanda_ob, demanda_est, fecha) 

ts_plot(demanda, slider = TRUE,
        title = "Demanda promedio mensual de pasajeros en usa \n normal y estimada de 1949-1960",
        Ytitle = "pasajeros",
        Xtitle = "years")
#                                        graficar los errores

ts_plot(arima_ar2$residuals, slider = TRUE,
        title = "Residuos",
        Ytitle = "",
        Xtitle = "years") 
par(mfcol = c(1,2 ))
hist(arima_ar2$residuals)
qqnorm(arima_ar2$residuals)
qqline(arima_ar2$residuals, col = "green")

library(tseries)
jarque.bera.test(arima_ar2$residuals)
Jarque Bera Test

data: arima_ar2$residuals X-squared = 2.2565, df = 2, p-value = 0.3236

Análisis de coeficientes

Una vez realizado la operación diferencia para convertir la serie no estacionaria a una serie estacionaria, se realizó la estimación del modelo a través de la versión automática utilizando la función auto.arima(), la cual arrojo una gama de modelos, seleccionando el ARIMA(2,1,1)(0,1,0)[12] como la mejor modelo, ya que presentan uno de los valores de la AIC más bajos en comparación a los demás. Tambien, se logra evidenciar que posee un AR (2), significando que los valores pasados influyen en el presente y que el modelo utiliza 2 rezagos autorregresivos, también nos dice que se aplicó una diferenciación (1) tal como nos lo indica el test de Dickey Fuller para pasar la serie a estacionaria; incluye (1) termino de media móvil, es decir, que los choques pasados influyen en los valores presentes. Estos resultados también se pueden observar en la tabla de abajo, donde se explica que el AR1 Y AR2 son significativos, afirmando que los valores pasado si influyeron en la demanda de los pasajeros. Así se evidencia un MA1 negativo, lo que indica que hubo un choque, donde hubo menos pasajeros de los esperado. De esta manera, se puede afirmar que esto es un ARIMA, ya que hay un componente AR de orden 2, un componente de diferenciación (I) de orden 1 y una media móvil (MA) de componente 1.

#                                                 auto.arima 

arima_auto <- auto.arima(AirPassengers, trace = T)

ARIMA(2,1,2)(1,1,1)[12] : Inf ARIMA(0,1,0)(0,1,0)[12] : 1031.539 ARIMA(1,1,0)(1,1,0)[12] : 1020.582 ARIMA(0,1,1)(0,1,1)[12] : 1021.192 ARIMA(1,1,0)(0,1,0)[12] : 1020.488 ARIMA(1,1,0)(0,1,1)[12] : 1021.103 ARIMA(1,1,0)(1,1,1)[12] : Inf ARIMA(2,1,0)(0,1,0)[12] : 1022.583 ARIMA(1,1,1)(0,1,0)[12] : 1022.583 ARIMA(0,1,1)(0,1,0)[12] : 1020.733 ARIMA(2,1,1)(0,1,0)[12] : 1018.165 ARIMA(2,1,1)(1,1,0)[12] : 1018.395 ARIMA(2,1,1)(0,1,1)[12] : 1018.84 ARIMA(2,1,1)(1,1,1)[12] : Inf ARIMA(3,1,1)(0,1,0)[12] : 1019.565 ARIMA(2,1,2)(0,1,0)[12] : 1019.771 ARIMA(1,1,2)(0,1,0)[12] : 1024.478 ARIMA(3,1,0)(0,1,0)[12] : 1023.984 ARIMA(3,1,2)(0,1,0)[12] : Inf

Best model: ARIMA(2,1,1)(0,1,0)[12]

htmlreg(arima_auto)
Statistical models
  Model 1
ar1 0.60***
  (0.09)
ar2 0.21*
  (0.09)
ma1 -0.98***
  (0.03)
AIC 1017.85
AICc 1018.17
BIC 1029.35
Log Likelihood -504.92
Num. obs. 131
***p < 0.001; **p < 0.01; *p < 0.05

PUNTO E

PRONOSTICO

Se pronostica que en los próximos 5 meses se presenta un aumento en la demanda de pasajeros de EEUU, debido al alto consumo en las próximas temporadas estacionales.

demanda <- demanda %>% mutate(resid = arima_auto$residuals, demanda_est = as.numeric(demanda_ob-resid)) %>% select(demanda_ob, demanda_est, fecha) 

ts_plot(demanda, slider = TRUE,
        title = "Demanda promedio mensual de pasajeros en usa \n normal y estimada de 1949-1960",
        Ytitle = "pasajeros",
        Xtitle = "años") 
par(mfcol = c(1,2 ))
hist(arima_auto$residuals)
qqnorm(arima_auto$residuals)
qqline(arima_auto$residuals, col = "red")

jarque.bera.test(arima_auto$residuals)
## 
##  Jarque Bera Test
## 
## data:  arima_auto$residuals
## X-squared = 15.131, df = 2, p-value = 0.0005181
furval <- forecast(arima_auto, h = 6, level = c(0.95))

par(mfcol = c(1, 1 ))   
plot(furval)