Importacion y presentacion de datos de la serie
Tabla
library(ggplot2)
library(forecast)
library(readxl)
ActPro_ts <- read_excel("E:/activi.profesionales.xlsx",
col_types = c("skip", "skip", "numeric"))
ts(data=ActPro_ts, start = c(2005,1),frequency = 12)->ActPro
print(ActPro)
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct
## 2005 71.09 71.80 72.17 76.15 75.85 76.11 78.62 69.76 79.38 74.52
## 2006 74.71 74.77 74.04 72.67 70.65 75.06 70.38 74.04 80.40 86.41
## 2007 77.11 70.61 74.20 74.44 81.29 79.95 86.55 83.15 67.57 76.16
## 2008 75.93 81.66 79.58 80.13 75.02 73.11 75.03 82.50 82.87 91.82
## 2009 86.05 79.92 78.78 80.36 83.21 85.64 82.17 80.59 80.51 65.37
## 2010 83.64 84.78 84.85 85.13 83.45 85.00 82.36 82.27 81.01 80.57
## 2011 82.50 84.45 85.68 87.73 88.36 90.74 87.84 90.11 93.04 84.67
## 2012 98.86 100.15 97.42 94.65 96.58 94.17 94.60 97.33 90.84 88.67
## 2013 94.15 97.52 97.14 97.53 97.71 92.66 93.60 94.15 95.34 94.07
## 2014 100.60 97.10 97.12 98.75 94.65 101.77 96.57 99.59 100.72 102.62
## 2015 104.61 100.76 101.96 99.22 98.63 101.12 97.93 100.51 101.08 101.51
## 2016 98.87 100.40 102.63 101.16 102.13 105.78 106.35 105.48 104.44 104.20
## 2017 104.44 105.23 105.07 107.21 105.73 104.77 107.85 107.94 105.49 107.68
## 2018 106.04 106.36 107.48 109.41 114.06 112.33 110.85 110.20 108.98 110.29
## 2019 112.45 112.15 109.14 112.31 111.24 108.60 109.35 107.82 108.33
## Nov Dec
## 2005 77.35 75.95
## 2006 90.88 70.36
## 2007 79.96 78.50
## 2008 80.56 72.72
## 2009 85.02 89.30
## 2010 82.41 83.13
## 2011 91.95 97.85
## 2012 90.76 90.30
## 2013 95.45 93.64
## 2014 103.52 106.98
## 2015 100.20 106.01
## 2016 103.75 106.30
## 2017 107.98 106.30
## 2018 110.12 111.74
## 2019
Grafico
autoplot(ActPro,xlab = "años",ylab = "Indice",main = "Actividades Profesionales, Cientificas, Tecnicas, Administrativas, de Apoyo y Otros Servicios, periodo 2005-2019 (agosto)")+theme_bw()
2 - Proyeccion para 6 meses
library(forecast)
modelo<-auto.arima(y = ActPro)
summary(modelo)
## Series: ActPro
## ARIMA(1,1,1)(0,0,1)[12] with drift
##
## Coefficients:
## ar1 ma1 sma1 drift
## 0.3159 -0.9393 -0.1456 0.2262
## s.e. 0.0865 0.0408 0.0738 0.0242
##
## sigma^2 estimated as 13.79: log likelihood=-479.58
## AIC=969.16 AICc=969.51 BIC=985.01
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -0.0211649 3.660498 2.612876 -0.2283405 3.03555 0.5323774
## ACF1
## Training set -0.01299943
pronosticos<-forecast(modelo,h = 6)
autoplot(pronosticos)+xlab("años")+ylab("indice")+theme_bw()
library(forecast)
autoplot(pronosticos$x,series = "Actividades Profesionales")+autolayer(pronosticos$fitted,series = "Pronostico")+ggtitle("Ajuste SARIMA")
3 - Descomposicion de serie temporal ampliada
ActPro_h<-ts(as.numeric(rbind(as.matrix(pronosticos$x),as.matrix(pronosticos$mean))),start = c(2005,1),frequency = 12)
print(ActPro_h)
## Jan Feb Mar Apr May Jun Jul
## 2005 71.0900 71.8000 72.1700 76.1500 75.8500 76.1100 78.6200
## 2006 74.7100 74.7700 74.0400 72.6700 70.6500 75.0600 70.3800
## 2007 77.1100 70.6100 74.2000 74.4400 81.2900 79.9500 86.5500
## 2008 75.9300 81.6600 79.5800 80.1300 75.0200 73.1100 75.0300
## 2009 86.0500 79.9200 78.7800 80.3600 83.2100 85.6400 82.1700
## 2010 83.6400 84.7800 84.8500 85.1300 83.4500 85.0000 82.3600
## 2011 82.5000 84.4500 85.6800 87.7300 88.3600 90.7400 87.8400
## 2012 98.8600 100.1500 97.4200 94.6500 96.5800 94.1700 94.6000
## 2013 94.1500 97.5200 97.1400 97.5300 97.7100 92.6600 93.6000
## 2014 100.6000 97.1000 97.1200 98.7500 94.6500 101.7700 96.5700
## 2015 104.6100 100.7600 101.9600 99.2200 98.6300 101.1200 97.9300
## 2016 98.8700 100.4000 102.6300 101.1600 102.1300 105.7800 106.3500
## 2017 104.4400 105.2300 105.0700 107.2100 105.7300 104.7700 107.8500
## 2018 106.0400 106.3600 107.4800 109.4100 114.0600 112.3300 110.8500
## 2019 112.4500 112.1500 109.1400 112.3100 111.2400 108.6000 109.3500
## 2020 112.5097 112.8334 113.5200
## Aug Sep Oct Nov Dec
## 2005 69.7600 79.3800 74.5200 77.3500 75.9500
## 2006 74.0400 80.4000 86.4100 90.8800 70.3600
## 2007 83.1500 67.5700 76.1600 79.9600 78.5000
## 2008 82.5000 82.8700 91.8200 80.5600 72.7200
## 2009 80.5900 80.5100 65.3700 85.0200 89.3000
## 2010 82.2700 81.0100 80.5700 82.4100 83.1300
## 2011 90.1100 93.0400 84.6700 91.9500 97.8500
## 2012 97.3300 90.8400 88.6700 90.7600 90.3000
## 2013 94.1500 95.3400 94.0700 95.4500 93.6400
## 2014 99.5900 100.7200 102.6200 103.5200 106.9800
## 2015 100.5100 101.0800 101.5100 100.2000 106.0100
## 2016 105.4800 104.4400 104.2000 103.7500 106.3000
## 2017 107.9400 105.4900 107.6800 107.9800 106.3000
## 2018 110.2000 108.9800 110.2900 110.1200 111.7400
## 2019 107.8200 108.3300 110.8712 111.9501 112.2546
## 2020
Grafico
library(stats)
fit<-stl(ActPro_h,"periodic")
autoplot(fit)+theme_bw()
Tabla
TC<-fit$time.series[,2]
print(TC)
## Jan Feb Mar Apr May Jun Jul
## 2005 72.96610 73.31212 73.65815 73.95773 74.25731 74.52673 74.79615
## 2006 74.61313 74.56274 74.51236 74.92936 75.34636 75.77747 76.20859
## 2007 78.03928 78.13622 78.23315 77.96325 77.69335 77.73121 77.76906
## 2008 77.86899 77.94314 78.01728 78.53409 79.05089 79.37563 79.70037
## 2009 81.53310 81.47628 81.41946 81.10991 80.80036 80.91710 81.03385
## 2010 82.64720 82.93016 83.21311 83.37903 83.54495 83.39215 83.23936
## 2011 84.39993 85.10840 85.81687 86.62125 87.42562 88.42379 89.42196
## 2012 94.49364 94.87744 95.26123 95.22625 95.19127 94.78786 94.38446
## 2013 93.98364 94.15178 94.31991 94.61671 94.91350 95.14405 95.37461
## 2014 96.45077 96.90145 97.35213 97.94559 98.53905 99.20474 99.87043
## 2015 101.65874 101.57904 101.49933 101.31219 101.12504 100.95355 100.78206
## 2016 101.79888 102.19640 102.59391 102.92862 103.26333 103.57987 103.89641
## 2017 105.29751 105.45275 105.60798 105.84476 106.08154 106.26740 106.45326
## 2018 108.08017 108.44118 108.80220 109.14136 109.48051 109.86354 110.24656
## 2019 110.70691 110.59325 110.47960 110.42610 110.37260 110.45804 110.54347
## 2020 111.85954 112.14517 112.43080
## Aug Sep Oct Nov Dec
## 2005 75.03686 75.27758 75.23590 75.19422 74.90368
## 2006 76.40581 76.60302 76.86248 77.12195 77.58061
## 2007 78.11149 78.45392 78.47315 78.49238 78.18069
## 2008 79.89517 80.08998 80.41892 80.74785 81.14048
## 2009 81.35188 81.66990 81.94714 82.22437 82.43579
## 2010 83.14155 83.04375 83.23502 83.42628 83.91310
## 2011 90.49701 91.57205 92.43016 93.28827 93.89096
## 2012 94.08249 93.78053 93.80039 93.82025 93.90195
## 2013 95.46807 95.56154 95.69965 95.83776 96.14427
## 2014 100.38040 100.89036 101.19165 101.49295 101.57585
## 2015 100.76439 100.74673 100.92282 101.09892 101.44890
## 2016 104.22252 104.54863 104.78791 105.02720 105.16235
## 2017 106.59258 106.73189 107.00444 107.27698 107.67857
## 2018 110.53624 110.82591 110.88183 110.93775 110.82233
## 2019 110.74217 110.94086 111.15347 111.36608 111.61281
## 2020
4 - Calculo de tasas
library(dplyr)
## Warning: package 'dplyr' was built under R version 3.5.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(zoo)
## Warning: package 'zoo' was built under R version 3.5.3
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
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
## Apr 2019 110.4261 -0.04842095 1.1771385 2.8907621 0.2449809 NA
## May 2019 110.3726 -0.04844441 0.8148408 2.6891184 0.3860980 NA
## Jun 2019 110.4580 0.07740472 0.5411274 2.4499655 0.7132847 NA
## Jul 2019 110.5435 0.07734485 0.2693158 2.1737235 1.0411536 NA
## Aug 2019 110.7422 0.17974307 0.1863017 1.8803528 1.4032655 NA
## Sep 2019 110.9409 0.17942057 0.1037215 1.5701096 1.7661224 NA
## Oct 2019 111.1535 0.19164284 0.2449809 1.2904817 NA NA
## Nov 2019 111.3661 0.19127627 0.3860980 1.0410600 NA NA
## Dec 2019 111.6128 0.22154644 0.7132847 0.8600359 NA NA
## Jan 2020 111.8595 0.22105670 1.0411536 0.7467082 NA NA
## Feb 2020 112.1452 0.25534887 1.4032655 0.7001249 NA NA
## Mar 2020 112.4308 0.25469850 1.7661224 0.7199105 NA 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()
Analisis de resultados
Prevision que se tiene como resultado del analisis de coyuntura del componente
###segun los resultados obetinos de los datos provenientes de actividades profesionales, cientificas, tecnicas, administrativas, de apoyo y otros servicios arroja que dicho crecimiento ha presentado un crecimiento ciclico en el periodo de 2005 al 2019, sin embargo presento una caida para el año 2013, sin embargo para este ultimo periodo se prevee que el sector presente un crecimiento