1. LEYENDO LOS DATOS - Informacion y Comunicaciones

library(ggplot2)
library(forecast)
library(readxl)
inf_ts <- read_excel("F:/DOCUMENTOS/INFyC.xlsx", 
                     col_types = c("skip", "skip", "numeric"))
data=inf_ts %>% ts(start = c(2005,1),frequency = 12)->inf
print(inf)
##         Jan    Feb    Mar    Apr    May    Jun    Jul    Aug    Sep    Oct
## 2005  84.94  82.70  84.64  90.63  91.18  90.91 101.30  93.74  98.08 109.04
## 2006  97.70  79.51  85.63  91.33  97.90  95.43  93.29  90.04  93.09 111.92
## 2007  92.17  74.44  81.52  83.00  95.41 106.16 101.88 103.87 110.65 125.69
## 2008 105.11  93.05  96.09 100.73 106.49  97.89  92.15  89.94  96.94 106.19
## 2009  94.63  76.87  81.86  81.01  92.30  91.86  96.93  81.34 104.17 111.13
## 2010 105.52  86.43  92.39  94.73 101.72 100.65  98.99  96.16  95.71 116.43
## 2011 105.55  91.76 101.29  99.53 106.47 102.28 104.85 105.40 107.60 114.63
## 2012 106.49  98.98 102.53  99.94 106.34 105.55  93.33  92.76  92.35 100.03
## 2013 100.39  87.23  90.10  95.22  98.58  96.98  98.91  99.90 101.60 107.93
## 2014 103.08  91.03  94.60  93.08  99.02  96.76  97.33  97.11  95.68 102.27
## 2015 107.55 101.28  99.62 100.02 103.19  99.07  99.31  96.15  97.73 102.82
## 2016 107.45 112.16 110.34 112.07 105.20 104.49 105.31 103.97 103.50 101.47
## 2017 113.10 114.54 117.25 110.44 105.14 103.67 103.10 101.65 101.21 102.59
## 2018 117.79 121.17 113.61 110.56 105.72 104.92 104.73 105.85 105.47 107.30
## 2019 118.45 123.83 113.72 112.38 107.17 105.57 108.50 107.04              
##         Nov    Dec
## 2005 119.56 106.35
## 2006 109.25 113.30
## 2007 123.77 133.14
## 2008 108.95 119.55
## 2009 122.10 126.29
## 2010 114.53 124.88
## 2011 121.82 128.13
## 2012 106.99 111.88
## 2013 108.65 120.65
## 2014 108.94 121.10
## 2015 111.41 113.75
## 2016 107.67 116.06
## 2017 108.02 119.17
## 2018 112.36 124.20
## 2019

2. proyección a Seis meses

library(forecast)
modelo<-auto.arima(y = inf)
summary(modelo)
## Series: inf 
## ARIMA(3,0,0)(2,1,0)[12] 
## 
## Coefficients:
##          ar1     ar2      ar3     sar1     sar2
##       0.5022  0.3728  -0.1131  -0.4699  -0.1542
## s.e.  0.0816  0.0853   0.0798   0.0843   0.0875
## 
## sigma^2 estimated as 24.96:  log likelihood=-495.76
## AIC=1003.52   AICc=1004.05   BIC=1022.12
## 
## Training set error measures:
##                    ME     RMSE      MAE       MPE    MAPE   MASE
## Training set 0.414756 4.748196 3.357522 0.2245014 3.29099 0.5139
##                     ACF1
## Training set 0.008647958
pronosticos<-forecast(modelo,h = 6) 
autoplot(pronosticos)+xlab("Años")+ylab("indice")+theme_bw()

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

3. Serie ampliada

inf_h<-ts(as.numeric(rbind(as.matrix(pronosticos$x),as.matrix(pronosticos$mean))),start = c(2005,1),frequency = 12)
print(inf_h)
##           Jan      Feb      Mar      Apr      May      Jun      Jul
## 2005  84.9400  82.7000  84.6400  90.6300  91.1800  90.9100 101.3000
## 2006  97.7000  79.5100  85.6300  91.3300  97.9000  95.4300  93.2900
## 2007  92.1700  74.4400  81.5200  83.0000  95.4100 106.1600 101.8800
## 2008 105.1100  93.0500  96.0900 100.7300 106.4900  97.8900  92.1500
## 2009  94.6300  76.8700  81.8600  81.0100  92.3000  91.8600  96.9300
## 2010 105.5200  86.4300  92.3900  94.7300 101.7200 100.6500  98.9900
## 2011 105.5500  91.7600 101.2900  99.5300 106.4700 102.2800 104.8500
## 2012 106.4900  98.9800 102.5300  99.9400 106.3400 105.5500  93.3300
## 2013 100.3900  87.2300  90.1000  95.2200  98.5800  96.9800  98.9100
## 2014 103.0800  91.0300  94.6000  93.0800  99.0200  96.7600  97.3300
## 2015 107.5500 101.2800  99.6200 100.0200 103.1900  99.0700  99.3100
## 2016 107.4500 112.1600 110.3400 112.0700 105.2000 104.4900 105.3100
## 2017 113.1000 114.5400 117.2500 110.4400 105.1400 103.6700 103.1000
## 2018 117.7900 121.1700 113.6100 110.5600 105.7200 104.9200 104.7300
## 2019 118.4500 123.8300 113.7200 112.3800 107.1700 105.5700 108.5000
## 2020 118.4968 122.3881                                             
##           Aug      Sep      Oct      Nov      Dec
## 2005  93.7400  98.0800 109.0400 119.5600 106.3500
## 2006  90.0400  93.0900 111.9200 109.2500 113.3000
## 2007 103.8700 110.6500 125.6900 123.7700 133.1400
## 2008  89.9400  96.9400 106.1900 108.9500 119.5500
## 2009  81.3400 104.1700 111.1300 122.1000 126.2900
## 2010  96.1600  95.7100 116.4300 114.5300 124.8800
## 2011 105.4000 107.6000 114.6300 121.8200 128.1300
## 2012  92.7600  92.3500 100.0300 106.9900 111.8800
## 2013  99.9000 101.6000 107.9300 108.6500 120.6500
## 2014  97.1100  95.6800 102.2700 108.9400 121.1000
## 2015  96.1500  97.7300 102.8200 111.4100 113.7500
## 2016 103.9700 103.5000 101.4700 107.6700 116.0600
## 2017 101.6500 101.2100 102.5900 108.0200 119.1700
## 2018 105.8500 105.4700 107.3000 112.3600 124.2000
## 2019 107.0400 106.6687 106.9157 112.0160 122.6596
## 2020

