#Librerias
library(readr)
library(forecast)
## Warning: package 'forecast' was built under R version 4.3.2
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(finreportr)
## Warning: package 'finreportr' was built under R version 4.3.2
library(dplyr)
## 
## 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(readxl)

Actividad 1

Crear la serie de tiempo

Ejemplo: Los siguientes datos de produccion trimestral inician en el primer trimestre del 2020.

Se busca pronosticar la producción de los siguientes 5 trimestres.

produccion <- c(50,53,55,57,55,60)
ts <- ts(data= produccion, start= c(2020,3),frequency = 4)
ts 
##      Qtr1 Qtr2 Qtr3 Qtr4
## 2020             50   53
## 2021   55   57   55   60

Crear un modelo ARIMA

ARIMA significa Autoregressive Integraded moving average o Modelo Autorregresivo integrado de promedio movil.

arima <- auto.arima(ts, D=1)

summary(arima)
## Series: ts 
## ARIMA(0,0,0)(0,1,0)[4] with drift 
## 
## Coefficients:
##        drift
##       1.5000
## s.e.  0.1768
## 
## sigma^2 = 2.01:  log likelihood = -2.84
## AIC=9.68   AICc=-2.32   BIC=7.06
## 
## Training set error measures:
##                      ME      RMSE       MAE        MPE      MAPE       MASE
## Training set 0.03333332 0.5787923 0.3666667 0.03685269 0.6429133 0.06111111
##                    ACF1
## Training set -0.5073047

Generar el pronóstico

pronostico <- forecast(arima,level=c(95), h=5)
pronostico
##         Point Forecast    Lo 95    Hi 95
## 2022 Q1             61 58.22127 63.77873
## 2022 Q2             63 60.22127 65.77873
## 2022 Q3             61 58.22127 63.77873
## 2022 Q4             66 63.22127 68.77873
## 2023 Q1             67 63.07028 70.92972
plot(pronostico)

Actividad 2 - Hershey’s

Hershey’s México empresa chocolatera con más de 100 años de historia a nivel global (fundación 1903) y establecida en México desde 1969, como una de confitería entre Hershey Food Corporation y Anderson Clayton & Co. S.A. formando Nacional de Dulces S.A. de C.V. en el Distrito Federal y después de 12 años cambiando sus instalaciones a El Salto, Jalisco e iniciando operaciones en el mes de febrero de 1981.

Datos proporcionados: Ventas históricas de leche saborizada Hershey México (Miles de dólares) mensuales del 2017 al 2019.

Importar base de datos

lechitas <- read_excel("E:/TRABAJO/2024/Ventas_Históricas_Lechitas.xlsx")
ts1 <- ts(data = lechitas$Ventas, start=c(2017,1),frequency = 12)
ts1
##           Jan      Feb      Mar      Apr      May      Jun      Jul      Aug
## 2017 25520.51 23740.11 26253.58 25868.43 27072.87 27150.50 27067.10 28145.25
## 2018 28463.69 26996.11 29768.20 29292.51 29950.68 30099.17 30851.26 32271.76
## 2019 32496.44 31287.28 33376.02 32949.77 34004.11 33757.89 32927.30 34324.12
##           Sep      Oct      Nov      Dec
## 2017 27546.29 28400.37 27441.98 27852.47
## 2018 31940.74 32995.93 32197.12 31984.82
## 2019 35151.28 36133.07 34799.91 34846.17

Crear un modelo ARIMA

arima2 <- auto.arima(ts1, D=1)
summary(arima2)
## Series: ts1 
## ARIMA(1,0,0)(1,1,0)[12] with drift 
## 
## Coefficients:
##          ar1     sar1     drift
##       0.6383  -0.5517  288.8979
## s.e.  0.1551   0.2047   14.5026
## 
## sigma^2 = 202701:  log likelihood = -181.5
## AIC=371   AICc=373.11   BIC=375.72
## 
## Training set error measures:
##                    ME    RMSE    MAE        MPE      MAPE       MASE      ACF1
## Training set 25.22158 343.864 227.17 0.08059932 0.7069542 0.06491044 0.2081026

Generar el pronóstico

pronostico2 <- forecast(arima2,level=c(95), h=12)
pronostico2
##          Point Forecast    Lo 95    Hi 95
## Jan 2020       35498.90 34616.48 36381.32
## Feb 2020       34202.17 33155.28 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.90 38246.40
## Jul 2020       37151.04 36005.73 38296.34
## Aug 2020       38564.64 37418.70 39710.58
## Sep 2020       38755.22 37609.03 39901.42
## Oct 2020       39779.02 38632.72 40925.32
## Nov 2020       38741.63 37595.28 39887.97
## Dec 2020       38645.86 37499.50 39792.22
plot(pronostico2)

