1. importar los datos
library(ggplot2)
library(forecast)
library(readxl)
ivae_ts <- read_excel("G:/Presentaciones Metodos/ivae_ts.xlsx",
col_types = c("skip", "skip", "numeric"))
data=ivae_ts$IVAE %>% ts(start = c(2005,1),frequency = 12)->ivae
print(ivae)
Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
2005 75.92 75.76 81.87 80.58 88.91 88.37 83.28 84.43 86.20 84.28 90.61 94.25
2006 81.72 80.03 87.53 80.37 90.05 90.58 83.50 86.67 91.30 92.21 96.98 94.23
2007 83.31 77.77 86.95 78.74 93.62 92.29 87.98 91.63 88.35 92.64 97.99 101.28
2008 85.76 85.50 87.67 89.96 93.86 92.26 86.03 91.05 92.21 93.62 95.41 94.03
2009 86.73 80.85 87.19 83.92 91.42 93.46 86.39 86.72 87.57 85.27 91.86 99.64
2010 85.56 84.69 90.90 85.94 94.33 92.23 87.19 90.25 88.99 88.73 93.12 100.76
2011 90.26 86.73 94.33 90.80 98.49 97.59 92.16 94.22 92.34 89.07 96.87 103.90
2012 92.66 91.20 98.45 91.22 102.83 102.84 93.61 98.21 93.94 93.49 99.62 105.05
2013 95.67 90.77 96.12 96.34 103.08 101.58 96.42 98.96 97.74 96.22 101.24 108.36
2014 98.69 94.69 101.29 97.12 103.86 104.73 98.47 98.60 98.26 96.44 100.66 107.18
2015 97.63 96.03 103.03 98.62 105.54 105.49 102.00 101.40 100.92 100.51 104.72 109.37
2016 99.12 97.08 102.60 103.24 108.11 110.53 104.01 106.24 104.41 102.22 106.73 115.36
2017 101.72 99.40 108.59 102.14 110.96 113.89 105.19 108.16 106.50 104.19 111.39 117.42
2018 105.54 103.65 108.64 106.86 113.02 115.77 107.55 111.07 107.92 106.83 113.58 120.29
2019 108.19 106.77 112.37 107.91 116.05 117.69 110.96 113.73
autoplot(ivae,xlab = "años",ylab = "Indice",main = "IVAE total, periodo 2005-2019 (agosto)")+theme_bw()

2. proyección a Seis meses
library(forecast)
modelo<-auto.arima(y = ivae)
summary(modelo)
Series: ivae
ARIMA(2,0,2)(1,1,2)[12] with drift
Coefficients:
ar1 ar2 ma1 ma2 sar1 sma1 sma2 drift
0.5956 0.2022 -0.2196 -0.0148 -0.5072 -0.2390 -0.2166 0.1639
s.e. 0.4491 0.4051 0.4462 0.2704 0.2829 0.2967 0.2174 0.0197
sigma^2 estimated as 4.234: log likelihood=-350.86
AIC=719.71 AICc=720.88 BIC=747.61
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set -0.006465035 1.937169 1.46388 -0.05696266 1.545086 0.5228941 -0.00219594
pronosticos<-forecast(modelo,h = 6)
autoplot(pronosticos)+xlab("Años")+ylab("indice")+theme_bw()

library(forecast)
autoplot(pronosticos$x,series = "IVAE")+autolayer(pronosticos$fitted,series = "Pronóstico")+ggtitle("Ajuste SARIMA")

