Actividad 2. Generación de escenarios futuros con modelos de pronósticos en series de tiempo

INSTALAR Y CARGAR LIBRERIAS

# install.packages("forecast")   # solo la primera vez
library(forecast)

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

1. CARGAR DATOS (Ventas Hershey)

ventas_hershey <- c(
  25520.51,23740.11,26253.58,25868.43,27072.87,27150.50,
  27067.10,28145.25,27546.29,28400.37,27441.98,27852.47,
  28463.69,26996.11,29768.20,29292.51,29950.68,30099.17,
  30851.26,32271.76,31940.74,32995.93,32197.12,31984.82,
  32496.44,31287.28,33376.02,32949.77,34004.11,33757.89,
  32927.30,34324.12,35151.28,36133.07,34799.91,34846.17
)

2. CREAR SERIE DE TIEMPO (MENSUAL)

serie <- ts(ventas_hershey, start=c(2017,1), frequency=12)

# Visualizar serie
plot(serie, main="Ventas Leche Saborizada Hershey", col="blue")

3. ANALISIS EXPLORATORIO

# Descomposición para ver tendencia y estacionalidad
decomp <- decompose(serie)
plot(decomp)

4. MODELO ARIMA (BOX-JENKINS)

modelo_arima <- auto.arima(serie)

modelo_arima

## Series: serie 
## ARIMA(1,0,0)(1,1,0)[12] with drift 
## 
## Coefficients:
##          ar1     sar1     drift
##       0.6383  -0.5517  288.8980
## s.e.  0.1551   0.2047   14.5026
## 
## sigma^2 = 202700:  log likelihood = -181.5
## AIC=371   AICc=373.11   BIC=375.72

summary(modelo_arima)

## Series: serie 
## ARIMA(1,0,0)(1,1,0)[12] with drift 
## 
## Coefficients:
##          ar1     sar1     drift
##       0.6383  -0.5517  288.8980
## s.e.  0.1551   0.2047   14.5026
## 
## sigma^2 = 202700:  log likelihood = -181.5
## AIC=371   AICc=373.11   BIC=375.72
## 
## Training set error measures:
##                    ME    RMSE      MAE        MPE      MAPE       MASE
## Training set 25.22163 343.863 227.1699 0.08059942 0.7069541 0.06491041
##                   ACF1
## Training set 0.2081043

5. VALIDACION DEL MODELO (RESIDUALES)

checkresiduals(modelo_arima)

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(1,0,0)(1,1,0)[12] with drift
## Q* = 12.545, df = 5, p-value = 0.02804
## 
## Model df: 2.   Total lags used: 7

6. PRONOSTICO (SIGUIENTE AÑO = 12 MESES)

pronostico <- forecast(modelo_arima, h=12, level=95)

pronostico

##          Point Forecast    Lo 95    Hi 95
## Jan 2020       35498.90 34616.48 36381.32
## Feb 2020       34202.17 33155.29 35249.05
## Mar 2020       36703.01 35596.10 37809.92
## Apr 2020       36271.90 35141.44 37402.36
## May 2020       37121.98 35982.07 38261.90
## Jun 2020       37102.65 35958.91 38246.40
## Jul 2020       37151.04 36005.74 38296.35
## Aug 2020       38564.65 37418.71 39710.59
## Sep 2020       38755.23 37609.03 39901.42
## Oct 2020       39779.03 38632.73 40925.33
## Nov 2020       38741.63 37595.29 39887.97
## Dec 2020       38645.86 37499.50 39792.22

plot(pronostico, main="Pronóstico Ventas Hershey")

7. PROYECCIÓN ANUAL VENTAS (Modelo SARIMA)

total_anual <- sum(as.numeric(pronostico$mean))

total_anual

## [1] 448538.1

8. MODELO DE REGRESION (Comparación)

# Crear variable tiempo
t <- 1:length(serie)

modelo_regresion <- lm(serie ~ t)

summary(modelo_regresion)

## 
## Call:
## lm(formula = serie ~ t)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2075.79  -326.41    33.74   458.41  1537.04 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 24894.67     275.03   90.52   <2e-16 ***
## t             298.37      12.96   23.02   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 808 on 34 degrees of freedom
## Multiple R-squared:  0.9397, Adjusted R-squared:  0.9379 
## F-statistic: 529.8 on 1 and 34 DF,  p-value: < 2.2e-16

9. COMPARAR EXACTITUD (ARIMA vs REGRESION)

accuracy(modelo_arima)

##                    ME    RMSE      MAE        MPE      MAPE       MASE
## Training set 25.22163 343.863 227.1699 0.08059942 0.7069541 0.06491041
##                   ACF1
## Training set 0.2081043

accuracy(modelo_regresion)

##              ME     RMSE      MAE         MPE     MAPE      MASE
## Training set  0 785.1913 599.6134 -0.07414447 2.011298 0.2123252

10. ESCENARIOS FUTUROS

# Escenario esperado
escenario_A <- pronostico$mean

# Escenario optimista (intervalo superior)
escenario_B <- pronostico$upper

# Escenario pesimista (intervalo inferior)
escenario_C <- pronostico$lower

escenario_A

##           Jan      Feb      Mar      Apr      May      Jun      Jul      Aug
## 2020 35498.90 34202.17 36703.01 36271.90 37121.98 37102.65 37151.04 38564.65
##           Sep      Oct      Nov      Dec
## 2020 38755.23 39779.03 38741.63 38645.86

escenario_B

##           Jan      Feb      Mar      Apr      May      Jun      Jul      Aug
## 2020 36381.32 35249.05 37809.92 37402.36 38261.90 38246.40 38296.35 39710.59
##           Sep      Oct      Nov      Dec
## 2020 39901.42 40925.33 39887.97 39792.22

escenario_C

##           Jan      Feb      Mar      Apr      May      Jun      Jul      Aug
## 2020 34616.48 33155.29 35596.10 35141.44 35982.07 35958.91 36005.74 37418.71
##           Sep      Oct      Nov      Dec
## 2020 37609.03 38632.73 37595.29 37499.50