Preguntas a responder

1.- Utilizando modelos ARIMA (Box-Jenkins, ARMA, SARIMA) y los datos históricos de las ventas de leche saborizada ¿Cuál es el modelo que mejor se adapta a la serie?

El mejor modelo ARIMA para la serie de ventas de leche saborizada, según los resultados proporcionados, es ARIMA(1,0,0)(1,1,0)[12] con drift. Este modelo tiene coeficientes significativos para el componente autoregresivo (AR), el componente estacional autoregresivo (SAR), y también incluye un término de deriva (drift).

2.- ¿Qué modelo de regresión ofrece mejor exactitud predictiva?

library(lmtest)
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
library(ggplot2)

# Crear un dataframe con la serie de tiempo
data_df <- data.frame(Mes = time(ts1), Ventas = as.vector(ts1))

# Modelo de regresión lineal simple
model_linear <- lm(Ventas ~ Mes, data = data_df)

# Modelo de regresión lineal con términos polinómicos (grado 2)
model_polynomial <- lm(Ventas ~ poly(Mes, 2), data = data_df)

# Comparar los modelos utilizando el test de Breusch-Godfrey (prueba de autocorrelación)
linear_test <- bgtest(model_linear, order = 12)  # order=12 para considerar la estacionalidad mensual
poly_test <- bgtest(model_polynomial, order = 12)

# Imprimir los resultados de las pruebas
print("Prueba de Breusch-Godfrey para modelo lineal:")
## [1] "Prueba de Breusch-Godfrey para modelo lineal:"
print(linear_test)
## 
##  Breusch-Godfrey test for serial correlation of order up to 12
## 
## data:  model_linear
## LM test = 17.95, df = 12, p-value = 0.1172
print("Prueba de Breusch-Godfrey para modelo polinómico:")
## [1] "Prueba de Breusch-Godfrey para modelo polinómico:"
print(poly_test)
## 
##  Breusch-Godfrey test for serial correlation of order up to 12
## 
## data:  model_polynomial
## LM test = 18.82, df = 12, p-value = 0.09296
# Graficar las predicciones de ambos modelos
ggplot(data_df, aes(x = Mes, y = Ventas)) +
  geom_line(aes(y = fitted(model_linear), color = "Linear"), linetype = "dashed") +
  geom_line(aes(y = fitted(model_polynomial), color = "Polynomial"), linetype = "dashed") +
  geom_line(linetype = "solid") +
  labs(title = "Comparación de Modelos de Regresión",
       x = "Mes",
       y = "Ventas") +
  scale_color_manual(values = c("Linear" = "blue", "Polynomial" = "red"))
## Don't know how to automatically pick scale for object of type <ts>. Defaulting
## to continuous.

Podemos observar que el mejor modelo de regresión es el lineal

3.-Según su mejor modelo ¿Cuál es la proyección de ventas en valor monetario para el siguiente a total de Hershey´s?

# Ajusta el modelo ARIMA
arima_model <- Arima(ts1, order=c(1,0,0), seasonal=c(1,1,0), include.drift=TRUE)

# Genera la proyección para el siguiente año (12 meses)
forecast_result <- forecast(arima_model, h=12)

# Muestra los resultados de la proyección
print(forecast_result)
##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2020       35498.90 34921.91 36075.88 34616.48 36381.32
## Feb 2020       34202.17 33517.65 34886.69 33155.28 35249.05
## Mar 2020       36703.01 35979.24 37426.78 35596.10 37809.92
## Apr 2020       36271.90 35532.73 37011.07 35141.44 37402.36
## May 2020       37121.98 36376.63 37867.33 35982.07 38261.90
## Jun 2020       37102.65 36354.79 37850.51 35958.90 38246.40
## Jul 2020       37151.04 36402.16 37899.91 36005.73 38296.34
## Aug 2020       38564.64 37815.35 39313.93 37418.70 39710.58
## Sep 2020       38755.22 38005.77 39504.68 37609.03 39901.42
## Oct 2020       39779.02 39029.50 40528.55 38632.72 40925.32
## Nov 2020       38741.63 37992.07 39491.18 37595.28 39887.97
## Dec 2020       38645.86 37896.29 39395.42 37499.50 39792.22