3. Serie ampliada
ivae_h<-ts(as.numeric(rbind(as.matrix(pronosticos$x),as.matrix(pronosticos$mean))),start = c(2005,1),frequency = 12)
print(ivae_h)
Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
2005 75.9200 75.7600 81.8700 80.5800 88.9100 88.3700 83.2800 84.4300 86.2000 84.2800 90.6100 94.2500
2006 81.7200 80.0300 87.5300 80.3700 90.0500 90.5800 83.5000 86.6700 91.3000 92.2100 96.9800 94.2300
2007 83.3100 77.7700 86.9500 78.7400 93.6200 92.2900 87.9800 91.6300 88.3500 92.6400 97.9900 101.2800
2008 85.7600 85.5000 87.6700 89.9600 93.8600 92.2600 86.0300 91.0500 92.2100 93.6200 95.4100 94.0300
2009 86.7300 80.8500 87.1900 83.9200 91.4200 93.4600 86.3900 86.7200 87.5700 85.2700 91.8600 99.6400
2010 85.5600 84.6900 90.9000 85.9400 94.3300 92.2300 87.1900 90.2500 88.9900 88.7300 93.1200 100.7600
2011 90.2600 86.7300 94.3300 90.8000 98.4900 97.5900 92.1600 94.2200 92.3400 89.0700 96.8700 103.9000
2012 92.6600 91.2000 98.4500 91.2200 102.8300 102.8400 93.6100 98.2100 93.9400 93.4900 99.6200 105.0500
2013 95.6700 90.7700 96.1200 96.3400 103.0800 101.5800 96.4200 98.9600 97.7400 96.2200 101.2400 108.3600
2014 98.6900 94.6900 101.2900 97.1200 103.8600 104.7300 98.4700 98.6000 98.2600 96.4400 100.6600 107.1800
2015 97.6300 96.0300 103.0300 98.6200 105.5400 105.4900 102.0000 101.4000 100.9200 100.5100 104.7200 109.3700
2016 99.1200 97.0800 102.6000 103.2400 108.1100 110.5300 104.0100 106.2400 104.4100 102.2200 106.7300 115.3600
2017 101.7200 99.4000 108.5900 102.1400 110.9600 113.8900 105.1900 108.1600 106.5000 104.1900 111.3900 117.4200
2018 105.5400 103.6500 108.6400 106.8600 113.0200 115.7700 107.5500 111.0700 107.9200 106.8300 113.5800 120.2900
2019 108.1900 106.7700 112.3700 107.9100 116.0500 117.6900 110.9600 113.7300 111.1608 109.3682 115.2308 121.5382
2020 109.6810 107.5833
4. Descomposición de la serie temporal
library(stats)
fit<-stl(ivae_h,"periodic")
autoplot(fit)+theme_bw()

