Ejercicios de pronóstico

UNIVERSIDAD DE EL SALVADOR FACULTAD DE CIENCIAS ECONÓMICAS ESCUELA DE ECONOMÍA ECONOMETRÍA I CICLO I-2024
GT03

“Ejericio de pronósticos.”

Nombre	Cárne	Participación
Gabriel Arturo Sánchez Henríquez	SH22002	100%

DOCENTE:
Carlos Ademir Pérez Alas

Ciudad Universitaria, San Salvador, 20 de julio del 2024

PIB TRIMESTRAL

Se cargan los datos

library(readxl)
PIB_trim <- read_excel("C:/Users/SANCHEZ/Desktop/GABRIEL2021/Universidad/Ciclo V/Econometria/tablePIB.xls.xlsx", 
    sheet = "Table", col_types = c("skip", 
        "numeric"), skip = 5)
names(PIB_trim)<-c("PIB_trim")

Se convierte en serie temporal

PIB_trim.ts<-ts(data = PIB_trim$PIB_trim,start = c(2009,1),frequency = 4) |> print()

##         Qtr1    Qtr2    Qtr3    Qtr4
## 2009 4227.33 4436.39 4312.85 4625.05
## 2010 4375.00 4579.71 4498.45 4994.77
## 2011 4727.87 5163.09 5032.40 5360.43
## 2012 5176.52 5401.29 5225.97 5582.38
## 2013 5208.33 5550.62 5428.02 5803.99
## 2014 5434.08 5701.62 5589.75 5868.02
## 2015 5617.57 5870.22 5828.24 6122.21
## 2016 5695.11 6181.81 5962.28 6352.22
## 2017 5934.20 6271.01 6150.91 6623.07
## 2018 6159.12 6529.22 6480.41 6852.10
## 2019 6401.11 6713.27 6691.85 7074.90
## 2020 6462.10 5378.00 6118.58 6962.52
## 2021 6736.65 7203.03 7236.93 7866.54

Calculo de forma automatica

library(forecast)
library(TSstudio)
PIB_trim.arima.automatico<-auto.arima(y = PIB_trim.ts)
summary(PIB_trim.arima.automatico)

## Series: PIB_trim.ts 
## ARIMA(1,0,0)(2,1,0)[4] with drift 
## 
## Coefficients:
##          ar1     sar1     sar2    drift
##       0.5874  -0.8878  -0.3696  53.5077
## s.e.  0.1216   0.1435   0.2155   9.6501
## 
## sigma^2 = 62491:  log likelihood = -332.83
## AIC=675.66   AICc=677.09   BIC=685.02
## 
## Training set error measures:
##                    ME     RMSE      MAE        MPE     MAPE      MASE
## Training set 1.201582 229.9509 105.3609 -0.0516886 1.814615 0.3266292
##                    ACF1
## Training set 0.04733266

Pronóstico automático

library(forecast)
#tabla
pronostico.arima.automatico<-forecast(object = PIB_trim.arima.automatico,h = 4,level = c(.95)) |> print()

##         Point Forecast    Lo 95    Hi 95
## 2022 Q1       7190.474 6700.516 7680.431
## 2022 Q2       6698.563 6130.341 7266.786
## 2022 Q3       7020.812 6427.981 7613.642
## 2022 Q4       7636.634 7035.547 8237.721

#Grafico
PIB_trim.arima.automatico |> forecast(h = 4,level = c(.95)) |> autoplot()

Calculo de forma manual

library(kableExtra)
d<-ndiffs(PIB_trim.ts)
D<-nsdiffs(PIB_trim.ts)
ordenes_integracion<-c(d,D)
names(ordenes_integracion)<-c("d","D")
ordenes_integracion %>% kable(caption = "Ordenes de Integración")  |>  kable_material()

Ordenes de Integración
	x
d	1
D	1

library(TSstudio)
PIB_trim.ts_diff<-PIB_trim.ts |>  
  diff(lag = 4,diffences=D) |> 
  diff(diffences=d)
PIB_trim.ts_diff |> 
  ts_cor(lag.max = 3*4)

