Trabajo Final Parcial 2
Fernanda Itzel Suarez Reynoso
25 de octubre de 2018
ANALISIS DEPOSITOS DE AHORRO
Serie: DAIS (Depositos de Ahorro). 1994(m1)-2018(m7), incluye serie original. Unidad de medida: Porcentaje. Periodicidad: Mensual. Fuente: www.inegi.org.mx.
library(forecast)## Warning: package 'forecast' was built under R version 3.4.4library(TSA)## Warning: package 'TSA' was built under R version 3.4.4##
## Attaching package: 'TSA'## The following objects are masked from 'package:stats':
##
## acf, arima## The following object is masked from 'package:utils':
##
## tarlibrary(urca)## Warning: package 'urca' was built under R version 3.4.4library(ggplot2)## Warning: package 'ggplot2' was built under R version 3.4.4base <- read.csv("/Users/Itzel/Music/dais.csv", sep=';')- Graficar los datos, analizar patrones y observaciones atipicas. Apoye su analisis con una descomposicion clasica.
ts.dep <- ts(base$depS, start = c(1994, 1),frequency = 12)
autoplot(ts.dep)
fit<-decompose(ts.dep)
plot(fit, col='red', ylab = 'eje y', xlab = 'eje x', lwd=.5, type = 'l', pch=5)
- Si es necesario, utilizar transformacion Box-Cox / logaritmos para estabilizar la varianza.
Aplicando logaritmos:
ldep<-log(ts.dep)
autoplot(ldep)
Applicando una diferencia de la diferencia de logaritmo:
dddep<-diff(diff(ldep))
autoplot(dddep)
BoxCox.ar(ts.dep)## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
## Warning in arima0(x, order = c(i, 0L, 0L), include.mean = demean): possible
## convergence problem: optim gave code = 1
El valor de maxima verosimilitud para lambda es cerca de 0.4 con el intervalo de confianza al 95% incluye la transformacion logaritmica en lambda=0.3
- En caso de estacionalidad, aplicar diferencias estacionales.
ggseasonplot(dddep, polar = TRUE)
ggseasonplot(dddep, year.labels=TRUE, year.labels.left=TRUE)
- Usar prueba Dickey-Fuller para evaluar el orden de integracion de la serie. Diferenciar hasta que la serie sea estacionaria.
summary(ur.df(ts.dep))##
## ###############################################
## # 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
## -2.24829 -0.08190 0.00286 0.08561 2.61414
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## z.lag.1 -0.00495 0.00575 -0.861 0.390
## z.diff.lag 0.06136 0.05834 1.052 0.294
##
## Residual standard error: 0.3801 on 291 degrees of freedom
## Multiple R-squared: 0.006083, Adjusted R-squared: -0.000748
## F-statistic: 0.8905 on 2 and 291 DF, p-value: 0.4116
##
##
## Value of test-statistic is: -0.861
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau1 -2.58 -1.95 -1.62summary(ur.df(dddep))##
## ###############################################
## # 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
## -0.77916 -0.04073 -0.00009 0.03979 1.64269
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## z.lag.1 -1.94760 0.09467 -20.571 < 2e-16 ***
## z.diff.lag 0.33519 0.05544 6.046 4.57e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1631 on 289 degrees of freedom
## Multiple R-squared: 0.7596, Adjusted R-squared: 0.758
## F-statistic: 456.7 on 2 and 289 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic is: -20.5714
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau1 -2.58 -1.95 -1.62- Usar herramientas ACF, PACF, EACF y criterios de Akaike/ Bayes para construir propuestas de modelos.
ggAcf(dddep)
ggPacf(dddep)
eacf(dddep)## 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 x x x o o
## 1 x x o o o o o x o o x o o o
## 2 x x o o o o o o o o o o o o
## 3 x x x x o o o o o o o o o o
## 4 x x x o o o o o o o o o o o
## 5 x x x o x o o o o o o o o o
## 6 x x x x x o o o o o o o o o
## 7 x o x x o x x x o o o o o oggtsdisplay(dddep)
Criterio de Bayes:
dais <- armasubsets(y=dddep, nar=12, nma=12, y.name='test', ar.method='ols')
plot(dais)
Criterio de Akaike:
propuesta1 <- arima(dddep, order=c(2,0,0),method='ML') # AR(2)
propuesta1##
## Call:
## arima(x = dddep, order = c(2, 0, 0), method = "ML")
##
## Coefficients:
## ar1 ar2 intercept
## -0.6104 -0.3330 0.0003
## s.e. 0.0550 0.0549 0.0049
##
## sigma^2 estimated as 0.02625: log likelihood = 117.29, aic = -228.59propuesta2 <- arima(dddep, order=c(0,0,1),method='ML') # MA(1)
propuesta2##
## Call:
## arima(x = dddep, order = c(0, 0, 1), method = "ML")
##
## Coefficients:
## ma1 intercept
## -1.0000 1e-04
## s.e. 0.0104 1e-04
##
## sigma^2 estimated as 0.01854: log likelihood = 165.66, aic = -327.31propuesta3 <- arima(dddep, order=c(3,0,4),method='ML') # ARMA(3,4)
propuesta3##
## Call:
## arima(x = dddep, order = c(3, 0, 4), method = "ML")
##
## Coefficients:## Warning in sqrt(diag(x$var.coef)): Se han producido NaNs## ar1 ar2 ar3 ma1 ma2 ma3 ma4 intercept
## 0.4416 0.6009 -0.5318 -1.473 -0.2177 1.2292 -0.5384 1e-04
## s.e. NaN 0.1848 NaN NaN NaN NaN NaN 1e-04
##
## sigma^2 estimated as 0.01809: log likelihood = 168.9, aic = -321.79- Como parte del diagnostico del modelo, analizar los residuos y aplicar la prueba Ljung-Box.
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 Ljunk Box:
tsdiag(propuesta1,gof=8,omit.initial=F)
En esta propuesta 1 podemos observar que los valores estadisticos para p el tienen un valor menor a 0.5 por lo que no existe correlacion serial en los valores.
tsdiag(propuesta2,gof=8,omit.initial=F)
En esta propuesta 2 podemos observar que los valores estadisticos para p el rezago 1 tiene un valor mayor a 0.5 por lo que no existe correlacion serial en los valores.
tsdiag(propuesta3,gof=8,omit.initial=F)
En esta propuesta 3 podemos observar que los valores estadisticos para p tienen un valor mayor a 0.5 por lo que no existe correlacion serial en los valores.
- Usar la funcion auto.arima() y compare sus resultados con el inciso anterior.
propuesta.auto <- auto.arima(dddep)
propuesta.auto## Series: dddep
## ARIMA(1,0,1) with zero mean
##
## Coefficients:
## ar1 ma1
## -0.0051 -0.9898
## s.e. 0.0589 0.0113
##
## sigma^2 estimated as 0.0189: log likelihood=164.71
## AIC=-323.42 AICc=-323.34 BIC=-312.38Residuos auto.arima:
plot(rstandard(propuesta.auto),ylab ='Residuos estandarizados', type='o'); abline(h=0)
qqnorm(residuals(propuesta.auto)); qqline(residuals(propuesta.auto))
ggAcf(residuals(propuesta.auto))
tsdiag(propuesta.auto, gof=12, omit.initial=F)
checkresiduals(propuesta.auto)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,0,1) with zero mean
## Q* = 35.605, df = 22, p-value = 0.03346
##
## Model df: 2. Total lags used: 24- Presente la ecuacion final y describa.
\[ Depositos= 1e^{-04} -1.0000ar_{(1)} \] el mejor modelo es un AR(1) para describir la serie, y de acuerdo a la funcion auto arima debe ser un ARIMA(1,0,1).
- Crear un pronostico a dos anos.
pronostico <- plot(forecast(propuesta.auto,h=24))
pronostico## $mean
## Jan Feb Mar Apr May
## 2018
## 2019 1.426405e-13 -7.271915e-16 3.707274e-18 -1.889995e-20 9.635330e-23
## 2020 4.396571e-41 -2.241403e-43 1.142683e-45 -5.825482e-48 2.969873e-50
## Jun Jul Aug Sep Oct
## 2018 -4.142029e-02 2.111636e-04 -1.076527e-06
## 2019 -4.912160e-25 2.504255e-27 -1.276687e-29 6.508641e-32 -3.318152e-34
## 2020 -1.514062e-52 7.718798e-55
## Nov Dec
## 2018 5.488213e-09 -2.797930e-11
## 2019 1.691618e-36 -8.623988e-39
## 2020
##
## $lower
## 80% 95%
## Aug 2018 -0.2176028 -0.3108682
## Sep 2018 -0.2483120 -0.3798723
## Oct 2018 -0.2485259 -0.3800870
## Nov 2018 -0.2485248 -0.3800859
## Dec 2018 -0.2485248 -0.3800859
## Jan 2019 -0.2485248 -0.3800859
## Feb 2019 -0.2485248 -0.3800859
## Mar 2019 -0.2485248 -0.3800859
## Apr 2019 -0.2485248 -0.3800859
## May 2019 -0.2485248 -0.3800859
## Jun 2019 -0.2485248 -0.3800859
## Jul 2019 -0.2485248 -0.3800859
## Aug 2019 -0.2485248 -0.3800859
## Sep 2019 -0.2485248 -0.3800859
## Oct 2019 -0.2485248 -0.3800859
## Nov 2019 -0.2485248 -0.3800859
## Dec 2019 -0.2485248 -0.3800859
## Jan 2020 -0.2485248 -0.3800859
## Feb 2020 -0.2485248 -0.3800859
## Mar 2020 -0.2485248 -0.3800859
## Apr 2020 -0.2485248 -0.3800859
## May 2020 -0.2485248 -0.3800859
## Jun 2020 -0.2485248 -0.3800859
## Jul 2020 -0.2485248 -0.3800859
##
## $upper
## 80% 95%
## Aug 2018 0.1347622 0.2280276
## Sep 2018 0.2487344 0.3802946
## Oct 2018 0.2485237 0.3800848
## Nov 2018 0.2485248 0.3800859
## Dec 2018 0.2485248 0.3800859
## Jan 2019 0.2485248 0.3800859
## Feb 2019 0.2485248 0.3800859
## Mar 2019 0.2485248 0.3800859
## Apr 2019 0.2485248 0.3800859
## May 2019 0.2485248 0.3800859
## Jun 2019 0.2485248 0.3800859
## Jul 2019 0.2485248 0.3800859
## Aug 2019 0.2485248 0.3800859
## Sep 2019 0.2485248 0.3800859
## Oct 2019 0.2485248 0.3800859
## Nov 2019 0.2485248 0.3800859
## Dec 2019 0.2485248 0.3800859
## Jan 2020 0.2485248 0.3800859
## Feb 2020 0.2485248 0.3800859
## Mar 2020 0.2485248 0.3800859
## Apr 2020 0.2485248 0.3800859
## May 2020 0.2485248 0.3800859
## Jun 2020 0.2485248 0.3800859
## Jul 2020 0.2485248 0.3800859