ANALISIS DE COYUNTURA ECONOMICA
BARBARA ELIZABETH MEJIA GONZALEZ
21 de noviembre de 2019
1. LEYENDO LOS DATOS - Indice de produccion industrial
library(ggplot2)
library(forecast)
library(readxl)
ipi_ts <- read_excel("F:/DESCARGAS/Coyuntura/IPI.xlsx",
col_types = c("skip", "skip", "numeric"))
data=ipi_ts %>% ts(start = c(2005,1),frequency = 12)->ipi
print(ipi)## Jan Feb Mar Apr May Jun Jul Aug Sep Oct
## 2005 73.22 75.32 96.84 81.11 89.77 84.40 83.23 78.23 83.98 86.95
## 2006 78.29 79.37 102.71 83.37 89.56 84.34 83.21 79.78 93.40 94.46
## 2007 78.39 77.94 98.61 79.85 90.33 85.52 85.89 83.00 92.01 100.72
## 2008 87.79 90.12 102.29 99.37 95.41 90.07 93.49 91.74 95.46 100.78
## 2009 86.59 85.35 100.16 91.57 91.21 89.71 86.77 81.16 86.55 93.67
## 2010 89.06 90.36 100.83 91.37 91.35 87.93 93.05 87.18 87.66 94.81
## 2011 92.39 94.41 107.64 97.03 99.26 94.01 94.69 91.02 92.50 90.19
## 2012 96.51 96.76 107.57 95.48 100.25 94.31 96.67 94.99 92.99 97.69
## 2013 101.21 97.63 102.90 99.95 99.45 91.92 97.41 93.37 92.55 96.94
## 2014 99.06 99.24 109.48 101.17 103.08 94.61 102.25 94.40 95.09 101.32
## 2015 101.57 99.26 112.71 103.48 103.95 97.07 102.88 96.47 96.34 103.58
## 2016 102.63 98.56 108.86 107.29 106.68 99.04 100.10 98.58 97.91 101.38
## 2017 102.38 102.55 116.95 99.10 106.37 105.88 100.49 100.80 99.87 102.22
## 2018 105.17 108.58 115.75 105.01 109.02 105.75 103.09 103.24 100.50 103.19
## 2019 106.71 110.92 119.78 104.89 110.48 109.11 111.62 106.39
## Nov Dec
## 2005 86.77 88.49
## 2006 91.75 87.19
## 2007 101.36 98.86
## 2008 94.14 94.79
## 2009 92.58 92.25
## 2010 92.64 92.78
## 2011 96.88 99.73
## 2012 96.97 96.04
## 2013 95.56 99.10
## 2014 99.24 101.05
## 2015 103.85 104.22
## 2016 99.58 109.31
## 2017 105.45 111.78
## 2018 106.21 112.62
## 20192. proyección a Seis meses
library(forecast)
modelo<-auto.arima(y = ipi)
summary(modelo)## Series: ipi
## ARIMA(1,0,1)(0,1,1)[12] with drift
##
## Coefficients:
## ar1 ma1 sma1 drift
## 0.8032 -0.4841 -0.4972 0.1462
## s.e. 0.0892 0.1280 0.0750 0.0290
##
## sigma^2 estimated as 10.33: log likelihood=-423.99
## AIC=857.99 AICc=858.37 BIC=873.49
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 0.02513118 3.064757 2.238753 -0.02598095 2.315291 0.6594145
## ACF1
## Training set 0.008233148pronosticos<-forecast(modelo,h = 6)
autoplot(pronosticos)+xlab("Años")+ylab("indice")+theme_bw()
library(forecast)
autoplot(pronosticos$x,series = "IPI")+autolayer(pronosticos$fitted,series = "Pronóstico")+ggtitle("Ajuste SARIMA")
##3. Serie ampliada
ipi_h<-ts(as.numeric(rbind(as.matrix(pronosticos$x),as.matrix(pronosticos$mean))),start = c(2005,1),frequency = 12)
print(ipi_h)## Jan Feb Mar Apr May Jun Jul
## 2005 73.2200 75.3200 96.8400 81.1100 89.7700 84.4000 83.2300
## 2006 78.2900 79.3700 102.7100 83.3700 89.5600 84.3400 83.2100
## 2007 78.3900 77.9400 98.6100 79.8500 90.3300 85.5200 85.8900
## 2008 87.7900 90.1200 102.2900 99.3700 95.4100 90.0700 93.4900
## 2009 86.5900 85.3500 100.1600 91.5700 91.2100 89.7100 86.7700
## 2010 89.0600 90.3600 100.8300 91.3700 91.3500 87.9300 93.0500
## 2011 92.3900 94.4100 107.6400 97.0300 99.2600 94.0100 94.6900
## 2012 96.5100 96.7600 107.5700 95.4800 100.2500 94.3100 96.6700
## 2013 101.2100 97.6300 102.9000 99.9500 99.4500 91.9200 97.4100
## 2014 99.0600 99.2400 109.4800 101.1700 103.0800 94.6100 102.2500
## 2015 101.5700 99.2600 112.7100 103.4800 103.9500 97.0700 102.8800
## 2016 102.6300 98.5600 108.8600 107.2900 106.6800 99.0400 100.1000
## 2017 102.3800 102.5500 116.9500 99.1000 106.3700 105.8800 100.4900
## 2018 105.1700 108.5800 115.7500 105.0100 109.0200 105.7500 103.0900
## 2019 106.7100 110.9200 119.7800 104.8900 110.4800 109.1100 111.6200
## 2020 109.3132 111.8233
## Aug Sep Oct Nov Dec
## 2005 78.2300 83.9800 86.9500 86.7700 88.4900
## 2006 79.7800 93.4000 94.4600 91.7500 87.1900
## 2007 83.0000 92.0100 100.7200 101.3600 98.8600
## 2008 91.7400 95.4600 100.7800 94.1400 94.7900
## 2009 81.1600 86.5500 93.6700 92.5800 92.2500
## 2010 87.1800 87.6600 94.8100 92.6400 92.7800
## 2011 91.0200 92.5000 90.1900 96.8800 99.7300
## 2012 94.9900 92.9900 97.6900 96.9700 96.0400
## 2013 93.3700 92.5500 96.9400 95.5600 99.1000
## 2014 94.4000 95.0900 101.3200 99.2400 101.0500
## 2015 96.4700 96.3400 103.5800 103.8500 104.2200
## 2016 98.5800 97.9100 101.3800 99.5800 109.3100
## 2017 100.8000 99.8700 102.2200 105.4500 111.7800
## 2018 103.2400 100.5000 103.1900 106.2100 112.6200
## 2019 106.3900 104.5340 107.3289 109.1054 115.0398
## 20204. Descomposición de la serie temporal
library(stats)
fit<-stl(ipi_h,"periodic")
autoplot(fit)+theme_bw()
TC<-fit$time.series[,2]
print(TC)## Jan Feb Mar Apr May Jun Jul
## 2005 80.70409 81.29252 81.88096 82.41602 82.95108 83.46418 83.97728
## 2006 85.45473 85.70105 85.94738 86.40883 86.87028 87.15809 87.44590
## 2007 86.64889 86.67417 86.69945 87.21377 87.72810 88.74253 89.75697
## 2008 94.46621 94.73182 94.99743 95.01907 95.04072 94.92295 94.80519
## 2009 92.31031 91.64258 90.97484 90.51615 90.05746 90.02315 89.98885
## 2010 90.81819 91.03072 91.24325 91.37124 91.49922 91.63891 91.77861
## 2011 94.42223 94.75011 95.07799 95.28263 95.48726 95.67091 95.85455
## 2012 96.50210 96.75417 97.00624 97.18201 97.35779 97.39608 97.43436
## 2013 97.42186 97.38096 97.34006 97.28036 97.22067 97.19523 97.16979
## 2014 98.64518 98.95210 99.25902 99.51115 99.76328 99.90477 100.04625
## 2015 100.99237 101.17021 101.34804 101.54339 101.73875 101.87493 102.01112
## 2016 102.43146 102.47764 102.52382 102.47287 102.42193 102.45149 102.48105
## 2017 103.31195 103.53403 103.75612 103.92812 104.10012 104.30396 104.50780
## 2018 106.08842 106.25425 106.42007 106.43768 106.45528 106.45490 106.45451
## 2019 107.95963 108.39177 108.82390 109.11178 109.39966 109.58092 109.76219
## 2020 111.28251 111.54632
## Aug Sep Oct Nov Dec
## 2005 84.45863 84.93998 85.12747 85.31496 85.38485
## 2006 87.37531 87.30471 87.08995 86.87519 86.76204
## 2007 90.77458 91.79219 92.59115 93.39011 93.92816
## 2008 94.53116 94.25713 93.81799 93.37884 92.84458
## 2009 90.14015 90.29146 90.39428 90.49711 90.65765
## 2010 92.11743 92.45625 92.95979 93.46333 93.94278
## 2011 95.97531 96.09607 96.15957 96.22308 96.36259
## 2012 97.45025 97.46613 97.48779 97.50945 97.46565
## 2013 97.29704 97.42429 97.72229 98.02030 98.33274
## 2014 100.15854 100.27084 100.44570 100.62056 100.80647
## 2015 102.03059 102.05006 102.12743 102.20479 102.31812
## 2016 102.62373 102.76641 102.87726 102.98811 103.15003
## 2017 104.78762 105.06745 105.35414 105.64084 105.86463
## 2018 106.61356 106.77261 107.01434 107.25607 107.60785
## 2019 110.02281 110.28344 110.53389 110.78434 111.03343
## 20205. 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 108.8239 0.3986783 2.258816 1.895299 3.288137 NA
## Apr 2019 109.1118 0.2645356 2.512367 1.904548 3.288859 NA
## May 2019 109.3997 0.2638376 2.765834 1.947506 3.289577 NA
## Jun 2019 109.5809 0.1656896 2.936480 2.021025 3.183388 NA
## Jul 2019 109.7622 0.1654155 3.107128 2.124985 3.077891 NA
## Aug 2019 110.0228 0.2374451 3.197768 2.246304 2.910327 NA
## Sep 2019 110.2834 0.2368827 3.288137 2.384941 NA NA
## Oct 2019 110.5339 0.2270994 3.288859 2.527503 NA NA
## Nov 2019 110.7843 0.2265848 3.289577 2.673989 NA NA
## Dec 2019 111.0334 0.2248385 3.183388 2.801798 NA NA
## Jan 2020 111.2825 0.2243341 3.077891 2.910968 NA NA
## Feb 2020 111.5463 0.2370629 2.910327 2.985340 NA NA6. 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()