Series de tiempo 2
Rafael Navarro Garza
2026-08-19
#install.packages("forecast")
library(forecast)
#install.packages("readxl")
library(readxl)Ejercicio 1. Ventas Semanales
INSTRUCCIONES: Modela la siguiente Serie de Tiempo y elige la mejor opcion.
Datos
semana <- c(1:12)
valor <- c(17,21,19,23,18,16,20,18,22,20,15,22)
df1 <- data.frame(semana, valor)
ts1 <- ts(valor, c(2025,1), frequency=52)plot(ts1,
main = "Ventas Semanales",
xlab = "Semana",
ylab = "Ventas")
Modelo 1. Naive
#Modelo 1. Naive
naive1 <- naive(ts1, h=6)
summary(naive1)##
## Forecast method: Naive method
##
## Model Information:
## Call: naive(y = ts1, h = 6)
##
## Residual sd: 4.0339
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 0.4545455 4.033947 3.727273 0.1082169 19.24431 NaN -0.4553872
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 2025.231 22 16.830289 27.16971 14.093609 29.90639
## 2025.250 22 14.688925 29.31108 10.818675 33.18132
## 2025.269 22 13.045798 30.95420 8.305730 35.69427
## 2025.288 22 11.660578 32.33942 6.187219 37.81278
## 2025.308 22 10.440175 33.55983 4.320773 39.67923
## 2025.327 22 9.336846 34.66315 2.633377 41.36662Modelo 2. Promedio Movil
#Modelo 2. Promedio Movil (k=3)
promedio_movil1 <- mean(tail(ts1, 3))
pronostico_pm1 <- rep(promedio_movil1, 6)
pronostico_pm1## [1] 19 19 19 19 19 19Modelo 3. Promedio movil ponderado
#Modelo 3. Promedio movil ponderado (k=3 Pesos: 3/6, 2/6 y 1/6)
ultimos3_1 <- tail(ts1, 3)
promedio_ponderado1 <- (ultimos3_1[3] * (3/6)) +
(ultimos3_1[2] * (2/6)) +
(ultimos3_1[1] * (1/6))
pronostico_pmp1 <- rep(promedio_ponderado1, 6)
pronostico_pmp1## [1] 19.33333 19.33333 19.33333 19.33333 19.33333 19.33333Modelo 4. Suavizador Exponencial
#Modelo 4. Suavizador Exponencial (alfa = 0.2)
suavizador1 <- ses(ts1, alpha = 0.2, h = 6)
summary(suavizador1)##
## Forecast method: Simple exponential smoothing
##
## Model Information:
## Simple exponential smoothing
##
## Call:
## ses(y = ts1, h = 6, alpha = 0.2)
##
## Smoothing parameters:
## alpha = 0.2
##
## Initial states:
## l = 19.1774
##
## sigma: 2.9273
##
## AIC AICc BIC
## 57.40932 58.74266 58.37914
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 0.06549665 2.672288 2.312859 -1.479963 12.37329 NaN -0.3669082
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 2025.231 19.33458 15.58304 23.08613 13.59709 25.07208
## 2025.250 19.33458 15.50875 23.16042 13.48347 25.18570
## 2025.269 19.33458 15.43587 23.23330 13.37201 25.29716
## 2025.288 19.33458 15.36432 23.30485 13.26259 25.40657
## 2025.308 19.33458 15.29405 23.37512 13.15512 25.51405
## 2025.327 19.33458 15.22497 23.44419 13.04948 25.61969Modelo 5. ARIMA
#Modelo 5. ARIMA
arima1 <- auto.arima(ts1, seasonal = FALSE)
arima1## Series: ts1
## ARIMA(0,0,0) with non-zero mean
##
## Coefficients:
## mean
## 19.2500
## s.e. 0.6985
##
## sigma^2 = 6.386: log likelihood = -27.63
## AIC=59.26 AICc=60.59 BIC=60.23pronostico1 <- forecast(arima1, level=c(95), h=6)
plot(pronostico1)
Tabla con el resumen de los resultados
#Tabla con el resumen de los resultados
tabla1 <- data.frame(
Periodo = 1:6,
Naive = round(as.numeric(naive1$mean), 2),
Promedio_Movil = round(pronostico_pm1, 2),
Promedio_Movil_Ponderado = round(pronostico_pmp1, 2),
Suavizador_Exponencial = round(as.numeric(suavizador1$mean), 2),
ARIMA = round(as.numeric(pronostico1$mean), 2)
)
tabla1## Periodo Naive Promedio_Movil Promedio_Movil_Ponderado Suavizador_Exponencial
## 1 1 22 19 19.33 19.33
## 2 2 22 19 19.33 19.33
## 3 3 22 19 19.33 19.33
## 4 4 22 19 19.33 19.33
## 5 5 22 19 19.33 19.33
## 6 6 22 19 19.33 19.33
## ARIMA
## 1 19.25
## 2 19.25
## 3 19.25
## 4 19.25
## 5 19.25
## 6 19.25Comparación de los modelos
Para elegir una opción se utilizan las últimas tres semanas como prueba y se calcula el RMSE de cada modelo.
entrenamiento1 <- ts(valor[1:9], c(2025,1), frequency=52)
prueba1 <- valor[10:12]
naive1_prueba <- naive(entrenamiento1, h=3)
pm1_prueba <- rep(mean(tail(entrenamiento1, 3)), 3)
ultimos3_prueba1 <- tail(entrenamiento1, 3)
pmp1_prueba_valor <- (ultimos3_prueba1[3] * (3/6)) +
(ultimos3_prueba1[2] * (2/6)) +
(ultimos3_prueba1[1] * (1/6))
pmp1_prueba <- rep(pmp1_prueba_valor, 3)
suavizador1_prueba <- ses(entrenamiento1, alpha = 0.2, h = 3)
arima1_prueba <- auto.arima(entrenamiento1, seasonal = FALSE)
pronostico_arima1_prueba <- forecast(arima1_prueba, h=3)
rmse1 <- c(
sqrt(mean((prueba1 - as.numeric(naive1_prueba$mean))^2)),
sqrt(mean((prueba1 - pm1_prueba)^2)),
sqrt(mean((prueba1 - pmp1_prueba)^2)),
sqrt(mean((prueba1 - as.numeric(suavizador1_prueba$mean))^2)),
sqrt(mean((prueba1 - as.numeric(pronostico_arima1_prueba$mean))^2))
)
errores1 <- data.frame(
Modelo = c("Naive",
"Promedio Movil",
"Promedio Movil Ponderado",
"Suavizador Exponencial",
"ARIMA"),
RMSE = rmse1
)
mejor_modelo1 <- errores1$Modelo[which.min(errores1$RMSE)]
errores1$RMSE <- round(errores1$RMSE, 2)
errores1## Modelo RMSE
## 1 Naive 4.20
## 2 Promedio Movil 3.11
## 3 Promedio Movil Ponderado 3.23
## 4 Suavizador Exponencial 2.98
## 5 ARIMA 2.96cat("El modelo con menor RMSE es:", mejor_modelo1, "\n")## El modelo con menor RMSE es: ARIMAConclusion
Los cinco modelos generan pronósticos similares porque la serie es corta y no presenta una tendencia fuerte o una estacionalidad que pueda observarse con solamente 12 semanas. Para elegir entre los modelos se comparó el RMSE de las últimas tres observaciones. El modelo con el menor error es ARIMA, por lo que con los datos disponibles sería la mejor opción para realizar el pronóstico de las siguientes semanas.
Ejercicio 2. Hersheys
Cargar la base de datos
El archivo de Excel contiene las ventas mensuales de 2017, 2018 y 2019. Los tres años se encuentran acomodados por columnas en la misma hoja.
datos_hersheys <- read_excel(
"Ventas_Históricas_Lechitas.xlsx",
range = "A4:F15",
col_names = FALSE
)## New names:
## • `` -> `...1`
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`df2 <- data.frame(
Ventas = c(datos_hersheys[[2]],
datos_hersheys[[4]],
datos_hersheys[[6]])
)
str(df2)## 'data.frame': 36 obs. of 1 variable:
## $ Ventas: num 25521 23740 26254 25868 27073 ...df2$Ventas <- as.numeric(df2$Ventas)
ts2 <- ts(df2$Ventas, c(2017,1), frequency=12)plot(ts2,
main = "Ventas Históricas de Leche Saborizada Hershey",
xlab = "Año",
ylab = "Ventas")
Modelo 1. Naive
#Modelo 1. Naive
naive2 <- naive(ts2, h=6)
summary(naive2)##
## Forecast method: Naive method
##
## Model Information:
## Call: naive(y = ts2, h = 6)
##
## Residual sd: 1112.6435
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 266.4474 1112.644 902.8514 0.8162353 3.013136 0.2579763 -0.5648044
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2020 34846.17 33420.26 36272.08 32665.43 37026.91
## Feb 2020 34846.17 32829.63 36862.71 31762.14 37930.20
## Mar 2020 34846.17 32376.42 37315.92 31069.02 38623.32
## Apr 2020 34846.17 31994.35 37697.99 30484.69 39207.65
## May 2020 34846.17 31657.74 38034.60 29969.88 39722.46
## Jun 2020 34846.17 31353.42 38338.92 29504.47 40187.87Modelo 2. Promedio Movil
#Modelo 2. Promedio Movil (k=3)
promedio_movil2 <- mean(tail(ts2, 3))
pronostico_pm2 <- rep(promedio_movil2, 6)
pronostico_pm2## [1] 35259.72 35259.72 35259.72 35259.72 35259.72 35259.72Modelo 3. Promedio movil ponderado
#Modelo 3. Promedio movil ponderado (k=3 Pesos: 3/6, 2/6 y 1/6)
ultimos3_2 <- tail(ts2, 3)
promedio_ponderado2 <- (ultimos3_2[3] * (3/6)) +
(ultimos3_2[2] * (2/6)) +
(ultimos3_2[1] * (1/6))
pronostico_pmp2 <- rep(promedio_ponderado2, 6)
pronostico_pmp2## [1] 35045.23 35045.23 35045.23 35045.23 35045.23 35045.23Modelo 4. Suavizador Exponencial
#Modelo 4. Suavizador Exponencial (alfa = 0.2)
suavizador2 <- ses(ts2, alpha = 0.2, h = 6)
summary(suavizador2)##
## Forecast method: Simple exponential smoothing
##
## Model Information:
## Simple exponential smoothing
##
## Call:
## ses(y = ts2, h = 6, alpha = 0.2)
##
## Smoothing parameters:
## alpha = 0.2
##
## Initial states:
## l = 26303.9678
##
## sigma: 1574.861
##
## AIC AICc BIC
## 661.0074 661.3710 664.1744
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 1111.747 1530.489 1335.458 3.458378 4.357771 0.3815873 0.3247295
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2020 34308.55 32290.28 36326.81 31221.88 37395.22
## Feb 2020 34308.55 32250.31 36366.78 31160.75 37456.34
## Mar 2020 34308.55 32211.10 36405.99 31100.78 37516.31
## Apr 2020 34308.55 32172.61 36444.48 31041.92 37575.17
## May 2020 34308.55 32134.81 36482.28 30984.10 37632.99
## Jun 2020 34308.55 32097.65 36519.44 30927.27 37689.82Modelo 5. ARIMA
#Modelo 5. ARIMA
arima2 <- auto.arima(ts2)
arima2## Series: ts2
## 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.72pronostico2 <- forecast(arima2, level=c(95), h=6)
plot(pronostico2)
Tabla con el resumen de los resultados
#Tabla con el resumen de los resultados
tabla2 <- data.frame(
Mes = c("Enero 2020",
"Febrero 2020",
"Marzo 2020",
"Abril 2020",
"Mayo 2020",
"Junio 2020"),
Naive = round(as.numeric(naive2$mean), 2),
Promedio_Movil = round(pronostico_pm2, 2),
Promedio_Movil_Ponderado = round(pronostico_pmp2, 2),
Suavizador_Exponencial = round(as.numeric(suavizador2$mean), 2),
ARIMA = round(as.numeric(pronostico2$mean), 2)
)
tabla2## Mes Naive Promedio_Movil Promedio_Movil_Ponderado
## 1 Enero 2020 34846.17 35259.72 35045.23
## 2 Febrero 2020 34846.17 35259.72 35045.23
## 3 Marzo 2020 34846.17 35259.72 35045.23
## 4 Abril 2020 34846.17 35259.72 35045.23
## 5 Mayo 2020 34846.17 35259.72 35045.23
## 6 Junio 2020 34846.17 35259.72 35045.23
## Suavizador_Exponencial ARIMA
## 1 34308.55 35498.90
## 2 34308.55 34202.17
## 3 34308.55 36703.01
## 4 34308.55 36271.90
## 5 34308.55 37121.98
## 6 34308.55 37102.65Comparación de los modelos
Para comparar los cinco modelos se utilizan los últimos seis meses de 2019 como datos de prueba.
entrenamiento2 <- ts(head(df2$Ventas, 30), c(2017,1), frequency=12)
prueba2 <- tail(df2$Ventas, 6)
naive2_prueba <- naive(entrenamiento2, h=6)
pm2_prueba <- rep(mean(tail(entrenamiento2, 3)), 6)
ultimos3_prueba2 <- tail(entrenamiento2, 3)
pmp2_prueba_valor <- (ultimos3_prueba2[3] * (3/6)) +
(ultimos3_prueba2[2] * (2/6)) +
(ultimos3_prueba2[1] * (1/6))
pmp2_prueba <- rep(pmp2_prueba_valor, 6)
suavizador2_prueba <- ses(entrenamiento2, alpha = 0.2, h = 6)
arima2_prueba <- auto.arima(entrenamiento2)
pronostico_arima2_prueba <- forecast(arima2_prueba, h=6)
rmse2 <- c(
sqrt(mean((prueba2 - as.numeric(naive2_prueba$mean))^2)),
sqrt(mean((prueba2 - pm2_prueba)^2)),
sqrt(mean((prueba2 - pmp2_prueba)^2)),
sqrt(mean((prueba2 - as.numeric(suavizador2_prueba$mean))^2)),
sqrt(mean((prueba2 - as.numeric(pronostico_arima2_prueba$mean))^2))
)
errores2 <- data.frame(
Modelo = c("Naive",
"Promedio Movil",
"Promedio Movil Ponderado",
"Suavizador Exponencial",
"ARIMA"),
RMSE = rmse2
)
mejor_modelo2 <- errores2$Modelo[which.min(errores2$RMSE)]
errores2$RMSE <- round(errores2$RMSE, 2)
errores2## Modelo RMSE
## 1 Naive 1345.59
## 2 Promedio Movil 1482.39
## 3 Promedio Movil Ponderado 1382.82
## 4 Suavizador Exponencial 2200.40
## 5 ARIMA 1103.70cat("El modelo con menor RMSE es:", mejor_modelo2, "\n")## El modelo con menor RMSE es: ARIMAConclusion
Las ventas de Hershey’s muestran un crecimiento general durante los tres años. Los cinco modelos producen estimaciones para los primeros seis meses de 2020, pero no todos reaccionan de la misma forma a la tendencia de la serie. Utilizando los últimos seis meses como prueba, el modelo con menor RMSE es ARIMA. Por esta razón, este modelo sería la mejor alternativa entre los cinco analizados para generar el pronóstico.
Ejercicio 3. Vintage Restaurant
El Vintage Restaurant cuenta con tres años de ventas mensuales de alimentos y bebidas, expresadas en miles de dólares. El objetivo es analizar la tendencia y estacionalidad y pronosticar los doce meses del cuarto año.
Datos
meses3 <- c("Enero","Febrero","Marzo","Abril","Mayo","Junio",
"Julio","Agosto","Septiembre","Octubre","Noviembre","Diciembre")
ventas_vintage <- c(
242,235,232,178,184,140,145,152,110,130,152,206,
263,238,247,193,193,149,157,161,122,130,167,230,
282,255,265,205,210,160,166,174,126,148,173,235
)
df3 <- data.frame(
Mes = rep(meses3, 3),
Anio = rep(1:3, each=12),
Ventas = ventas_vintage
)
ts3 <- ts(df3$Ventas, c(1,1), frequency=12)
df3## Mes Anio Ventas
## 1 Enero 1 242
## 2 Febrero 1 235
## 3 Marzo 1 232
## 4 Abril 1 178
## 5 Mayo 1 184
## 6 Junio 1 140
## 7 Julio 1 145
## 8 Agosto 1 152
## 9 Septiembre 1 110
## 10 Octubre 1 130
## 11 Noviembre 1 152
## 12 Diciembre 1 206
## 13 Enero 2 263
## 14 Febrero 2 238
## 15 Marzo 2 247
## 16 Abril 2 193
## 17 Mayo 2 193
## 18 Junio 2 149
## 19 Julio 2 157
## 20 Agosto 2 161
## 21 Septiembre 2 122
## 22 Octubre 2 130
## 23 Noviembre 2 167
## 24 Diciembre 2 230
## 25 Enero 3 282
## 26 Febrero 3 255
## 27 Marzo 3 265
## 28 Abril 3 205
## 29 Mayo 3 210
## 30 Junio 3 160
## 31 Julio 3 166
## 32 Agosto 3 174
## 33 Septiembre 3 126
## 34 Octubre 3 148
## 35 Noviembre 3 173
## 36 Diciembre 3 2351. Gráfica de serie de tiempo
plot(ts3,
main = "Ventas Mensuales - Vintage Restaurant",
xlab = "Año",
ylab = "Ventas ($ miles)")
La serie muestra un crecimiento general de las ventas conforme pasan los años. También se observa un patrón estacional: los primeros meses del año presentan ventas altas, mientras que durante algunos meses de verano y principalmente septiembre las ventas son menores. Diciembre vuelve a presentar un aumento importante.
2. Análisis de estacionalidad
descomposicion3 <- decompose(ts3, type = "multiplicative")
plot(descomposicion3)
indices3 <- descomposicion3$figure
tabla_indices3 <- data.frame(
Mes = meses3,
Indice_Estacional = round(indices3, 3)
)
tabla_indices3## Mes Indice_Estacional
## 1 Enero 1.444
## 2 Febrero 1.300
## 3 Marzo 1.344
## 4 Abril 1.041
## 5 Mayo 1.049
## 6 Junio 0.800
## 7 Julio 0.828
## 8 Agosto 0.853
## 9 Septiembre 0.628
## 10 Octubre 0.700
## 11 Noviembre 0.853
## 12 Diciembre 1.159Un índice mayor a 1 indica un mes con ventas por encima del nivel promedio de la serie y un índice menor a 1 indica un mes por debajo del promedio. Los índices muestran que enero, febrero, marzo y diciembre son meses fuertes. Septiembre y octubre se encuentran entre los meses más bajos.
Los índices tienen sentido con los datos originales porque los mismos meses tienden a presentar niveles altos o bajos en los tres años.
3. Desestacionalizar la serie
desestacionalizada3 <- ts3 / descomposicion3$seasonal
plot(desestacionalizada3,
main = "Serie Desestacionalizada - Vintage Restaurant",
xlab = "Año",
ylab = "Ventas desestacionalizadas")
tiempo3 <- 1:length(desestacionalizada3)
modelo_tendencia3 <- lm(as.numeric(desestacionalizada3) ~ tiempo3)
summary(modelo_tendencia3)##
## Call:
## lm(formula = as.numeric(desestacionalizada3) ~ tiempo3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.1892 -2.2527 -0.4848 0.8131 9.4189
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 169.3494 1.0926 155.00 <2e-16 ***
## tiempo3 1.0213 0.0515 19.83 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.21 on 34 degrees of freedom
## Multiple R-squared: 0.9204, Adjusted R-squared: 0.9181
## F-statistic: 393.3 on 1 and 34 DF, p-value: < 2.2e-16plot(desestacionalizada3,
main = "Tendencia de la Serie Desestacionalizada",
xlab = "Tiempo",
ylab = "Ventas desestacionalizadas")
abline(modelo_tendencia3)
Después de eliminar el efecto estacional se observa una tendencia creciente. Esto significa que el crecimiento de las ventas no se debe solamente a la época del año, sino que también existe un crecimiento del restaurante con el paso del tiempo.
4. Pronóstico por método de descomposición
tiempo_futuro3 <- 37:48
pronostico_tendencia3 <- predict(
modelo_tendencia3,
newdata = data.frame(tiempo3 = tiempo_futuro3)
)
pronostico_descomposicion3 <- pronostico_tendencia3 * indices3
pronostico_descomposicion3## 1 2 3 4 5 6 7 8
## 299.0209 270.5439 281.1630 218.8619 221.6542 169.8759 176.6490 182.7809
## 9 10 11 12
## 135.2105 151.5002 185.3475 253.15215. Pronóstico por regresión con variables ficticias
df_regresion3 <- data.frame(
Ventas = as.numeric(ts3),
Tiempo = 1:36,
Mes = factor(rep(1:12, 3))
)
regresion3 <- lm(Ventas ~ Tiempo + Mes, data = df_regresion3)
summary(regresion3)##
## Call:
## lm(formula = Ventas ~ Tiempo + Mes, data = df_regresion3)
##
## Residuals:
## Min 1Q Median 3Q Max
## -8.1250 -1.9583 0.1667 2.2292 7.4583
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 249.10764 2.74567 90.727 < 2e-16 ***
## Tiempo 1.01736 0.07554 13.467 2.14e-12 ***
## Mes2 -20.68403 3.62688 -5.703 8.30e-06 ***
## Mes3 -16.36806 3.62924 -4.510 0.000158 ***
## Mes4 -73.38542 3.63317 -20.199 3.90e-16 ***
## Mes5 -70.73611 3.63866 -19.440 8.97e-16 ***
## Mes6 -117.75347 3.64571 -32.299 < 2e-16 ***
## Mes7 -112.43750 3.65431 -30.768 < 2e-16 ***
## Mes8 -107.12153 3.66445 -29.233 < 2e-16 ***
## Mes9 -151.13889 3.67611 -41.114 < 2e-16 ***
## Mes10 -135.48958 3.68928 -36.725 < 2e-16 ***
## Mes11 -108.50694 3.70395 -29.295 < 2e-16 ***
## Mes12 -49.85764 3.72009 -13.402 2.36e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.441 on 23 degrees of freedom
## Multiple R-squared: 0.9942, Adjusted R-squared: 0.9911
## F-statistic: 327 on 12 and 23 DF, p-value: < 2.2e-16futuro3 <- data.frame(
Tiempo = 37:48,
Mes = factor(1:12, levels=1:12)
)
pronostico_regresion3 <- predict(regresion3, newdata=futuro3)
pronostico_regresion3## 1 2 3 4 5 6 7 8
## 286.7500 267.0833 272.4167 216.4167 220.0833 174.0833 180.4167 186.7500
## 9 10 11 12
## 143.7500 160.4167 188.4167 248.0833Tabla de pronósticos del cuarto año
tabla_pronosticos3 <- data.frame(
Mes = meses3,
Descomposicion = round(as.numeric(pronostico_descomposicion3), 2),
Regresion_Variables_Ficticias = round(as.numeric(pronostico_regresion3), 2)
)
tabla_pronosticos3## Mes Descomposicion Regresion_Variables_Ficticias
## 1 Enero 299.02 286.75
## 2 Febrero 270.54 267.08
## 3 Marzo 281.16 272.42
## 4 Abril 218.86 216.42
## 5 Mayo 221.65 220.08
## 6 Junio 169.88 174.08
## 7 Julio 176.65 180.42
## 8 Agosto 182.78 186.75
## 9 Septiembre 135.21 143.75
## 10 Octubre 151.50 160.42
## 11 Noviembre 185.35 188.42
## 12 Diciembre 253.15 248.08Los dos métodos conservan el patrón estacional observado en los tres años anteriores y al mismo tiempo incorporan el crecimiento de las ventas.
Error de pronóstico en enero del cuarto año
Se sabe que las ventas reales de enero del cuarto año fueron de $295,000, por lo que en la escala utilizada en la tabla el valor real es 295.
venta_real_enero4 <- 295
error_descomposicion3 <- venta_real_enero4 - pronostico_descomposicion3[1]
error_regresion3 <- venta_real_enero4 - pronostico_regresion3[1]
cat("Error de pronóstico con descomposición:",
round(error_descomposicion3, 2), "miles de dólares\n")## Error de pronóstico con descomposición: -4.02 miles de dólarescat("Error de pronóstico con regresión:",
round(error_regresion3, 2), "miles de dólares\n")## Error de pronóstico con regresión: 8.25 miles de dólaresUn error positivo significa que las ventas reales fueron mayores al pronóstico y un error negativo significa que el pronóstico fue mayor a las ventas reales.
Para disminuir la incertidumbre del procedimiento, Karen puede actualizar los modelos cada vez que se obtengan nuevos datos reales, comparar más de un método de pronóstico y utilizar intervalos de pronóstico en lugar de depender solamente de una estimación puntual. De esta forma puede observar un rango posible de ventas y no solamente un único valor.
6. Resumen de cálculos y gráficas
Índices estacionales
tabla_indices3## Mes Indice_Estacional
## 1 Enero 1.444
## 2 Febrero 1.300
## 3 Marzo 1.344
## 4 Abril 1.041
## 5 Mayo 1.049
## 6 Junio 0.800
## 7 Julio 0.828
## 8 Agosto 0.853
## 9 Septiembre 0.628
## 10 Octubre 0.700
## 11 Noviembre 0.853
## 12 Diciembre 1.159Pronósticos del cuarto año
tabla_pronosticos3## Mes Descomposicion Regresion_Variables_Ficticias
## 1 Enero 299.02 286.75
## 2 Febrero 270.54 267.08
## 3 Marzo 281.16 272.42
## 4 Abril 218.86 216.42
## 5 Mayo 221.65 220.08
## 6 Junio 169.88 174.08
## 7 Julio 176.65 180.42
## 8 Agosto 182.78 186.75
## 9 Septiembre 135.21 143.75
## 10 Octubre 151.50 160.42
## 11 Noviembre 185.35 188.42
## 12 Diciembre 253.15 248.08Serie original
plot(ts3,
main = "Ventas Mensuales - Vintage Restaurant",
xlab = "Año",
ylab = "Ventas ($ miles)")
Serie desestacionalizada
plot(desestacionalizada3,
main = "Serie Desestacionalizada - Vintage Restaurant",
xlab = "Año",
ylab = "Ventas desestacionalizadas")
Pronóstico por descomposición
serie_descomposicion3 <- ts(
c(as.numeric(ts3), as.numeric(pronostico_descomposicion3)),
c(1,1),
frequency=12
)
plot(serie_descomposicion3,
main = "Serie Histórica y Pronóstico por Descomposición",
xlab = "Año",
ylab = "Ventas ($ miles)")
Pronóstico por regresión
serie_regresion3 <- ts(
c(as.numeric(ts3), as.numeric(pronostico_regresion3)),
c(1,1),
frequency=12
)
plot(serie_regresion3,
main = "Serie Histórica y Pronóstico por Regresión",
xlab = "Año",
ylab = "Ventas ($ miles)")
Conclusión Vintage Restaurant
Vintage Restaurant presenta tanto una tendencia creciente como una estacionalidad clara. Las ventas suelen ser mayores durante los primeros meses del año y diciembre, mientras que septiembre se encuentra entre los meses de menor actividad.
Después de desestacionalizar la serie se mantiene una tendencia creciente, lo que indica que el restaurante ha aumentado sus ventas con el paso del tiempo. Tanto el método de descomposición como la regresión con variables ficticias permiten conservar la estacionalidad y proyectar el crecimiento para el cuarto año.
En enero del cuarto año, el error del método de descomposición es de -4.02 miles de dólares y el error del método de regresión es de 8.25 miles de dólares. Para la planeación futura conviene continuar actualizando los modelos con información nueva y considerar un rango de posibles valores para no depender únicamente de un pronóstico puntual.
Ejercicio 4. Carlson Department Store
Carlson Department Store permaneció cerrada de septiembre a diciembre del quinto año debido a un huracán. Se utilizarán las ventas anteriores al huracán para estimar las ventas normales que Carlson y las demás tiendas del condado habrían registrado durante esos cuatro meses.
Debido a que las dos series presentan un patrón mensual muy marcado, se utiliza una regresión con tendencia y variables ficticias para representar la estacionalidad.
Datos de Carlson Department Store
ventas_carlson <- c(
1.71,1.90,2.74,4.20,
1.45,1.80,2.03,1.99,2.32,2.20,2.13,2.43,1.90,2.13,2.56,4.16,
2.31,1.89,2.02,2.23,2.39,2.14,2.27,2.21,1.89,2.29,2.83,4.04,
2.31,1.99,2.42,2.45,2.57,2.42,2.40,2.50,2.09,2.54,2.97,4.35,
2.56,2.28,2.69,2.48,2.73,2.37,2.31,2.23
)
mes_carlson <- rep(c(9,10,11,12,1,2,3,4,5,6,7,8), 4)
df4_carlson <- data.frame(
Ventas = ventas_carlson,
Tiempo = 1:48,
Mes = factor(mes_carlson, levels=1:12)
)
ts4_carlson <- ts(ventas_carlson, c(1,9), frequency=12)plot(ts4_carlson,
main = "Ventas Históricas - Carlson Department Store",
xlab = "Año",
ylab = "Ventas ($ millones)")
Datos de tiendas departamentales del condado
ventas_condado <- c(
55.80,56.40,71.40,117.60,
46.80,48.00,60.00,57.60,61.80,58.20,56.40,63.00,57.60,53.40,71.40,114.00,
46.80,48.60,59.40,58.20,60.60,55.20,51.00,58.80,49.80,54.60,65.40,102.00,
43.80,45.60,57.60,53.40,56.40,52.80,54.00,60.60,47.40,54.60,67.80,100.20,
48.00,51.60,57.60,58.20,60.00,57.00,57.60,61.80
)
df4_condado <- data.frame(
Ventas = ventas_condado,
Tiempo = 1:48,
Mes = factor(mes_carlson, levels=1:12)
)
ts4_condado <- ts(ventas_condado, c(1,9), frequency=12)plot(ts4_condado,
main = "Ventas Históricas de Tiendas Departamentales del Condado",
xlab = "Año",
ylab = "Ventas ($ millones)")
Modelos de regresión con variables ficticias
regresion_carlson <- lm(Ventas ~ Tiempo + Mes, data=df4_carlson)
regresion_condado <- lm(Ventas ~ Tiempo + Mes, data=df4_condado)
summary(regresion_carlson)##
## Call:
## lm(formula = Ventas ~ Tiempo + Mes, data = df4_carlson)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.50750 -0.06604 0.00875 0.07458 0.28750
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.901944 0.090906 20.922 < 2e-16 ***
## Tiempo 0.011111 0.001753 6.338 2.78e-07 ***
## Mes2 -0.178611 0.115236 -1.550 0.1301
## Mes3 0.110278 0.115276 0.957 0.3453
## Mes4 0.096667 0.115342 0.838 0.4077
## Mes5 0.300556 0.115436 2.604 0.0134 *
## Mes6 0.069444 0.115555 0.601 0.5517
## Mes7 0.053333 0.115701 0.461 0.6477
## Mes8 0.107222 0.115874 0.925 0.3611
## Mes9 -0.215556 0.115436 -1.867 0.0702 .
## Mes10 0.090833 0.115342 0.788 0.4363
## Mes11 0.639722 0.115276 5.549 3.03e-06 ***
## Mes12 2.041111 0.115236 17.712 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1629 on 35 degrees of freedom
## Multiple R-squared: 0.9472, Adjusted R-squared: 0.9291
## F-statistic: 52.35 on 12 and 35 DF, p-value: < 2.2e-16summary(regresion_condado)##
## Call:
## lm(formula = Ventas ~ Tiempo + Mes, data = df4_condado)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.5925 -2.0250 0.0475 1.4963 7.4925
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 48.46792 1.80898 26.793 < 2e-16 ***
## Tiempo -0.09208 0.03488 -2.640 0.012311 *
## Mes2 2.19208 2.29314 0.956 0.345663
## Mes3 12.48417 2.29393 5.442 4.20e-06 ***
## Mes4 10.77625 2.29526 4.695 4.02e-05 ***
## Mes5 13.71833 2.29711 5.972 8.41e-07 ***
## Mes6 9.91042 2.29950 4.310 0.000126 ***
## Mes7 8.95250 2.30241 3.888 0.000431 ***
## Mes8 15.34458 2.30584 6.655 1.07e-07 ***
## Mes9 5.93167 2.29711 2.582 0.014160 *
## Mes10 8.12375 2.29526 3.539 0.001155 **
## Mes11 22.46583 2.29393 9.794 1.46e-11 ***
## Mes12 62.00792 2.29314 27.041 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.243 on 35 degrees of freedom
## Multiple R-squared: 0.9693, Adjusted R-squared: 0.9587
## F-statistic: 92.02 on 12 and 35 DF, p-value: < 2.2e-161. Estimación de las ventas de Carlson sin huracán
futuro4 <- data.frame(
Tiempo = 49:52,
Mes = factor(9:12, levels=1:12)
)
pronostico_carlson <- predict(regresion_carlson, newdata=futuro4)
cat("Pronóstico Carlson septiembre:",
round(pronostico_carlson[1], 2), "millones\n")## Pronóstico Carlson septiembre: 2.23 millonescat("Pronóstico Carlson octubre:",
round(pronostico_carlson[2], 2), "millones\n")## Pronóstico Carlson octubre: 2.55 millonescat("Pronóstico Carlson noviembre:",
round(pronostico_carlson[3], 2), "millones\n")## Pronóstico Carlson noviembre: 3.11 millonescat("Pronóstico Carlson diciembre:",
round(pronostico_carlson[4], 2), "millones\n")## Pronóstico Carlson diciembre: 4.52 millones2. Estimación de las ventas del condado sin huracán
pronostico_condado <- predict(regresion_condado, newdata=futuro4)
cat("Pronóstico condado septiembre:",
round(pronostico_condado[1], 2), "millones\n")## Pronóstico condado septiembre: 49.89 millonescat("Pronóstico condado octubre:",
round(pronostico_condado[2], 2), "millones\n")## Pronóstico condado octubre: 51.99 millonescat("Pronóstico condado noviembre:",
round(pronostico_condado[3], 2), "millones\n")## Pronóstico condado noviembre: 66.24 millonescat("Pronóstico condado diciembre:",
round(pronostico_condado[4], 2), "millones\n")## Pronóstico condado diciembre: 105.69 millones3. Estimación de la pérdida de ventas de Carlson
Como la tienda estuvo cerrada durante los cuatro meses, la pérdida normal de ventas corresponde a la suma de lo que se pronostica que habría vendido de septiembre a diciembre.
perdida_carlson <- sum(pronostico_carlson)
cat("Pérdida estimada de ventas normales de Carlson: $",
round(perdida_carlson, 2), "millones\n")## Pérdida estimada de ventas normales de Carlson: $ 12.41 millonesVentas reales del condado y exceso relacionado con el huracán
ventas_reales_condado <- c(69.00, 75.00, 85.20, 121.80)
exceso_condado <- ventas_reales_condado - pronostico_condado
tabla4 <- data.frame(
Mes = c("Septiembre","Octubre","Noviembre","Diciembre"),
Carlson_Sin_Huracan = round(pronostico_carlson, 2),
Condado_Sin_Huracan = round(pronostico_condado, 2),
Condado_Real = ventas_reales_condado,
Exceso_Condado = round(exceso_condado, 2)
)
tabla4## Mes Carlson_Sin_Huracan Condado_Sin_Huracan Condado_Real
## 1 Septiembre 2.23 49.89 69.0
## 2 Octubre 2.55 51.99 75.0
## 3 Noviembre 3.11 66.24 85.2
## 4 Diciembre 4.52 105.69 121.8
## Exceso_Condado
## 1 19.11
## 2 23.01
## 3 18.96
## 4 16.11total_exceso_condado <- sum(exceso_condado)
cat("Exceso total estimado de ventas en el condado: $",
round(total_exceso_condado, 2), "millones\n")## Exceso total estimado de ventas en el condado: $ 77.2 millonesLas ventas reales del condado son mayores que las ventas estimadas sin huracán durante los cuatro meses. Esto apoya el argumento de que existió un aumento extraordinario en la actividad comercial después del huracán.
Como aproximación, se puede suponer que Carlson habría experimentado el mismo incremento porcentual que el conjunto de tiendas del condado.
factor_incremento4 <- ventas_reales_condado / pronostico_condado
ventas_carlson_con_efecto <- pronostico_carlson * factor_incremento4
exceso_carlson_estimado <- ventas_carlson_con_efecto - pronostico_carlson
total_exceso_carlson <- sum(exceso_carlson_estimado)
tabla_exceso_carlson <- data.frame(
Mes = c("Septiembre","Octubre","Noviembre","Diciembre"),
Venta_Normal = round(pronostico_carlson, 2),
Venta_Con_Efecto_Huracan = round(ventas_carlson_con_efecto, 2),
Exceso_Estimado = round(exceso_carlson_estimado, 2)
)
tabla_exceso_carlson## Mes Venta_Normal Venta_Con_Efecto_Huracan Exceso_Estimado
## 1 Septiembre 2.23 3.09 0.85
## 2 Octubre 2.55 3.68 1.13
## 3 Noviembre 3.11 4.00 0.89
## 4 Diciembre 4.52 5.21 0.69cat("Exceso estimado de ventas que Carlson pudo haber obtenido: $",
round(total_exceso_carlson, 2), "millones\n")## Exceso estimado de ventas que Carlson pudo haber obtenido: $ 3.56 millonesConclusión Carlson Department Store
El modelo estima que Carlson habría registrado aproximadamente $12.41 millones en ventas normales durante septiembre, octubre, noviembre y diciembre si el huracán no hubiera ocurrido. Debido a que la tienda estuvo completamente cerrada, esta cantidad representa la estimación de las ventas normales perdidas.
Para el condado, las ventas reales de los cuatro meses resultan mayores que las estimaciones normales y el exceso total es de aproximadamente $77.2 millones. Esto proporciona evidencia a favor de que el huracán y la entrada de recursos posteriores generaron un incremento extraordinario de la actividad comercial.
Si se supone que Carlson habría recibido un incremento proporcional al observado en el resto del condado, el exceso adicional de ventas que pudo haber perdido se estima en aproximadamente $3.56 millones. Esta segunda estimación depende del supuesto de que Carlson habría seguido el mismo comportamiento porcentual que las demás tiendas, por lo que debe presentarse como una estimación adicional y no como una cantidad completamente segura.
Conclusión general
En los primeros dos ejercicios se aplicaron los cinco modelos trabajados en clase: Naive, promedio móvil, promedio móvil ponderado, suavización exponencial y ARIMA. La comparación mediante RMSE permite seleccionar el modelo con menor error para cada serie.
En Vintage Restaurant se encontró una combinación de tendencia creciente y estacionalidad. Los métodos de descomposición y regresión con variables ficticias permiten pronosticar el cuarto año manteniendo estos dos componentes.
En Carlson Department Store, la regresión con tendencia y variables ficticias permite estimar las ventas que se habrían realizado durante el cierre. La comparación contra las ventas reales del condado muestra un aumento posterior al huracán, lo que respalda la posibilidad de reclamar no solamente las ventas normales perdidas, sino también una estimación adicional del exceso de ventas relacionado con el incremento de actividad comercial.