base<-read.csv(file.choose())
PDO<-ts(base$Dato,frequency=12,start=c(1986,01))
autoplot(PDO)
La serie de tiempo elegida muestra la cantidad de oro producida desde el mes de JUnio año 1986 hasta el año 2018 Ruta temática Minería Volumen de producción minera por principales entidades federativas y municipios> Oro> Total nacional Periodicidad Mensual Unidad de medida Kilogramos Fuente INEGI. Estadística Mensual de la Industria Minerometalúrgica. Cifras preliminares a partir de 2018/03 Cifras revisadas a partir de 2018/01 Fecha inicial 2018/06 Fecha final 1986/01 Última actualización 2018/08/31
se muestra que durante los primeros diez años de tiene una tendencia baja, posteriormete en los proximos cinco se incrementa la produccion, tambien se muestra una tendencia lateral.
autoplot( PDO,main="PRODUCCION DE ORO")
autoplot(diff(log(PDO)),main='Difference of Log(PRODUCCION DE ORO)')
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. Lo podemos observar porque la variana esta mas cercana al cero.
BoxCox.ar(PDO)
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 = 1Error in solve.default(res$hessian * length(x)) :
Lapack routine dgesv: system is exactly singular: U[1,1] = 0
autoplot(diff(log(PDO))^2,type="l")
autoplot( PDO,main="PRODUCCION DE ORO")
autoplot( log(PDO),main="Log(PRODUCCION DE ORO)")
autoplot(diff(log(PDO)),main='Difference of Log(PRODUCCION DE ORO)')
NO corrio la funcion BoxCOx, por lo tanto se aplican los logaritmos.
ggtsdisplay(diff(diff(PDO.log),4),maim=' diferencia atipica de PRODUCCION DE ORO ')
summary(ur.df(PDO))
###############################################
# 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
-2046.90 -94.35 1.05 120.91 1688.90
Coefficients:
Estimate Std. Error t value Pr(>|t|)
z.lag.1 0.004471 0.003573 1.251 0.212
z.diff.lag -0.340254 0.048158 -7.065 7.52e-12 ***
---
Signif. codes: 0 *** 0.001 ** 0.01 * 0.05 . 0.1 1
Residual standard error: 370.8 on 386 degrees of freedom
Multiple R-squared: 0.1151, Adjusted R-squared: 0.1105
F-statistic: 25.1 on 2 and 386 DF, p-value: 5.651e-11
Value of test-statistic is: 1.2514
Critical values for test statistics:
1pct 5pct 10pct
tau1 -2.58 -1.95 -1.62
ggAcf(PDO)
ggPacf(PDO)
eacf(PDO)
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 x x o x x x o o o o x o o
2 x x o o o x x o o o o x o o
3 o x x o o x x o o o o x x o
4 x o x x o x x o o o o x o o
5 x x x o o o x o o o o x o o
6 x x x o x x o o x o o x o o
7 o x x x x x o o x o o o o o
ggtsdisplay(PDO)
PDO<- armasubsets(y=TS.digae, nar=1, nma=12, y.name='test', ar.method='ols')
plot(PDO)
propuesta1 <- arima(PDO, order=c(0,0,1),seasonal=c(2,0,2))
propuesta1
Call:
arima(x = PDO, order = c(0, 0, 1), seasonal = c(2, 0, 2))
Coefficients:
ma1 sar1 sar2 sma1 sma2 intercept
0.5171 1.8565 -0.8859 -0.9985 0.3874 3888.8256
s.e. 0.0363 0.0374 0.0379 0.0677 0.0644 508.3111
sigma^2 estimated as 268887: log likelihood = -3015.06, aic = 6042.12
propuesta1 <- arima(PDO, order=c(1,0,1),seasonal=c(1,0,1))
propuesta1
Call:
arima(x = PDO, order = c(1, 0, 1), seasonal = c(1, 0, 1))
Coefficients:
ar1 ma1 sar1 sma1 intercept
0.9966 -0.4507 0.8157 -0.6385 4185.403
s.e. 0.0033 0.0458 0.0962 0.1264 3410.661
sigma^2 estimated as 119371: log likelihood = -2836.41, aic = 5682.81
propuesta1 <- arima(PDO, order=c(0,0,3),seasonal=c(0,0,2))
propuesta1
Call:
arima(x = PDO, order = c(0, 0, 3), seasonal = c(0, 0, 2))
Coefficients:
ma1 ma2 ma3 sma1 sma2 intercept
0.8809 0.8494 0.8075 0.9930 0.4607 3958.6725
s.e. 0.0297 0.0332 0.0339 0.0482 0.0438 287.3841
sigma^2 estimated as 450961: log likelihood = -3099.33, aic = 6210.65
plot(rstandard(propuesta1),ylab ='Residuos estandarizados', type='o'); abline(h=0)
plot(rstandard(propuesta2),ylab ='Residuos estandarizados', type='o'); abline(h=0)
Error in rstandard(propuesta2) : object 'propuesta2' not found
checkresiduals(propuesta3)
Error in is.element("lm", class(object)) : object 'propuesta3' not found
Autoarima<- auto.arima(PDO, d=1,stepwise=FALSE, approximation=FALSE)
Autoarima
Series: PDO
ARIMA(2,1,0)(1,0,1)[12]
Coefficients:
ar1 ar2 sar1 sma1
-0.4395 -0.2382 0.8084 -0.6380
s.e. 0.0493 0.0494 0.1185 0.1548
sigma^2 estimated as 119523: log likelihood=-2824.83
AIC=5659.65 AICc=5659.81 BIC=5679.47
checkresiduals(Autoarima)
Ljung-Box test
data: Residuals from ARIMA(2,1,0)(1,0,1)[12]
Q* = 56.117, df = 20, p-value = 2.791e-05
Model df: 4. Total lags used: 24
PROPCHOOSE<- Arima(EG, order= c(0,0,3), seasonal= c(0,0,2))
Error in Arima(EG, order = c(0, 0, 3), seasonal = c(0, 0, 2)) :
object 'EG' not found
pronostico <- plot(forecast(Autoarima,h=24))
pronostico
$`mean`
Jan Feb Mar Apr May Jun Jul Aug
2018 9842.404 9997.123
2019 9840.923 9731.437 9978.062 10021.466 10088.023 10055.955 9801.587 9917.587
2020 9805.240 9716.422 9916.083 9951.115 10004.873 9978.983
Sep Oct Nov Dec
2018 10130.315 10101.057 9994.944 10016.718
2019 10046.300 10015.560 9927.883 9948.007
2020
$lower
80% 95%
Jul 2018 9399.345 9164.803
Aug 2018 9489.222 9220.355
Sep 2018 9573.433 9278.637
Oct 2018 9476.152 9145.347
Nov 2018 9316.548 8957.427
Dec 2018 9290.395 8905.903
Jan 2019 9067.384 8657.897
Feb 2019 8913.997 8481.270
Mar 2019 9119.200 8664.546
Apr 2019 9122.861 8647.169
May 2019 9151.406 8655.590
Jun 2019 9082.839 8567.703
Jul 2019 8770.919 8225.316
Aug 2019 8842.340 8273.139
Sep 2019 8929.181 8337.814
Oct 2019 8855.585 8241.531
Nov 2019 8727.439 8091.963
Dec 2019 8708.609 8052.511
Jan 2020 8527.801 7851.566
Feb 2020 8402.116 7706.364
Mar 2020 8565.947 7851.228
Apr 2020 8566.046 7832.835
May 2020 8585.737 7834.491
Jun 2020 8526.582 7757.727
$upper
80% 95%
Jul 2018 10285.46 10520.01
Aug 2018 10505.02 10773.89
Sep 2018 10687.20 10981.99
Oct 2018 10725.96 11056.77
Nov 2018 10673.34 11032.46
Dec 2018 10743.04 11127.53
Jan 2019 10614.46 11023.95
Feb 2019 10548.88 10981.60
Mar 2019 10836.92 11291.58
Apr 2019 10920.07 11395.76
May 2019 11024.64 11520.46
Jun 2019 11029.07 11544.21
Jul 2019 10832.25 11377.86
Aug 2019 10992.83 11562.03
Sep 2019 11163.42 11754.79
Oct 2019 11175.54 11789.59
Nov 2019 11128.33 11763.80
Dec 2019 11187.40 11843.50
Jan 2020 11082.68 11758.91
Feb 2020 11030.73 11726.48
Mar 2020 11266.22 11980.94
Apr 2020 11336.18 12069.39
May 2020 11424.01 12175.26
Jun 2020 11431.38 12200.24