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=