TRABAJO SEGUNDO PARCIAL

1. Breve descripcion de la serie elegida, asi como su frecuencia, unidad de medida, fuente, etc.

Serie: cantidad de pasajeros en el metrobus en la ciuidad de mexico.

# su periodo es de 10 años (2008-2018)
# Unidad de medida: numeros de pasajeros 
# Periodicidad: Mensual
# Fuente: www.inegi.org.mx

2. Graficar los datos, analizar patrones y observaciones atipicas. Apoye su analisis con una descomposicion clasica.

declaramos la base y la graficamos normal para notar sus componentes.

descomposicion clasica.

       vemos que en la grafica maneja una tendencia positiva aun que no 
        este muy marcada y no maneja estacionalidad.

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

autoplot(ST,main="NUM DE PASAJEROS" )

autoplot(log(ST),main="Log(NUM DE PASAJEROS)" )

autoplot(diff(log(ST)),main='Difference  of  Log(NUM DE PASAJEROS)')

       en estas graficas vemos que si hay una tendencia no tan marcada e identificamos 
       como se estabiliza la varianza la cual ya es más suave y la media de igual forma
       se estabiliza.
       
      

BoxCox.ar (ST,lambda = seq(-0.5,2,0.5))

possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1possible convergence problem: optim gave code = 1

         El  intervalo  a  95 %  para lambda contiene el 
         valor  de lambda = 0 muy  cerca  de su centro  y sugiere  
         fuertemente  una transformación  logarítmica.

4. En caso de estacionalidad, aplicar diferencias estacionales.

   omitimos este paso debido a que la serie no presenta estacionalidad.
   
   

5. Usar prueba Dickey-Fuller para evaluar el orden de integracion de la serie. Difereniar 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 
-7859.0  -602.6    54.7   969.8  4742.0 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
z.lag.1     0.012805   0.008354   1.533    0.128    
z.diff.lag -0.560181   0.076373  -7.335 2.69e-11 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1615 on 122 degrees of freedom
Multiple R-squared:  0.3071,    Adjusted R-squared:  0.2958 
F-statistic: 27.04 on 2 and 122 DF,  p-value: 1.904e-10


Value of test-statistic is: 1.5329 

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

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

ggAcf(ST)

ggPacf(ST)

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 o o o o o  o  o  o 
2 x x o o o o o o o o o  o  o  o 
3 o x o o o o o o o o o  o  o  o 
4 o x o o o x o o o o o  o  o  o 
5 x o o o x x x o o o o  o  o  o 
6 x o x x o o x o o o o  o  o  o 
7 x x x x x o x o o o o  o  o  o 

ggtsdisplay(ST)

criterio de información de Bayes PROPUESTAS.

res <- armasubsets(y=TS.digae, nar=1, nma=12, y.name='test', ar.method='ols')
plot(res)

propuesta1

Call:
arima(x = ST, order = c(1, 0, 2), seasonal = c(1, 0, 2))

Coefficients:
         ar1      ma1     ma2    sar1     sma1    sma2  intercept
      0.9954  -0.6778  0.1429  0.9079  -0.8854  0.1481   16699.52
s.e.  0.0060   0.0883  0.0913  0.0757   0.1510  0.1251   15466.07

sigma^2 estimated as 2149165:  log likelihood = -1102.29,  aic = 2220.59

propuesta2 <- arima(ST, order=c(1,0,1),seasonal=c(1,0,1))
propuesta2

Call:
arima(x = ST, order = c(1, 0, 1), seasonal = c(1, 0, 1))

Coefficients:
         ar1      ma1    sar1     sma1  intercept
      0.9969  -0.5979  0.9378  -0.8034   19057.17
s.e.  0.0044   0.0695  0.0610   0.1112   19336.76

sigma^2 estimated as 2226302:  log likelihood = -1104.38,  aic = 2220.76

propuesta3 <- arima(ST, order=c(0,0,4),seasonal=c(0,0,4))
propuesta3

Call:
arima(x = ST, order = c(0, 0, 4), seasonal = c(0, 0, 4))

Coefficients:
         ma1     ma2     ma3     ma4    sma1    sma2    sma3    sma4  intercept
      0.2785  0.4838  0.4305  0.5059  0.6954  0.6741  0.5518  0.3561   16583.75
s.e.  0.1111  0.1090  0.1267  0.1046  0.1051  0.1537  0.1620  0.1493    1335.42

sigma^2 estimated as 3803289:  log likelihood = -1141.58,  aic = 2303.16

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

Grafica de residuos estandarizados.