library(forecast)
PIB_trim.arima.manual<-Arima(y = PIB_trim.ts,order = c(0,1,0), seasonal = c(2,1,0)) |> print()

## Series: PIB_trim.ts 
## ARIMA(0,1,0)(2,1,0)[4] 
## 
## Coefficients:
##          sar1     sar2
##       -0.8752  -0.3604
## s.e.   0.1439   0.2166
## 
## sigma^2 = 75962:  log likelihood = -331.39
## AIC=668.77   AICc=669.33   BIC=674.32

Pronóstico manual

library(forecast)

#Tabla

pronostico.arima.manual<-forecast(object = PIB_trim.arima.manual,h = 4,level = c(0.95)) |> print()

##         Point Forecast    Lo 95    Hi 95
## 2022 Q1       7360.342 6820.153 7900.532
## 2022 Q2       6972.921 6208.978 7736.865
## 2022 Q3       7350.701 6415.065 8286.337
## 2022 Q4       8001.800 6921.421 9082.180

#Gráfica

PIB_trim.arima.manual |> forecast(h = 4,level = c(.95)) |> autoplot()

Calculo de Pronóstico modelo Holt-Winters

library(forecast)

#Estimar el modelo
ModeloHW<-HoltWinters(x = PIB_trim.ts,
                      seasonal = "multiplicative",
                      optim.start = c(0.9,0.9,0.9))
ModeloHW

## Holt-Winters exponential smoothing with trend and multiplicative seasonal component.
## 
## Call:
## HoltWinters(x = PIB_trim.ts, seasonal = "multiplicative", optim.start = c(0.9,     0.9, 0.9))
## 
## Smoothing parameters:
##  alpha: 0.824158
##  beta : 0
##  gamma: 0
## 
## Coefficients:
##            [,1]
## a  7531.9276190
## b    48.1826250
## s1    0.9754034
## s2    1.0055201
## s3    0.9784087
## s4    1.0406678

#Generar el pronóstico:
PronosticosHW<-forecast(object = ModeloHW,h = 4,level = c(0.95))
PronosticosHW

##         Point Forecast    Lo 95    Hi 95
## 2022 Q1       7393.665 6979.857 7807.474
## 2022 Q2       7670.402 7076.084 8264.719
## 2022 Q3       7510.730 6799.632 8221.828
## 2022 Q4       8038.803 7282.403 8795.203

#Gráfico de la serie original y del pronóstico.
PronosticosHW %>% autoplot()

Validación cruzada

library(forecast)
library(dplyr)
library(tsibble)
library(fable)
library(fabletools)
PIB<-PIB_trim.ts%>% as_tsibble() %>% rename(PIB_trim=value)
data.cross.validation<-PIB %>% 
  as_tsibble() %>% 
  stretch_tsibble(.init = 40,.step = 1)
TSCV<-data.cross.validation %>% 
model(ARIMA(PIB_trim ~ pdq(0, 1, 0) + PDQ(2, 1, 0))) %>% 
forecast(h=1) %>% accuracy(PIB)

print(TSCV)

## # A tibble: 1 × 10
##   .model                 .type    ME  RMSE   MAE   MPE  MAPE  MASE RMSSE    ACF1
##   <chr>                  <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>   <dbl>
## 1 ARIMA(PIB_trim ~ pdq(… Test   108.  603.  401.  1.11  6.36  1.24  1.30 -0.0245

El MAPE es de 6.3 lo cual no es óptimo pero si aceptable

IPC General de El Salvador

Se cargan los datos

library(readxl)
IPC_month <- read_excel("C:/Users/SANCHEZ/Desktop/GABRIEL2021/Universidad/Ciclo V/Econometria/tableIPC.xls.xlsx", 
    sheet = "Table", col_types = c("skip", 
        "numeric"), skip = 5)
names(IPC_month)<-c("IPC_month")

Se convierte en serie temporal

IPC_month.ts<-ts(data = IPC_month$IPC_month,start = c(2009,1),frequency = 12) |> print()

