base<-read.csv(file.choose())
PDO<-ts(base$Dato,frequency=12,start=c(1986,01))
autoplot(PDO)

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

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

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

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.

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

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.

4. En caso de estacionalidad, aplicar diferencias estacionales.

ggtsdisplay(diff(diff(PDO.log),4),maim=' diferencia atipica de PRODUCCION DE ORO ')

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

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

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

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)

criterio de información de Bayes PROPUESTAS.

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

7. Como parte del diagn??stico 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)
Error in rstandard(propuesta2) : object 'propuesta2' not found

Prueba Ljung-Box (independencia de residuos)

checkresiduals(propuesta3)
Error in is.element("lm", class(object)) : object 'propuesta3' not found

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

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

9. PRESENTE LA ECUACION FINAL Y DESCRIBA.

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

DIEZ. Pronostico.

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
LS0tDQp0aXRsZTogIk1PREVMQURPIEFSSU1BIg0KYXV0aG9yOiBHQUxJTkRPIFNBTlRJQUdPIERJQU5BIExBVVJBDQpvdXRwdXQ6IA0KIGh0bWxfbm90ZWJvb2s6DQogIHRvYzogdHJ1ZQ0KLS0tDQoNCg0KDQpgYGB7cn0NCmJhc2U8LXJlYWQuY3N2KGZpbGUuY2hvb3NlKCkpDQpQRE88LXRzKGJhc2UkRGF0byxmcmVxdWVuY3k9MTIsc3RhcnQ9YygxOTg2LDAxKSkNCmF1dG9wbG90KFBETykNCmBgYA0KDQoNCg0KIyAxLiBCcmV2ZSAgZGVzY3JpcGNpb24gIGRlICBsYSAgc2VyaWUgIGVsZWdpZGEsICBhc2kgIGNvbW8gIHN1ICBmcmVjdWVuY2lhLCAgdW5pZGFkICBkZSBtZWRpZGEsIGZ1ZW50ZSwgZXRjLg0KDQpMYSBzZXJpZSBkZSB0aWVtcG8gZWxlZ2lkYSBtdWVzdHJhIGxhIGNhbnRpZGFkIGRlIG9ybyBwcm9kdWNpZGEgZGVzZGUgZWwgbWVzIGRlIEpVbmlvIGHxbyAxOTg2IGhhc3RhIGVsIGHxbyAyMDE4DQpSdXRhIHRlbeF0aWNhCU1pbmVy7WENClZvbHVtZW4gZGUgcHJvZHVjY2nzbiBtaW5lcmEgcG9yIHByaW5jaXBhbGVzIGVudGlkYWRlcyBmZWRlcmF0aXZhcyB5IG11bmljaXBpb3M+IE9ybz4gVG90YWwgbmFjaW9uYWwNClBlcmlvZGljaWRhZAlNZW5zdWFsDQpVbmlkYWQgZGUgbWVkaWRhCUtpbG9ncmFtb3MNCkZ1ZW50ZQlJTkVHSS4gRXN0YWTtc3RpY2EgTWVuc3VhbCBkZSBsYSBJbmR1c3RyaWEgTWluZXJvbWV0YWz6cmdpY2EuDQpDaWZyYXMgcHJlbGltaW5hcmVzIGEgcGFydGlyIGRlIAkyMDE4LzAzDQpDaWZyYXMgcmV2aXNhZGFzIGEgcGFydGlyIGRlIAkyMDE4LzAxDQpGZWNoYSBpbmljaWFsCTIwMTgvMDYNCkZlY2hhIGZpbmFsCTE5ODYvMDENCtpsdGltYSBhY3R1YWxpemFjafNuCTIwMTgvMDgvMzENCg0KDQoNCg0KDQojIDIuICBHcmFmaWNhciAgbG9zICBkYXRvcywgIGFuYWxpemFyICBwYXRyb25lcyAgeSAgb2JzZXJ2YWNpb25lcyAgYXRpcGljYXMuIEFwb3llICBzdSAgYW5hbGlzaXMgIGNvbiAgdW5hICBkZXNjb21wb3NpY2lvbiAgY2xhc2ljYS4NCg0KDQpgYGB7cn0NCmZpdDwtIGRlY29tcG9zZShQRE8sIHR5cGUgPSAiYWRkaXRpdmUiKQ0KYXV0b3Bsb3QoZml0KQ0KYGBgDQoNCnNlIG11ZXN0cmEgcXVlIGR1cmFudGUgbG9zIHByaW1lcm9zIGRpZXogYfFvcyBkZSB0aWVuZSB1bmEgdGVuZGVuY2lhIGJhamEsIHBvc3Rlcmlvcm1ldGUgZW4gbG9zIHByb3hpbW9zIGNpbmNvIHNlIGluY3JlbWVudGEgbGEgcHJvZHVjY2lvbiwgdGFtYmllbiBzZSBtdWVzdHJhIHVuYSB0ZW5kZW5jaWEgbGF0ZXJhbC4NCg0KDQoNCiMgMy4gIFNpICBlcyAgbmVjZXNhcmlvLCAgdXRpbGl6YXIgIHRyYW5zZm9ybWFjaW9uICBCb3gtQ294ICAvICBsb2dhcml0bW9zICBwYXJhICBlc3RhYmlsaXphciAgbGEgIHZhcmlhbnphLg0KDQoNCg0KDQoNCmBgYHtyfQ0KYXV0b3Bsb3QoIFBETyxtYWluPSJQUk9EVUNDSU9OIERFIE9STyIpDQphdXRvcGxvdChkaWZmKGxvZyhQRE8pKSxtYWluPSdEaWZmZXJlbmNlICBvZiAgTG9nKFBST0RVQ0NJT04gREUgT1JPKScpDQoNCmBgYA0KDQoNCmVuIGVzdGFzIGdyYWZpY2FzIHZlbW9zIHF1ZSBzaSBoYXkgdW5hIHRlbmRlbmNpYSBubyB0YW4gbWFyY2FkYSBlIGlkZW50aWZpY2Ftb3MgY29tbyBzZSBlc3RhYmlsaXphIGxhIHZhcmlhbnphIGxhIGN1YWwgeWEgZXMgbeFzIHN1YXZlIHkgbGEgbWVkaWEgZGUgaWd1YWwgZm9ybWEgc2UgZXN0YWJpbGl6YS4NCkxvIHBvZGVtb3Mgb2JzZXJ2YXIgcG9ycXVlIGxhIHZhcmlhbmEgZXN0YSBtYXMgY2VyY2FuYSBhbCBjZXJvLg0KDQoNCmBgYHtyfQ0KQm94Q294LmFyKFBETykNCkJveENveC5hciAoU1QsbGFtYmRhID0gc2VxKC0wLjUsMiwwLjUpKQ0KYGBgDQoNCmBgYHtyfQ0KYXV0b3Bsb3QoZGlmZihsb2coUERPKSleMix0eXBlPSJsIikNCmBgYA0KDQpgYGB7cn0NCmF1dG9wbG90KCBQRE8sbWFpbj0iUFJPRFVDQ0lPTiBERSBPUk8iKQ0KYXV0b3Bsb3QoIGxvZyhQRE8pLG1haW49IkxvZyhQUk9EVUNDSU9OIERFIE9STykiKQ0KYXV0b3Bsb3QoZGlmZihsb2coUERPKSksbWFpbj0nRGlmZmVyZW5jZSAgb2YgIExvZyhQUk9EVUNDSU9OIERFIE9STyknKQ0KYGBgDQoNCg0KDQpOTyBjb3JyaW8gbGEgZnVuY2lvbiBCb3hDT3gsIHBvciBsbyB0YW50byBzZSBhcGxpY2FuIGxvcyBsb2dhcml0bW9zLg0KDQojIDQuICBFbiAgY2FzbyAgZGUgIGVzdGFjaW9uYWxpZGFkLCAgYXBsaWNhciAgZGlmZXJlbmNpYXMgIGVzdGFjaW9uYWxlcy4NCg0KYGBge3J9DQpnZ3RzZGlzcGxheShkaWZmKFBETy5sb2csMSksbWFpbj0nZGlmZXJlbmNpYSB0aXBpY2EgZGUgUFJPRFVDQ0lPTiBERSBPUk8nKQ0KYGBgDQoNCg0KDQoNCmBgYHtyfQ0KZ2d0c2Rpc3BsYXkoZGlmZihkaWZmKFBETy5sb2cpLDQpLG1haW09JyBkaWZlcmVuY2lhIGF0aXBpY2EgZGUgUFJPRFVDQ0lPTiBERSBPUk8gJykNCmBgYA0KDQojIDUuIFVzYXIgcHJ1ZWJhIERpY2tleS1GdWxsZXIgcGFyYSBldmFsdWFyIGVsIG9yZGVuIGRlIGludGVncmFjaW9uIGRlIGxhIHNlcmllLiBEaWZlcmVuaWFyIGhhc3RhIHF1ZSBsYSBzZXJpZSBzZWEgZXN0YWNpb25hcmlhLg0KDQoNCg0KDQpgYGB7cn0NCnN1bW1hcnkodXIuZGYoUERPKSkNCmBgYA0KDQoNCg0KIyA2LiBVc2FyIGhlcnJhbWllbnRhcyBBQ0YsUEFDRixFQUNGIHkvbyBjcml0ZXJpb3MgZGUgQWthaWtlL0JheWVzIHBhcmEgY29uc3RydWlyIHByb3B1ZXN0YXMgZGUgbW9kZWxvcy4NCg0KDQoNCmBgYHtyfQ0KZ2dBY2YoUERPKQ0KZ2dQYWNmKFBETykNCmVhY2YoUERPKQ0KDQpnZ3RzZGlzcGxheShQRE8pDQpgYGANCg0KDQojIyBjcml0ZXJpbyBkZSBpbmZvcm1hY2nzbiBkZSBCYXllcyBQUk9QVUVTVEFTLg0KDQoNCmBgYHtyfQ0KUERPPC0gYXJtYXN1YnNldHMoeT1UUy5kaWdhZSwgbmFyPTEsIG5tYT0xMiwgeS5uYW1lPSd0ZXN0JywgYXIubWV0aG9kPSdvbHMnKQ0KcGxvdChQRE8pDQoNCmBgYA0KDQoNCg0KYGBge3J9DQpwcm9wdWVzdGExIDwtIGFyaW1hKFBETywgb3JkZXI9YygwLDAsMSksc2Vhc29uYWw9YygyLDAsMikpDQpwcm9wdWVzdGExDQpgYGANCg0KDQoNCmBgYHtyfQ0KcHJvcHVlc3RhMSA8LSBhcmltYShQRE8sIG9yZGVyPWMoMSwwLDEpLHNlYXNvbmFsPWMoMSwwLDEpKQ0KcHJvcHVlc3RhMQ0KYGBgDQoNCg0KDQpgYGB7cn0NCnByb3B1ZXN0YTEgPC0gYXJpbWEoUERPLCBvcmRlcj1jKDAsMCwzKSxzZWFzb25hbD1jKDAsMCwyKSkNCnByb3B1ZXN0YTENCmBgYA0KDQoNCg0KIyA3LiBDb21vIHBhcnRlIGRlbCBkaWFnbj8/c3RpY28gZGVsIG1vZGVsbywgYW5hbGl6YXIgbG9zIHJlc2lkdW9zIHkgYXBsaWNhciBsYSBwcnVlYmEgTGp1bmctQm94Lg0KDQoNCg0KIyMgR3JhZmljYSBkZSByZXNpZHVvcyBlc3RhbmRhcml6YWRvcy4NCg0KYGBge3J9DQpwbG90KHJzdGFuZGFyZChwcm9wdWVzdGExKSx5bGFiID0nUmVzaWR1b3MgZXN0YW5kYXJpemFkb3MnLCB0eXBlPSdvJyk7IGFibGluZShoPTApDQpwbG90KHJzdGFuZGFyZChwcm9wdWVzdGEyKSx5bGFiID0nUmVzaWR1b3MgZXN0YW5kYXJpemFkb3MnLCB0eXBlPSdvJyk7IGFibGluZShoPTApDQpwbG90KHJzdGFuZGFyZChwcm9wdWVzdGEzKSx5bGFiID0nUmVzaWR1b3MgZXN0YW5kYXJpemFkb3MnLCB0eXBlPSdvJyk7IGFibGluZShoPTApDQpgYGANCg0KDQojIyBQcnVlYmEgTGp1bmctQm94IChpbmRlcGVuZGVuY2lhIGRlIHJlc2lkdW9zKQ0KDQoNCmBgYHtyfQ0KY2hlY2tyZXNpZHVhbHMocHJvcHVlc3RhMSkNCmNoZWNrcmVzaWR1YWxzKHByb3B1ZXN0YTIpDQpjaGVja3Jlc2lkdWFscyhwcm9wdWVzdGEzKQ0KYGBgDQoNCg0KDQoNCiM4LiBVc2FyIGxhIGZ1bmNpb24gYXV0by5hcmltYSgpIHkgY29tcGFyZSBzdXMgcmVzdWx0YWRvcyBjb24gZWwgaW5jaXNvIGFudGVyaW9yLg0KDQpgYGB7cn0NCkF1dG9hcmltYTwtIGF1dG8uYXJpbWEoUERPLCBkPTEsc3RlcHdpc2U9RkFMU0UsIGFwcHJveGltYXRpb249RkFMU0UpDQpBdXRvYXJpbWENCmNoZWNrcmVzaWR1YWxzKEF1dG9hcmltYSkNCmBgYA0KDQoNCg0KIyMjIDkuIFBSRVNFTlRFIExBIEVDVUFDSU9OIEZJTkFMIFkgREVTQ1JJQkEuDQoNCmBgYHtyfQ0KUFJPUENIT09TRTwtIEFyaW1hKEVHLCBvcmRlcj0gYygwLDAsMyksIHNlYXNvbmFsPSBjKDAsMCwyKSkgDQpQUk9QQ0hPT1NFDQpgYGANCg0KDQoNCiMjIyBESUVaLiBQcm9ub3N0aWNvLg0KDQoNCmBgYHtyfQ0KcHJvbm9zdGljbyA8LSBwbG90KGZvcmVjYXN0KEF1dG9hcmltYSxoPTI0KSkNCnByb25vc3RpY28NCmBgYA0KDQo=