TC<-fit$time.series[,2]
print(TC)
Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
2005 81.68954 82.20083 82.71211 83.19408 83.67605 84.13601 84.59598 85.03062 85.46527 85.72118 85.97710 86.07118
2006 86.16526 86.35094 86.53662 86.91938 87.30215 87.62705 87.95196 88.05254 88.15312 88.16402 88.17491 88.22765
2007 88.28039 88.31069 88.34100 88.49509 88.64918 89.08988 89.53057 90.04290 90.55523 90.88324 91.21124 91.24551
2008 91.27977 91.19847 91.11716 91.05092 90.98468 90.86859 90.75250 90.57538 90.39826 90.18002 89.96178 89.74478
2009 89.52778 89.20466 88.88154 88.58214 88.28274 88.29267 88.30260 88.51378 88.72497 88.94378 89.16260 89.31387
2010 89.46514 89.61036 89.75558 89.88906 90.02253 90.17694 90.33135 90.59492 90.85848 91.24817 91.63785 92.07279
2011 92.50774 92.85858 93.20942 93.42102 93.63262 93.80692 93.98122 94.20524 94.42926 94.71837 95.00747 95.34810
2012 95.68873 96.01349 96.33826 96.56587 96.79349 96.89754 97.00160 97.03299 97.06439 97.13165 97.19892 97.31753
2013 97.43614 97.63218 97.82821 98.03158 98.23494 98.45323 98.67151 98.93121 99.19091 99.43194 99.67297 99.85518
2014 100.03739 100.13961 100.24183 100.20899 100.17614 100.07116 99.96617 99.95740 99.94863 100.08222 100.21580 100.44218
2015 100.66855 100.96264 101.25673 101.54255 101.82837 101.99004 102.15171 102.23677 102.32184 102.50316 102.68448 102.98789
2016 103.29130 103.62951 103.96772 104.27705 104.58637 104.85383 105.12129 105.33790 105.55450 105.72155 105.88859 106.07361
2017 106.25863 106.47873 106.69883 106.93823 107.17763 107.41599 107.65434 107.88054 108.10673 108.31678 108.52683 108.74767
2018 108.96851 109.19150 109.41449 109.60377 109.79306 109.97499 110.15692 110.37571 110.59449 110.81557 111.03664 111.27898
2019 111.52132 111.78618 112.05103 112.24691 112.44279 112.52504 112.60729 112.70941 112.81154 112.90387 112.99619 113.08046
2020 113.16472 113.24873
5. Cálculo de las tasas
library(dplyr)
library(zoo)
TC %>% as.numeric() %>% as.data.frame()->TC_df
names(TC_df)<-c("TC")
TC_df %>% mutate(T_1_1=(TC/dplyr::lag(TC,n=1)-1)*100,
T_1_12=(TC/dplyr::lag(TC,n=12)-1)*100,
T_12_12=(rollapply(TC,12,mean,align='right',fill=NA)
/rollapply(dplyr::lag(TC,n=12),12,mean,align='right',fill=NA)-1)*100) %>%
#Aquí se realiza el centrado
mutate(T_1_12C=dplyr::lead(T_1_12,n = 6),
T_12_12C=dplyr::lead(T_12_12,n = 12)) %>% ts(start = c(2005,1),frequency = 12)->tabla_coyuntura
print(tail(tabla_coyuntura,n=12))
TC T_1_1 T_1_12 T_12_12 T_1_12C T_12_12C
Mar 2019 112.0510 0.23693034 2.409682 2.360663 2.004669 NA
Apr 2019 112.2469 0.17480973 2.411538 2.354104 1.884484 NA
May 2019 112.4428 0.17450468 2.413387 2.352012 1.764779 NA
Jun 2019 112.5250 0.07314787 2.318753 2.346719 1.618881 NA
Jul 2019 112.6073 0.07309440 2.224431 2.338241 1.473616 NA
Aug 2019 112.7094 0.09069524 2.114332 2.321478 1.308346 NA
Sep 2019 112.8115 0.09061306 2.004669 2.296475 NA NA
Oct 2019 112.9039 0.08183898 1.884484 2.260927 NA NA
Nov 2019 112.9962 0.08177205 1.764779 2.214895 NA NA
Dec 2019 113.0805 0.07457241 1.618881 2.155411 NA NA
Jan 2020 113.1647 0.07451684 1.473616 2.082556 NA NA
Feb 2020 113.2487 0.07423564 1.308346 1.993125 NA NA
6. Gráfico de las tasas (centradas)
library(dplyr)
library(forecast)
library(ggplot2)
tabla_coyuntura %>% as.data.frame() %>% select(T_1_12C,T_12_12C) %>% ts(start = c(2005,1),frequency = 12)->tabla_coyuntura_graficos
autoplot(tabla_coyuntura_graficos)+theme_bw()

tabla_coyuntura %>% as.data.frame() %>% select(T_1_1) %>% ts(start = c(2005,1),frequency = 12) %>% autoplot()