##         Jan    Feb    Mar    Apr    May    Jun    Jul    Aug    Sep    Oct
## 2009  99.65  99.53 100.00 100.08 100.36 100.40  99.99  99.79  99.73  99.03
## 2010 100.44 100.57 100.89 100.71 100.50 100.96 100.98 100.81 101.11 101.78
## 2011 102.77 102.96 103.63 106.71 107.23 107.29 107.57 107.69 107.40 107.32
## 2012 107.65 108.00 108.16 108.83 108.53 107.94 107.61 107.80 108.24 108.33
## 2013 108.59 109.05 109.54 108.85 108.69 108.91 108.78 108.87 109.06 108.91
## 2014 109.51 109.72 109.99 109.47 109.72 110.15 110.77 111.04 110.91 110.97
## 2015 108.69 108.56 109.10 109.11 109.33 109.24 109.16 108.82 108.41 110.76
## 2016 110.67 110.37 110.32 110.05 110.13 110.24 110.12 109.85 109.51 109.79
## 2017 110.39 110.69 110.92 111.00 111.19 111.26 111.24 111.10 111.22 111.36
## 2018 111.96 112.05 111.93 111.97 112.11 112.26 112.42 112.71 112.76 113.02
## 2019 112.24 112.44 112.69 112.87 113.01 112.85 112.56 112.16 111.99 112.04
## 2020 112.15 112.00 112.09 111.69 111.94 112.59 112.49 111.82 111.56 111.81
## 2021 112.49 113.19 114.08 114.81 114.84 115.51 116.36 116.63 117.10 117.95
## 2022 119.79 120.73 121.71 122.32 123.43                                   
##         Nov    Dec
## 2009 100.41 100.00
## 2010 102.24 102.13
## 2011 107.48 107.29
## 2012 108.18 108.13
## 2013 109.00 108.98
## 2014 110.40 109.50
## 2015 110.69 110.61
## 2016 109.78 109.58
## 2017 111.62 111.81
## 2018 112.82 112.30
## 2019 112.17 112.29
## 2020 111.98 112.20
## 2021 118.92 119.06
## 2022

Calculo de forma automatica

library(forecast)
library(TSstudio)
IPC_month.arima.automatico<-auto.arima(y = IPC_month.ts)
summary(IPC_month.arima.automatico)

## Series: IPC_month.ts 
## ARIMA(0,1,1)(1,0,0)[12] with drift 
## 
## Coefficients:
##          ma1    sar1   drift
##       0.2321  0.1481  0.1557
## s.e.  0.0758  0.0861  0.0526
## 
## sigma^2 = 0.2203:  log likelihood = -104.62
## AIC=217.24   AICc=217.5   BIC=229.54
## 
## Training set error measures:
##                       ME      RMSE       MAE           MPE      MAPE    MASE
## Training set 0.001979736 0.4634631 0.3022345 -0.0008175962 0.2770172 0.16378
##                    ACF1
## Training set 0.01394664

Pronóstico automático

library(forecast)
#tabla
pronostico.arima.automatico<-forecast(object = IPC_month.arima.automatico,h = 4,level = c(.95)) |> print()

##          Point Forecast    Lo 95    Hi 95
## Jun 2022       123.8751 122.9552 124.7950
## Jul 2022       124.1337 122.6740 125.5933
## Aug 2022       124.3063 122.4583 126.1543
## Sep 2022       124.5086 122.3408 126.6765

#Grafico
IPC_month.arima.automatico |> forecast(h = 4,level = c(.95)) |> autoplot()

Calculo de forma manual

library(kableExtra)
d<-ndiffs(IPC_month.ts)
D<-nsdiffs(IPC_month.ts)
ordenes_integracion<-c(d,D)
names(ordenes_integracion)<-c("d","D")
ordenes_integracion %>% kable(caption = "Ordenes de Integración")  |>  kable_material()

Ordenes de Integración
	x
d	1
D	0

library(TSstudio)
IPC_month.ts_diff<-IPC_month.ts |>  
  diff(lag = 12,diffences=D) |> 
  diff(diffences=d)