4.- Considerando algunos imponderables establezca con los modelos construidos tres escenarios futuros (proyecciones) A (escenario esperado) , B (escenario optimista) y C (escenario pesimista).

# Escenario A (Esperado) - Utiliza el modelo ARIMA existente
escenario_A <- forecast(arima_model, h=12)

# Escenario B (Optimista) - Aumento del 10% en las predicciones
escenario_B <- forecast(arima_model, h=12)
escenario_B$mean <- escenario_B$mean * 1.10

# Escenario C (Pesimista) - Reducción del 10% en las predicciones
escenario_C <- forecast(arima_model, h=12)
escenario_C$mean <- escenario_C$mean * 0.90

# Muestra los resultados de los tres escenarios
print("Escenario A (Esperado):")
## [1] "Escenario A (Esperado):"
print(escenario_A)
##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2020       35498.90 34921.91 36075.88 34616.48 36381.32
## Feb 2020       34202.17 33517.65 34886.69 33155.28 35249.05
## Mar 2020       36703.01 35979.24 37426.78 35596.10 37809.92
## Apr 2020       36271.90 35532.73 37011.07 35141.44 37402.36
## May 2020       37121.98 36376.63 37867.33 35982.07 38261.90
## Jun 2020       37102.65 36354.79 37850.51 35958.90 38246.40
## Jul 2020       37151.04 36402.16 37899.91 36005.73 38296.34
## Aug 2020       38564.64 37815.35 39313.93 37418.70 39710.58
## Sep 2020       38755.22 38005.77 39504.68 37609.03 39901.42
## Oct 2020       39779.02 39029.50 40528.55 38632.72 40925.32
## Nov 2020       38741.63 37992.07 39491.18 37595.28 39887.97
## Dec 2020       38645.86 37896.29 39395.42 37499.50 39792.22
print("Escenario B (Optimista):")
## [1] "Escenario B (Optimista):"
print(escenario_B)
##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2020       39048.79 34921.91 36075.88 34616.48 36381.32
## Feb 2020       37622.38 33517.65 34886.69 33155.28 35249.05
## Mar 2020       40373.31 35979.24 37426.78 35596.10 37809.92
## Apr 2020       39899.09 35532.73 37011.07 35141.44 37402.36
## May 2020       40834.18 36376.63 37867.33 35982.07 38261.90
## Jun 2020       40812.91 36354.79 37850.51 35958.90 38246.40
## Jul 2020       40866.14 36402.16 37899.91 36005.73 38296.34
## Aug 2020       42421.10 37815.35 39313.93 37418.70 39710.58
## Sep 2020       42630.75 38005.77 39504.68 37609.03 39901.42
## Oct 2020       43756.92 39029.50 40528.55 38632.72 40925.32
## Nov 2020       42615.79 37992.07 39491.18 37595.28 39887.97
## Dec 2020       42510.44 37896.29 39395.42 37499.50 39792.22
print("Escenario C (Pesimista):")
## [1] "Escenario C (Pesimista):"
print(escenario_C)
##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Jan 2020       31949.01 34921.91 36075.88 34616.48 36381.32
## Feb 2020       30781.95 33517.65 34886.69 33155.28 35249.05
## Mar 2020       33032.71 35979.24 37426.78 35596.10 37809.92
## Apr 2020       32644.71 35532.73 37011.07 35141.44 37402.36
## May 2020       33409.79 36376.63 37867.33 35982.07 38261.90
## Jun 2020       33392.38 36354.79 37850.51 35958.90 38246.40
## Jul 2020       33435.93 36402.16 37899.91 36005.73 38296.34
## Aug 2020       34708.17 37815.35 39313.93 37418.70 39710.58
## Sep 2020       34879.70 38005.77 39504.68 37609.03 39901.42
## Oct 2020       35801.12 39029.50 40528.55 38632.72 40925.32
## Nov 2020       34867.46 37992.07 39491.18 37595.28 39887.97
## Dec 2020       34781.27 37896.29 39395.42 37499.50 39792.22

5.- Con este análisis descriptivo, predictivo ¿Qué recomendaciones y medidas prescriptivas le puede dar a la compañía Hershey´s?

  • Monitorear de cerca los indicadores económicos y de mercado que puedan afectar las ventas.

  • Realizar análisis de sensibilidad para evaluar el impacto de cambios en variables clave en las proyecciones.

  • Diversificar estrategias de marketing y promoción para abordar diferentes escenarios.

  • Establecer planes de contingencia y ajustes rápidos en caso de cambios significativos en las condiciones del mercado.