LS0tDQp0aXRsZTogIkludHJvZHVjY2nDs24gYWwgQW7DoWxpc2lzIGRlIENveXVudHVyYSBFY29uw7NtaWNhIg0KYXV0aG9yOiAiTVNGLiBBZGVtaXIgUMOpcmV6Ig0Kb3V0cHV0OiANCiAgaHRtbF9ub3RlYm9vazogDQogICAgdG9jOiB5ZXMNCiAgaHRtbF9kb2N1bWVudDogDQogICAgZGZfcHJpbnQ6IGthYmxlDQogICAgdG9jOiB5ZXMNCi0tLQ0KDQpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0NCmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkNCmBgYA0KIyAxLiBpbXBvcnRhciBsb3MgZGF0b3MNCmBgYHtyLHdhcm5pbmc9RkFMU0UsbWVzc2FnZT1GQUxTRSxldmFsPVRSVUUsZWNobz1UUlVFfQ0KbGlicmFyeShnZ3Bsb3QyKQ0KbGlicmFyeShmb3JlY2FzdCkNCmxpYnJhcnkocmVhZHhsKQ0KaXZhZV90cyA8LSByZWFkX2V4Y2VsKCJHOi9QcmVzZW50YWNpb25lcyBNZXRvZG9zL2l2YWVfdHMueGxzeCIsIA0KICAgIGNvbF90eXBlcyA9IGMoInNraXAiLCAic2tpcCIsICJudW1lcmljIikpDQpkYXRhPWl2YWVfdHMkSVZBRSAlPiUgdHMoc3RhcnQgPSBjKDIwMDUsMSksZnJlcXVlbmN5ID0gMTIpLT5pdmFlDQpwcmludChpdmFlKQ0KYXV0b3Bsb3QoaXZhZSx4bGFiID0gImHDsW9zIix5bGFiID0gIkluZGljZSIsbWFpbiA9ICJJVkFFIHRvdGFsLCBwZXJpb2RvIDIwMDUtMjAxOSAoYWdvc3RvKSIpK3RoZW1lX2J3KCkNCmBgYA0KIyAyLiBwcm95ZWNjacOzbiBhIFNlaXMgbWVzZXMNCmBgYHtyLHdhcm5pbmc9RkFMU0UsbWVzc2FnZT1GQUxTRSxldmFsPVRSVUUsZWNobz1UUlVFfQ0KbGlicmFyeShmb3JlY2FzdCkNCm1vZGVsbzwtYXV0by5hcmltYSh5ID0gaXZhZSkNCnN1bW1hcnkobW9kZWxvKQ0KcHJvbm9zdGljb3M8LWZvcmVjYXN0KG1vZGVsbyxoID0gNikNCmF1dG9wbG90KHByb25vc3RpY29zKSt4bGFiKCJBw7FvcyIpK3lsYWIoImluZGljZSIpK3RoZW1lX2J3KCkNCmBgYA0KYGBge3Isd2FybmluZz1GQUxTRSxtZXNzYWdlPUZBTFNFLGV2YWw9VFJVRSxlY2hvPVRSVUV9DQpsaWJyYXJ5KGZvcmVjYXN0KQ0KYXV0b3Bsb3QocHJvbm9zdGljb3MkeCxzZXJpZXMgPSAiSVZBRSIpK2F1dG9sYXllcihwcm9ub3N0aWNvcyRmaXR0ZWQsc2VyaWVzID0gIlByb27Ds3N0aWNvIikrZ2d0aXRsZSgiQWp1c3RlIFNBUklNQSIpDQpgYGANCiMgMy4gU2VyaWUgYW1wbGlhZGENCg0KYGBge3Isd2FybmluZz1GQUxTRSxtZXNzYWdlPUZBTFNFLGV2YWw9VFJVRSxlY2hvPVRSVUV9DQppdmFlX2g8LXRzKGFzLm51bWVyaWMocmJpbmQoYXMubWF0cml4KHByb25vc3RpY29zJHgpLGFzLm1hdHJpeChwcm9ub3N0aWNvcyRtZWFuKSkpLHN0YXJ0ID0gYygyMDA1LDEpLGZyZXF1ZW5jeSA9IDEyKQ0KcHJpbnQoaXZhZV9oKQ0KDQpgYGANCg0KIyA0LiBEZXNjb21wb3NpY2nDs24gZGUgbGEgc2VyaWUgdGVtcG9yYWwNCmBgYHtyLHdhcm5pbmc9RkFMU0UsbWVzc2FnZT1GQUxTRSxldmFsPVRSVUUsZWNobz1UUlVFfQ0KbGlicmFyeShzdGF0cykNCmZpdDwtc3RsKGl2YWVfaCwicGVyaW9kaWMiKQ0KYXV0b3Bsb3QoZml0KSt0aGVtZV9idygpDQpUQzwtZml0JHRpbWUuc2VyaWVzWywyXQ0KcHJpbnQoVEMpDQpgYGANCiMgNS4gQ8OhbGN1bG8gZGUgbGFzIHRhc2FzDQpgYGB7cix3YXJuaW5nPUZBTFNFLG1lc3NhZ2U9RkFMU0UsZXZhbD1UUlVFLGVjaG89VFJVRX0NCmxpYnJhcnkoZHBseXIpDQpsaWJyYXJ5KHpvbykNClRDICU+JSBhcy5udW1lcmljKCkgJT4lIGFzLmRhdGEuZnJhbWUoKS0+VENfZGYNCm5hbWVzKFRDX2RmKTwtYygiVEMiKQ0KVENfZGYgJT4lIG11dGF0ZShUXzFfMT0oVEMvZHBseXI6OmxhZyhUQyxuPTEpLTEpKjEwMCwNCiAgICAgICAgICAgICAgICAgVF8xXzEyPShUQy9kcGx5cjo6bGFnKFRDLG49MTIpLTEpKjEwMCwNCiAgICAgICAgICAgICAgICAgVF8xMl8xMj0ocm9sbGFwcGx5KFRDLDEyLG1lYW4sYWxpZ249J3JpZ2h0JyxmaWxsPU5BKQ0KICAgICAgICAgICAgICAgICAgICAgICAgICAvcm9sbGFwcGx5KGRwbHlyOjpsYWcoVEMsbj0xMiksMTIsbWVhbixhbGlnbj0ncmlnaHQnLGZpbGw9TkEpLTEpKjEwMCkgJT4lDQogICAgICAgICAgI0FxdcOtIHNlIHJlYWxpemEgZWwgY2VudHJhZG8NCiAgICAgICAgICBtdXRhdGUoVF8xXzEyQz1kcGx5cjo6bGVhZChUXzFfMTIsbiA9IDYpLA0KICAgICAgICAgICAgICAgICBUXzEyXzEyQz1kcGx5cjo6bGVhZChUXzEyXzEyLG4gPSAxMikpICU+JSB0cyhzdGFydCA9IGMoMjAwNSwxKSxmcmVxdWVuY3kgPSAxMiktPnRhYmxhX2NveXVudHVyYQ0KcHJpbnQodGFpbCh0YWJsYV9jb3l1bnR1cmEsbj0xMikpDQpgYGANCiMgNi4gR3LDoWZpY28gZGUgbGFzIHRhc2FzIChjZW50cmFkYXMpDQoNCmBgYHtyLHdhcm5pbmc9RkFMU0UsbWVzc2FnZT1GQUxTRSxldmFsPVRSVUUsZWNobz1UUlVFfQ0KbGlicmFyeShkcGx5cikNCmxpYnJhcnkoZm9yZWNhc3QpDQpsaWJyYXJ5KGdncGxvdDIpDQp0YWJsYV9jb3l1bnR1cmEgJT4lIGFzLmRhdGEuZnJhbWUoKSAlPiUgc2VsZWN0KFRfMV8xMkMsVF8xMl8xMkMpICU+JSB0cyhzdGFydCA9IGMoMjAwNSwxKSxmcmVxdWVuY3kgPSAxMiktPnRhYmxhX2NveXVudHVyYV9ncmFmaWNvcw0KYXV0b3Bsb3QodGFibGFfY295dW50dXJhX2dyYWZpY29zKSt0aGVtZV9idygpDQp0YWJsYV9jb3l1bnR1cmEgJT4lIGFzLmRhdGEuZnJhbWUoKSAlPiUgc2VsZWN0KFRfMV8xKSAlPiUgdHMoc3RhcnQgPSBjKDIwMDUsMSksZnJlcXVlbmN5ID0gMTIpICU+JSBhdXRvcGxvdCgpDQpgYGANCg0KDQo=