plot(rstandard(propuesta1),ylab ='Residuos estandarizados', type='o'); abline(h=0)
plot(rstandard(propuesta2),ylab ='Residuos estandarizados', type='o'); abline(h=0)
plot(rstandard(propuesta3),ylab ='Residuos estandarizados', type='o'); abline(h=0)

Prueba Ljung-Box (independencia de residuos)

checkresiduals(propuesta1)

    Ljung-Box test

data:  Residuals from ARIMA(0,0,4)(0,0,4)[12] with non-zero mean
Q* = 51.657, df = 15, p-value = 6.435e-06

Model df: 9.   Total lags used: 24

checkresiduals(propuesta2)

    Ljung-Box test

data:  Residuals from ARIMA(0,0,4) with non-zero mean
Q* = 290.79, df = 19, p-value < 2.2e-16

Model df: 5.   Total lags used: 24

checkresiduals(propuesta3)

    Ljung-Box test

data:  Residuals from ARIMA(1,0,1) with non-zero mean
Q* = 26.074, df = 21, p-value = 0.2036

Model df: 3.   Total lags used: 24

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

Autoarima<- auto.arima(ST, d=1,stepwise=FALSE, approximation=FALSE)
Autoarima

Series: ST 
ARIMA(0,1,1) with drift 

Coefficients:
          ma1     drift
      -0.6767  167.3577
s.e.   0.0765   45.3992

sigma^2 estimated as 2414785:  log likelihood=-1095.24
AIC=2196.47   AICc=2196.67   BIC=2204.96

checkresiduals(Autoarima)

    Ljung-Box test

data:  Residuals from ARIMA(0,1,1) with drift
Q* = 25.613, df = 22, p-value = 0.2687

Model df: 2.   Total lags used: 24

9. Presente la ecuacion final y describa.

prop <-auto.arima(ST, order=c(0,1,1), seasonal = c(0,0,0))

the condition has length > 1 and only the first element will be usedError in myarima(x, order = c(p, d, q), seasonal = c(P, D, Q), constant = constant,  : 
  formal argument "order" matched by multiple actual arguments

10. Crear un promositco a dos años.

pronostico <- plot(forecast(ST,h=24))
pronostico

$`mean`
          Jan      Feb      Mar      Apr      May      Jun      Jul      Aug      Sep
2018                                                       27017.77 29109.96 26642.89
2019 27474.67 27534.67 28587.09 28035.50 30033.70 29531.60 29083.43 31321.48 28654.25
2020 29497.91 29549.96 30666.73 30062.72 32192.40 31641.57                           
          Oct      Nov      Dec
2018 29325.39 27692.70 25775.12
2019 31525.42 29757.34 27684.93
2020                           

$lower
              80%      95%
Jul 2018 24302.09 22864.49
Aug 2018 26048.27 24427.51
Sep 2018 23719.76 22172.35
Oct 2018 25978.03 24206.04
Nov 2018 24411.69 22674.83
Dec 2018 22611.81 20937.26
Jan 2019 23988.19 22142.55
Feb 2019 23927.65 22018.21
Mar 2019 24726.78 22683.25
Apr 2019 24138.08 22074.92
May 2019 25740.55 23467.89
Jun 2019 25195.67 22900.37
Jul 2019 24701.70 22382.15
Aug 2019 26483.76 23922.83
Sep 2019 24120.91 21721.10
Oct 2019 26420.57 23718.23
Nov 2019 24829.10 22220.25
Dec 2019 22998.70 20517.97
Jan 2020 24397.81 21697.99
Feb 2020 24334.48 21573.57
Mar 2020 25144.51 22221.23
Apr 2020 24542.51 21620.29
May 2020 26167.52 22978.15
Jun 2020 25608.78 22415.21

$upper
              80%      95%
Jul 2018 29733.46 31171.06
Aug 2018 32171.65 33792.41
Sep 2018 29566.03 31113.44
Oct 2018 32672.74 34444.73
Nov 2018 30973.72 32710.58
Dec 2018 28938.44 30612.99
Jan 2019 30961.15 32806.79
Feb 2019 31141.69 33051.13
Mar 2019 32447.41 34490.94
Apr 2019 31932.91 33996.08
May 2019 34326.85 36599.51
Jun 2019 33867.53 36162.83
Jul 2019 33465.15 35784.70
Aug 2019 36159.20 38720.13
Sep 2019 33187.60 35587.41
Oct 2019 36630.26 39332.60
Nov 2019 34685.58 37294.43
Dec 2019 32371.16 34851.89
Jan 2020 34598.01 37297.83
Feb 2020 34765.43 37526.34
Mar 2020 36188.94 39112.23
Apr 2020 35582.93 38505.15
May 2020 38217.28 41406.65
Jun 2020 37674.36 40867.93