IPC_month.ts_diff |> 
  ts_cor(lag.max = 3*12)

library(forecast)
IPC_month.arima.manual<-Arima(y = IPC_month.ts,order = c(1,1,0), seasonal = c(2,0,0)) |> print()

## Series: IPC_month.ts 
## ARIMA(1,1,0)(2,0,0)[12] 
## 
## Coefficients:
##          ar1    sar1     sar2
##       0.3146  0.2095  -0.1037
## s.e.  0.0765  0.0864   0.0870
## 
## sigma^2 = 0.2257:  log likelihood = -106.8
## AIC=221.59   AICc=221.85   BIC=233.89

Pronóstico manual

library(forecast)

#Tabla

pronostico.arima.manual<-forecast(object = IPC_month.arima.manual,h = 7,level = c(0.95)) |> print()

##          Point Forecast    Lo 95    Hi 95
## Jun 2022       123.8583 122.9273 124.7894
## Jul 2022       124.1586 122.6207 125.6964
## Aug 2022       124.3198 122.2956 126.3439
## Sep 2022       124.4562 122.0260 126.8865
## Oct 2022       124.6119 121.8297 127.3940
## Nov 2022       124.7985 121.7031 127.8940
## Dec 2022       124.8054 121.4252 128.1856

#Gráfica

IPC_month.arima.manual |> forecast(h = 7,level = c(.95)) |> autoplot()

Calculo de Pronóstico modelo Holt-Winters

library(forecast)

#Estimar el modelo
ModeloHW<-HoltWinters(x = IPC_month.ts,
                      seasonal = "multiplicative",
                      optim.start = c(0.9,0.9,0.9))
ModeloHW

## Holt-Winters exponential smoothing with trend and multiplicative seasonal component.
## 
## Call:
## HoltWinters(x = IPC_month.ts, seasonal = "multiplicative", optim.start = c(0.9,     0.9, 0.9))
## 
## Smoothing parameters:
##  alpha: 0.8353873
##  beta : 0.07612657
##  gamma: 1
## 
## Coefficients:
##            [,1]
## a   122.7690242
## b     0.4801476
## s1    1.0043291
## s2    1.0021040
## s3    0.9986014
## s4    0.9975846
## s5    0.9989586
## s6    0.9984650
## s7    0.9959074
## s8    0.9975598
## s9    1.0007205
## s10   1.0041558
## s11   1.0048925
## s12   1.0053839

#Generar el pronóstico:
PronosticosHW<-forecast(object = ModeloHW,h = 7,level = c(0.95))
PronosticosHW

##          Point Forecast    Lo 95    Hi 95
## Jun 2022       123.7827 122.6365 124.9289
## Jul 2022       123.9896 122.4499 125.5294
## Aug 2022       124.0357 122.1459 125.9256
## Sep 2022       124.3884 122.1648 126.6120
## Oct 2022       125.0394 122.4870 127.5918
## Nov 2022       125.4570 122.5842 128.3298
## Dec 2022       125.6139 122.4280 128.7997

#Gráfico de la serie original y del pronóstico.
PronosticosHW %>% autoplot()

Validación cruzada

library(forecast)
library(dplyr)
library(tsibble)
library(fable)
library(fabletools)
IPC<-IPC_month.ts%>% as_tsibble() %>% rename(IPC_month=value)
data.cross.validation<-IPC %>% 
  as_tsibble() %>% 
  stretch_tsibble(.init = 40,.step = 1)
TSCV<-data.cross.validation %>% 
model(ARIMA(IPC_month ~ pdq(0,1,1) + PDQ(1,0,0))) %>% 
forecast(h=1) %>% accuracy(IPC)

print(TSCV)

## # A tibble: 1 × 10
##   .model              .type      ME  RMSE   MAE      MPE  MAPE  MASE RMSSE  ACF1
##   <chr>               <chr>   <dbl> <dbl> <dbl>    <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 ARIMA(IPC_month ~ … Test  0.00319 0.424 0.292 -0.00139 0.261 0.158 0.156 0.206

Con un error del 0.261% se tiene que el modelo posee un buen poder predictivo

