Actividades de Administracion Publica
ALISSON SAMARIA VAQUERANO MORALES
4 de diciembre 2019
#1. importar los Datos
library(ggplot2)
library(forecast)
library(readxl)
ActDeAdm_ts <- read_excel("F:/MAE/ActDeAdm.xlsx",
col_types = c("skip", "skip", "numeric"))
ts(data=ActDeAdm_ts, start = c(2005,1),frequency = 12)->ActDeAdm
print(ActDeAdm)## Jan Feb Mar Apr May Jun Jul Aug Sep Oct
## 2005 76.32 79.41 81.31 79.83 80.13 80.87 87.32 88.25 84.69 84.83
## 2006 81.55 85.21 88.53 83.55 84.68 85.21 87.64 87.45 89.74 90.21
## 2007 81.66 82.35 84.41 79.85 80.89 81.12 82.71 85.08 85.85 85.70
## 2008 84.32 85.72 85.24 88.63 84.75 84.07 84.29 84.27 86.43 89.02
## 2009 80.77 82.97 91.33 83.92 84.88 86.71 90.28 87.68 88.35 85.22
## 2010 80.16 83.46 87.33 86.79 88.27 89.02 86.76 88.96 92.29 90.69
## 2011 91.47 89.88 91.49 97.49 94.79 100.50 96.04 97.75 96.75 96.14
## 2012 93.59 101.55 102.10 102.79 96.77 97.16 103.88 102.04 101.93 102.19
## 2013 97.12 97.82 104.76 105.79 105.11 96.47 103.28 101.81 103.46 103.36
## 2014 100.10 98.10 99.70 98.04 98.74 104.68 101.98 98.39 103.26 100.99
## 2015 98.04 96.54 101.25 101.62 103.16 103.67 101.05 106.22 104.79 107.44
## 2016 98.65 99.11 103.16 102.70 103.17 106.00 107.93 106.01 105.57 106.84
## 2017 101.26 99.81 106.96 103.32 106.11 107.97 107.23 111.99 107.60 110.58
## 2018 100.51 103.23 103.82 109.10 105.71 110.07 110.22 116.74 108.92 115.07
## 2019 100.35 106.43 108.30 106.41 107.45 107.47 107.68 110.94
## Nov Dec
## 2005 84.83 85.32
## 2006 88.08 86.44
## 2007 88.01 88.86
## 2008 91.65 87.04
## 2009 86.02 86.24
## 2010 88.27 91.43
## 2011 97.56 96.17
## 2012 98.75 98.13
## 2013 105.34 103.96
## 2014 95.91 100.11
## 2015 105.92 103.44
## 2016 106.58 108.37
## 2017 111.15 110.91
## 2018 112.05 112.96
## 2019autoplot(ActDeAdm,xlab = "aƱos",ylab = "Indice",main = "Actividades de Administracion Publica, periodo 2005-2019 (agosto)")+theme_bw()
#2.Proyeccion a seis meses
library(forecast)
modelo<-auto.arima(y = ActDeAdm)
summary(modelo)## Series: ActDeAdm
## ARIMA(1,1,1)(0,0,2)[12] with drift
##
## Coefficients:
## ar1 ma1 sma1 sma2 drift
## 0.3333 -0.8530 0.2524 0.1394 0.1619
## s.e. 0.1121 0.0698 0.0781 0.0707 0.0682
##
## sigma^2 estimated as 8.802: log likelihood=-436.96
## AIC=885.92 AICc=886.42 BIC=904.91
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 0.04435517 2.915839 2.256902 -0.01588836 2.358381 0.6250539
## ACF1
## Training set -0.008020384pronosticos<-forecast(modelo,h = 6)
autoplot(pronosticos)+xlab("AƱos")+ylab("indice")+theme_bw()
library(forecast)
autoplot(pronosticos$x,series = "Actividades de Administracion Publica")+autolayer(pronosticos$fitted,series = "PronĆ³stico")+ggtitle("Ajuste SARIMA")
#3.Serie ampliada
ActDeAdm_h<-ts(as.numeric(rbind(as.matrix(pronosticos$x),as.matrix(pronosticos$mean))),start = c(2005,1),frequency = 12)
print(ActDeAdm_h)## Jan Feb Mar Apr May Jun Jul
## 2005 76.3200 79.4100 81.3100 79.8300 80.1300 80.8700 87.3200
## 2006 81.5500 85.2100 88.5300 83.5500 84.6800 85.2100 87.6400
## 2007 81.6600 82.3500 84.4100 79.8500 80.8900 81.1200 82.7100
## 2008 84.3200 85.7200 85.2400 88.6300 84.7500 84.0700 84.2900
## 2009 80.7700 82.9700 91.3300 83.9200 84.8800 86.7100 90.2800
## 2010 80.1600 83.4600 87.3300 86.7900 88.2700 89.0200 86.7600
## 2011 91.4700 89.8800 91.4900 97.4900 94.7900 100.5000 96.0400
## 2012 93.5900 101.5500 102.1000 102.7900 96.7700 97.1600 103.8800
## 2013 97.1200 97.8200 104.7600 105.7900 105.1100 96.4700 103.2800
## 2014 100.1000 98.1000 99.7000 98.0400 98.7400 104.6800 101.9800
## 2015 98.0400 96.5400 101.2500 101.6200 103.1600 103.6700 101.0500
## 2016 98.6500 99.1100 103.1600 102.7000 103.1700 106.0000 107.9300
## 2017 101.2600 99.8100 106.9600 103.3200 106.1100 107.9700 107.2300
## 2018 100.5100 103.2300 103.8200 109.1000 105.7100 110.0700 110.2200
## 2019 100.3500 106.4300 108.3000 106.4100 107.4500 107.4700 107.6800
## 2020 107.1864 109.1215
## Aug Sep Oct Nov Dec
## 2005 88.2500 84.6900 84.8300 84.8300 85.3200
## 2006 87.4500 89.7400 90.2100 88.0800 86.4400
## 2007 85.0800 85.8500 85.7000 88.0100 88.8600
## 2008 84.2700 86.4300 89.0200 91.6500 87.0400
## 2009 87.6800 88.3500 85.2200 86.0200 86.2400
## 2010 88.9600 92.2900 90.6900 88.2700 91.4300
## 2011 97.7500 96.7500 96.1400 97.5600 96.1700
## 2012 102.0400 101.9300 102.1900 98.7500 98.1300
## 2013 101.8100 103.4600 103.3600 105.3400 103.9600
## 2014 98.3900 103.2600 100.9900 95.9100 100.1100
## 2015 106.2200 104.7900 107.4400 105.9200 103.4400
## 2016 106.0100 105.5700 106.8400 106.5800 108.3700
## 2017 111.9900 107.6000 110.5800 111.1500 110.9100
## 2018 116.7400 108.9200 115.0700 112.0500 112.9600
## 2019 110.9400 109.0895 111.0047 110.4071 110.6716
## 2020#4.Serie Temporal
library(stats)
fit<-stl(ActDeAdm_h,"periodic")
autoplot(fit)+theme_bw()
TC<-fit$time.series[,2]
print(TC)## Jan Feb Mar Apr May Jun Jul
## 2005 80.46729 80.90878 81.35026 81.78374 82.21722 82.64027 83.06331
## 2006 85.27510 85.47526 85.67542 85.93868 86.20194 86.31651 86.43108
## 2007 84.88280 84.47227 84.06175 83.82115 83.58054 83.67041 83.76028
## 2008 85.96798 86.02818 86.08837 86.08227 86.07617 86.01693 85.95769
## 2009 86.48504 86.63726 86.78948 86.70122 86.61296 86.43285 86.25274
## 2010 86.27076 86.46209 86.65341 86.98919 87.32497 87.79800 88.27103
## 2011 92.27873 93.03241 93.78609 94.34398 94.90187 95.35940 95.81694
## 2012 98.41590 98.84266 99.26942 99.61443 99.95943 100.04814 100.13686
## 2013 101.10139 101.23381 101.36624 101.59460 101.82296 102.05870 102.29444
## 2014 101.53123 101.41546 101.29969 100.97600 100.65232 100.33161 100.01090
## 2015 100.39528 100.74617 101.09705 101.57609 102.05513 102.44746 102.83980
## 2016 103.63284 103.77831 103.92377 104.05244 104.18111 104.39790 104.61470
## 2017 105.53544 105.76083 105.98622 106.28618 106.58613 106.84562 107.10512
## 2018 107.72565 107.92879 108.13193 108.40773 108.68352 108.95324 109.22297
## 2019 109.16856 108.87548 108.58241 108.40113 108.21986 108.41063 108.60141
## 2020 110.17848 110.49308
## Aug Sep Oct Nov Dec
## 2005 83.49843 83.93355 84.35879 84.78403 85.02956
## 2006 86.32264 86.21419 85.94064 85.66709 85.27494
## 2007 84.10971 84.45914 84.91683 85.37452 85.67125
## 2008 85.93286 85.90802 85.98541 86.06279 86.27392
## 2009 86.15241 86.05207 86.06326 86.07444 86.17260
## 2010 88.81524 89.35944 90.02632 90.69321 91.48597
## 2011 96.31410 96.81126 97.26101 97.71076 98.06333
## 2012 100.16081 100.18477 100.40794 100.63111 100.86625
## 2013 102.23308 102.17171 101.94193 101.71215 101.62169
## 2014 99.91017 99.80944 99.92064 100.03183 100.21356
## 2015 103.00509 103.17039 103.25904 103.34768 103.49026
## 2016 104.81953 105.02436 105.14556 105.26675 105.40110
## 2017 107.25015 107.39518 107.45520 107.51521 107.62043
## 2018 109.42647 109.62997 109.61717 109.60437 109.38647
## 2019 108.83805 109.07470 109.33610 109.59750 109.88799
## 2020#5. Calculo de 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
## Mar 2019 108.5824 -0.2691832 0.416598427 1.68597585 -0.506499746
## Apr 2019 108.4011 -0.1669490 -0.006083853 1.51822608 -0.256413696
## May 2019 108.2199 -0.1672282 -0.426620945 1.31754704 -0.006269237
## Jun 2019 108.4106 0.1762858 -0.498022808 1.11061930 0.458487727
## Jul 2019 108.6014 0.1759755 -0.569072024 0.89747825 0.925100051
## Aug 2019 108.8381 0.2179009 -0.537727702 0.68305090 1.485725954
## Sep 2019 109.0747 0.2174272 -0.506499746 0.46737265 NA
## Oct 2019 109.3361 0.2396547 -0.256413696 0.27908325 NA
## Nov 2019 109.5975 0.2390817 -0.006269237 0.11801508 NA
## Dec 2019 109.8880 0.2650504 0.458487727 0.02108564 NA
## Jan 2020 110.1785 0.2643498 0.925100051 -0.01203665 NA
## Feb 2020 110.4931 0.2855353 1.485725954 0.03922068 NA
## T_12_12C
## Mar 2019 NA
## Apr 2019 NA
## May 2019 NA
## Jun 2019 NA
## Jul 2019 NA
## Aug 2019 NA
## Sep 2019 NA
## Oct 2019 NA
## Nov 2019 NA
## Dec 2019 NA
## Jan 2020 NA
## Feb 2020 NA#Grafico de 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()