4. Descomposición de la serie temporal

library(stats)
fit<-stl(inf_h,"periodic")
autoplot(fit)+theme_bw()

TC<-fit$time.series[,2]
print(TC)
##            Jan       Feb       Mar       Apr       May       Jun       Jul
## 2005  89.38671  90.56610  91.74550  92.76693  93.78837  94.66286  95.53735
## 2006  97.16367  96.79160  96.41953  96.31536  96.21119  96.32083  96.43046
## 2007  95.18690  96.03456  96.88223  98.37211  99.86199 101.76018 103.65837
## 2008 107.77524 106.56359 105.35194 104.00307 102.65420 101.62529 100.59639
## 2009  94.37796  94.17716  93.97636  94.42462  94.87287  95.98335  97.09383
## 2010 102.30245 102.41325 102.52405 102.40184 102.27963 102.40145 102.52327
## 2011 104.87358 105.33857 105.80357 106.28067 106.75777 107.21691 107.67604
## 2012 107.80556 106.89182 105.97807 104.74897 103.51987 102.37904 101.23821
## 2013  97.49115  97.95524  98.41932  99.05487  99.69042 100.23665 100.78289
## 2014 101.03889 100.75255 100.46622 100.24224 100.01827 100.14631 100.27436
## 2015 102.94335 103.10965 103.27595 103.22367 103.17138 103.01238 102.85339
## 2016 106.55287 107.18069 107.80850 107.97788 108.14726 107.92527 107.70328
## 2017 108.55152 108.68405 108.81657 108.76794 108.71930 108.46588 108.21246
## 2018 109.59025 110.05317 110.51609 110.74187 110.96766 110.83583 110.70401
## 2019 112.26319 112.52740 112.79161 112.70208 112.61254 112.30858 112.00462
## 2020 112.16910 112.30321                                                  
##            Aug       Sep       Oct       Nov       Dec
## 2005  96.31252  97.08769  97.33762  97.58754  97.37560
## 2006  96.21031  95.99016  95.51795  95.04574  95.11632
## 2007 105.30451 106.95065 107.73845 108.52626 108.15075
## 2008  99.50002  98.40366  97.17552  95.94739  95.16268
## 2009  98.30560  99.51737 100.39967 101.28196 101.79220
## 2010 102.94834 103.37341 103.76022 104.14704 104.51031
## 2011 108.01720 108.35836 108.41946 108.48055 108.14306
## 2012 100.26880  99.29940  98.57195  97.84450  97.66783
## 2013 101.10043 101.41798 101.43098 101.44399 101.24144
## 2014 100.75277 101.23118 101.75026 102.26934 102.60635
## 2015 103.17708 103.50077 104.25470 105.00863 105.78075
## 2016 107.65854 107.61381 107.84262 108.07144 108.31148
## 2017 108.14327 108.07407 108.37254 108.67101 109.13063
## 2018 110.69609 110.68817 111.06307 111.43798 111.85058
## 2019 112.03130 112.05798 112.07151 112.08503 112.12707
## 2020

5. Cálculo de las tasas (sin centrar)

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.7916  0.23479778  2.05899638 2.2844166  1.23754020       NA
## Apr 2019 112.7021 -0.07938355  1.77006375 2.2799215  0.90798347       NA
## May 2019 112.6125 -0.07944662  1.48230688 2.2299777  0.58064415       NA
## Jun 2019 112.3086 -0.26991520  1.32876215 2.1576370  0.24718970       NA
## Jul 2019 112.0046 -0.27064571  1.17485176 2.0630403 -0.08381362       NA
## Aug 2019 112.0313  0.02382130  1.20619374 1.9666866 -0.19923694       NA
## Sep 2019 112.0580  0.02381563  1.23754020 1.8685995          NA       NA
## Oct 2019 112.0715  0.01206969  0.90798347 1.7377218          NA       NA
## Nov 2019 112.0850  0.01206824  0.58064415 1.5742758          NA       NA
## Dec 2019 112.1271  0.03750061  0.24718970 1.3872167          NA       NA
## Jan 2020 112.1691  0.03748655 -0.08381362 1.1766693          NA       NA
## Feb 2020 112.3032  0.11955836 -0.19923694 0.9722509          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()