Introduccion al Analisis de Coyuntura Economica

Indice de volumen de la actividad economica (IVAE)

Actividad economica: CONSTRUCCION

1. importar los datos

library(ggplot2)
library(forecast)
library(readxl)
ivae_ts <- read_excel("C:/Users/74/Desktop/IVAE Original.xlsx", 
    col_types = c("skip", "skip", "numeric"))
data=ivae_ts %>% ts(start = c(2005,1),frequency = 12)->ivae
print(ivae)

        Jan    Feb    Mar    Apr    May    Jun    Jul    Aug    Sep    Oct
2005  53.64  66.26  74.71  95.27  76.28  82.05  77.38  68.53  70.42  71.00
2006  58.02  78.13  85.91  71.83  76.95  86.10  81.23  71.78  80.45  84.78
2007  69.44  72.62  89.93  75.06  87.83  78.06  87.98  73.90  77.90  89.63
2008  70.91  91.48  86.79 111.87  92.50  86.57  91.02  74.44  80.25  77.81
2009  66.58  76.94  82.57  82.62  68.96  80.85  82.53  67.30  74.47  71.25
2010  50.25  82.29  94.10  80.80  80.59  80.94  82.17  70.28 101.33  79.48
2011  81.43  92.48 106.20  90.68  97.49  94.65 115.03  88.75  93.80  79.15
2012  90.17  99.48 113.51  98.29 102.30 100.09  96.59  88.06  86.30  94.04
2013  78.75  90.95 106.29 107.91 107.35 107.74  96.13  94.65  97.50 100.94
2014  87.69 100.81 122.10 107.84 108.73 113.51  96.09  90.17  87.93  90.88
2015  66.34 121.00  97.81  97.78 103.66 100.67 117.20  90.08 102.67  99.73
2016  86.05  92.25 101.06 120.36 103.98 102.38 109.23  98.71  98.27  98.07
2017  83.79 102.74 118.21 108.37 105.76  99.71 108.77  92.83 102.04 103.00
2018  97.91 114.22 113.47 118.91 108.05 117.92 113.89  99.47 108.72 104.17
2019 108.12 119.68 127.94 126.94 121.95 124.17 122.67 117.47              
        Nov    Dec
2005  80.96  96.61
2006  90.15 108.46
2007  84.78 106.15
2008  81.55  84.51
2009  64.42 118.97
2010  83.07 111.93
2011  83.82 107.40
2012  99.95 111.92
2013 100.60 129.86
2014  92.06 102.18
2015  95.42 101.63
2016  95.18 131.51
2017 112.04 135.28
2018 119.14 140.79
2019              

autoplot(ivae,xlab = "años",ylab = "Indice",main = "IVAE , periodo 2005-2019 (agosto)")+theme_bw()

2. proyeccion a Seis meses

library(forecast)
modelo<-auto.arima(y = ivae)
summary(modelo)

Series: ivae 
ARIMA(4,1,1)(0,0,2)[12] 

Coefficients:
          ar1     ar2     ar3     ar4      ma1    sma1    sma2
      -0.0311  0.1259  0.1556  0.0054  -0.8982  0.4361  0.1869
s.e.   0.1139  0.1139  0.1018  0.0914   0.0824  0.0801  0.0678

sigma^2 estimated as 113.7:  log likelihood=-660.79
AIC=1337.57   AICc=1338.44   BIC=1362.89

Training set error measures:
                  ME     RMSE      MAE      MPE     MAPE      MASE
Training set 1.52846 10.41918 7.541779 0.516149 8.104341 0.7969559
                     ACF1
Training set -0.005887418

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
2005  53.6400  66.2600  74.7100  95.2700  76.2800  82.0500  77.3800  68.5300
2006  58.0200  78.1300  85.9100  71.8300  76.9500  86.1000  81.2300  71.7800
2007  69.4400  72.6200  89.9300  75.0600  87.8300  78.0600  87.9800  73.9000
2008  70.9100  91.4800  86.7900 111.8700  92.5000  86.5700  91.0200  74.4400
2009  66.5800  76.9400  82.5700  82.6200  68.9600  80.8500  82.5300  67.3000
2010  50.2500  82.2900  94.1000  80.8000  80.5900  80.9400  82.1700  70.2800
2011  81.4300  92.4800 106.2000  90.6800  97.4900  94.6500 115.0300  88.7500
2012  90.1700  99.4800 113.5100  98.2900 102.3000 100.0900  96.5900  88.0600
2013  78.7500  90.9500 106.2900 107.9100 107.3500 107.7400  96.1300  94.6500
2014  87.6900 100.8100 122.1000 107.8400 108.7300 113.5100  96.0900  90.1700
2015  66.3400 121.0000  97.8100  97.7800 103.6600 100.6700 117.2000  90.0800
2016  86.0500  92.2500 101.0600 120.3600 103.9800 102.3800 109.2300  98.7100
2017  83.7900 102.7400 118.2100 108.3700 105.7600  99.7100 108.7700  92.8300
2018  97.9100 114.2200 113.4700 118.9100 108.0500 117.9200 113.8900  99.4700
2019 108.1200 119.6800 127.9400 126.9400 121.9500 124.1700 122.6700 117.4700
2020 118.9252 122.4540                                                      
          Sep      Oct      Nov      Dec
