2. Pronóstico Producto 2
p2 <- subset(Datos_GdA, Producto == 2)
p2$fecha <- as.Date(p2$fecha_mes)
p2 <- p2[order(p2$fecha), ]
p2$cant_kg <- pmax(p2$cant_kg, 0)
# Variables de tiempo
p2$t <- 1:nrow(p2)
p2$mes <- as.factor(month(p2$fecha))
serie_p2 <- ts(p2$cant_kg, frequency = 12, start = c(year(min(p2$fecha)), month(min(p2$fecha))))
# --- AJUSTAR LOS MODELOS ---
modelo_hw_2 <- hw(serie_p2, seasonal = "multiplicative", h = 12)
modelo_sarima_2 <- auto.arima(serie_p2, seasonal = TRUE)
modelo_reg_2 <- lm(cant_kg ~ t, data = p2)
modelo_ses_2 <- ses(serie_p2, h = 12)
# --- VERIFICAR EL AJUSTE Y CALCULAR ERRORES ---
p2$pron_hw <- fitted(modelo_hw_2)
p2$pron_sarima <- fitted(modelo_sarima_2)
p2$pron_reg <- fitted(modelo_reg_2)
p2$pron_ses <- fitted(modelo_ses_2)
# Errores Winters
p2$error_hw <- p2$cant_kg - p2$pron_hw
MAD_hw_2 <- mean(abs(p2$error_hw))
ECM_hw_2 <- mean((p2$error_hw)^2)
MAPE_hw_2 <- mean(abs(p2$error_hw / p2$cant_kg)) * 100
SMAPE_hw_2 <- smape_calc(p2$cant_kg, p2$pron_hw)
# Errores SARIMA
p2$error_sarima <- p2$cant_kg - p2$pron_sarima
MAD_sarima_2 <- mean(abs(p2$error_sarima))
ECM_sarima_2 <- mean((p2$error_sarima)^2)
MAPE_sarima_2 <- mean(abs(p2$error_sarima / p2$cant_kg)) * 100
SMAPE_sarima_2 <- smape_calc(p2$cant_kg, p2$pron_sarima)
# Errores Regresión
p2$error_reg <- p2$cant_kg - p2$pron_reg
MAD_reg_2 <- mean(abs(p2$error_reg))
ECM_reg_2 <- mean((p2$error_reg)^2)
MAPE_reg_2 <- mean(abs(p2$error_reg / p2$cant_kg)) * 100
SMAPE_reg_2 <- smape_calc(p2$cant_kg, p2$pron_reg)
# Errores SES (Se omite el NA inicial)
datos_ses_2 <- na.omit(p2)
datos_ses_2$error_ses <- datos_ses_2$cant_kg - datos_ses_2$pron_ses
MAD_ses_2 <- mean(abs(datos_ses_2$error_ses))
ECM_ses_2 <- mean((datos_ses_2$error_ses)^2)
MAPE_ses_2 <- mean(abs(datos_ses_2$error_ses / datos_ses_2$cant_kg)) * 100
SMAPE_ses_2 <- smape_calc(datos_ses_2$cant_kg, datos_ses_2$pron_ses)
Tabla Comparativa de Errores (Producto 2)
comparacion_2 <- data.frame(
Metodo = c("Winters Multiplicativo", "SARIMA", "Regresión Lineal", "SES"),
MAD_kg = c(MAD_hw_2, MAD_sarima_2, MAD_reg_2, MAD_ses_2),
ECM = c(ECM_hw_2, ECM_sarima_2, ECM_reg_2, ECM_ses_2),
MAPE = c(MAPE_hw_2, MAPE_sarima_2, MAPE_reg_2, MAPE_ses_2),
SMAPE = c(SMAPE_hw_2, SMAPE_sarima_2, SMAPE_reg_2, SMAPE_ses_2)
)
# Forzar el ordenamiento matemático
comparacion_2 <- comparacion_2[order(as.numeric(comparacion_2$SMAPE)), ]
# Formato final con redondeos y %
comparacion_2$MAD_kg <- round(comparacion_2$MAD_kg, 2)
comparacion_2$ECM <- round(comparacion_2$ECM, 2)
comparacion_2$MAPE <- paste0(round(comparacion_2$MAPE, 2), " %")
comparacion_2$SMAPE <- paste0(round(comparacion_2$SMAPE, 2), " %")
kable(comparacion_2, align = "c", row.names = FALSE, caption = "Ranking de Errores - Producto 2 (Ordenado por SMAPE)")
Ranking de Errores - Producto 2 (Ordenado por SMAPE)
| SARIMA |
132427.9 |
37866006092 |
74.23 % |
25.42 % |
| Winters Multiplicativo |
276479.8 |
142553615619 |
129.97 % |
45.67 % |
| SES |
273010.8 |
131108466865 |
70.39 % |
49.95 % |
| Regresión Lineal |
460796.3 |
288988677903 |
635.68 % |
73.56 % |
Resumen del Modelo de Regresión y Gráficas (Producto 2)
summary(modelo_reg_2)
##
## Call:
## lm(formula = cant_kg ~ t, data = p2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -748162 -456962 -106008 406635 1619731
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 499470 87057 5.737 4.95e-08 ***
## t 3546 962 3.686 0.000315 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 541100 on 154 degrees of freedom
## Multiple R-squared: 0.08107, Adjusted R-squared: 0.0751
## F-statistic: 13.59 on 1 and 154 DF, p-value: 0.0003151
# 1. Real vs Regresión (Ajustado)
ggplot(p2, aes(x = fecha)) +
geom_line(aes(y = cant_kg, color = "Real"), size = 0.8) +
geom_line(aes(y = pron_reg, color = "Regresión"), size = 0.8, linetype = "dashed") +
labs(title = "Producto 2: Demanda Real vs Regresión Lineal", x = "Fecha", y = "Cantidad (kg)", color = "") +
theme_minimal()
# 2. Real vs SES
ggplot(p2, aes(x = fecha)) +
geom_line(aes(y = cant_kg, color = "Real"), size = 0.8) +
geom_line(aes(y = pron_ses, color = "SES"), size = 0.8, linetype = "dashed") +
labs(title = "Producto 2: Demanda Real vs Suavización Exponencial (SES)", x = "Fecha", y = "Cantidad (kg)", color = "") +
theme_minimal()
Pronóstico a 12 Meses con SARIMA (Producto 2)
meses_futuro <- 12
ultima_fecha_2 <- max(p2$fecha)
ultimo_valor_2 <- p2$cant_kg[which.max(p2$fecha)]
pred_sarima_2 <- forecast(modelo_sarima_2, h = meses_futuro)
resultados_2 <- data.frame(
Fecha = seq(ultima_fecha_2 %m+% months(1), by = "month", length.out = meses_futuro),
Pronostico = pmax(round(as.numeric(pred_sarima_2$mean)), 0),
Inferior = pmax(round(as.numeric(pred_sarima_2$lower[,2])), 0),
Superior = pmax(round(as.numeric(pred_sarima_2$upper[,2])), 0)
)
puente_2 <- data.frame(Fecha = ultima_fecha_2, Pronostico = ultimo_valor_2, Inferior = ultimo_valor_2, Superior = ultimo_valor_2)
resultados_2_grafico <- rbind(puente_2, resultados_2)
historico_2 <- data.frame(Fecha = p2$fecha, Pronostico = p2$cant_kg, Inferior = NA, Superior = NA)
ggplot() +
geom_line(data = historico_2, aes(x = Fecha, y = Pronostico), color = "steelblue", linewidth = 0.8) +
geom_line(data = resultados_2_grafico, aes(x = Fecha, y = Pronostico), color = "darkgreen", linewidth = 1) +
geom_ribbon(data = resultados_2_grafico, aes(x = Fecha, ymin = Inferior, ymax = Superior), alpha = 0.2, fill = "darkgreen") +
labs(title = "Producto 2 - Pronóstico Óptimo 12 meses (SARIMA)", subtitle = "Las bandas verdes muestran el intervalo de confianza", x = "Fecha", y = "Cantidad (kg)") +
theme_minimal()
3. Pronóstico Producto 4
p4 <- subset(Datos_GdA, Producto == 4)
p4$fecha <- as.Date(p4$fecha_mes)
p4 <- p4[order(p4$fecha), ]
p4$cant_kg <- pmax(p4$cant_kg, 0)
# Variables de tiempo
p4$t <- 1:nrow(p4)
p4$mes <- as.factor(month(p4$fecha))
serie_p4 <- ts(p4$cant_kg, frequency = 12, start = c(year(min(p4$fecha)), month(min(p4$fecha))))
# --- AJUSTAR LOS MODELOS ---
modelo_hw_4 <- hw(serie_p4, seasonal = "multiplicative", h = 12)
modelo_sarima_4 <- auto.arima(serie_p4, seasonal = TRUE)
modelo_reg_4 <- lm(cant_kg ~ t, data = p4)
modelo_ses_4 <- ses(serie_p4, h = 12)
# --- VERIFICAR EL AJUSTE Y CALCULAR ERRORES ---
p4$pron_hw <- fitted(modelo_hw_4)
p4$pron_sarima <- fitted(modelo_sarima_4)
p4$pron_reg <- fitted(modelo_reg_4)
p4$pron_ses <- fitted(modelo_ses_4)
# Errores Winters
p4$error_hw <- p4$cant_kg - p4$pron_hw
MAD_hw_4 <- mean(abs(p4$error_hw))
ECM_hw_4 <- mean((p4$error_hw)^2)
MAPE_hw_4 <- mean(abs(p4$error_hw / (p4$cant_kg + 1))) * 100
SMAPE_hw_4 <- smape_calc(p4$cant_kg, p4$pron_hw)
# Errores SARIMA
p4$error_sarima <- p4$cant_kg - p4$pron_sarima
MAD_sarima_4 <- mean(abs(p4$error_sarima))
ECM_sarima_4 <- mean((p4$error_sarima)^2)
MAPE_sarima_4 <- mean(abs(p4$error_sarima / (p4$cant_kg + 1))) * 100
SMAPE_sarima_4 <- smape_calc(p4$cant_kg, p4$pron_sarima)
# Errores Regresión
p4$error_reg <- p4$cant_kg - p4$pron_reg
MAD_reg_4 <- mean(abs(p4$error_reg))
ECM_reg_4 <- mean((p4$error_reg)^2)
MAPE_reg_4 <- mean(abs(p4$error_reg / (p4$cant_kg + 1))) * 100
SMAPE_reg_4 <- smape_calc(p4$cant_kg, p4$pron_reg)
# Errores SES
datos_ses_4 <- na.omit(p4)
datos_ses_4$error_ses <- datos_ses_4$cant_kg - datos_ses_4$pron_ses
MAD_ses_4 <- mean(abs(datos_ses_4$error_ses))
ECM_ses_4 <- mean((datos_ses_4$error_ses)^2)
MAPE_ses_4 <- mean(abs(datos_ses_4$error_ses / (datos_ses_4$cant_kg + 1))) * 100
SMAPE_ses_4 <- smape_calc(datos_ses_4$cant_kg, datos_ses_4$pron_ses)
Tabla Comparativa de Errores (Producto 4)
comparacion_4 <- data.frame(
Metodo = c("Winters Multiplicativo", "SARIMA", "Regresión Lineal", "SES"),
MAD_kg = c(MAD_hw_4, MAD_sarima_4, MAD_reg_4, MAD_ses_4),
ECM = c(ECM_hw_4, ECM_sarima_4, ECM_reg_4, ECM_ses_4),
MAPE = c(MAPE_hw_4, MAPE_sarima_4, MAPE_reg_4, MAPE_ses_4),
SMAPE = c(SMAPE_hw_4, SMAPE_sarima_4, SMAPE_reg_4, SMAPE_ses_4)
)
# Forzar el ordenamiento matemático
comparacion_4 <- comparacion_4[order(as.numeric(comparacion_4$SMAPE)), ]
# Formato final con redondeos y %
comparacion_4$MAD_kg <- round(comparacion_4$MAD_kg, 2)
comparacion_4$ECM <- round(comparacion_4$ECM, 2)
comparacion_4$MAPE <- paste0(round(comparacion_4$MAPE, 2), " %")
comparacion_4$SMAPE <- paste0(round(comparacion_4$SMAPE, 2), " %")
kable(comparacion_4, align = "c", row.names = FALSE, caption = "Ranking de Errores - Producto 4 (Ordenado por SMAPE)")
Ranking de Errores - Producto 4 (Ordenado por SMAPE)
| SARIMA |
59304.79 |
6939533068 |
52.45 % |
42.34 % |
| Winters Multiplicativo |
67182.70 |
8942985871 |
58.33 % |
44.63 % |
| SES |
129044.92 |
35723105263 |
84.61 % |
59.36 % |
| Regresión Lineal |
217305.23 |
70169785872 |
427.97 % |
91.11 % |
Resumen del Modelo de Regresión y Gráficas (Producto 4)
summary(modelo_reg_4)
##
## Call:
## lm(formula = cant_kg ~ t, data = p4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -251127 -203198 -130390 185344 784280
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 238996.0 63987.6 3.735 0.000379 ***
## t 613.5 1523.4 0.403 0.688370
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 268700 on 70 degrees of freedom
## Multiple R-squared: 0.002312, Adjusted R-squared: -0.01194
## F-statistic: 0.1622 on 1 and 70 DF, p-value: 0.6884
# 1. Real vs Regresión (Ajustado)
ggplot(p4, aes(x = fecha)) +
geom_line(aes(y = cant_kg, color = "Real"), size = 0.8) +
geom_line(aes(y = pron_reg, color = "Regresión"), size = 0.8, linetype = "dashed") +
labs(title = "Producto 4: Demanda Real vs Regresión Lineal", x = "Fecha", y = "Cantidad (kg)", color = "") +
theme_minimal()
# 2. Real vs SES
ggplot(p4, aes(x = fecha)) +
geom_line(aes(y = cant_kg, color = "Real"), size = 0.8) +
geom_line(aes(y = pron_ses, color = "SES"), size = 0.8, linetype = "dashed") +
labs(title = "Producto 4: Demanda Real vs Suavización Exponencial (SES)", x = "Fecha", y = "Cantidad (kg)", color = "") +
theme_minimal()
Pronóstico a 12 Meses con SARIMA (Producto 4)
ultima_fecha_4 <- max(p4$fecha)
ultimo_valor_4 <- p4$cant_kg[which.max(p4$fecha)]
pred_sarima_4 <- forecast(modelo_sarima_4, h = meses_futuro)
resultados_4 <- data.frame(
Fecha = seq(ultima_fecha_4 %m+% months(1), by = "month", length.out = meses_futuro),
Pronostico = pmax(round(as.numeric(pred_sarima_4$mean)), 0),
Inferior = pmax(round(as.numeric(pred_sarima_4$lower[,2])), 0),
Superior = pmax(round(as.numeric(pred_sarima_4$upper[,2])), 0)
)
puente_4 <- data.frame(Fecha = ultima_fecha_4, Pronostico = ultimo_valor_4, Inferior = ultimo_valor_4, Superior = ultimo_valor_4)
resultados_4_grafico <- rbind(puente_4, resultados_4)
historico_4 <- data.frame(Fecha = p4$fecha, Pronostico = p4$cant_kg, Inferior = NA, Superior = NA)
ggplot() +
geom_line(data = historico_4, aes(x = Fecha, y = Pronostico), color = "steelblue", linewidth = 0.8) +
geom_line(data = resultados_4_grafico, aes(x = Fecha, y = Pronostico), color = "darkgreen", linewidth = 1) +
geom_ribbon(data = resultados_4_grafico, aes(x = Fecha, ymin = Inferior, ymax = Superior), alpha = 0.2, fill = "darkgreen") +
labs(title = "Producto 4 - Pronóstico Óptimo 12 meses (SARIMA)", subtitle = "Pronóstico anclado al último registro disponible", x = "Fecha", y = "Cantidad (kg)") +
theme_minimal()