IMPORTACION DE HIDROCARBUROS MENSUAL

Se cargan los datos

library(readxl)
Impor_month <- read_excel("C:/Users/SANCHEZ/Desktop/GABRIEL2021/Universidad/Ciclo V/Econometria/tableHidroc.xls.xlsx", 
    sheet = "Table", col_types = c("skip", 
        "numeric"), skip = 5)
names(Impor_month)<-c("Impor_month")

Se convierte en serie temporal

Impor_month.ts<-ts(data = Impor_month$Impor_month,start = c(2017,1),frequency = 12) |> print()

##            Jan       Feb       Mar       Apr       May       Jun       Jul
## 2017 245281.10 173399.96 233320.45 220284.95 203655.71 275330.95 176511.44
## 2018 176860.00 208040.00 241980.00 267580.00 211080.00 202470.00 199160.00
## 2019 244220.00 172590.00 227640.00 232750.00 268910.00 214990.00 228650.00
## 2020 209088.61 192750.84 232738.11 212858.25  97575.83 175258.65 190317.69
## 2021 239938.21 190943.14 252235.78 175849.15 211409.80 275893.64 238569.80
## 2022 207025.43 258770.90 288743.53 284014.55 171331.42                    
##            Aug       Sep       Oct       Nov       Dec
## 2017 181637.97 181178.43 162342.83 273551.34 159754.63
## 2018 229540.00 219830.00 246640.00 206880.00 220810.00
## 2019 228580.00 198920.00 236590.00 233050.00 231570.00
## 2020 134017.33 187064.26 161027.78 221739.41 185403.23
## 2021 196986.17 207613.25 227286.37 225971.47 280510.69
## 2022

Calculo de forma automatica

library(forecast)
library(TSstudio)
Impor_month.arima.automatico<-auto.arima(y = Impor_month.ts)
summary(Impor_month.arima.automatico)

## Series: Impor_month.ts 
## ARIMA(0,0,0)(1,0,0)[12] with non-zero mean 
## 
## Coefficients:
##          sar1        mean
##       -0.2204  214330.441
## s.e.   0.1437    3836.624
## 
## sigma^2 = 1.362e+09:  log likelihood = -775.07
## AIC=1556.14   AICc=1556.53   BIC=1562.66
## 
## Training set error measures:
##                     ME     RMSE      MAE     MPE     MAPE      MASE       ACF1
## Training set -258.2539 36337.82 29355.11 -3.5468 14.88772 0.6657831 0.08935384

Pronóstico automático

library(forecast)
#tabla
pronostico.arima.automatico<-forecast(object = Impor_month.arima.automatico,h = 4,level = c(.95)) |> print()

##          Point Forecast    Lo 95    Hi 95
## Jun 2022       200759.5 128417.0 273101.9
## Jul 2022       208987.1 136644.6 281329.6
## Aug 2022       218153.8 145811.3 290496.3
## Sep 2022       215811.2 143468.7 288153.7

#Grafico
Impor_month.arima.automatico |> forecast(h = 12,level = c(.95)) |> autoplot()

Calculo de forma manual

library(kableExtra)
d<-ndiffs(Impor_month.ts)
D<-nsdiffs(Impor_month.ts)
ordenes_integracion<-c(d,D)
names(ordenes_integracion)<-c("d","D")
ordenes_integracion %>% kable(caption = "Ordenes de Integración")  |>  kable_material()

Ordenes de Integración
	x
d	0
D	0

library(TSstudio)
Impor_month.ts_diff<-Impor_month.ts |>  
  diff(lag = 12,diffences=D) |> 
  diff(diffences=d)
Impor_month.ts_diff |> 
  ts_cor(lag.max = 3*12)

library(forecast)
Impor_month.arima.manual<-Arima(y = Impor_month.ts,order = c(0,0,0), seasonal = c(1,0,0)) |> print()