2005  70.4200  71.0000  80.9600  96.6100
2006  80.4500  84.7800  90.1500 108.4600
2007  77.9000  89.6300  84.7800 106.1500
2008  80.2500  77.8100  81.5500  84.5100
2009  74.4700  71.2500  64.4200 118.9700
2010 101.3300  79.4800  83.0700 111.9300
2011  93.8000  79.1500  83.8200 107.4000
2012  86.3000  94.0400  99.9500 111.9200
2013  97.5000 100.9400 100.6000 129.8600
2014  87.9300  90.8800  92.0600 102.1800
2015 102.6700  99.7300  95.4200 101.6300
2016  98.2700  98.0700  95.1800 131.5100
2017 102.0400 103.0000 112.0400 135.2800
2018 108.7200 104.1700 119.1400 140.7900
2019 118.9081 117.0985 123.4852 129.5766
2020                                    

4. Descomposicion 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
2005  72.47003  73.10561  73.74119  74.31263  74.88407  75.43508  75.98608
2006  76.97893  77.35823  77.73754  78.52131  79.30508  80.24030  81.17552
2007  83.06746  82.88152  82.69559  82.58703  82.47848  82.78074  83.08299
2008  88.56172  88.68477  88.80781  88.34231  87.87681  86.96777  86.05873
2009  78.48010  77.81744  77.15478  76.85858  76.56239  76.70585  76.84931
2010  79.19480  79.79812  80.40144  81.34350  82.28555  83.37335  84.46115
2011  92.36214  93.39022  94.41831  94.66457  94.91083  94.96997  95.02911
2012  96.60975  96.60767  96.60559  96.98297  97.36035  97.39883  97.43731
2013  97.84006  98.39537  98.95068  99.60413 100.25757 101.08808 101.91859
2014 105.08020 104.81773 104.55525 103.60753 102.65980 101.34685 100.03390
2015  96.35327  97.11108  97.86889  98.73557  99.60225  99.94783 100.29342
2016 100.29457 100.41902 100.54348 101.00941 101.47534 102.23274 102.99014
2017 104.14167 104.10435 104.06704 104.43945 104.81186 105.54088 106.26990
2018 110.75684 111.20820 111.65955 111.90049 112.14142 112.62059 113.09976
2019 118.79529 119.72680 120.65831 121.22435 121.79038 122.03814 122.28590
2020 124.12318 124.44135                                                  
           Aug       Sep       Oct       Nov       Dec
2005  76.49266  76.99925  77.00995  77.02065  76.99979
2006  81.85656  82.53760  82.82227  83.10695  83.08720
2007  83.95291  84.82283  85.94765  87.07246  87.81709
2008  84.83794  83.61716  82.17969  80.74222  79.61116
2009  77.25228  77.65525  78.09868  78.54210  78.86845
2010  85.72842  86.99569  88.29973  89.60376  90.98295
2011  95.36520  95.70128  96.11462  96.52796  96.56886
2012  97.07925  96.72120  96.81148  96.90176  97.37091
2013 102.71985 103.52110 104.04529 104.56948 104.82484
2014  98.96836  97.90283  97.14839  96.39396  96.37362
2015 100.18707 100.08073 100.13303 100.18533 100.23995
2016 103.54080 104.09147 104.22085 104.35022 104.24595
2017 107.04814 107.82639 108.55067 109.27496 110.01590
2018 113.97131 114.84287 115.84835 116.85382 117.82456
2019 122.58681 122.88772 123.19646 123.50520 123.81419
2020                                                  

5. Calculo 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) %>%
          #Aqui 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 120.6583 0.7780317 8.059104 7.004828 7.005093       NA
Apr 2019 121.2243 0.4691233 8.332279 7.107535 6.342870       NA
May 2019 121.7904 0.4669328 8.604280 7.244591 5.692044       NA
Jun 2019 122.0381 0.2034287 8.362193 7.382921 5.083515       NA
Jul 2019 122.2859 0.2030157 8.122157 7.522581 4.484932       NA
Aug 2019 122.5868 0.2460709 7.559354 7.610465 3.937758       NA
Sep 2019 122.8877 0.2454669 7.005093 7.647359       NA       NA
Oct 2019 123.1965 0.2512367 6.342870 7.609682       NA       NA
Nov 2019 123.5052 0.2506071 5.692044 7.498662       NA       NA
Dec 2019 123.8142 0.2501837 5.083515 7.322209       NA       NA
Jan 2020 124.1232 0.2495593 4.484932 7.081530       NA       NA
Feb 2020 124.4414 0.2563390 3.937758 6.761995       NA       NA

6. Grafico 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()