## Series: Impor_month.ts 
## ARIMA(0,0,0)(1,0,0)[12] with non-zero mean 
## 
## Coefficients:
##          sar1        mean
##       -0.2204  214330.441
## s.e.   0.1437    3836.624
## 
## sigma^2 = 1.362e+09:  log likelihood = -775.07
## AIC=1556.14   AICc=1556.53   BIC=1562.66

Pronóstico manual

library(forecast)

#Tabla

pronostico.arima.manual<-forecast(object = Impor_month.arima.manual,h = 12,level = c(0.95)) |> print()

##          Point Forecast    Lo 95    Hi 95
## Jun 2022       200759.5 128417.0 273101.9
## Jul 2022       208987.1 136644.6 281329.6
## Aug 2022       218153.8 145811.3 290496.3
## Sep 2022       215811.2 143468.7 288153.7
## Oct 2022       211474.4 139132.0 283816.9
## Nov 2022       211764.3 139421.8 284106.8
## Dec 2022       199741.7 127399.2 272084.2
## Jan 2023       215940.8 143598.3 288283.2
## Feb 2023       204534.0 132191.5 276876.5
## Mar 2023       197926.8 125584.4 270269.3
## Apr 2023       198969.3 126626.8 271311.8
## May 2023       223809.1 151466.7 296151.6

#Gráfica

Impor_month.arima.manual |> forecast(h = 12,level = c(.95)) |> autoplot()

Calculo de Pronóstico modelo Holt-Winters

library(forecast)

#Estimar el modelo
ModeloHW<-HoltWinters(x = Impor_month.ts,
                      seasonal = "multiplicative",
                      optim.start = c(0.9,0.9,0.9))
ModeloHW

## Holt-Winters exponential smoothing with trend and multiplicative seasonal component.
## 
## Call:
## HoltWinters(x = Impor_month.ts, seasonal = "multiplicative",     optim.start = c(0.9, 0.9, 0.9))
## 
## Smoothing parameters:
##  alpha: 0.1429275
##  beta : 0
##  gamma: 0.4446265
## 
## Coefficients:
##             [,1]
## a   2.521978e+05
## b   1.239453e+03
## s1  1.031430e+00
## s2  9.655959e-01
## s3  8.373676e-01
## s4  8.997235e-01
## s5  9.154143e-01
## s6  1.034878e+00
## s7  1.012064e+00
## s8  9.427592e-01
## s9  9.466304e-01
## s10 1.117844e+00
## s11 1.021463e+00
## s12 7.895019e-01

#Generar el pronóstico:
PronosticosHW<-forecast(object = ModeloHW,h = 7,level = c(0.95))
PronosticosHW

##          Point Forecast    Lo 95    Hi 95
## Jun 2022       261402.7 215838.4 306967.1
## Jul 2022       245914.8 198888.4 292941.2
## Aug 2022       214295.9 166399.4 262192.4
## Sep 2022       231369.0 181308.4 281429.6
## Oct 2022       236538.6 184759.4 288317.8
## Nov 2022       268690.0 213493.2 323886.9
## Dec 2022       264021.2 207877.7 320164.8

#Gráfico de la serie original y del pronóstico.
PronosticosHW %>% autoplot()

Validación cruzada

library(forecast)
library(dplyr)
library(tsibble)
library(fable)
library(fabletools)
Impor<-Impor_month.ts%>% as_tsibble() %>% rename(Impor_month=value)
data.cross.validation<-Impor %>% 
  as_tsibble() %>% 
  stretch_tsibble(.init = 40,.step = 1)
TSCV<-data.cross.validation %>% 
model(ARIMA(Impor_month ~ pdq(0, 0, 0) + PDQ(0, 0, 1))) %>% 
forecast(h=1) %>% accuracy(Impor)

print(TSCV)

## # A tibble: 1 × 10
##   .model                .type     ME   RMSE    MAE   MPE  MAPE  MASE RMSSE  ACF1
##   <chr>                 <chr>  <dbl>  <dbl>  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 ARIMA(Impor_month ~ … Test  -2192. 47068. 39108. -7.20  21.1 0.887 0.847 0.225

Con un eror porcentual del 21.13% se tiene que el modelo no posee un buen poder predictivo.