EVIDENCIA NOVEM
Maria Del Bosque
2025-05-23
# Librerías necesarias
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(readxl)
library(purrr)
library(knitr)
#install.packages("kableExtra")
library(kableExtra)##
## Attaching package: 'kableExtra'
##
## The following object is masked from 'package:dplyr':
##
## group_rowslibrary(ggplot2)
#install.packages("igraph")
library(igraph)##
## Attaching package: 'igraph'
##
## The following objects are masked from 'package:lubridate':
##
## %--%, union
##
## The following objects are masked from 'package:dplyr':
##
## as_data_frame, groups, union
##
## The following objects are masked from 'package:purrr':
##
## compose, simplify
##
## The following object is masked from 'package:tidyr':
##
## crossing
##
## The following object is masked from 'package:tibble':
##
## as_data_frame
##
## The following objects are masked from 'package:stats':
##
## decompose, spectrum
##
## The following object is masked from 'package:base':
##
## union#install.packages("forecast")
#install.packages("lubridate")
library(forecast)## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(lubridate)
library(corrplot)## corrplot 0.95 loadedlibrary(RColorBrewer)
#install.packages("ggcorrplot")
library(ggcorrplot)
library(caret)## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## liftlibrary(car)## Loading required package: carData
##
## Attaching package: 'car'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following object is masked from 'package:purrr':
##
## somelibrary(randomForest)## randomForest 4.7-1.2
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
##
## The following object is masked from 'package:dplyr':
##
## combine
##
## The following object is masked from 'package:ggplot2':
##
## margin#install.packages("xgboost")
library(xgboost)##
## Attaching package: 'xgboost'
##
## The following object is masked from 'package:dplyr':
##
## slice#install.packages("patchwork")
library(patchwork)# Cargar archivo Excel desde ruta local
ruta <- "/Users/mariadelbosque/Downloads/top_5_products.xlsx"
datos <- read_excel(ruta)
# Vista general
head(datos)## # A tibble: 6 × 26
## Trx_Num Trx_Fecha Origen Sucursal Num_Cliente ID_Inventario Cant
## <dbl> <dttm> <chr> <chr> <dbl> <dbl> <dbl>
## 1 3954 2023-02-25 00:00:00 NOTAS DE… ACA 1049 155001 -2
## 2 46453 2023-02-09 00:00:00 FACTURAS… ACA 1049 155001 2
## 3 46455 2023-02-09 00:00:00 FACTURAS… ACA 7455 155001 40
## 4 46476 2023-02-16 00:00:00 FACTURAS… ACA 4981 155001 30
## 5 46480 2023-02-16 00:00:00 FACTURAS… ACA 7455 155001 60
## 6 46501 2023-02-20 00:00:00 FACTURAS… ACA 2925 155001 5
## # ℹ 19 more variables: Linea <chr>, Especifico <chr>, Canal_Venta <chr>,
## # Tipo_Precio <dbl>, Tipo_Modificador <chr>, Venta <dbl>, Costo_Venta <dbl>,
## # Costo_Devolucion <dbl>, Ajus_Sistema <dbl>, Ajuste_Manual <dbl>,
## # Precio_Lista_Unitario <dbl>, Precio_Final_Unitario <dbl>, Semana <dbl>,
## # Mes <dbl>, Ciudad <chr>, Zona <chr>, Devoluciones <dbl>,
## # Diferencia_Precio <dbl>, Descuento_Porcentaje <dbl>str(datos)## tibble [32,684 × 26] (S3: tbl_df/tbl/data.frame)
## $ Trx_Num : num [1:32684] 3954 46453 46455 46476 46480 ...
## $ Trx_Fecha : POSIXct[1:32684], format: "2023-02-25" "2023-02-09" ...
## $ Origen : chr [1:32684] "NOTAS DE CREDITO IMPORTADAS" "FACTURAS IMPORTADAS" "FACTURAS IMPORTADAS" "FACTURAS IMPORTADAS" ...
## $ Sucursal : chr [1:32684] "ACA" "ACA" "ACA" "ACA" ...
## $ Num_Cliente : num [1:32684] 1049 1049 7455 4981 7455 ...
## $ ID_Inventario : num [1:32684] 155001 155001 155001 155001 155001 ...
## $ Cant : num [1:32684] -2 2 40 30 60 5 2 1 4 1 ...
## $ Linea : chr [1:32684] "PQU" "PQU" "PQU" "PQU" ...
## $ Especifico : chr [1:32684] "TCG" "TCG" "TCG" "TCG" ...
## $ Canal_Venta : chr [1:32684] "Sucursal" "Sucursal" "Sucursal" "Sucursal" ...
## $ Tipo_Precio : num [1:32684] 1 1 1 1 1 1 1 1 1 1 ...
## $ Tipo_Modificador : chr [1:32684] "CARTA DESCUENTO" "CARTA DESCUENTO" "CARTA DESCUENTO" "CARTA DESCUENTO" ...
## $ Venta : num [1:32684] -1187 1187 21280 15960 31920 ...
## $ Costo_Venta : num [1:32684] 0 1194 23874 17906 35811 ...
## $ Costo_Devolucion : num [1:32684] 958 0 0 0 0 ...
## $ Ajus_Sistema : num [1:32684] -2515 -2515 -2515 -2515 -2515 ...
## $ Ajuste_Manual : num [1:32684] -1083 -1083 -1145 -1145 -1145 ...
## $ Precio_Lista_Unitario: num [1:32684] 4192 4192 4192 4192 4192 ...
## $ Precio_Final_Unitario: num [1:32684] 594 594 532 532 532 ...
## $ Semana : num [1:32684] 8 6 6 7 7 8 8 5 5 5 ...
## $ Mes : num [1:32684] 2 2 2 2 2 2 2 2 2 2 ...
## $ Ciudad : chr [1:32684] "Acapulco" "Acapulco" "Acapulco" "Acapulco" ...
## $ Zona : chr [1:32684] "Sur" "Sur" "Sur" "Sur" ...
## $ Devoluciones : num [1:32684] 1 0 0 0 0 0 0 0 0 0 ...
## $ Diferencia_Precio : num [1:32684] 3598 3598 3660 3660 3660 ...
## $ Descuento_Porcentaje : num [1:32684] 85.8 85.8 87.3 87.3 87.3 ...# Obtener los 5 productos más vendidos (por valor)
top_ids <- datos %>%
group_by(ID_Inventario) %>%
summarise(Ventas_Totales = sum(Venta, na.rm = TRUE)) %>%
arrange(desc(Ventas_Totales)) %>%
slice_head(n = 5) %>%
pull(ID_Inventario)
print("Top 5 productos más vendidos (ID_Inventario):")## [1] "Top 5 productos más vendidos (ID_Inventario):"print(top_ids)## [1] 155001 3929788 3904152 155002 3678055# Filtrar datos válidos
datos_filtrados <- datos %>%
filter(ID_Inventario %in% top_ids) %>%
filter(!is.na(Precio_Final_Unitario))
# Contar observaciones por producto
conteo <- datos_filtrados %>%
count(ID_Inventario, sort = TRUE)
print("Número de registros por producto en datos_filtrados:")## [1] "Número de registros por producto en datos_filtrados:"print(conteo)## # A tibble: 5 × 2
## ID_Inventario n
## <dbl> <int>
## 1 3929788 13856
## 2 155001 8662
## 3 155002 5837
## 4 3904152 2616
## 5 3678055 1713# Verifica si hay suficientes datos
if (nrow(datos_filtrados) == 0) {
stop("No hay datos suficientes luego de filtrar por top_ids y precios válidos.")
}# Combinaciones de pares
productos <- unique(datos_filtrados$ID_Inventario)
pares_productos <- combn(productos, 2, simplify = FALSE)
# Inicializar resultados
resultados_ks <- map_df(pares_productos, function(par) {
prod1 <- par[1]
prod2 <- par[2]
precios1 <- datos_filtrados %>%
filter(ID_Inventario == prod1) %>%
pull(Precio_Final_Unitario)
precios2 <- datos_filtrados %>%
filter(ID_Inventario == prod2) %>%
pull(Precio_Final_Unitario)
print(paste("Comparando productos", prod1, "vs", prod2))
print(paste("Cantidad de precios:", length(precios1), "y", length(precios2)))
if (length(precios1) >= 5 & length(precios2) >= 5) {
prueba <- suppressWarnings(ks.test(precios1, precios2))
data.frame(
Producto_1 = prod1,
Producto_2 = prod2,
D = round(prueba$statistic, 4),
p_value = round(prueba$p.value, 4),
Conclusion = ifelse(prueba$p.value > 0.05, "Distribuciones similares", "Distribuciones diferentes")
)
} else {
data.frame(
Producto_1 = prod1,
Producto_2 = prod2,
D = NA,
p_value = NA,
Conclusion = "Datos insuficientes"
)
}
})## [1] "Comparando productos 155001 vs 3929788"
## [1] "Cantidad de precios: 8662 y 13856"
## [1] "Comparando productos 155001 vs 155002"
## [1] "Cantidad de precios: 8662 y 5837"
## [1] "Comparando productos 155001 vs 3904152"
## [1] "Cantidad de precios: 8662 y 2616"
## [1] "Comparando productos 155001 vs 3678055"
## [1] "Cantidad de precios: 8662 y 1713"
## [1] "Comparando productos 3929788 vs 155002"
## [1] "Cantidad de precios: 13856 y 5837"
## [1] "Comparando productos 3929788 vs 3904152"
## [1] "Cantidad de precios: 13856 y 2616"
## [1] "Comparando productos 3929788 vs 3678055"
## [1] "Cantidad de precios: 13856 y 1713"
## [1] "Comparando productos 155002 vs 3904152"
## [1] "Cantidad de precios: 5837 y 2616"
## [1] "Comparando productos 155002 vs 3678055"
## [1] "Cantidad de precios: 5837 y 1713"
## [1] "Comparando productos 3904152 vs 3678055"
## [1] "Cantidad de precios: 2616 y 1713"print("Resultados de la prueba KS:")## [1] "Resultados de la prueba KS:"print(resultados_ks)## Producto_1 Producto_2 D p_value Conclusion
## D...1 155001 3929788 1.0000 0 Distribuciones diferentes
## D...2 155001 155002 0.0419 0 Distribuciones diferentes
## D...3 155001 3904152 1.0000 0 Distribuciones diferentes
## D...4 155001 3678055 1.0000 0 Distribuciones diferentes
## D...5 3929788 155002 1.0000 0 Distribuciones diferentes
## D...6 3929788 3904152 1.0000 0 Distribuciones diferentes
## D...7 3929788 3678055 1.0000 0 Distribuciones diferentes
## D...8 155002 3904152 1.0000 0 Distribuciones diferentes
## D...9 155002 3678055 1.0000 0 Distribuciones diferentes
## D...10 3904152 3678055 1.0000 0 Distribuciones diferentes# Filtrar los productos
df_155001 <- datos_filtrados %>%
filter(ID_Inventario == 155001) %>%
select(Precio_Final_Unitario) %>%
mutate(Producto = "155001")
df_155002 <- datos_filtrados %>%
filter(ID_Inventario == 155002) %>%
select(Precio_Final_Unitario) %>%
mutate(Producto = "155002")
# Unir en un solo dataframe
df_ecdf <- bind_rows(df_155001, df_155002)
# Graficar ECDF
ggplot(df_ecdf, aes(x = Precio_Final_Unitario, color = Producto)) +
stat_ecdf(geom = "step", size = 1) +
labs(title = "ECDF de Precio Final Unitario: Productos 155001 vs 155002",
x = "Precio Final Unitario",
y = "Función de Distribución Acumulada (ECDF)",
color = "Producto") +
theme_minimal(base_size = 14)## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# ARMA ## PRODUCTO 155001
colnames(datos_filtrados)## [1] "Trx_Num" "Trx_Fecha" "Origen"
## [4] "Sucursal" "Num_Cliente" "ID_Inventario"
## [7] "Cant" "Linea" "Especifico"
## [10] "Canal_Venta" "Tipo_Precio" "Tipo_Modificador"
## [13] "Venta" "Costo_Venta" "Costo_Devolucion"
## [16] "Ajus_Sistema" "Ajuste_Manual" "Precio_Lista_Unitario"
## [19] "Precio_Final_Unitario" "Semana" "Mes"
## [22] "Ciudad" "Zona" "Devoluciones"
## [25] "Diferencia_Precio" "Descuento_Porcentaje"# Crear serie de tiempo con base en Ventas en dinero (para producto 155001)
ventas_mensuales <- datos_filtrados %>%
filter(ID_Inventario == 155001) %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month"))) %>% # 👈 se fuerza a Date
group_by(Fecha) %>%
summarise(Venta = sum(Venta, na.rm = TRUE)) %>%
arrange(Fecha)
# Crear serie de tiempo
serie_ts <- ts(ventas_mensuales$Venta, frequency = 12, start = c(year(min(ventas_mensuales$Fecha)), month(min(ventas_mensuales$Fecha))))
# Gráfico estacional por mes con Ventas
ggseasonplot(serie_ts, year.labels = TRUE) +
labs(title = "Gráfico estacional por mes", y = "Ventas (dinero)", x = "Mes")
acf(serie_ts)
pacf(serie_ts)
# PREDICCIONES DE VENTAS
modelo_arma <- auto.arima(serie_ts, seasonal = FALSE, stepwise = FALSE, approximation = FALSE)
modelo_sarima <- auto.arima(serie_ts, seasonal = TRUE, stepwise = FALSE, approximation = FALSE)
cat("AIC ARMA:", modelo_arma$aic, "\n")## AIC ARMA: 664.0425cat("AIC SARIMA:", modelo_sarima$aic, "\n")## AIC SARIMA: 664.0425if (modelo_arma$aic < modelo_sarima$aic) {
mejor_modelo <- modelo_arma
modelo_usado <- "ARMA"
} else if (modelo_sarima$aic < modelo_arma$aic) {
mejor_modelo <- modelo_sarima
modelo_usado <- "SARIMA"
} else {
mejor_modelo <- modelo_arma
modelo_usado <- "ARMA (por empate)"
}
forecast_modelo <- forecast(mejor_modelo, h = 3)
autoplot(forecast_modelo) +
labs(title = paste("Pronóstico mensual de ventas -", modelo_usado, "(Producto 155001)"),
x = "Mes", y = "Ventas ($)") +
theme_minimal()
ventas_historicas <- ventas_mensuales %>%
select(Fecha, Venta) %>%
mutate(
Tipo = "Histórico",
IC_Inferior = NA,
IC_Superior = NA
)
predicciones <- data.frame(
Fecha = seq.Date(from = max(ventas_historicas$Fecha) %m+% months(1),
by = "month", length.out = 3),
Venta = as.numeric(forecast_modelo$mean),
IC_Inferior = as.numeric(forecast_modelo$lower[,2]),
IC_Superior = as.numeric(forecast_modelo$upper[,2]),
Tipo = "Pronóstico"
)
tabla_completa <- bind_rows(ventas_historicas, predicciones) %>%
arrange(Fecha)
tabla_completa %>%
kable(digits = 2, caption = "Ventas mensuales y pronóstico - Producto 155001") %>%
kable_styling(full_width = FALSE)| Fecha | Venta | Tipo | IC_Inferior | IC_Superior |
|---|---|---|---|---|
| 2023-01-01 | 765135.7 | Histórico | NA | NA |
| 2023-02-01 | 709227.5 | Histórico | NA | NA |
| 2023-03-01 | 898405.1 | Histórico | NA | NA |
| 2023-04-01 | 843544.8 | Histórico | NA | NA |
| 2023-05-01 | 1103547.4 | Histórico | NA | NA |
| 2023-06-01 | 1229308.2 | Histórico | NA | NA |
| 2023-07-01 | 868233.5 | Histórico | NA | NA |
| 2023-08-01 | 1530224.9 | Histórico | NA | NA |
| 2023-09-01 | 1184488.5 | Histórico | NA | NA |
| 2023-10-01 | 1209917.8 | Histórico | NA | NA |
| 2023-11-01 | 784330.1 | Histórico | NA | NA |
| 2023-12-01 | 765147.0 | Histórico | NA | NA |
| 2024-01-01 | 763581.1 | Histórico | NA | NA |
| 2024-02-01 | 687222.5 | Histórico | NA | NA |
| 2024-03-01 | 740704.4 | Histórico | NA | NA |
| 2024-04-01 | 983570.8 | Histórico | NA | NA |
| 2024-05-01 | 1418016.7 | Histórico | NA | NA |
| 2024-06-01 | 1189873.6 | Histórico | NA | NA |
| 2024-07-01 | 1398347.2 | Histórico | NA | NA |
| 2024-08-01 | 1112443.4 | Histórico | NA | NA |
| 2024-09-01 | 1099078.6 | Histórico | NA | NA |
| 2024-10-01 | 1196470.8 | Histórico | NA | NA |
| 2024-11-01 | 922782.1 | Histórico | NA | NA |
| 2024-12-01 | 847560.6 | Histórico | NA | NA |
| 2025-01-01 | 932653.8 | Pronóstico | 489202.8 | 1376105 |
| 2025-02-01 | 969666.8 | Pronóstico | 486081.7 | 1453252 |
| 2025-03-01 | 985766.3 | Pronóstico | 494956.9 | 1476576 |
# Mostrar resumen del modelo y diagnóstico
cat("Modelo seleccionado:", modelo_usado, "\n")## Modelo seleccionado: ARMA (por empate)summary(mejor_modelo)## Series: serie_ts
## ARIMA(1,0,0) with non-zero mean
##
## Coefficients:
## ar1 mean
## 0.4350 998160.07
## s.e. 0.1839 76353.41
##
## sigma^2 = 5.119e+10: log likelihood = -329.02
## AIC=664.04 AICc=665.24 BIC=667.58
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 5189.894 216622.3 174665.7 -3.834784 17.48586 1.078845 -0.06891323checkresiduals(mejor_modelo)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,0,0) with non-zero mean
## Q* = 4.5458, df = 4, p-value = 0.3371
##
## Model df: 1. Total lags used: 5# Usar los valores ajustados del modelo para calcular las métricas
# Obtener los valores ajustados (fitted values)
fitted_values <- fitted(mejor_modelo)
# Calcular RMSE (Root Mean Squared Error)
rmse_modelo <- sqrt(mean((serie_ts - fitted_values)^2))
# Calcular MAPE (Mean Absolute Percentage Error) - con protección contra división por cero
mape_modelo <- mean(abs((serie_ts - fitted_values) / pmax(serie_ts, 0.01))) * 100
# Calcular MSE (Mean Squared Error)
mse_modelo <- mean((serie_ts - fitted_values)^2)
# Calcular R²
sse_modelo <- sum((serie_ts - fitted_values)^2)
sst_modelo <- sum((serie_ts - mean(serie_ts))^2)
r2_modelo <- 1 - (sse_modelo / sst_modelo)
# Mostrar las métricas
cat("R² del modelo", modelo_usado, "para 155001:", r2_modelo, "\n")## R² del modelo ARMA (por empate) para 155001: 0.1923463cat("AIC del modelo", modelo_usado, "para 155001:", mejor_modelo$aic, "\n")## AIC del modelo ARMA (por empate) para 155001: 664.0425cat("RMSE del modelo", modelo_usado, "para 155001:", rmse_modelo, "\n")## RMSE del modelo ARMA (por empate) para 155001: 216622.3cat("MAPE del modelo", modelo_usado, "para 155001:", mape_modelo, "\n")## MAPE del modelo ARMA (por empate) para 155001: 17.48586cat("MSE del modelo", modelo_usado, "para 155001:", mse_modelo, "\n")## MSE del modelo ARMA (por empate) para 155001: 46925242372# Guardar métricas ARMA/SARIMA para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "155001", # Cambia este ID para cada producto
Modelo = "ARMA/SARIMA",
R2 = r2_modelo,
RMSE = rmse_modelo,
MAPE = mape_modelo,
MSE = mse_modelo,
AIC = mejor_modelo$aic
))PRODUCTO 3929788
id_producto <- 3929788
ventas_mensuales <- datos_filtrados %>%
filter(ID_Inventario == id_producto) %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month"))) %>%
group_by(Fecha) %>%
summarise(Venta = sum(Venta, na.rm = TRUE), .groups = "drop") %>%
arrange(Fecha)
serie_ts <- ts(ventas_mensuales$Venta,
frequency = 12,
start = c(year(min(ventas_mensuales$Fecha)), month(min(ventas_mensuales$Fecha))))modelo_arma <- auto.arima(serie_ts, seasonal = FALSE, stepwise = FALSE, approximation = FALSE)
modelo_sarima <- auto.arima(serie_ts, seasonal = TRUE, stepwise = FALSE, approximation = FALSE)
cat("AIC ARMA:", modelo_arma$aic, "\n")## AIC ARMA: 619.6674cat("AIC SARIMA:", modelo_sarima$aic, "\n")## AIC SARIMA: 619.6674if (modelo_arma$aic < modelo_sarima$aic) {
mejor_modelo <- modelo_arma
modelo_usado <- "ARMA"
} else if (modelo_sarima$aic < modelo_arma$aic) {
mejor_modelo <- modelo_sarima
modelo_usado <- "SARIMA"
} else {
mejor_modelo <- modelo_arma
modelo_usado <- "ARMA (por empate)"
}
forecast_modelo <- forecast(mejor_modelo, h = 3)
autoplot(forecast_modelo) +
labs(title = paste("Pronóstico mensual de ventas -", modelo_usado, "(Producto 3929788)"),
x = "Mes", y = "Ventas ($)") +
theme_minimal()
predicciones <- data.frame(
Fecha = seq.Date(from = max(ventas_historicas$Fecha) %m+% months(1),
by = "month", length.out = 3),
Venta = as.numeric(forecast_modelo$mean),
IC_Inferior = as.numeric(forecast_modelo$lower[,2]),
IC_Superior = as.numeric(forecast_modelo$upper[,2]),
Tipo = "Pronóstico"
)
tabla_completa <- bind_rows(ventas_historicas, predicciones) %>%
arrange(Fecha)
# Mostrar tabla
tabla_completa %>%
kable(digits = 2, caption = "Ventas mensuales y pronóstico - Producto 3929788") %>%
kable_styling(full_width = FALSE)| Fecha | Venta | Tipo | IC_Inferior | IC_Superior |
|---|---|---|---|---|
| 2023-01-01 | 765135.7 | Histórico | NA | NA |
| 2023-02-01 | 709227.5 | Histórico | NA | NA |
| 2023-03-01 | 898405.1 | Histórico | NA | NA |
| 2023-04-01 | 843544.8 | Histórico | NA | NA |
| 2023-05-01 | 1103547.4 | Histórico | NA | NA |
| 2023-06-01 | 1229308.2 | Histórico | NA | NA |
| 2023-07-01 | 868233.5 | Histórico | NA | NA |
| 2023-08-01 | 1530224.9 | Histórico | NA | NA |
| 2023-09-01 | 1184488.5 | Histórico | NA | NA |
| 2023-10-01 | 1209917.8 | Histórico | NA | NA |
| 2023-11-01 | 784330.1 | Histórico | NA | NA |
| 2023-12-01 | 765147.0 | Histórico | NA | NA |
| 2024-01-01 | 763581.1 | Histórico | NA | NA |
| 2024-02-01 | 687222.5 | Histórico | NA | NA |
| 2024-03-01 | 740704.4 | Histórico | NA | NA |
| 2024-04-01 | 983570.8 | Histórico | NA | NA |
| 2024-05-01 | 1418016.7 | Histórico | NA | NA |
| 2024-06-01 | 1189873.6 | Histórico | NA | NA |
| 2024-07-01 | 1398347.2 | Histórico | NA | NA |
| 2024-08-01 | 1112443.4 | Histórico | NA | NA |
| 2024-09-01 | 1099078.6 | Histórico | NA | NA |
| 2024-10-01 | 1196470.8 | Histórico | NA | NA |
| 2024-11-01 | 922782.1 | Histórico | NA | NA |
| 2024-12-01 | 847560.6 | Histórico | NA | NA |
| 2025-01-01 | 935659.1 | Pronóstico | 633446.1 | 1237872 |
| 2025-02-01 | 932705.6 | Pronóstico | 627634.8 | 1237776 |
| 2025-03-01 | 944878.9 | Pronóstico | 618678.4 | 1271079 |
# Mostrar resumen del modelo y diagnóstico
cat("Modelo seleccionado:", modelo_usado, "\n")## Modelo seleccionado: ARMA (por empate)summary(mejor_modelo)## Series: serie_ts
## ARIMA(2,1,0)
##
## Coefficients:
## ar1 ar2
## -0.8622 -0.4990
## s.e. 0.1764 0.1841
##
## sigma^2 = 2.378e+10: log likelihood = -306.83
## AIC=619.67 AICc=620.93 BIC=623.07
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 13227.22 144234.5 121979.8 -0.4466725 13.19875 0.5210489
## ACF1
## Training set 0.07347353checkresiduals(mejor_modelo)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(2,1,0)
## Q* = 3.5633, df = 3, p-value = 0.3126
##
## Model df: 2. Total lags used: 5# Usar los valores ajustados del modelo para calcular las métricas
# Obtener los valores ajustados (fitted values)
fitted_values <- fitted(mejor_modelo)
# Calcular RMSE (Root Mean Squared Error)
rmse_modelo <- sqrt(mean((serie_ts - fitted_values)^2))
# Calcular MAPE (Mean Absolute Percentage Error) - con protección contra división por cero
mape_modelo <- mean(abs((serie_ts - fitted_values) / pmax(serie_ts, 0.01))) * 100
# Calcular MSE (Mean Squared Error)
mse_modelo <- mean((serie_ts - fitted_values)^2)
# Calcular R²
sse_modelo <- sum((serie_ts - fitted_values)^2)
sst_modelo <- sum((serie_ts - mean(serie_ts))^2)
r2_modelo <- 1 - (sse_modelo / sst_modelo)
# Mostrar las métricas
cat("R² del modelo", modelo_usado, "para 3929788:", r2_modelo, "\n")## R² del modelo ARMA (por empate) para 3929788: 0.2466637cat("AIC del modelo", modelo_usado, "para 3929788:", mejor_modelo$aic, "\n")## AIC del modelo ARMA (por empate) para 3929788: 619.6674cat("RMSE del modelo", modelo_usado, "para 3929788:", rmse_modelo, "\n")## RMSE del modelo ARMA (por empate) para 3929788: 144234.5cat("MAPE del modelo", modelo_usado, "para 3929788:", mape_modelo, "\n")## MAPE del modelo ARMA (por empate) para 3929788: 13.19875cat("MSE del modelo", modelo_usado, "para 3929788:", mse_modelo, "\n")## MSE del modelo ARMA (por empate) para 3929788: 20803579371# Guardar métricas ARMA/SARIMA para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3929788", # Cambia este ID para cada producto
Modelo = "ARMA/SARIMA",
R2 = r2_modelo,
RMSE = rmse_modelo,
MAPE = mape_modelo,
MSE = mse_modelo,
AIC = mejor_modelo$aic
))PRODUCTO 3904152
# Establecer el ID del producto
id_producto <- 3904152
# Agrupar ventas mensuales
ventas_mensuales <- datos_filtrados %>%
filter(ID_Inventario == id_producto) %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month"))) %>%
group_by(Fecha) %>%
summarise(Venta = sum(Venta, na.rm = TRUE), .groups = "drop") %>%
arrange(Fecha)
# Crear serie de tiempo mensual
serie_ts <- ts(ventas_mensuales$Venta, frequency = 12,
start = c(year(min(ventas_mensuales$Fecha)), month(min(ventas_mensuales$Fecha))))# Ajustar modelos ARMA y SARIMA
modelo_arma <- auto.arima(serie_ts, seasonal = FALSE, stepwise = FALSE, approximation = FALSE)
modelo_sarima <- auto.arima(serie_ts, seasonal = TRUE, stepwise = FALSE, approximation = FALSE)
# Mostrar AIC de ambos modelos
cat("AIC ARMA:", modelo_arma$aic, "\n")## AIC ARMA: 647.2636cat("AIC SARIMA:", modelo_sarima$aic, "\n")## AIC SARIMA: 647.2636# Seleccionar el mejor modelo
if (modelo_arma$aic < modelo_sarima$aic) {
mejor_modelo <- modelo_arma
modelo_usado <- "ARMA"
} else if (modelo_sarima$aic < modelo_arma$aic) {
mejor_modelo <- modelo_sarima
modelo_usado <- "SARIMA"
} else {
mejor_modelo <- modelo_arma
modelo_usado <- "ARMA (por empate)"
}
# Generar pronóstico a 3 meses
forecast_modelo <- forecast(mejor_modelo, h = 3)
autoplot(forecast_modelo) +
labs(title = paste("Pronóstico mensual de ventas -", modelo_usado, "(Producto 3904152)"),
x = "Mes", y = "Ventas ($)") +
theme_minimal()
# Construir tabla combinada de histórico y predicción
ventas_historicas <- ventas_mensuales %>%
select(Fecha, Venta) %>%
mutate(Tipo = "Histórico", IC_Inferior = NA, IC_Superior = NA)
predicciones <- data.frame(
Fecha = seq.Date(from = max(ventas_historicas$Fecha) %m+% months(1),
by = "month", length.out = 3),
Venta = as.numeric(forecast_modelo$mean),
IC_Inferior = as.numeric(forecast_modelo$lower[,2]),
IC_Superior = as.numeric(forecast_modelo$upper[,2]),
Tipo = "Pronóstico"
)
tabla_completa <- bind_rows(ventas_historicas, predicciones) %>%
arrange(Fecha)
# Mostrar tabla
tabla_completa %>%
kable(digits = 2, caption = "Ventas mensuales y pronóstico - Producto 3904152") %>%
kable_styling(full_width = FALSE)| Fecha | Venta | Tipo | IC_Inferior | IC_Superior |
|---|---|---|---|---|
| 2023-01-01 | 799075.1 | Histórico | NA | NA |
| 2023-02-01 | 631883.7 | Histórico | NA | NA |
| 2023-03-01 | 850263.4 | Histórico | NA | NA |
| 2023-04-01 | 653134.2 | Histórico | NA | NA |
| 2023-05-01 | 835093.8 | Histórico | NA | NA |
| 2023-06-01 | 727430.8 | Histórico | NA | NA |
| 2023-07-01 | 489240.9 | Histórico | NA | NA |
| 2023-08-01 | 782323.2 | Histórico | NA | NA |
| 2023-09-01 | 851668.9 | Histórico | NA | NA |
| 2023-10-01 | 680519.4 | Histórico | NA | NA |
| 2023-11-01 | 1136816.4 | Histórico | NA | NA |
| 2023-12-01 | 915402.7 | Histórico | NA | NA |
| 2024-01-01 | 834988.8 | Histórico | NA | NA |
| 2024-02-01 | 767570.1 | Histórico | NA | NA |
| 2024-03-01 | 566158.9 | Histórico | NA | NA |
| 2024-04-01 | 784431.1 | Histórico | NA | NA |
| 2024-05-01 | 914803.8 | Histórico | NA | NA |
| 2024-06-01 | 881416.7 | Histórico | NA | NA |
| 2024-07-01 | 630550.9 | Histórico | NA | NA |
| 2024-08-01 | 1156776.8 | Histórico | NA | NA |
| 2024-09-01 | 796120.5 | Histórico | NA | NA |
| 2024-10-01 | 787514.2 | Histórico | NA | NA |
| 2024-11-01 | 839937.8 | Histórico | NA | NA |
| 2024-12-01 | 507597.4 | Histórico | NA | NA |
| 2025-01-01 | 784196.6 | Pronóstico | 464031.8 | 1104362 |
| 2025-02-01 | 784196.6 | Pronóstico | 464031.8 | 1104362 |
| 2025-03-01 | 784196.6 | Pronóstico | 464031.8 | 1104362 |
# Mostrar resumen del modelo y diagnóstico
cat("Modelo seleccionado:", modelo_usado, "\n")## Modelo seleccionado: ARMA (por empate)summary(mejor_modelo)## Series: serie_ts
## ARIMA(0,0,0) with non-zero mean
##
## Coefficients:
## mean
## 784196.63
## s.e. 32641.98
##
## sigma^2 = 2.668e+10: log likelihood = -321.63
## AIC=647.26 AICc=647.83 BIC=649.62
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -3.225675e-10 159913 117129.8 -4.420423 16.18578 0.6378203
## ACF1
## Training set -0.1164644checkresiduals(mejor_modelo)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(0,0,0) with non-zero mean
## Q* = 5.788, df = 5, p-value = 0.3274
##
## Model df: 0. Total lags used: 5# Usar los valores ajustados del modelo para calcular las métricas
# Obtener los valores ajustados (fitted values)
fitted_values <- fitted(mejor_modelo)
# Calcular RMSE (Root Mean Squared Error)
rmse_modelo <- sqrt(mean((serie_ts - fitted_values)^2))
# Calcular MAPE (Mean Absolute Percentage Error) - con protección contra división por cero
mape_modelo <- mean(abs((serie_ts - fitted_values) / pmax(serie_ts, 0.01))) * 100
# Calcular MSE (Mean Squared Error)
mse_modelo <- mean((serie_ts - fitted_values)^2)
# Calcular R²
sse_modelo <- sum((serie_ts - fitted_values)^2)
sst_modelo <- sum((serie_ts - mean(serie_ts))^2)
r2_modelo <- 1 - (sse_modelo / sst_modelo)
# Mostrar las métricas
cat("R² del modelo", modelo_usado, "para 3904152:", r2_modelo, "\n")## R² del modelo ARMA (por empate) para 3904152: 0cat("AIC del modelo", modelo_usado, "para 3904152:", mejor_modelo$aic, "\n")## AIC del modelo ARMA (por empate) para 3904152: 647.2636cat("RMSE del modelo", modelo_usado, "para 3904152:", rmse_modelo, "\n")## RMSE del modelo ARMA (por empate) para 3904152: 159913cat("MAPE del modelo", modelo_usado, "para 3904152:", mape_modelo, "\n")## MAPE del modelo ARMA (por empate) para 3904152: 16.18578cat("MSE del modelo", modelo_usado, "para 3904152:", mse_modelo, "\n")## MSE del modelo ARMA (por empate) para 3904152: 25572183540# Guardar métricas ARMA/SARIMA para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3904152", # Cambia este ID para cada producto
Modelo = "ARMA/SARIMA",
R2 = r2_modelo,
RMSE = rmse_modelo,
MAPE = mape_modelo,
MSE = mse_modelo,
AIC = mejor_modelo$aic
))PRODUCTO 155002
# Establecer el ID del producto
id_producto <- 155002
# Agrupar ventas mensuales
ventas_mensuales <- datos_filtrados %>%
filter(ID_Inventario == id_producto) %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month"))) %>%
group_by(Fecha) %>%
summarise(Venta = sum(Venta, na.rm = TRUE), .groups = "drop") %>%
arrange(Fecha)
# Crear serie de tiempo mensual
serie_ts <- ts(ventas_mensuales$Venta, frequency = 12,
start = c(year(min(ventas_mensuales$Fecha)), month(min(ventas_mensuales$Fecha))))# Ajustar modelos ARMA y SARIMA
modelo_arma <- auto.arima(serie_ts, seasonal = FALSE, stepwise = FALSE, approximation = FALSE)
modelo_sarima <- auto.arima(serie_ts, seasonal = TRUE, stepwise = FALSE, approximation = FALSE)
# Mostrar AIC de ambos modelos
cat("AIC ARMA:", modelo_arma$aic, "\n")## AIC ARMA: 659.9971cat("AIC SARIMA:", modelo_sarima$aic, "\n")## AIC SARIMA: 659.9971# Seleccionar el mejor modelo
if (modelo_arma$aic < modelo_sarima$aic) {
mejor_modelo <- modelo_arma
modelo_usado <- "ARMA"
} else if (modelo_sarima$aic < modelo_arma$aic) {
mejor_modelo <- modelo_sarima
modelo_usado <- "SARIMA"
} else {
mejor_modelo <- modelo_arma
modelo_usado <- "ARMA (por empate)"
}
# Generar pronóstico a 3 meses
forecast_modelo <- forecast(mejor_modelo, h = 3)
autoplot(forecast_modelo) +
labs(title = paste("Pronóstico mensual de ventas -", modelo_usado, "(Producto 155002)"),
x = "Mes", y = "Ventas ($)") +
theme_minimal()
# Construir tabla combinada de histórico y predicción
ventas_historicas <- ventas_mensuales %>%
select(Fecha, Venta) %>%
mutate(Tipo = "Histórico", IC_Inferior = NA, IC_Superior = NA)
predicciones <- data.frame(
Fecha = seq.Date(from = max(ventas_historicas$Fecha) %m+% months(1),
by = "month", length.out = 3),
Venta = as.numeric(forecast_modelo$mean),
IC_Inferior = as.numeric(forecast_modelo$lower[,2]),
IC_Superior = as.numeric(forecast_modelo$upper[,2]),
Tipo = "Pronóstico"
)
tabla_completa <- bind_rows(ventas_historicas, predicciones) %>%
arrange(Fecha)
# Mostrar tabla
tabla_completa %>%
kable(digits = 2, caption = "Ventas mensuales y pronóstico - Producto 155002") %>%
kable_styling(full_width = FALSE)| Fecha | Venta | Tipo | IC_Inferior | IC_Superior |
|---|---|---|---|---|
| 2023-01-01 | 484267.0 | Histórico | NA | NA |
| 2023-02-01 | 356929.8 | Histórico | NA | NA |
| 2023-03-01 | 849531.5 | Histórico | NA | NA |
| 2023-04-01 | 586246.4 | Histórico | NA | NA |
| 2023-05-01 | 870550.9 | Histórico | NA | NA |
| 2023-06-01 | 840797.0 | Histórico | NA | NA |
| 2023-07-01 | 482272.0 | Histórico | NA | NA |
| 2023-08-01 | 1026313.2 | Histórico | NA | NA |
| 2023-09-01 | 686875.0 | Histórico | NA | NA |
| 2023-10-01 | 768111.4 | Histórico | NA | NA |
| 2023-11-01 | 337716.7 | Histórico | NA | NA |
| 2023-12-01 | 494176.2 | Histórico | NA | NA |
| 2024-01-01 | 436061.2 | Histórico | NA | NA |
| 2024-02-01 | 457276.1 | Histórico | NA | NA |
| 2024-03-01 | 492586.4 | Histórico | NA | NA |
| 2024-04-01 | 636181.4 | Histórico | NA | NA |
| 2024-05-01 | 984456.2 | Histórico | NA | NA |
| 2024-06-01 | 977578.8 | Histórico | NA | NA |
| 2024-07-01 | 1149984.8 | Histórico | NA | NA |
| 2024-08-01 | 705081.6 | Histórico | NA | NA |
| 2024-09-01 | 622780.8 | Histórico | NA | NA |
| 2024-10-01 | 742951.7 | Histórico | NA | NA |
| 2024-11-01 | 641666.6 | Histórico | NA | NA |
| 2024-12-01 | 703508.3 | Histórico | NA | NA |
| 2025-01-01 | 653573.9 | Pronóstico | 257632.8 | 1049515 |
| 2025-02-01 | 634428.4 | Pronóstico | 224044.6 | 1044812 |
| 2025-03-01 | 668385.1 | Pronóstico | 205710.5 | 1131060 |
# Mostrar resumen del modelo y diagnóstico
cat("Modelo seleccionado:", modelo_usado, "\n")## Modelo seleccionado: ARMA (por empate)summary(mejor_modelo)## Series: serie_ts
## ARIMA(0,0,2) with non-zero mean
##
## Coefficients:
## ma1 ma2 mean
## 0.2726 0.5396 668385.14
## s.e. 0.1612 0.2136 67923.92
##
## sigma^2 = 4.081e+10: log likelihood = -326
## AIC=660 AICc=662.1 BIC=664.71
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 5999.422 188967.2 159380.3 -7.596432 25.93817 0.7976991
## ACF1
## Training set -0.01120463checkresiduals(mejor_modelo)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(0,0,2) with non-zero mean
## Q* = 0.93934, df = 3, p-value = 0.8159
##
## Model df: 2. Total lags used: 5# Usar los valores ajustados del modelo para calcular las métricas
# Obtener los valores ajustados (fitted values)
fitted_values <- fitted(mejor_modelo)
# Calcular RMSE (Root Mean Squared Error)
rmse_modelo <- sqrt(mean((serie_ts - fitted_values)^2))
# Calcular MAPE (Mean Absolute Percentage Error) - con protección contra división por cero
mape_modelo <- mean(abs((serie_ts - fitted_values) / pmax(serie_ts, 0.01))) * 100
# Calcular MSE (Mean Squared Error)
mse_modelo <- mean((serie_ts - fitted_values)^2)
# Calcular R²
sse_modelo <- sum((serie_ts - fitted_values)^2)
sst_modelo <- sum((serie_ts - mean(serie_ts))^2)
r2_modelo <- 1 - (sse_modelo / sst_modelo)
# Mostrar las métricas
cat("R² del modelo", modelo_usado, "para 155002:", r2_modelo, "\n")## R² del modelo ARMA (por empate) para 155002: 0.2341854cat("AIC del modelo", modelo_usado, "para 155002:", mejor_modelo$aic, "\n")## AIC del modelo ARMA (por empate) para 155002: 659.9971cat("RMSE del modelo", modelo_usado, "para 155002:", rmse_modelo, "\n")## RMSE del modelo ARMA (por empate) para 155002: 188967.2cat("MAPE del modelo", modelo_usado, "para 155002:", mape_modelo, "\n")## MAPE del modelo ARMA (por empate) para 155002: 25.93817cat("MSE del modelo", modelo_usado, "para 155002:", mse_modelo, "\n")## MSE del modelo ARMA (por empate) para 155002: 35708610199# Guardar métricas ARMA/SARIMA para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "155002", # Cambia este ID para cada producto
Modelo = "ARMA/SARIMA",
R2 = r2_modelo,
RMSE = rmse_modelo,
MAPE = mape_modelo,
MSE = mse_modelo,
AIC = mejor_modelo$aic
))PRODUCTO 3678055
# Establecer el ID del producto
id_producto <- 3678055
# Agrupar ventas mensuales
ventas_mensuales <- datos_filtrados %>%
filter(ID_Inventario == id_producto) %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month"))) %>%
group_by(Fecha) %>%
summarise(Venta = sum(Venta, na.rm = TRUE), .groups = "drop") %>%
arrange(Fecha)
# Crear serie de tiempo mensual
serie_ts <- ts(ventas_mensuales$Venta, frequency = 12,
start = c(year(min(ventas_mensuales$Fecha)), month(min(ventas_mensuales$Fecha))))# Ajustar modelos ARMA y SARIMA
modelo_arma <- auto.arima(serie_ts, seasonal = FALSE, stepwise = FALSE, approximation = FALSE)
modelo_sarima <- auto.arima(serie_ts, seasonal = TRUE, stepwise = FALSE, approximation = FALSE)
# Mostrar AIC de ambos modelos
cat("AIC ARMA:", modelo_arma$aic, "\n")## AIC ARMA: 650.1669cat("AIC SARIMA:", modelo_sarima$aic, "\n")## AIC SARIMA: 650.1669# Seleccionar el mejor modelo
if (modelo_arma$aic < modelo_sarima$aic) {
mejor_modelo <- modelo_arma
modelo_usado <- "ARMA"
} else if (modelo_sarima$aic < modelo_arma$aic) {
mejor_modelo <- modelo_sarima
modelo_usado <- "SARIMA"
} else {
mejor_modelo <- modelo_arma
modelo_usado <- "ARMA (por empate)"
}
# Generar pronóstico a 3 meses
forecast_modelo <- forecast(mejor_modelo, h = 3)
autoplot(forecast_modelo) +
labs(title = paste("Pronóstico mensual de ventas -", modelo_usado, "(Producto 3678055)"),
x = "Mes", y = "Ventas ($)") +
theme_minimal()
# Construir tabla combinada de histórico y predicción
ventas_historicas <- ventas_mensuales %>%
select(Fecha, Venta) %>%
mutate(Tipo = "Histórico", IC_Inferior = NA, IC_Superior = NA)
predicciones <- data.frame(
Fecha = seq.Date(from = max(ventas_historicas$Fecha) %m+% months(1),
by = "month", length.out = 3),
Venta = as.numeric(forecast_modelo$mean),
IC_Inferior = as.numeric(forecast_modelo$lower[,2]),
IC_Superior = as.numeric(forecast_modelo$upper[,2]),
Tipo = "Pronóstico"
)
tabla_completa <- bind_rows(ventas_historicas, predicciones) %>%
arrange(Fecha)
# Mostrar tabla
tabla_completa %>%
kable(digits = 2, caption = "Ventas mensuales y pronóstico - Producto 3678055") %>%
kable_styling(full_width = FALSE)| Fecha | Venta | Tipo | IC_Inferior | IC_Superior |
|---|---|---|---|---|
| 2023-01-01 | 727899.5 | Histórico | NA | NA |
| 2023-02-01 | 485061.1 | Histórico | NA | NA |
| 2023-03-01 | 907476.7 | Histórico | NA | NA |
| 2023-04-01 | 649840.0 | Histórico | NA | NA |
| 2023-05-01 | 550570.2 | Histórico | NA | NA |
| 2023-06-01 | 840594.2 | Histórico | NA | NA |
| 2023-07-01 | 466467.4 | Histórico | NA | NA |
| 2023-08-01 | 721771.1 | Histórico | NA | NA |
| 2023-09-01 | 1054439.7 | Histórico | NA | NA |
| 2023-10-01 | 643177.4 | Histórico | NA | NA |
| 2023-11-01 | 503904.6 | Histórico | NA | NA |
| 2023-12-01 | 507739.0 | Histórico | NA | NA |
| 2024-01-01 | 590547.7 | Histórico | NA | NA |
| 2024-02-01 | 350606.1 | Histórico | NA | NA |
| 2024-03-01 | 656677.1 | Histórico | NA | NA |
| 2024-04-01 | 528473.3 | Histórico | NA | NA |
| 2024-05-01 | 602836.8 | Histórico | NA | NA |
| 2024-06-01 | 588154.1 | Histórico | NA | NA |
| 2024-07-01 | 672666.2 | Histórico | NA | NA |
| 2024-08-01 | 866894.0 | Histórico | NA | NA |
| 2024-09-01 | 803128.3 | Histórico | NA | NA |
| 2024-10-01 | 621479.1 | Histórico | NA | NA |
| 2024-11-01 | 949993.2 | Histórico | NA | NA |
| 2024-12-01 | 847613.8 | Histórico | NA | NA |
| 2025-01-01 | 672417.1 | Pronóstico | 332289.1 | 1012545 |
| 2025-02-01 | 672417.1 | Pronóstico | 332289.1 | 1012545 |
| 2025-03-01 | 672417.1 | Pronóstico | 332289.1 | 1012545 |
# Mostrar resumen del modelo y diagnóstico
cat("Modelo seleccionado:", modelo_usado, "\n")## Modelo seleccionado: ARMA (por empate)summary(mejor_modelo)## Series: serie_ts
## ARIMA(0,0,0) with non-zero mean
##
## Coefficients:
## mean
## 672417.1
## s.e. 34677.7
##
## sigma^2 = 3.012e+10: log likelihood = -323.08
## AIC=650.17 AICc=650.74 BIC=652.52
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -3.953264e-10 169884 139025.5 -6.788285 22.22443 0.7072165
## ACF1
## Training set 0.04966062checkresiduals(mejor_modelo)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(0,0,0) with non-zero mean
## Q* = 3.3443, df = 5, p-value = 0.6471
##
## Model df: 0. Total lags used: 5# Usar los valores ajustados del modelo para calcular las métricas
# Obtener los valores ajustados (fitted values)
fitted_values <- fitted(mejor_modelo)
# Calcular RMSE (Root Mean Squared Error)
rmse_modelo <- sqrt(mean((serie_ts - fitted_values)^2))
# Calcular MAPE (Mean Absolute Percentage Error) - con protección contra división por cero
mape_modelo <- mean(abs((serie_ts - fitted_values) / pmax(serie_ts, 0.01))) * 100
# Calcular MSE (Mean Squared Error)
mse_modelo <- mean((serie_ts - fitted_values)^2)
# Calcular R²
sse_modelo <- sum((serie_ts - fitted_values)^2)
sst_modelo <- sum((serie_ts - mean(serie_ts))^2)
r2_modelo <- 1 - (sse_modelo / sst_modelo)
# Mostrar las métricas
cat("R² del modelo", modelo_usado, "para 3678055:", r2_modelo, "\n")## R² del modelo ARMA (por empate) para 3678055: 0cat("AIC del modelo", modelo_usado, "para 3678055:", mejor_modelo$aic, "\n")## AIC del modelo ARMA (por empate) para 3678055: 650.1669cat("RMSE del modelo", modelo_usado, "para 3678055:", rmse_modelo, "\n")## RMSE del modelo ARMA (por empate) para 3678055: 169884cat("MAPE del modelo", modelo_usado, "para 3678055:", mape_modelo, "\n")## MAPE del modelo ARMA (por empate) para 3678055: 22.22443cat("MSE del modelo", modelo_usado, "para 3678055:", mse_modelo, "\n")## MSE del modelo ARMA (por empate) para 3678055: 28860588465# Guardar métricas ARMA/SARIMA para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3678055", # Cambia este ID para cada producto
Modelo = "ARMA/SARIMA",
R2 = r2_modelo,
RMSE = rmse_modelo,
MAPE = mape_modelo,
MSE = mse_modelo,
AIC = mejor_modelo$aic
))REGRESION LINEAL
MAPA DE CALOR
# Variables numéricas relevantes
vars_numericas <- c("Cant", "Venta", "Costo_Venta", "Costo_Devolucion",
"Ajus_Sistema", "Ajuste_Manual", "Precio_Lista_Unitario",
"Precio_Final_Unitario", "Semana", "Mes", "Descuento_Porcentaje")
# Preparación de los datos
datos_cor <- datos_filtrados %>%
select(all_of(vars_numericas)) %>%
na.omit()
# Generar la matriz de correlación
matriz_cor <- cor(datos_cor)
# Ajuste del gráfico sin mar
ggcorrplot(matriz_cor,
method = "square",
type = "upper",
lab = TRUE,
lab_size = 2, # Mejor tamaño de los coeficientes
tl.cex = 10, # Tamaño de etiquetas más grande
tl.srt = 45, # Rotación de 45° de etiquetas
colors = c("#6D9EC1", "white", "#E46726"),
title = "Mapa de Correlación - Variables Numéricas",
ggtheme = theme_minimal(base_size = 14) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
axis.text.y = element_text(angle = 0, hjust = 1))
)
PRODUCTO 155001
# Filtrar solo los datos para el producto 155001
datos_155001 <- datos_filtrados %>%
filter(ID_Inventario == 155001) %>%
select(Venta, Cant, Costo_Venta, Costo_Devolucion,
Ajus_Sistema, Ajuste_Manual, Precio_Lista_Unitario,
Precio_Final_Unitario, Semana, Mes, Descuento_Porcentaje, Trx_Fecha) %>%
na.omit() # Eliminar filas con valores NA
# Crear una variable de tiempo continua basada en la fecha
datos_155001 <- datos_155001 %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month")), # Asegúrate de que la fecha esté en formato Date
Tiempo = as.numeric(Fecha - min(Fecha)) / (30 * 24 * 60 * 60)) # Tiempo en meses (ajustado por días)
# Verificar las primeras filas para asegurarnos de que la variable de tiempo esté bien creada
head(datos_155001)## # A tibble: 6 × 14
## Venta Cant Costo_Venta Costo_Devolucion Ajus_Sistema Ajuste_Manual
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 -1187. -2 0 958. -2515. -1083.
## 2 1187. 2 1194. 0 -2515. -1083.
## 3 21280 40 23874. 0 -2515. -1145.
## 4 15960 30 17906. 0 -2515. -1145.
## 5 31920 60 35811. 0 -2515. -1145.
## 6 2968 5 2570. 0 -2515. -1083.
## # ℹ 8 more variables: Precio_Lista_Unitario <dbl>, Precio_Final_Unitario <dbl>,
## # Semana <dbl>, Mes <dbl>, Descuento_Porcentaje <dbl>, Trx_Fecha <dttm>,
## # Fecha <date>, Tiempo <dbl># Ajustar el modelo de regresión lineal
modelo_regresion_155001 <- lm(Venta ~ Cant + Costo_Venta + Costo_Devolucion + Ajuste_Manual +
Precio_Lista_Unitario + Precio_Final_Unitario + Semana + Mes + Descuento_Porcentaje + Tiempo,
data = datos_155001)
# Ver resumen del modelo
summary(modelo_regresion_155001)##
## Call:
## lm(formula = Venta ~ Cant + Costo_Venta + Costo_Devolucion +
## Ajuste_Manual + Precio_Lista_Unitario + Precio_Final_Unitario +
## Semana + Mes + Descuento_Porcentaje + Tiempo, data = datos_155001)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12727.8 -127.9 1.2 136.4 24493.6
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.991e+04 3.609e+03 -5.515 3.58e-08 ***
## Cant 1.480e+02 3.347e+00 44.219 < 2e-16 ***
## Costo_Venta 7.063e-01 8.937e-03 79.030 < 2e-16 ***
## Costo_Devolucion -7.222e-01 1.020e-02 -70.778 < 2e-16 ***
## Ajuste_Manual -9.221e-02 1.494e-02 -6.173 6.99e-10 ***
## Precio_Lista_Unitario -3.664e-01 9.459e-02 -3.873 0.000108 ***
## Precio_Final_Unitario 6.711e+00 9.625e-01 6.973 3.34e-12 ***
## Semana -1.337e+00 2.591e+00 -0.516 0.605802
## Mes 2.854e+01 1.147e+01 2.488 0.012868 *
## Descuento_Porcentaje 2.044e+02 3.978e+01 5.139 2.83e-07 ***
## Tiempo 6.316e+04 2.193e+05 0.288 0.773322
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 770.5 on 8651 degrees of freedom
## Multiple R-squared: 0.9887, Adjusted R-squared: 0.9887
## F-statistic: 7.601e+04 on 10 and 8651 DF, p-value: < 2.2e-16# Ajuste del modelo de regresión lineal
modelo_regresion_155001 <- lm(Venta ~ Cant + Costo_Venta + Costo_Devolucion + Ajuste_Manual +
Precio_Lista_Unitario + Precio_Final_Unitario + Semana + Mes + Descuento_Porcentaje + Tiempo,
data = datos_155001)
# Predicciones usando el modelo ajustado
predicciones_155001 <- predict(modelo_regresion_155001, newdata = datos_155001)
# Calcular R^2 (coeficiente de determinación)
r2_155001 <- summary(modelo_regresion_155001)$r.squared
# Calcular AIC (Akaike Information Criterion)
aic_155001 <- AIC(modelo_regresion_155001)
# Calcular RMSE (Root Mean Squared Error)
rmse_155001 <- sqrt(mean((datos_155001$Venta - predicciones_155001)^2))
# Calcular MAPE (Mean Absolute Percentage Error)
mape_155001 <- mean(abs((datos_155001$Venta - predicciones_155001) / datos_155001$Venta)) * 100
# Calcular MSE (Mean Squared Error)
mse_155001 <- mean((datos_155001$Venta - predicciones_155001)^2)
# Mostrar las métricas
cat("R^2 del modelo de regresión lineal para 155001: ", r2_155001, "\n")## R^2 del modelo de regresión lineal para 155001: 0.9887468cat("AIC del modelo de regresión lineal para 155001: ", aic_155001, "\n")## AIC del modelo de regresión lineal para 155001: 139748.7cat("RMSE del modelo de regresión lineal para 155001: ", rmse_155001, "\n")## RMSE del modelo de regresión lineal para 155001: 770.0434cat("MAPE del modelo de regresión lineal para 155001: ", mape_155001, "\n")## MAPE del modelo de regresión lineal para 155001: 15.90447cat("MSE del modelo de regresión lineal para 155001: ", mse_155001, "\n")## MSE del modelo de regresión lineal para 155001: 592966.8# Diagnóstico de residuos del modelo
par(mfrow = c(2, 2))
plot(modelo_regresion_155001)
# Guardar métricas de Regresión Lineal para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "155001", # Cambia este ID para cada producto
Modelo = "Regresión Lineal",
R2 = r2_155001, # Usa el nombre específico para este producto
RMSE = rmse_155001,
MAPE = mape_155001,
MSE = mse_155001,
AIC = aic_155001
))PRODUCTO 3929788
# Filtrar solo los datos para el producto 3929788
datos_3929788 <- datos_filtrados %>%
filter(ID_Inventario == 3929788) %>%
select(Venta, Cant, Costo_Venta, Costo_Devolucion,
Ajus_Sistema, Ajuste_Manual, Precio_Lista_Unitario,
Precio_Final_Unitario, Semana, Mes, Descuento_Porcentaje, Trx_Fecha) %>%
na.omit() # Eliminar filas con valores NA
# Crear una variable de tiempo continua basada en la fecha
datos_3929788 <- datos_3929788 %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month")), # Asegúrate de que la fecha esté en formato Date
Tiempo = as.numeric(Fecha - min(Fecha)) / (30 * 24 * 60 * 60)) # Tiempo en meses (ajustado por días)
# Verificar las primeras filas para asegurarnos de que la variable de tiempo esté bien creada
head(datos_3929788)## # A tibble: 6 × 14
## Venta Cant Costo_Venta Costo_Devolucion Ajus_Sistema Ajuste_Manual
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 364 10 254. 0 -54.6 0
## 2 242. 6 167. 0 -60.5 0
## 3 -8680 -200 0 6740. -47.6 0
## 4 697. 15 506. 0 -44.5 0
## 5 13020 300 10110. 0 -47.6 0
## 6 2170 50 1685. 0 -47.6 0
## # ℹ 8 more variables: Precio_Lista_Unitario <dbl>, Precio_Final_Unitario <dbl>,
## # Semana <dbl>, Mes <dbl>, Descuento_Porcentaje <dbl>, Trx_Fecha <dttm>,
## # Fecha <date>, Tiempo <dbl># Ajustar el modelo de regresión lineal
modelo_regresion_3929788 <- lm(Venta ~ Cant + Costo_Venta + Costo_Devolucion + Ajuste_Manual +
Precio_Lista_Unitario + Precio_Final_Unitario + Semana + Mes + Descuento_Porcentaje + Tiempo,
data = datos_3929788)
# Ver resumen del modelo
summary(modelo_regresion_3929788)##
## Call:
## lm(formula = Venta ~ Cant + Costo_Venta + Costo_Devolucion +
## Ajuste_Manual + Precio_Lista_Unitario + Precio_Final_Unitario +
## Semana + Mes + Descuento_Porcentaje + Tiempo, data = datos_3929788)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4344.0 -83.2 -43.7 30.1 3413.2
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.812e+03 3.978e+02 4.555 5.29e-06 ***
## Cant 2.753e+00 2.503e-01 10.996 < 2e-16 ***
## Costo_Venta 1.096e+00 8.318e-03 131.756 < 2e-16 ***
## Costo_Devolucion -1.118e+00 9.204e-03 -121.466 < 2e-16 ***
## Ajuste_Manual 5.962e-01 2.087e-01 2.857 0.004283 **
## Precio_Lista_Unitario 1.180e+01 2.596e+00 4.543 5.59e-06 ***
## Precio_Final_Unitario -2.356e+01 6.225e+00 -3.785 0.000154 ***
## Semana -1.111e+00 5.774e-01 -1.924 0.054327 .
## Mes 8.009e+00 2.571e+00 3.114 0.001847 **
## Descuento_Porcentaje -3.276e+01 6.506e+00 -5.035 4.84e-07 ***
## Tiempo 3.724e+04 5.570e+04 0.669 0.503806
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 222.5 on 13845 degrees of freedom
## Multiple R-squared: 0.995, Adjusted R-squared: 0.995
## F-statistic: 2.755e+05 on 10 and 13845 DF, p-value: < 2.2e-16# Predicciones usando el modelo ajustado
predicciones_3929788 <- predict(modelo_regresion_3929788, newdata = datos_3929788)
# Calcular R^2 (coeficiente de determinación)
r2_3929788 <- summary(modelo_regresion_3929788)$r.squared
# Calcular AIC (Akaike Information Criterion)
aic_3929788 <- AIC(modelo_regresion_3929788)
# Calcular RMSE (Root Mean Squared Error)
rmse_3929788 <- sqrt(mean((datos_3929788$Venta - predicciones_3929788)^2))
# Calcular MAPE (Mean Absolute Percentage Error)
# Añadimos protección contra división por cero
mape_3929788 <- mean(abs((datos_3929788$Venta - predicciones_3929788) / pmax(datos_3929788$Venta, 0.01))) * 100
# Calcular MSE (Mean Squared Error)
mse_3929788 <- mean((datos_3929788$Venta - predicciones_3929788)^2)
# Mostrar las métricas
cat("R^2 del modelo de regresión lineal para 3929788: ", r2_3929788, "\n")## R^2 del modelo de regresión lineal para 3929788: 0.9949995cat("AIC del modelo de regresión lineal para 3929788: ", aic_3929788, "\n")## AIC del modelo de regresión lineal para 3929788: 189113.8cat("RMSE del modelo de regresión lineal para 3929788: ", rmse_3929788, "\n")## RMSE del modelo de regresión lineal para 3929788: 222.3941cat("MAPE del modelo de regresión lineal para 3929788: ", mape_3929788, "\n")## MAPE del modelo de regresión lineal para 3929788: 29141.99cat("MSE del modelo de regresión lineal para 3929788: ", mse_3929788, "\n")## MSE del modelo de regresión lineal para 3929788: 49459.16# Diagnóstico de residuos del modelo
par(mfrow = c(2, 2))
plot(modelo_regresion_3929788)
# Guardar métricas de Regresión Lineal para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3929788", # Cambia este ID para cada producto
Modelo = "Regresión Lineal",
R2 = r2_3929788, # Usa el nombre específico para este producto
RMSE = rmse_3929788,
MAPE = mape_3929788,
MSE = mse_3929788,
AIC = aic_3929788
))##PRODUCTO 3904152
# Filtrar solo los datos para el producto 3904152
datos_3904152 <- datos_filtrados %>%
filter(ID_Inventario == 3904152) %>%
select(Venta, Cant, Costo_Venta, Costo_Devolucion,
Ajus_Sistema, Ajuste_Manual, Precio_Lista_Unitario,
Precio_Final_Unitario, Semana, Mes, Descuento_Porcentaje, Trx_Fecha) %>%
na.omit() # Eliminar filas con valores NA
# Crear una variable de tiempo continua basada en la fecha
datos_3904152 <- datos_3904152 %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month")), # Asegúrate de que la fecha esté en formato Date
Tiempo = as.numeric(Fecha - min(Fecha)) / (30 * 24 * 60 * 60)) # Tiempo en meses (ajustado por días)
# Verificar las primeras filas para asegurarnos de que la variable de tiempo esté bien creada
head(datos_3904152)## # A tibble: 6 × 14
## Venta Cant Costo_Venta Costo_Devolucion Ajus_Sistema Ajuste_Manual
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 3402 1 2462. 0 -5652. 0
## 2 9240 3 7382. 0 -5720. -254.
## 3 3402 1 2461. 0 -5652. 0
## 4 3402 1 2462. 0 -5652. 0
## 5 3402 1 2462. 0 -5652. 0
## 6 30800 10 24563. 0 -5652. -322
## # ℹ 8 more variables: Precio_Lista_Unitario <dbl>, Precio_Final_Unitario <dbl>,
## # Semana <dbl>, Mes <dbl>, Descuento_Porcentaje <dbl>, Trx_Fecha <dttm>,
## # Fecha <date>, Tiempo <dbl># Ajustar el modelo de regresión lineal
modelo_regresion_3904152 <- lm(Venta ~ Cant + Costo_Venta + Costo_Devolucion + Ajuste_Manual +
Precio_Lista_Unitario + Precio_Final_Unitario + Semana + Mes + Descuento_Porcentaje + Tiempo,
data = datos_3904152)
# Ver resumen del modelo
summary(modelo_regresion_3904152)##
## Call:
## lm(formula = Venta ~ Cant + Costo_Venta + Costo_Devolucion +
## Ajuste_Manual + Precio_Lista_Unitario + Precio_Final_Unitario +
## Semana + Mes + Descuento_Porcentaje + Tiempo, data = datos_3904152)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7518.7 -136.5 -4.9 119.1 3169.4
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.355e+04 9.019e+03 3.720 0.000203 ***
## Cant 2.305e+02 6.261e+01 3.681 0.000237 ***
## Costo_Venta 1.187e+00 2.654e-02 44.713 < 2e-16 ***
## Costo_Devolucion -1.201e+00 2.849e-02 -42.150 < 2e-16 ***
## Ajuste_Manual 4.915e-02 2.548e-02 1.929 0.053865 .
## Precio_Lista_Unitario 1.156e+00 5.044e-01 2.292 0.021989 *
## Precio_Final_Unitario -3.647e+00 1.482e+00 -2.461 0.013916 *
## Semana 6.603e+00 2.061e+00 3.204 0.001374 **
## Mes -1.994e+01 9.143e+00 -2.181 0.029278 *
## Descuento_Porcentaje -5.004e+02 1.365e+02 -3.667 0.000250 ***
## Tiempo 2.204e+06 1.514e+05 14.551 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 386.4 on 2605 degrees of freedom
## Multiple R-squared: 0.9987, Adjusted R-squared: 0.9987
## F-statistic: 2.009e+05 on 10 and 2605 DF, p-value: < 2.2e-16# Predicciones usando el modelo ajustado
predicciones_3904152 <- predict(modelo_regresion_3904152, newdata = datos_3904152)
# Calcular R^2 (coeficiente de determinación)
r2_3904152 <- summary(modelo_regresion_3904152)$r.squared
# Calcular AIC (Akaike Information Criterion)
aic_3904152 <- AIC(modelo_regresion_3904152)
# Calcular RMSE (Root Mean Squared Error)
rmse_3904152 <- sqrt(mean((datos_3904152$Venta - predicciones_3904152)^2))
# Calcular MAPE (Mean Absolute Percentage Error)
# Añadimos protección contra división por cero
mape_3904152 <- mean(abs((datos_3904152$Venta - predicciones_3904152) / pmax(datos_3904152$Venta, 0.01))) * 100
# Calcular MSE (Mean Squared Error)
mse_3904152 <- mean((datos_3904152$Venta - predicciones_3904152)^2)
# Mostrar las métricas
cat("R^2 del modelo de regresión lineal para 3904152: ", r2_3904152, "\n")## R^2 del modelo de regresión lineal para 3904152: 0.9987051cat("AIC del modelo de regresión lineal para 3904152: ", aic_3904152, "\n")## AIC del modelo de regresión lineal para 3904152: 38603.25cat("RMSE del modelo de regresión lineal para 3904152: ", rmse_3904152, "\n")## RMSE del modelo de regresión lineal para 3904152: 385.5886cat("MAPE del modelo de regresión lineal para 3904152: ", mape_3904152, "\n")## MAPE del modelo de regresión lineal para 3904152: 128319.3cat("MSE del modelo de regresión lineal para 3904152: ", mse_3904152, "\n")## MSE del modelo de regresión lineal para 3904152: 148678.6# Diagnóstico de residuos del modelo
par(mfrow = c(2, 2))
plot(modelo_regresion_3904152)
# Guardar métricas de Regresión Lineal para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3904152", # Cambia este ID para cada producto
Modelo = "Regresión Lineal",
R2 = r2_3904152, # Usa el nombre específico para este producto
RMSE = rmse_3904152,
MAPE = mape_3904152,
MSE = mse_3904152,
AIC = aic_3904152
))PRODUCTO 155002
# Filtrar solo los datos para el producto 155002
datos_155002 <- datos_filtrados %>%
filter(ID_Inventario == 155002) %>%
select(Venta, Cant, Costo_Venta, Costo_Devolucion,
Ajus_Sistema, Ajuste_Manual, Precio_Lista_Unitario,
Precio_Final_Unitario, Semana, Mes, Descuento_Porcentaje, Trx_Fecha) %>%
na.omit() # Eliminar filas con valores NA
# Crear una variable de tiempo continua basada en la fecha
datos_155002 <- datos_155002 %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month")), # Asegúrate de que la fecha esté en formato Date
Tiempo = as.numeric(Fecha - min(Fecha)) / (30 * 24 * 60 * 60)) # Tiempo en meses (ajustado por días)
# Verificar las primeras filas para asegurarnos de que la variable de tiempo esté bien creada
head(datos_155002)## # A tibble: 6 × 14
## Venta Cant Costo_Venta Costo_Devolucion Ajus_Sistema Ajuste_Manual
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 5320 10 8247. 0 -2515. -1145.
## 2 5320 10 8247. 0 -2515. -1145.
## 3 2660 5 4124. 0 -2515. -1145.
## 4 630 1 519. 0 -2305. -1256.
## 5 1120 2 1037. 0 -2515. -1117.
## 6 1537. 3 1556. 0 -2515. -1164.
## # ℹ 8 more variables: Precio_Lista_Unitario <dbl>, Precio_Final_Unitario <dbl>,
## # Semana <dbl>, Mes <dbl>, Descuento_Porcentaje <dbl>, Trx_Fecha <dttm>,
## # Fecha <date>, Tiempo <dbl># Ajustar el modelo de regresión lineal
modelo_regresion_155002 <- lm(Venta ~ Cant + Costo_Venta + Costo_Devolucion + Ajuste_Manual +
Precio_Lista_Unitario + Precio_Final_Unitario + Semana + Mes + Descuento_Porcentaje + Tiempo,
data = datos_155002)
# Ver resumen del modelo
summary(modelo_regresion_155002)##
## Call:
## lm(formula = Venta ~ Cant + Costo_Venta + Costo_Devolucion +
## Ajuste_Manual + Precio_Lista_Unitario + Precio_Final_Unitario +
## Semana + Mes + Descuento_Porcentaje + Tiempo, data = datos_155002)
##
## Residuals:
## Min 1Q Median 3Q Max
## -49757 -156 2 130 49110
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.247e+05 2.839e+04 4.393 1.14e-05 ***
## Cant 2.935e+02 5.054e+00 58.072 < 2e-16 ***
## Costo_Venta 3.077e-01 1.267e-02 24.297 < 2e-16 ***
## Costo_Devolucion -6.061e-01 2.361e-02 -25.674 < 2e-16 ***
## Ajuste_Manual -4.431e-02 2.706e-02 -1.637 0.10158
## Precio_Lista_Unitario 3.206e+00 6.621e-01 4.842 1.32e-06 ***
## Precio_Final_Unitario -3.104e+01 7.417e+00 -4.184 2.90e-05 ***
## Semana -2.151e+00 5.622e+00 -0.383 0.70199
## Mes 1.811e+01 2.470e+01 0.733 0.46359
## Descuento_Porcentaje -1.390e+03 3.116e+02 -4.462 8.29e-06 ***
## Tiempo -1.124e+06 4.005e+05 -2.807 0.00502 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1137 on 5826 degrees of freedom
## Multiple R-squared: 0.9571, Adjusted R-squared: 0.957
## F-statistic: 1.3e+04 on 10 and 5826 DF, p-value: < 2.2e-16# Predicciones usando el modelo ajustado
predicciones_155002 <- predict(modelo_regresion_155002, newdata = datos_155002)
# Calcular R^2 (coeficiente de determinación)
r2_155002 <- summary(modelo_regresion_155002)$r.squared
# Calcular AIC (Akaike Information Criterion)
aic_155002 <- AIC(modelo_regresion_155002)
# Calcular RMSE (Root Mean Squared Error)
rmse_155002 <- sqrt(mean((datos_155002$Venta - predicciones_155002)^2))
# Calcular MAPE (Mean Absolute Percentage Error)
# Añadimos protección contra división por cero
mape_155002 <- mean(abs((datos_155002$Venta - predicciones_155002) / pmax(datos_155002$Venta, 0.01))) * 100
# Calcular MSE (Mean Squared Error)
mse_155002 <- mean((datos_155002$Venta - predicciones_155002)^2)
# Mostrar las métricas
cat("R^2 del modelo de regresión lineal para 155002: ", r2_155002, "\n")## R^2 del modelo de regresión lineal para 155002: 0.9571086cat("AIC del modelo de regresión lineal para 155002: ", aic_155002, "\n")## AIC del modelo de regresión lineal para 155002: 98715.09cat("RMSE del modelo de regresión lineal para 155002: ", rmse_155002, "\n")## RMSE del modelo de regresión lineal para 155002: 1135.676cat("MAPE del modelo de regresión lineal para 155002: ", mape_155002, "\n")## MAPE del modelo de regresión lineal para 155002: 238027.6cat("MSE del modelo de regresión lineal para 155002: ", mse_155002, "\n")## MSE del modelo de regresión lineal para 155002: 1289760# Diagnóstico de residuos del modelo
par(mfrow = c(2, 2))
plot(modelo_regresion_155002)
# Guardar métricas de Regresión Lineal para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "155002", # Cambia este ID para cada producto
Modelo = "Regresión Lineal",
R2 = r2_155002, # Usa el nombre específico para este producto
RMSE = rmse_155002,
MAPE = mape_155002,
MSE = mse_155002,
AIC = aic_155002
))PRODUCTO 3678055
# Filtrar solo los datos para el producto 3678055
datos_3678055 <- datos_filtrados %>%
filter(ID_Inventario == 3678055) %>%
select(Venta, Cant, Costo_Venta, Costo_Devolucion,
Ajus_Sistema, Ajuste_Manual, Precio_Lista_Unitario,
Precio_Final_Unitario, Semana, Mes, Descuento_Porcentaje, Trx_Fecha) %>%
na.omit() # Eliminar filas con valores NA
# Crear una variable de tiempo continua basada en la fecha
datos_3678055 <- datos_3678055 %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month")), # Asegúrate de que la fecha esté en formato Date
Tiempo = as.numeric(Fecha - min(Fecha)) / (30 * 24 * 60 * 60)) # Tiempo en meses (ajustado por días)
# Verificar las primeras filas para asegurarnos de que la variable de tiempo esté bien creada
head(datos_3678055)## # A tibble: 6 × 14
## Venta Cant Costo_Venta Costo_Devolucion Ajus_Sistema Ajuste_Manual
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 36358 7 28807. 0 -9695 -363.
## 2 5670 1 4213. 0 -9582. 0
## 3 10773 2 8232. 0 -9582. -284.
## 4 5670 1 4116. 0 -9582. 0
## 5 5386. 1 4156. 0 -9582. -284.
## 6 5386. 1 4213. 0 -9582. -284.
## # ℹ 8 more variables: Precio_Lista_Unitario <dbl>, Precio_Final_Unitario <dbl>,
## # Semana <dbl>, Mes <dbl>, Descuento_Porcentaje <dbl>, Trx_Fecha <dttm>,
## # Fecha <date>, Tiempo <dbl># Ajustar el modelo de regresión lineal
modelo_regresion_3678055 <- lm(Venta ~ Cant + Costo_Venta + Costo_Devolucion + Ajuste_Manual +
Precio_Lista_Unitario + Precio_Final_Unitario + Semana + Mes + Descuento_Porcentaje + Tiempo,
data = datos_3678055)
# Ver resumen del modelo
summary(modelo_regresion_3678055)##
## Call:
## lm(formula = Venta ~ Cant + Costo_Venta + Costo_Devolucion +
## Ajuste_Manual + Precio_Lista_Unitario + Precio_Final_Unitario +
## Semana + Mes + Descuento_Porcentaje + Tiempo, data = datos_3678055)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3892.2 -156.4 -8.0 149.7 3675.0
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.121e+04 1.245e+04 4.915 9.72e-07 ***
## Cant 1.402e+03 1.045e+02 13.408 < 2e-16 ***
## Costo_Venta 9.479e-01 2.613e-02 36.280 < 2e-16 ***
## Costo_Devolucion -9.928e-01 2.718e-02 -36.524 < 2e-16 ***
## Ajuste_Manual 4.928e-02 2.659e-02 1.853 0.064020 .
## Precio_Lista_Unitario 1.573e+00 4.037e-01 3.895 0.000102 ***
## Precio_Final_Unitario -4.533e+00 1.201e+00 -3.774 0.000166 ***
## Semana 4.904e+00 2.595e+00 1.890 0.058963 .
## Mes -6.678e+00 1.185e+01 -0.563 0.573276
## Descuento_Porcentaje -9.384e+02 1.873e+02 -5.011 5.99e-07 ***
## Tiempo 1.952e+06 2.115e+05 9.231 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 483.7 on 1702 degrees of freedom
## Multiple R-squared: 0.9977, Adjusted R-squared: 0.9977
## F-statistic: 7.446e+04 on 10 and 1702 DF, p-value: < 2.2e-16#Predicciones usando el modelo ajustado
predicciones_3678055 <- predict(modelo_regresion_3678055, newdata = datos_3678055)
# Calcular R^2 (coeficiente de determinación)
r2_3678055 <- summary(modelo_regresion_3678055)$r.squared
# Calcular AIC (Akaike Information Criterion)
aic_3678055 <- AIC(modelo_regresion_3678055)
# Calcular RMSE (Root Mean Squared Error)
rmse_3678055 <- sqrt(mean((datos_3678055$Venta - predicciones_3678055)^2))
# Calcular MAPE (Mean Absolute Percentage Error)
# Añadimos protección contra división por cero
mape_3678055 <- mean(abs((datos_3678055$Venta - predicciones_3678055) / pmax(datos_3678055$Venta, 0.01))) * 100
# Calcular MSE (Mean Squared Error)
mse_3678055 <- mean((datos_3678055$Venta - predicciones_3678055)^2)
# Mostrar las métricas
cat("R^2 del modelo de regresión lineal para 3678055: ", r2_3678055, "\n")## R^2 del modelo de regresión lineal para 3678055: 0.9977194cat("AIC del modelo de regresión lineal para 3678055: ", aic_3678055, "\n")## AIC del modelo de regresión lineal para 3678055: 26051.77cat("RMSE del modelo de regresión lineal para 3678055: ", rmse_3678055, "\n")## RMSE del modelo de regresión lineal para 3678055: 482.1191cat("MAPE del modelo de regresión lineal para 3678055: ", mape_3678055, "\n")## MAPE del modelo de regresión lineal para 3678055: 236820.8cat("MSE del modelo de regresión lineal para 3678055: ", mse_3678055, "\n")## MSE del modelo de regresión lineal para 3678055: 232438.8# Diagnóstico de residuos del modelo
par(mfrow = c(2, 2))
plot(modelo_regresion_3678055)
# Guardar métricas de Regresión Lineal para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3678055", # Cambia este ID para cada producto
Modelo = "Regresión Lineal",
R2 = r2_3678055, # Usa el nombre específico para este producto
RMSE = rmse_3678055,
MAPE = mape_3678055,
MSE = mse_3678055,
AIC = aic_3678055
))ANALISIS DE VARIABLES IMPORTANTES
# Función simplificada para analizar coeficientes
analizar_coeficientes <- function(modelo, nombre_producto) {
resumen <- summary(modelo)
coef_df <- as.data.frame(resumen$coefficients)
colnames(coef_df) <- c("Estimate", "Std.Error", "t.value", "p.value")
coef_df$Variable <- rownames(coef_df)
coef_df$Producto <- nombre_producto
coef_df$Significativo <- ifelse(coef_df$p.value < 0.05, "Sí", "No")
return(coef_df %>%
select(Producto, Variable, Estimate, p.value, Significativo) %>%
arrange(desc(abs(Estimate))))
}
# Aplicar a cada modelo
coef_155001 <- analizar_coeficientes(modelo_regresion_155001, "155001")
coef_155002 <- analizar_coeficientes(modelo_regresion_155002, "155002")
coef_3678055 <- analizar_coeficientes(modelo_regresion_3678055, "3678055")
coef_3904152 <- analizar_coeficientes(modelo_regresion_3904152, "3904152")
coef_3929788 <- analizar_coeficientes(modelo_regresion_3929788, "3929788")
# Combinar todos los coeficientes
todos_coeficientes <- bind_rows(coef_155001, coef_155002, coef_3678055, coef_3904152, coef_3929788)
# Tabla con variables importantes incluyendo significancia
variables_importantes <- todos_coeficientes %>%
filter(Variable != "(Intercept)") %>%
group_by(Producto) %>%
arrange(Producto, desc(abs(Estimate))) %>%
mutate(Impacto = ifelse(Estimate > 0, "Positivo", "Negativo"))
# Tabla completa con todas las variables importantes
kable(variables_importantes %>%
select(Producto, Variable, Estimate, p.value, Significativo, Impacto),
caption = "Variables importantes por producto",
col.names = c("Producto", "Variable", "Coeficiente", "p-value", "Significativo", "Impacto"),
digits = c(0, 0, 4, 4, 0, 0)) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| Producto | Variable | Coeficiente | p-value | Significativo | Impacto |
|---|---|---|---|---|---|
| 155001 | Tiempo | 63161.0840 | 0.7733 | No | Positivo |
| 155001 | Descuento_Porcentaje | 204.3951 | 0.0000 | Sí | Positivo |
| 155001 | Cant | 147.9938 | 0.0000 | Sí | Positivo |
| 155001 | Mes | 28.5405 | 0.0129 | Sí | Positivo |
| 155001 | Precio_Final_Unitario | 6.7112 | 0.0000 | Sí | Positivo |
| 155001 | Semana | -1.3371 | 0.6058 | No | Negativo |
| 155001 | Costo_Devolucion | -0.7222 | 0.0000 | Sí | Negativo |
| 155001 | Costo_Venta | 0.7063 | 0.0000 | Sí | Positivo |
| 155001 | Precio_Lista_Unitario | -0.3664 | 0.0001 | Sí | Negativo |
| 155001 | Ajuste_Manual | -0.0922 | 0.0000 | Sí | Negativo |
| 155002 | Tiempo | -1124277.1053 | 0.0050 | Sí | Negativo |
| 155002 | Descuento_Porcentaje | -1390.3581 | 0.0000 | Sí | Negativo |
| 155002 | Cant | 293.5122 | 0.0000 | Sí | Positivo |
| 155002 | Precio_Final_Unitario | -31.0372 | 0.0000 | Sí | Negativo |
| 155002 | Mes | 18.1056 | 0.4636 | No | Positivo |
| 155002 | Precio_Lista_Unitario | 3.2062 | 0.0000 | Sí | Positivo |
| 155002 | Semana | -2.1511 | 0.7020 | No | Negativo |
| 155002 | Costo_Devolucion | -0.6061 | 0.0000 | Sí | Negativo |
| 155002 | Costo_Venta | 0.3077 | 0.0000 | Sí | Positivo |
| 155002 | Ajuste_Manual | -0.0443 | 0.1016 | No | Negativo |
| 3678055 | Tiempo | 1952336.4033 | 0.0000 | Sí | Positivo |
| 3678055 | Cant | 1401.6976 | 0.0000 | Sí | Positivo |
| 3678055 | Descuento_Porcentaje | -938.3801 | 0.0000 | Sí | Negativo |
| 3678055 | Mes | -6.6784 | 0.5733 | No | Negativo |
| 3678055 | Semana | 4.9042 | 0.0590 | No | Positivo |
| 3678055 | Precio_Final_Unitario | -4.5331 | 0.0002 | Sí | Negativo |
| 3678055 | Precio_Lista_Unitario | 1.5725 | 0.0001 | Sí | Positivo |
| 3678055 | Costo_Devolucion | -0.9928 | 0.0000 | Sí | Negativo |
| 3678055 | Costo_Venta | 0.9479 | 0.0000 | Sí | Positivo |
| 3678055 | Ajuste_Manual | 0.0493 | 0.0640 | No | Positivo |
| 3904152 | Tiempo | 2203734.6518 | 0.0000 | Sí | Positivo |
| 3904152 | Descuento_Porcentaje | -500.4495 | 0.0003 | Sí | Negativo |
| 3904152 | Cant | 230.4975 | 0.0002 | Sí | Positivo |
| 3904152 | Mes | -19.9406 | 0.0293 | Sí | Negativo |
| 3904152 | Semana | 6.6029 | 0.0014 | Sí | Positivo |
| 3904152 | Precio_Final_Unitario | -3.6473 | 0.0139 | Sí | Negativo |
| 3904152 | Costo_Devolucion | -1.2009 | 0.0000 | Sí | Negativo |
| 3904152 | Costo_Venta | 1.1869 | 0.0000 | Sí | Positivo |
| 3904152 | Precio_Lista_Unitario | 1.1561 | 0.0220 | Sí | Positivo |
| 3904152 | Ajuste_Manual | 0.0492 | 0.0539 | No | Positivo |
| 3929788 | Tiempo | 37238.1681 | 0.5038 | No | Positivo |
| 3929788 | Descuento_Porcentaje | -32.7588 | 0.0000 | Sí | Negativo |
| 3929788 | Precio_Final_Unitario | -23.5631 | 0.0002 | Sí | Negativo |
| 3929788 | Precio_Lista_Unitario | 11.7953 | 0.0000 | Sí | Positivo |
| 3929788 | Mes | 8.0085 | 0.0018 | Sí | Positivo |
| 3929788 | Cant | 2.7528 | 0.0000 | Sí | Positivo |
| 3929788 | Costo_Devolucion | -1.1180 | 0.0000 | Sí | Negativo |
| 3929788 | Semana | -1.1111 | 0.0543 | No | Negativo |
| 3929788 | Costo_Venta | 1.0959 | 0.0000 | Sí | Positivo |
| 3929788 | Ajuste_Manual | 0.5962 | 0.0043 | Sí | Positivo |
# Tabla resumen con top 3 por producto
top_por_producto <- variables_importantes %>%
group_by(Producto) %>%
slice_head(n = 3) %>%
select(Producto, Variable, Estimate, p.value, Significativo, Impacto)
kable(top_por_producto,
caption = "Top 3 variables más importantes por producto",
col.names = c("Producto", "Variable", "Coeficiente", "p-value", "Significativo", "Impacto"),
digits = c(0, 0, 4, 4, 0, 0)) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| Producto | Variable | Coeficiente | p-value | Significativo | Impacto |
|---|---|---|---|---|---|
| 155001 | Tiempo | 63161.0840 | 0.7733 | No | Positivo |
| 155001 | Descuento_Porcentaje | 204.3951 | 0.0000 | Sí | Positivo |
| 155001 | Cant | 147.9938 | 0.0000 | Sí | Positivo |
| 155002 | Tiempo | -1124277.1053 | 0.0050 | Sí | Negativo |
| 155002 | Descuento_Porcentaje | -1390.3581 | 0.0000 | Sí | Negativo |
| 155002 | Cant | 293.5122 | 0.0000 | Sí | Positivo |
| 3678055 | Tiempo | 1952336.4033 | 0.0000 | Sí | Positivo |
| 3678055 | Cant | 1401.6976 | 0.0000 | Sí | Positivo |
| 3678055 | Descuento_Porcentaje | -938.3801 | 0.0000 | Sí | Negativo |
| 3904152 | Tiempo | 2203734.6518 | 0.0000 | Sí | Positivo |
| 3904152 | Descuento_Porcentaje | -500.4495 | 0.0003 | Sí | Negativo |
| 3904152 | Cant | 230.4975 | 0.0002 | Sí | Positivo |
| 3929788 | Tiempo | 37238.1681 | 0.5038 | No | Positivo |
| 3929788 | Descuento_Porcentaje | -32.7588 | 0.0000 | Sí | Negativo |
| 3929788 | Precio_Final_Unitario | -23.5631 | 0.0002 | Sí | Negativo |
#RANDOM FOREST
##PRODUCTO 155001
# Preparar datos para el modelo (eliminar columnas no necesarias)
datos_modelo <- datos_155001 %>%
select(-Trx_Fecha, -Fecha)
# Ajustar el modelo Random Forest
set.seed(123) # Para reproducibilidad
modelo_rf_155001 <- randomForest(
Venta ~ .,
data = datos_modelo,
ntree = 500, # Número de árboles
mtry = floor(sqrt(ncol(datos_modelo) - 1)), # Número de variables a considerar en cada split
importance = TRUE # Calcular importancia de variables
)
# Ver resumen del modelo
print(modelo_rf_155001)##
## Call:
## randomForest(formula = Venta ~ ., data = datos_modelo, ntree = 500, mtry = floor(sqrt(ncol(datos_modelo) - 1)), importance = TRUE)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 3
##
## Mean of squared residuals: 6577519
## % Var explained: 87.52# Obtener predicciones
predicciones_rf <- predict(modelo_rf_155001, newdata = datos_modelo)
# Calcular métricas
# R² (ya calculado por el modelo)
r2_rf <- 1 - sum((datos_modelo$Venta - predicciones_rf)^2) / sum((datos_modelo$Venta - mean(datos_modelo$Venta))^2)
# AIC aproximado (usando fórmula general para AIC)
n <- nrow(datos_modelo)
k <- length(modelo_rf_155001$forest$ncat) # Número de variables
mse <- mean((datos_modelo$Venta - predicciones_rf)^2)
aic_rf <- n * log(mse) + 2 * k
# RMSE
rmse_rf <- sqrt(mean((datos_modelo$Venta - predicciones_rf)^2))
# MAPE
mape_rf <- mean(abs((datos_modelo$Venta - predicciones_rf) / pmax(datos_modelo$Venta, 0.01))) * 100
# MSE
mse_rf <- mean((datos_modelo$Venta - predicciones_rf)^2)
# Mostrar las métricas
cat("Modelo Random Forest para producto 155001\n")## Modelo Random Forest para producto 155001cat("R² del modelo Random Forest:", r2_rf, "\n")## R² del modelo Random Forest: 0.9784171cat("AIC aproximado del modelo Random Forest:", aic_rf, "\n")## AIC aproximado del modelo Random Forest: 120806.1cat("RMSE del modelo Random Forest:", rmse_rf, "\n")## RMSE del modelo Random Forest: 1066.428cat("MAPE del modelo Random Forest:", mape_rf, "\n")## MAPE del modelo Random Forest: 156067.2cat("MSE del modelo Random Forest:", mse_rf, "\n\n")## MSE del modelo Random Forest: 1137268# Mostrar importancia de variables
importancia_vars <- importance(modelo_rf_155001)
print(importancia_vars)## %IncMSE IncNodePurity
## Cant 32.181672 187860926924
## Costo_Venta 35.455099 190655807445
## Costo_Devolucion 21.642299 36585857750
## Ajus_Sistema 7.407869 2900824957
## Ajuste_Manual 5.790217 3480956804
## Precio_Lista_Unitario 2.001407 1201653459
## Precio_Final_Unitario 4.439926 6129415777
## Semana 5.350558 4119086241
## Mes 3.082153 2077576769
## Descuento_Porcentaje 3.153115 9151699958
## Tiempo 3.649425 5068042666# Graficar importancia de variables
varImpPlot(modelo_rf_155001, main = "Importancia de Variables - Producto 155001")
# Crear gráfico de valores observados vs predicciones
datos_grafico <- data.frame(
Observado = datos_modelo$Venta,
Predicho = predicciones_rf
)
ggplot(datos_grafico, aes(x = Observado, y = Predicho)) +
geom_point(alpha = 0.5) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(
title = "Valores Observados vs Predicciones - Producto 155001",
x = "Ventas Observadas",
y = "Ventas Predichas"
) +
theme_minimal()
# NUEVOS ANÁLISIS AÑADIDOS
# Análisis del error
errores <- datos_grafico$Observado - datos_grafico$Predicho
hist(errores,
main = "Distribución de Errores - Producto 155001",
xlab = "Error (Observado - Predicho)",
col = "skyblue",
breaks = 30)
# Estadísticas descriptivas de los errores
cat("Estadísticas descriptivas de los errores:\n")## Estadísticas descriptivas de los errores:cat("Media de errores:", mean(errores), "\n")## Media de errores: 3.649569cat("Desviación estándar de errores:", sd(errores), "\n")## Desviación estándar de errores: 1066.483cat("Mínimo:", min(errores), "\n")## Mínimo: -64467.98cat("Máximo:", max(errores), "\n")## Máximo: 53659.3cat("Mediana:", median(errores), "\n")## Mediana: -1.082734# Gráfico del error vs predicción
ggplot(data.frame(Predicho = predicciones_rf, Error = errores), aes(x = Predicho, y = Error)) +
geom_point(alpha = 0.5) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Error vs Predicción - Producto 155001",
x = "Ventas Predichas",
y = "Error (Observado - Predicho)"
) +
theme_minimal()
# Guardar métricas de Random Forest para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "155001", # Cambia este ID para cada producto
Modelo = "Random Forest",
R2 = r2_rf, # Estas variables son las que se usan en tu código RF
RMSE = rmse_rf,
MAPE = mape_rf,
MSE = mse_rf,
AIC = aic_rf
))PRODUCTO 3929788
# Crear una variable de tiempo continua basada en la fecha
datos_3929788 <- datos_3929788 %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month")),
Tiempo = as.numeric(Fecha - min(Fecha)) / (30 * 24 * 60 * 60)) # Tiempo en meses
# Mostrar un resumen de los datos
summary(datos_3929788)## Venta Cant Costo_Venta Costo_Devolucion
## Min. :-51244.2 Min. :-1470.00 Min. : 0.0 Min. : 0.00
## 1st Qu.: 395.5 1st Qu.: 10.00 1st Qu.: 278.9 1st Qu.: 0.00
## Median : 871.4 Median : 20.00 Median : 605.4 Median : 0.00
## Mean : 1617.6 Mean : 41.89 Mean : 1288.8 Mean : 20.42
## 3rd Qu.: 2016.0 3rd Qu.: 50.00 3rd Qu.: 1513.4 3rd Qu.: 0.00
## Max. : 53096.4 Max. : 1540.00 Max. :46610.5 Max. :41003.59
## Ajus_Sistema Ajuste_Manual Precio_Lista_Unitario Precio_Final_Unitario
## Min. :-77.00 Min. :-73.920 Min. : 91.0 Min. : 28.00
## 1st Qu.:-65.86 1st Qu.: -4.144 1st Qu.:100.8 1st Qu.: 36.40
## Median :-60.48 Median : 0.000 Median :100.8 Median : 40.32
## Mean :-61.25 Mean : -3.332 Mean :104.3 Mean : 40.84
## 3rd Qu.:-58.46 3rd Qu.: 0.000 3rd Qu.:108.9 3rd Qu.: 43.57
## Max. : 0.00 Max. : 9.856 Max. :109.8 Max. :108.92
## Semana Mes Descuento_Porcentaje
## Min. : 1.00 Min. : 1.000 Min. : 0.00
## 1st Qu.:14.00 1st Qu.: 4.000 1st Qu.:60.00
## Median :26.00 Median : 6.000 Median :60.15
## Mean :26.32 Mean : 6.452 Mean :60.83
## 3rd Qu.:39.00 3rd Qu.: 9.000 3rd Qu.:65.28
## Max. :52.00 Max. :12.000 Max. :71.72
## Trx_Fecha Fecha Tiempo
## Min. :2023-01-02 00:00:00.00 Min. :2023-01-01 Min. :0.000e+00
## 1st Qu.:2023-07-05 00:00:00.00 1st Qu.:2023-07-01 1st Qu.:6.983e-05
## Median :2024-01-12 00:00:00.00 Median :2024-01-01 Median :1.408e-04
## Mean :2024-01-05 21:03:56.95 Mean :2023-12-21 Mean :1.366e-04
## 3rd Qu.:2024-07-08 00:00:00.00 3rd Qu.:2024-07-01 3rd Qu.:2.110e-04
## Max. :2024-12-31 00:00:00.00 Max. :2024-12-01 Max. :2.701e-04# Preparar datos para el modelo (eliminar columnas no necesarias)
datos_modelo <- datos_3929788 %>%
select(-Trx_Fecha, -Fecha)
# Ajustar el modelo Random Forest
set.seed(123) # Para reproducibilidad
modelo_rf_3929788 <- randomForest(
Venta ~ .,
data = datos_modelo,
ntree = 500, # Número de árboles
mtry = floor(sqrt(ncol(datos_modelo) - 1)), # Número de variables a considerar en cada split
importance = TRUE # Calcular importancia de variables
)
# Ver resumen del modelo
print(modelo_rf_3929788)##
## Call:
## randomForest(formula = Venta ~ ., data = datos_modelo, ntree = 500, mtry = floor(sqrt(ncol(datos_modelo) - 1)), importance = TRUE)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 3
##
## Mean of squared residuals: 250101.6
## % Var explained: 97.47# Obtener predicciones
predicciones_rf <- predict(modelo_rf_3929788, newdata = datos_modelo)
# Calcular métricas
# R² (ya calculado por el modelo)
r2_rf <- 1 - sum((datos_modelo$Venta - predicciones_rf)^2) / sum((datos_modelo$Venta - mean(datos_modelo$Venta))^2)
# AIC aproximado (usando fórmula general para AIC)
n <- nrow(datos_modelo)
k <- length(modelo_rf_3929788$forest$ncat) # Número de variables
mse <- mean((datos_modelo$Venta - predicciones_rf)^2)
aic_rf <- n * log(mse) + 2 * k
# RMSE
rmse_rf <- sqrt(mean((datos_modelo$Venta - predicciones_rf)^2))
# MAPE
mape_rf <- mean(abs((datos_modelo$Venta - predicciones_rf) / pmax(datos_modelo$Venta, 0.01))) * 100
# MSE
mse_rf <- mean((datos_modelo$Venta - predicciones_rf)^2)
# Mostrar las métricas
cat("Modelo Random Forest para producto 3929788\n")## Modelo Random Forest para producto 3929788cat("R² del modelo Random Forest:", r2_rf, "\n")## R² del modelo Random Forest: 0.9955214cat("AIC aproximado del modelo Random Forest:", aic_rf, "\n")## AIC aproximado del modelo Random Forest: 148262.6cat("RMSE del modelo Random Forest:", rmse_rf, "\n")## RMSE del modelo Random Forest: 210.4673cat("MAPE del modelo Random Forest:", mape_rf, "\n")## MAPE del modelo Random Forest: 36102.67cat("MSE del modelo Random Forest:", mse_rf, "\n\n")## MSE del modelo Random Forest: 44296.49# Mostrar importancia de variables
importancia_vars <- importance(modelo_rf_3929788)
print(importancia_vars)## %IncMSE IncNodePurity
## Cant 34.121128 57057463921
## Costo_Venta 38.822387 63786356271
## Costo_Devolucion 18.552797 3951240037
## Ajus_Sistema 3.670044 989088881
## Ajuste_Manual 5.951986 2224439897
## Precio_Lista_Unitario 2.469394 241849791
## Precio_Final_Unitario 4.922754 1684106754
## Semana 3.120466 476825233
## Mes 2.934183 283856526
## Descuento_Porcentaje 5.595171 4728817852
## Tiempo 3.326394 668536745# Graficar importancia de variables
varImpPlot(modelo_rf_3929788, main = "Importancia de Variables - Producto 3929788")
# Crear gráfico de valores observados vs predicciones
datos_grafico <- data.frame(
Observado = datos_modelo$Venta,
Predicho = predicciones_rf
)
ggplot(datos_grafico, aes(x = Observado, y = Predicho)) +
geom_point(alpha = 0.5) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(
title = "Valores Observados vs Predicciones - Producto 3929788",
x = "Ventas Observadas",
y = "Ventas Predichas"
) +
theme_minimal()
# Análisis del error
errores <- datos_grafico$Observado - datos_grafico$Predicho
hist(errores,
main = "Distribución de Errores - Producto 3929788",
xlab = "Error (Observado - Predicho)",
col = "skyblue",
breaks = 30)
# Gráfico del error vs predicción
ggplot(data.frame(Predicho = predicciones_rf, Error = errores), aes(x = Predicho, y = Error)) +
geom_point(alpha = 0.5) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Error vs Predicción - Producto 3929788",
x = "Ventas Predichas",
y = "Error (Observado - Predicho)"
) +
theme_minimal()
# Guardar métricas de Random Forest para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3929788", # Cambia este ID para cada producto
Modelo = "Random Forest",
R2 = r2_rf, # Estas variables son las que se usan en tu código RF
RMSE = rmse_rf,
MAPE = mape_rf,
MSE = mse_rf,
AIC = aic_rf
))PRODUCTO 3904152
# Crear una variable de tiempo continua basada en la fecha
datos_3904152 <- datos_3904152 %>%
mutate(Fecha = as.Date(floor_date(Trx_Fecha, "month")),
Tiempo = as.numeric(Fecha - min(Fecha)) / (30 * 24 * 60 * 60)) # Tiempo en meses
# Mostrar un resumen de los datos
summary(datos_3904152)## Venta Cant Costo_Venta Costo_Devolucion
## Min. :-32928 Min. :-12.000 Min. : 0 Min. : 0.00
## 1st Qu.: 3108 1st Qu.: 1.000 1st Qu.: 2324 1st Qu.: 0.00
## Median : 3402 Median : 1.000 Median : 2468 Median : 0.00
## Mean : 7194 Mean : 2.317 Mean : 5593 Mean : 97.01
## 3rd Qu.: 6804 3rd Qu.: 2.000 3rd Qu.: 5104 3rd Qu.: 0.00
## Max. :169344 Max. : 56.000 Max. :131032 Max. :27188.54
## Ajus_Sistema Ajuste_Manual Precio_Lista_Unitario Precio_Final_Unitario
## Min. :-6919 Min. :-6427.40 Min. : 9054 Min. :2677
## 1st Qu.:-6008 1st Qu.: -168.00 1st Qu.: 9054 1st Qu.:3051
## Median :-5946 Median : 0.00 Median : 9054 Median :3108
## Mean :-5976 Mean : -89.87 Mean : 9212 Mean :3158
## 3rd Qu.:-5817 3rd Qu.: 0.00 3rd Qu.: 9054 3rd Qu.:3318
## Max. :-5432 Max. : 475.25 Max. :10066 Max. :3639
## Semana Mes Descuento_Porcentaje
## Min. : 1.00 Min. : 1.000 Min. :60.00
## 1st Qu.:14.00 1st Qu.: 4.000 1st Qu.:64.43
## Median :26.00 Median : 6.000 Median :65.90
## Mean :26.25 Mean : 6.414 Mean :65.71
## 3rd Qu.:38.00 3rd Qu.: 9.000 3rd Qu.:66.60
## Max. :52.00 Max. :12.000 Max. :70.43
## Trx_Fecha Fecha Tiempo
## Min. :2023-01-02 00:00:00.00 Min. :2023-01-01 Min. :0.000e+00
## 1st Qu.:2023-07-11 18:00:00.00 1st Qu.:2023-07-01 1st Qu.:6.983e-05
## Median :2024-01-16 00:00:00.00 Median :2024-01-01 Median :1.408e-04
## Mean :2024-01-06 15:46:14.30 Mean :2023-12-20 Mean :1.365e-04
## 3rd Qu.:2024-06-28 00:00:00.00 3rd Qu.:2024-06-01 3rd Qu.:1.995e-04
## Max. :2024-12-31 00:00:00.00 Max. :2024-12-01 Max. :2.701e-04# Preparar datos para el modelo (eliminar columnas no necesarias)
datos_modelo <- datos_3904152 %>%
select(-Trx_Fecha, -Fecha)
# Ajustar el modelo Random Forest
set.seed(123) # Para reproducibilidad
modelo_rf_3904152 <- randomForest(
Venta ~ .,
data = datos_modelo,
ntree = 500, # Número de árboles
mtry = floor(sqrt(ncol(datos_modelo) - 1)), # Número de variables a considerar en cada split
importance = TRUE # Calcular importancia de variables
)
# Ver resumen del modelo
print(modelo_rf_3904152)##
## Call:
## randomForest(formula = Venta ~ ., data = datos_modelo, ntree = 500, mtry = floor(sqrt(ncol(datos_modelo) - 1)), importance = TRUE)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 3
##
## Mean of squared residuals: 1947014
## % Var explained: 98.3# Obtener predicciones
predicciones_rf <- predict(modelo_rf_3904152, newdata = datos_modelo)
# Calcular métricas
# R² (ya calculado por el modelo)
r2_rf <- 1 - sum((datos_modelo$Venta - predicciones_rf)^2) / sum((datos_modelo$Venta - mean(datos_modelo$Venta))^2)
# AIC aproximado (usando fórmula general para AIC)
n <- nrow(datos_modelo)
k <- length(modelo_rf_3904152$forest$ncat) # Número de variables
mse <- mean((datos_modelo$Venta - predicciones_rf)^2)
aic_rf <- n * log(mse) + 2 * k
# RMSE
rmse_rf <- sqrt(mean((datos_modelo$Venta - predicciones_rf)^2))
# MAPE
mape_rf <- mean(abs((datos_modelo$Venta - predicciones_rf) / pmax(datos_modelo$Venta, 0.01))) * 100
# MSE
mse_rf <- mean((datos_modelo$Venta - predicciones_rf)^2)
# Mostrar las métricas
cat("Modelo Random Forest para producto 3904152\n")## Modelo Random Forest para producto 3904152cat("R² del modelo Random Forest:", r2_rf, "\n")## R² del modelo Random Forest: 0.9948033cat("AIC aproximado del modelo Random Forest:", aic_rf, "\n")## AIC aproximado del modelo Random Forest: 34812.59cat("RMSE del modelo Random Forest:", rmse_rf, "\n")## RMSE del modelo Random Forest: 772.458cat("MAPE del modelo Random Forest:", mape_rf, "\n")## MAPE del modelo Random Forest: 148033.1cat("MSE del modelo Random Forest:", mse_rf, "\n\n")## MSE del modelo Random Forest: 596691.4# Mostrar importancia de variables
importancia_vars <- importance(modelo_rf_3904152)
print(importancia_vars)## %IncMSE IncNodePurity
## Cant 31.662621 130502175657
## Costo_Venta 31.868796 133943109052
## Costo_Devolucion 19.853497 5381566068
## Ajus_Sistema 6.335659 2522829430
## Ajuste_Manual 4.692671 5922819788
## Precio_Lista_Unitario 3.806847 582575127
## Precio_Final_Unitario 4.688881 3571577320
## Semana 4.515624 3043837570
## Mes 2.662071 1839345747
## Descuento_Porcentaje 8.168687 6084941317
## Tiempo 3.156113 1764659151# Graficar importancia de variables
varImpPlot(modelo_rf_3904152, main = "Importancia de Variables - Producto 3904152")
# Crear gráfico de valores observados vs predicciones
datos_grafico <- data.frame(
Observado = datos_modelo$Venta,
Predicho = predicciones_rf
)
ggplot(datos_grafico, aes(x = Observado, y = Predicho)) +
geom_point(alpha = 0.5) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(
title = "Valores Observados vs Predicciones - Producto 3904152",
x = "Ventas Observadas",
y = "Ventas Predichas"
) +
theme_minimal()
# Análisis del error
errores <- datos_grafico$Observado - datos_grafico$Predicho
hist(errores,
main = "Distribución de Errores - Producto 3904152",
xlab = "Error (Observado - Predicho)",
col = "skyblue",
breaks = 30)
# Gráfico del error vs predicción
ggplot(data.frame(Predicho = predicciones_rf, Error = errores), aes(x = Predicho, y = Error)) +
geom_point(alpha = 0.5) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Error vs Predicción - Producto 3904152",
x = "Ventas Predichas",
y = "Error (Observado - Predicho)"
) +
theme_minimal()
# Guardar métricas de Random Forest para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3904152", # Cambia este ID para cada producto
Modelo = "Random Forest",
R2 = r2_rf, # Estas variables son las que se usan en tu código RF
RMSE = rmse_rf,
MAPE = mape_rf,
MSE = mse_rf,
AIC = aic_rf
))PRODUCTO 155002
# Preparar datos para el modelo (eliminar columnas no necesarias)
datos_modelo <- datos_155002 %>%
select(-Trx_Fecha, -Fecha)
# Ajustar el modelo Random Forest
set.seed(123) # Para reproducibilidad
modelo_rf_155002 <- randomForest(
Venta ~ .,
data = datos_modelo,
ntree = 500, # Número de árboles
mtry = floor(sqrt(ncol(datos_modelo) - 1)), # Número de variables a considerar en cada split
importance = TRUE # Calcular importancia de variables
)
# Ver resumen del modelo
print(modelo_rf_155002)##
## Call:
## randomForest(formula = Venta ~ ., data = datos_modelo, ntree = 500, mtry = floor(sqrt(ncol(datos_modelo) - 1)), importance = TRUE)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 3
##
## Mean of squared residuals: 1738939
## % Var explained: 94.22# Obtener predicciones
predicciones_rf <- predict(modelo_rf_155002, newdata = datos_modelo)
# Calcular métricas
# R² (ya calculado por el modelo)
r2_rf <- 1 - sum((datos_modelo$Venta - predicciones_rf)^2) / sum((datos_modelo$Venta - mean(datos_modelo$Venta))^2)
# AIC aproximado (usando fórmula general para AIC)
n <- nrow(datos_modelo)
k <- length(modelo_rf_155002$forest$ncat) # Número de variables
mse <- mean((datos_modelo$Venta - predicciones_rf)^2)
aic_rf <- n * log(mse) + 2 * k
# RMSE
rmse_rf <- sqrt(mean((datos_modelo$Venta - predicciones_rf)^2))
# MAPE
mape_rf <- mean(abs((datos_modelo$Venta - predicciones_rf) / pmax(datos_modelo$Venta, 0.01))) * 100
# MSE
mse_rf <- mean((datos_modelo$Venta - predicciones_rf)^2)
# Mostrar las métricas
cat("Modelo Random Forest para producto 155002\n")## Modelo Random Forest para producto 155002cat("R² del modelo Random Forest:", r2_rf, "\n")## R² del modelo Random Forest: 0.9871784cat("AIC aproximado del modelo Random Forest:", aic_rf, "\n")## AIC aproximado del modelo Random Forest: 75099.98cat("RMSE del modelo Random Forest:", rmse_rf, "\n")## RMSE del modelo Random Forest: 620.9267cat("MAPE del modelo Random Forest:", mape_rf, "\n")## MAPE del modelo Random Forest: 102855.5cat("MSE del modelo Random Forest:", mse_rf, "\n\n")## MSE del modelo Random Forest: 385550# Mostrar importancia de variables
importancia_vars <- importance(modelo_rf_155002)
print(importancia_vars)## %IncMSE IncNodePurity
## Cant 34.217643 80225856934
## Costo_Venta 30.176300 71362120510
## Costo_Devolucion 21.877485 4543864694
## Ajus_Sistema 6.233525 1249869555
## Ajuste_Manual 3.441983 1508329290
## Precio_Lista_Unitario 1.952219 557122624
## Precio_Final_Unitario 6.025291 3680114312
## Semana 8.656020 1745284618
## Mes 4.431888 848273585
## Descuento_Porcentaje 7.085270 6167842697
## Tiempo 3.275418 1922858726# Graficar importancia de variables
varImpPlot(modelo_rf_155002, main = "Importancia de Variables - Producto 155002")
# Crear gráfico de valores observados vs predicciones
datos_grafico <- data.frame(
Observado = datos_modelo$Venta,
Predicho = predicciones_rf
)
ggplot(datos_grafico, aes(x = Observado, y = Predicho)) +
geom_point(alpha = 0.5) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(
title = "Valores Observados vs Predicciones - Producto 155002",
x = "Ventas Observadas",
y = "Ventas Predichas"
) +
theme_minimal()
# Análisis del error
errores <- datos_grafico$Observado - datos_grafico$Predicho
hist(errores,
main = "Distribución de Errores - Producto 155002",
xlab = "Error (Observado - Predicho)",
col = "skyblue",
breaks = 30)
# Gráfico del error vs predicción
ggplot(data.frame(Predicho = predicciones_rf, Error = errores), aes(x = Predicho, y = Error)) +
geom_point(alpha = 0.5) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Error vs Predicción - Producto 155002",
x = "Ventas Predichas",
y = "Error (Observado - Predicho)"
) +
theme_minimal()
# Guardar métricas de Random Forest para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "155002", # Cambia este ID para cada producto
Modelo = "Random Forest",
R2 = r2_rf, # Estas variables son las que se usan en tu código RF
RMSE = rmse_rf,
MAPE = mape_rf,
MSE = mse_rf,
AIC = aic_rf
))PRODUCTO 3678055
# Preparar datos para el modelo (eliminar columnas no necesarias)
datos_modelo <- datos_3678055 %>%
select(-Trx_Fecha, -Fecha)
# Ajustar el modelo Random Forest
set.seed(123) # Para reproducibilidad
modelo_rf_3678055 <- randomForest(
Venta ~ .,
data = datos_modelo,
ntree = 500, # Número de árboles
mtry = floor(sqrt(ncol(datos_modelo) - 1)), # Número de variables a considerar en cada split
importance = TRUE # Calcular importancia de variables
)
# Ver resumen del modelo
print(modelo_rf_3678055)##
## Call:
## randomForest(formula = Venta ~ ., data = datos_modelo, ntree = 500, mtry = floor(sqrt(ncol(datos_modelo) - 1)), importance = TRUE)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 3
##
## Mean of squared residuals: 3884938
## % Var explained: 96.19# Obtener predicciones
predicciones_rf <- predict(modelo_rf_3678055, newdata = datos_modelo)
# Calcular métricas
# R² (ya calculado por el modelo)
r2_rf <- 1 - sum((datos_modelo$Venta - predicciones_rf)^2) / sum((datos_modelo$Venta - mean(datos_modelo$Venta))^2)
# AIC aproximado (usando fórmula general para AIC)
n <- nrow(datos_modelo)
k <- length(modelo_rf_3678055$forest$ncat) # Número de variables
mse <- mean((datos_modelo$Venta - predicciones_rf)^2)
aic_rf <- n * log(mse) + 2 * k
# RMSE
rmse_rf <- sqrt(mean((datos_modelo$Venta - predicciones_rf)^2))
# MAPE
mape_rf <- mean(abs((datos_modelo$Venta - predicciones_rf) / pmax(datos_modelo$Venta, 0.01))) * 100
# MSE
mse_rf <- mean((datos_modelo$Venta - predicciones_rf)^2)
# Mostrar las métricas
cat("Modelo Random Forest para producto 3678055\n")## Modelo Random Forest para producto 3678055cat("R² del modelo Random Forest:", r2_rf, "\n")## R² del modelo Random Forest: 0.9918288cat("AIC aproximado del modelo Random Forest:", aic_rf, "\n")## AIC aproximado del modelo Random Forest: 23374.57cat("RMSE del modelo Random Forest:", rmse_rf, "\n")## RMSE del modelo Random Forest: 912.5829cat("MAPE del modelo Random Forest:", mape_rf, "\n")## MAPE del modelo Random Forest: 441446.6cat("MSE del modelo Random Forest:", mse_rf, "\n\n")## MSE del modelo Random Forest: 832807.5# Mostrar importancia de variables
importancia_vars <- importance(modelo_rf_3678055)
print(importancia_vars)## %IncMSE IncNodePurity
## Cant 32.721032 70741263686
## Costo_Venta 36.150548 76682691010
## Costo_Devolucion 23.010335 11104899857
## Ajus_Sistema 3.981929 1209957125
## Ajuste_Manual 4.757892 3880187425
## Precio_Lista_Unitario 2.703863 191443598
## Precio_Final_Unitario 4.912317 1756715727
## Semana 6.247012 2661180659
## Mes 6.067506 1094862408
## Descuento_Porcentaje 4.159380 2066915856
## Tiempo 5.415943 1213139729# Graficar importancia de variables
varImpPlot(modelo_rf_3678055, main = "Importancia de Variables - Producto 3678055")
# Crear gráfico de valores observados vs predicciones
datos_grafico <- data.frame(
Observado = datos_modelo$Venta,
Predicho = predicciones_rf
)
ggplot(datos_grafico, aes(x = Observado, y = Predicho)) +
geom_point(alpha = 0.5) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(
title = "Valores Observados vs Predicciones - Producto 3678055",
x = "Ventas Observadas",
y = "Ventas Predichas"
) +
theme_minimal()
# Análisis del error
errores <- datos_grafico$Observado - datos_grafico$Predicho
hist(errores,
main = "Distribución de Errores - Producto 3678055",
xlab = "Error (Observado - Predicho)",
col = "skyblue",
breaks = 30)
# Gráfico del error vs predicción
ggplot(data.frame(Predicho = predicciones_rf, Error = errores), aes(x = Predicho, y = Error)) +
geom_point(alpha = 0.5) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Error vs Predicción - Producto 3678055",
x = "Ventas Predichas",
y = "Error (Observado - Predicho)"
) +
theme_minimal()
# Guardar métricas de Random Forest para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3678055", # Cambia este ID para cada producto
Modelo = "Random Forest",
R2 = r2_rf, # Estas variables son las que se usan en tu código RF
RMSE = rmse_rf,
MAPE = mape_rf,
MSE = mse_rf,
AIC = aic_rf
))XGBOOST
PRODUCTO 155001
# Preparar datos para el modelo (eliminar columnas no necesarias)
datos_modelo <- datos_155001 %>%
select(-Trx_Fecha, -Fecha)
# Dividir los datos en conjuntos de entrenamiento (80%) y prueba (20%)
set.seed(123) # Para reproducibilidad
indices_train <- createDataPartition(datos_modelo$Venta, p = 0.8, list = FALSE)
datos_train <- datos_modelo[indices_train, ]
datos_test <- datos_modelo[-indices_train, ]
# Separar variables predictoras y variable objetivo
X_train <- as.matrix(datos_train[, colnames(datos_train) != "Venta"])
y_train <- datos_train$Venta
X_test <- as.matrix(datos_test[, colnames(datos_test) != "Venta"])
y_test <- datos_test$Venta
# Crear matrices DMatrix para XGBoost
dtrain <- xgb.DMatrix(data = X_train, label = y_train)
dtest <- xgb.DMatrix(data = X_test, label = y_test)
# Definir una rejilla completa de hiperparámetros para búsqueda
param_grid <- expand.grid(
eta = c(0.01, 0.05, 0.1, 0.3), # Learning rate
max_depth = c(3, 5, 7, 9), # Profundidad máxima
subsample = c(0.6, 0.8, 1.0), # Submuestra de observaciones
colsample_bytree = c(0.6, 0.8, 1.0), # Submuestra de variables
min_child_weight = c(1, 3, 5), # Peso mínimo en nodos hijos
gamma = c(0, 0.1, 0.3) # Regularización gamma
)
# Mostrar cuántas combinaciones tenemos
cat("Número total de combinaciones de hiperparámetros:", nrow(param_grid), "\n")## Número total de combinaciones de hiperparámetros: 1296# Para este ejemplo, vamos a limitar el número de combinaciones
# Seleccionando un subconjunto aleatorio de combinaciones (20 combinaciones)
set.seed(123)
if (nrow(param_grid) > 20) {
muestra_indices <- sample(1:nrow(param_grid), 20)
param_grid_reducida <- param_grid[muestra_indices, ]
} else {
param_grid_reducida <- param_grid
}
cat("Número de combinaciones a evaluar:", nrow(param_grid_reducida), "\n")## Número de combinaciones a evaluar: 20# Función para evaluar un conjunto de hiperparámetros con validación cruzada
evaluate_params <- function(params_row) {
params <- list(
objective = "reg:squarederror",
eval_metric = "rmse",
eta = params_row$eta,
max_depth = params_row$max_depth,
subsample = params_row$subsample,
colsample_bytree = params_row$colsample_bytree,
min_child_weight = params_row$min_child_weight,
gamma = params_row$gamma
)
# Realizar validación cruzada
cv_results <- xgb.cv(
params = params,
data = dtrain,
nrounds = 100,
nfold = 5, # 5-fold validación cruzada
early_stopping_rounds = 10,
verbose = 0
)
# Extraer el mejor RMSE y el número óptimo de rondas
best_rmse <- min(cv_results$evaluation_log$test_rmse_mean)
best_nrounds <- which.min(cv_results$evaluation_log$test_rmse_mean)
return(list(rmse = best_rmse, nrounds = best_nrounds, params = params))
}
# Inicializar tabla para almacenar resultados
resultados_grid <- data.frame(
eta = numeric(nrow(param_grid_reducida)),
max_depth = numeric(nrow(param_grid_reducida)),
subsample = numeric(nrow(param_grid_reducida)),
colsample_bytree = numeric(nrow(param_grid_reducida)),
min_child_weight = numeric(nrow(param_grid_reducida)),
gamma = numeric(nrow(param_grid_reducida)),
nrounds = numeric(nrow(param_grid_reducida)),
rmse = numeric(nrow(param_grid_reducida))
)
# Realizar la búsqueda en cuadrícula (esto puede tardar varios minutos)
cat("Iniciando búsqueda en cuadrícula...\n")## Iniciando búsqueda en cuadrícula...for (i in 1:nrow(param_grid_reducida)) {
cat(sprintf("Evaluando combinación %d de %d\n", i, nrow(param_grid_reducida)))
# Obtener fila de parámetros actual
params_row <- param_grid_reducida[i, ]
# Evaluar combinación actual
result <- evaluate_params(params_row)
# Guardar resultados
resultados_grid$eta[i] <- params_row$eta
resultados_grid$max_depth[i] <- params_row$max_depth
resultados_grid$subsample[i] <- params_row$subsample
resultados_grid$colsample_bytree[i] <- params_row$colsample_bytree
resultados_grid$min_child_weight[i] <- params_row$min_child_weight
resultados_grid$gamma[i] <- params_row$gamma
resultados_grid$nrounds[i] <- result$nrounds
resultados_grid$rmse[i] <- result$rmse
}## Evaluando combinación 1 de 20
## Evaluando combinación 2 de 20
## Evaluando combinación 3 de 20
## Evaluando combinación 4 de 20
## Evaluando combinación 5 de 20
## Evaluando combinación 6 de 20
## Evaluando combinación 7 de 20
## Evaluando combinación 8 de 20
## Evaluando combinación 9 de 20
## Evaluando combinación 10 de 20
## Evaluando combinación 11 de 20
## Evaluando combinación 12 de 20
## Evaluando combinación 13 de 20
## Evaluando combinación 14 de 20
## Evaluando combinación 15 de 20
## Evaluando combinación 16 de 20
## Evaluando combinación 17 de 20
## Evaluando combinación 18 de 20
## Evaluando combinación 19 de 20
## Evaluando combinación 20 de 20# Ordenar resultados por RMSE (de menor a mayor)
resultados_grid <- resultados_grid[order(resultados_grid$rmse), ]
# Mostrar los 5 mejores conjuntos de hiperparámetros
cat("\nLos 5 mejores conjuntos de hiperparámetros:\n")##
## Los 5 mejores conjuntos de hiperparámetros:print(head(resultados_grid, 5))## eta max_depth subsample colsample_bytree min_child_weight gamma nrounds
## 2 0.10 9 0.8 0.6 1 0.1 100
## 6 0.05 7 0.8 0.8 1 0.3 100
## 4 0.05 9 1.0 0.8 1 0.1 100
## 5 0.10 3 0.6 0.8 3 0.0 76
## 15 0.10 7 0.6 1.0 3 0.3 52
## rmse
## 2 1745.433
## 6 1837.103
## 4 1930.827
## 5 2189.881
## 15 2317.338# Obtener los mejores hiperparámetros
mejores_params <- list(
objective = "reg:squarederror",
eval_metric = "rmse",
eta = resultados_grid$eta[1],
max_depth = resultados_grid$max_depth[1],
subsample = resultados_grid$subsample[1],
colsample_bytree = resultados_grid$colsample_bytree[1],
min_child_weight = resultados_grid$min_child_weight[1],
gamma = resultados_grid$gamma[1]
)
mejor_nrounds <- resultados_grid$nrounds[1]
cat("\nMejores hiperparámetros encontrados:\n")##
## Mejores hiperparámetros encontrados:print(mejores_params)## $objective
## [1] "reg:squarederror"
##
## $eval_metric
## [1] "rmse"
##
## $eta
## [1] 0.1
##
## $max_depth
## [1] 9
##
## $subsample
## [1] 0.8
##
## $colsample_bytree
## [1] 0.6
##
## $min_child_weight
## [1] 1
##
## $gamma
## [1] 0.1cat("Número óptimo de rondas:", mejor_nrounds, "\n")## Número óptimo de rondas: 100cat("RMSE en validación cruzada:", resultados_grid$rmse[1], "\n\n")## RMSE en validación cruzada: 1745.433# Entrenar el modelo final con los mejores hiperparámetros
modelo_xgb_155001 <- xgb.train(
params = mejores_params,
data = dtrain,
nrounds = mejor_nrounds,
watchlist = list(train = dtrain, test = dtest),
verbose = 0
)
# Hacer predicciones en el conjunto de prueba
predicciones_test <- predict(modelo_xgb_155001, dtest)
# Calcular métricas en el conjunto de prueba
# R²
r2_test <- 1 - sum((y_test - predicciones_test)^2) / sum((y_test - mean(y_test))^2)
# RMSE
rmse_test <- sqrt(mean((y_test - predicciones_test)^2))
# MAPE
mape_test <- mean(abs((y_test - predicciones_test) / pmax(y_test, 0.01))) * 100
# MSE
mse_test <- mean((y_test - predicciones_test)^2)
# AIC aproximado
n <- length(y_test)
k <- length(mejores_params) + 1 # +1 por el número de rondas
aic_test <- n * log(mse_test) + 2 * k
# Mostrar las métricas en el conjunto de prueba
cat("Métricas en el conjunto de prueba:\n")## Métricas en el conjunto de prueba:cat("R² del modelo XGBoost:", r2_test, "\n")## R² del modelo XGBoost: 0.9922099cat("AIC aproximado del modelo XGBoost:", aic_test, "\n")## AIC aproximado del modelo XGBoost: 21619.63cat("RMSE del modelo XGBoost:", rmse_test, "\n")## RMSE del modelo XGBoost: 514.5263cat("MAPE del modelo XGBoost:", mape_test, "\n")## MAPE del modelo XGBoost: 88203.85cat("MSE del modelo XGBoost:", mse_test, "\n\n")## MSE del modelo XGBoost: 264737.3# Ahora hacer predicciones en el conjunto completo para comparabilidad con otros modelos
X_completo <- as.matrix(datos_modelo[, colnames(datos_modelo) != "Venta"])
predicciones_completas <- predict(modelo_xgb_155001, X_completo)
# Calcular métricas en el conjunto completo
# R²
r2_completo <- 1 - sum((datos_modelo$Venta - predicciones_completas)^2) / sum((datos_modelo$Venta - mean(datos_modelo$Venta))^2)
# RMSE
rmse_completo <- sqrt(mean((datos_modelo$Venta - predicciones_completas)^2))
# MAPE
mape_completo <- mean(abs((datos_modelo$Venta - predicciones_completas) / pmax(datos_modelo$Venta, 0.01))) * 100
# MSE
mse_completo <- mean((datos_modelo$Venta - predicciones_completas)^2)
# AIC aproximado
n <- nrow(datos_modelo)
aic_completo <- n * log(mse_completo) + 2 * k
# Mostrar las métricas en el conjunto completo
cat("Métricas en el conjunto completo:\n")## Métricas en el conjunto completo:cat("R² del modelo XGBoost:", r2_completo, "\n")## R² del modelo XGBoost: 0.998543cat("AIC aproximado del modelo XGBoost:", aic_completo, "\n")## AIC aproximado del modelo XGBoost: 97453.65cat("RMSE del modelo XGBoost:", rmse_completo, "\n")## RMSE del modelo XGBoost: 277.0827cat("MAPE del modelo XGBoost:", mape_completo, "\n")## MAPE del modelo XGBoost: 40544.68cat("MSE del modelo XGBoost:", mse_completo, "\n\n")## MSE del modelo XGBoost: 76774.81# Importancia de variables
importancia <- xgb.importance(
feature_names = colnames(datos_modelo)[colnames(datos_modelo) != "Venta"],
model = modelo_xgb_155001
)
print(importancia)## Feature Gain Cover Frequency
## <char> <num> <num> <num>
## 1: Costo_Venta 0.4783677923 0.191626954 0.14439846
## 2: Cant 0.4145960359 0.302497668 0.14824121
## 3: Costo_Devolucion 0.0385881502 0.086497053 0.03576707
## 4: Semana 0.0158392529 0.030720930 0.14484186
## 5: Precio_Final_Unitario 0.0142811269 0.112899120 0.14410287
## 6: Descuento_Porcentaje 0.0137412888 0.109667915 0.09872894
## 7: Tiempo 0.0090310651 0.060920999 0.05571978
## 8: Mes 0.0053854225 0.012042956 0.05172923
## 9: Ajuste_Manual 0.0049939221 0.049519508 0.09459060
## 10: Ajus_Sistema 0.0044589766 0.039299973 0.07094295
## 11: Precio_Lista_Unitario 0.0007169666 0.004306924 0.01093704# Graficar importancia de variables
xgb.plot.importance(importance_matrix = importancia,
main = "Importancia de Variables - Producto 155001 (XGBoost)")
# Crear gráfico de valores observados vs predicciones
datos_grafico <- data.frame(
Observado = datos_modelo$Venta,
Predicho = predicciones_completas
)
ggplot(datos_grafico, aes(x = Observado, y = Predicho)) +
geom_point(alpha = 0.5) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(
title = "Valores Observados vs Predicciones - Producto 155001 (XGBoost)",
x = "Ventas Observadas",
y = "Ventas Predichas"
) +
theme_minimal()
# Análisis del error
errores <- datos_grafico$Observado - datos_grafico$Predicho
hist(errores,
main = "Distribución de Errores - Producto 155001 (XGBoost)",
xlab = "Error (Observado - Predicho)",
col = "skyblue",
breaks = 30)
# Gráfico del error vs predicción
ggplot(data.frame(Predicho = predicciones_completas, Error = errores), aes(x = Predicho, y = Error)) +
geom_point(alpha = 0.5) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Error vs Predicción - Producto 155001 (XGBoost)",
x = "Ventas Predichas",
y = "Error (Observado - Predicho)"
) +
theme_minimal()
# Guardar métricas de XGBoost para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "155001", # Cambia este ID para cada producto
Modelo = "XGBoost",
R2 = r2_completo, # Usamos las métricas del conjunto completo
RMSE = rmse_completo,
MAPE = mape_completo,
MSE = mse_completo,
AIC = aic_completo
))##PRODUCTO 3929788
# Preparar datos para el modelo (eliminar columnas no necesarias)
datos_modelo <- datos_3929788 %>%
select(-Trx_Fecha, -Fecha)
# Paso 2: Dividir los datos en conjuntos de entrenamiento (80%) y prueba (20%)
set.seed(123) # Para reproducibilidad
train_index <- createDataPartition(datos_modelo$Venta, p = 0.8, list = FALSE)
train_data <- datos_modelo[train_index, ]
test_data <- datos_modelo[-train_index, ]
# Preparar matrices para XGBoost
train_x <- as.matrix(train_data[, colnames(train_data) != "Venta"])
train_y <- train_data$Venta
test_x <- as.matrix(test_data[, colnames(test_data) != "Venta"])
test_y <- test_data$Venta
# Crear DMatrix para XGBoost
dtrain <- xgb.DMatrix(data = train_x, label = train_y)
dtest <- xgb.DMatrix(data = test_x, label = test_y)
# Paso 3: Definir la rejilla de hiperparámetros para Grid Search
param_grid <- expand.grid(
eta = c(0.01, 0.05, 0.1, 0.3), # Learning rate
max_depth = c(3, 6, 9), # Profundidad máxima
min_child_weight = c(1, 3, 5), # Peso mínimo de nodo hijo
subsample = c(0.7, 0.9), # Proporción de observaciones
colsample_bytree = c(0.7, 0.9), # Proporción de variables
gamma = c(0, 0.1, 0.3) # Regularización gamma
)
# Mostrar dimensiones de la rejilla
cat("Grid Search para XGBoost - Producto 3929788\n")## Grid Search para XGBoost - Producto 3929788cat("Número total de combinaciones de hiperparámetros:", nrow(param_grid), "\n\n")## Número total de combinaciones de hiperparámetros: 432# Para este ejemplo, limitar a 12 combinaciones para ahorrar tiempo
# En un escenario real, podrías evaluar todas o usar una estrategia más eficiente
set.seed(456)
if (nrow(param_grid) > 12) {
selected_indices <- sample(1:nrow(param_grid), 12)
param_grid <- param_grid[selected_indices, ]
cat("Seleccionando 12 combinaciones aleatorias para evaluación.\n\n")
}## Seleccionando 12 combinaciones aleatorias para evaluación.# Paso 4: Implementar Grid Search
resultados <- data.frame()
cat("Iniciando Grid Search...\n")## Iniciando Grid Search...for (i in 1:nrow(param_grid)) {
# Extraer parámetros de la combinación actual
params <- list(
objective = "reg:squarederror", # Objetivo de regresión
eval_metric = "rmse", # Métrica de evaluación
eta = param_grid$eta[i],
max_depth = param_grid$max_depth[i],
min_child_weight = param_grid$min_child_weight[i],
subsample = param_grid$subsample[i],
colsample_bytree = param_grid$colsample_bytree[i],
gamma = param_grid$gamma[i]
)
cat("Evaluando combinación", i, "de", nrow(param_grid), ":\n")
cat(" eta =", params$eta,
", max_depth =", params$max_depth,
", min_child_weight =", params$min_child_weight,
", subsample =", params$subsample,
", colsample_bytree =", params$colsample_bytree,
", gamma =", params$gamma, "\n")
# Validación cruzada para encontrar el número óptimo de iteraciones
cv_model <- xgb.cv(
params = params,
data = dtrain,
nrounds = 200, # Máximo número de iteraciones
nfold = 5, # 5-fold validación cruzada
early_stopping_rounds = 20, # Detener si no hay mejora en 20 rondas
verbose = 0 # Suprimir mensajes
)
# Extraer mejor iteración y su RMSE
best_iteration <- cv_model$best_iteration
best_rmse <- min(cv_model$evaluation_log$test_rmse_mean)
cat(" Mejor iteración:", best_iteration, "\n")
cat(" RMSE en validación cruzada:", best_rmse, "\n\n")
# Guardar resultados
resultado_actual <- data.frame(
eta = params$eta,
max_depth = params$max_depth,
min_child_weight = params$min_child_weight,
subsample = params$subsample,
colsample_bytree = params$colsample_bytree,
gamma = params$gamma,
nrounds = best_iteration,
rmse_cv = best_rmse
)
resultados <- rbind(resultados, resultado_actual)
}## Evaluando combinación 1 de 12 :
## eta = 0.01 , max_depth = 9 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 200
## RMSE en validación cruzada: 752.1582
##
## Evaluando combinación 2 de 12 :
## eta = 0.1 , max_depth = 9 , min_child_weight = 3 , subsample = 0.9 , colsample_bytree = 0.9 , gamma = 0.3
## Mejor iteración: 61
## RMSE en validación cruzada: 538.2329
##
## Evaluando combinación 3 de 12 :
## eta = 0.05 , max_depth = 3 , min_child_weight = 1 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0
## Mejor iteración: 200
## RMSE en validación cruzada: 228.7636
##
## Evaluando combinación 4 de 12 :
## eta = 0.3 , max_depth = 9 , min_child_weight = 5 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 160
## RMSE en validación cruzada: 425.4294
##
## Evaluando combinación 5 de 12 :
## eta = 0.1 , max_depth = 6 , min_child_weight = 5 , subsample = 0.9 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 67
## RMSE en validación cruzada: 497.3487
##
## Evaluando combinación 6 de 12 :
## eta = 0.01 , max_depth = 6 , min_child_weight = 5 , subsample = 0.9 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 200
## RMSE en validación cruzada: 748.3926
##
## Evaluando combinación 7 de 12 :
## eta = 0.05 , max_depth = 3 , min_child_weight = 5 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0.1
## Mejor iteración: 162
## RMSE en validación cruzada: 445.1472
##
## Evaluando combinación 8 de 12 :
## eta = 0.1 , max_depth = 3 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.7 , gamma = 0.1
## Mejor iteración: 99
## RMSE en validación cruzada: 412.7368
##
## Evaluando combinación 9 de 12 :
## eta = 0.05 , max_depth = 6 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0.3
## Mejor iteración: 191
## RMSE en validación cruzada: 427.924
##
## Evaluando combinación 10 de 12 :
## eta = 0.1 , max_depth = 9 , min_child_weight = 1 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0.3
## Mejor iteración: 200
## RMSE en validación cruzada: 278.1048
##
## Evaluando combinación 11 de 12 :
## eta = 0.05 , max_depth = 6 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0
## Mejor iteración: 106
## RMSE en validación cruzada: 413.3047
##
## Evaluando combinación 12 de 12 :
## eta = 0.1 , max_depth = 3 , min_child_weight = 3 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0.3
## Mejor iteración: 122
## RMSE en validación cruzada: 380.9103# Ordenar resultados por RMSE (de menor a mayor)
resultados <- resultados[order(resultados$rmse_cv), ]
# Paso 5: Mostrar resultados del Grid Search
cat("Resultados del Grid Search ordenados por RMSE:\n")## Resultados del Grid Search ordenados por RMSE:print(resultados)## eta max_depth min_child_weight subsample colsample_bytree gamma nrounds
## 3 0.05 3 1 0.9 0.7 0.0 200
## 10 0.10 9 1 0.9 0.7 0.3 200
## 12 0.10 3 3 0.9 0.7 0.3 122
## 8 0.10 3 3 0.7 0.7 0.1 99
## 11 0.05 6 3 0.7 0.9 0.0 106
## 4 0.30 9 5 0.7 0.9 0.1 160
## 9 0.05 6 3 0.7 0.9 0.3 191
## 7 0.05 3 5 0.9 0.7 0.1 162
## 5 0.10 6 5 0.9 0.9 0.1 67
## 2 0.10 9 3 0.9 0.9 0.3 61
## 6 0.01 6 5 0.9 0.9 0.1 200
## 1 0.01 9 3 0.7 0.9 0.1 200
## rmse_cv
## 3 228.7636
## 10 278.1048
## 12 380.9103
## 8 412.7368
## 11 413.3047
## 4 425.4294
## 9 427.9240
## 7 445.1472
## 5 497.3487
## 2 538.2329
## 6 748.3926
## 1 752.1582# Visualizar resultados del Grid Search
ggplot(resultados, aes(x = reorder(paste("Comb", 1:nrow(resultados)), rmse_cv), y = rmse_cv)) +
geom_bar(stat = "identity", fill = "steelblue") +
labs(
title = "Resultados del Grid Search - Producto 3929788",
x = "Combinación de Hiperparámetros",
y = "RMSE en Validación Cruzada"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Paso 6: Seleccionar los mejores hiperparámetros
mejores_params <- list(
objective = "reg:squarederror",
eval_metric = "rmse",
eta = resultados$eta[1],
max_depth = resultados$max_depth[1],
min_child_weight = resultados$min_child_weight[1],
subsample = resultados$subsample[1],
colsample_bytree = resultados$colsample_bytree[1],
gamma = resultados$gamma[1]
)
mejor_nrounds <- resultados$nrounds[1]
cat("\nMejores hiperparámetros encontrados:\n")##
## Mejores hiperparámetros encontrados:print(mejores_params)## $objective
## [1] "reg:squarederror"
##
## $eval_metric
## [1] "rmse"
##
## $eta
## [1] 0.05
##
## $max_depth
## [1] 3
##
## $min_child_weight
## [1] 1
##
## $subsample
## [1] 0.9
##
## $colsample_bytree
## [1] 0.7
##
## $gamma
## [1] 0cat("Número óptimo de rondas:", mejor_nrounds, "\n\n")## Número óptimo de rondas: 200# Paso 7: Entrenar el modelo final con los mejores hiperparámetros
cat("Entrenando modelo final con los mejores hiperparámetros...\n")## Entrenando modelo final con los mejores hiperparámetros...modelo_final <- xgb.train(
params = mejores_params,
data = dtrain,
nrounds = mejor_nrounds,
watchlist = list(train = dtrain, test = dtest),
verbose = 0
)
# GUARDAR EL MODELO CON NOMBRE ESPERADO
modelo_xgb_3929788 <- modelo_final
# Paso 8: Evaluar el modelo
# Predicciones en conjunto de prueba
predicciones_test <- predict(modelo_final, dtest)
# Calcular métricas
# R²
r2_test <- 1 - sum((test_y - predicciones_test)^2) / sum((test_y - mean(test_y))^2)
# RMSE
rmse_test <- sqrt(mean((test_y - predicciones_test)^2))
# MAPE
mape_test <- mean(abs((test_y - predicciones_test) / pmax(test_y, 0.01))) * 100
# MSE
mse_test <- mean((test_y - predicciones_test)^2)
# AIC aproximado
n_test <- length(test_y)
k <- length(mejores_params) + 1 # +1 por número de iteraciones
aic_test <- n_test * log(mse_test) + 2 * k
# Mostrar métricas en conjunto de prueba
cat("\nMétricas en conjunto de prueba:\n")##
## Métricas en conjunto de prueba:cat("R² del modelo XGBoost:", r2_test, "\n")## R² del modelo XGBoost: 0.9968438cat("AIC aproximado del modelo XGBoost:", aic_test, "\n")## AIC aproximado del modelo XGBoost: 27749.72cat("RMSE del modelo XGBoost:", rmse_test, "\n")## RMSE del modelo XGBoost: 149.2654cat("MAPE del modelo XGBoost:", mape_test, "\n")## MAPE del modelo XGBoost: 15802.1cat("MSE del modelo XGBoost:", mse_test, "\n\n")## MSE del modelo XGBoost: 22280.15# Paso 9: Predicciones en el conjunto completo
# Hacer predicciones en todo el conjunto de datos para comparación con otros modelos
x_completo <- as.matrix(datos_modelo[, colnames(datos_modelo) != "Venta"])
predicciones_completo <- predict(modelo_final, x_completo)
# Calcular métricas en conjunto completo
r2_completo <- 1 - sum((datos_modelo$Venta - predicciones_completo)^2) /
sum((datos_modelo$Venta - mean(datos_modelo$Venta))^2)
rmse_completo <- sqrt(mean((datos_modelo$Venta - predicciones_completo)^2))
mape_completo <- mean(abs((datos_modelo$Venta - predicciones_completo) /
pmax(datos_modelo$Venta, 0.01))) * 100
mse_completo <- mean((datos_modelo$Venta - predicciones_completo)^2)
n_completo <- nrow(datos_modelo)
aic_completo <- n_completo * log(mse_completo) + 2 * k
# Mostrar métricas en conjunto completo
cat("Métricas en conjunto completo:\n")## Métricas en conjunto completo:cat("R² del modelo XGBoost:", r2_completo, "\n")## R² del modelo XGBoost: 0.9985496cat("AIC aproximado del modelo XGBoost:", aic_completo, "\n")## AIC aproximado del modelo XGBoost: 132636.2cat("RMSE del modelo XGBoost:", rmse_completo, "\n")## RMSE del modelo XGBoost: 119.7715cat("MAPE del modelo XGBoost:", mape_completo, "\n")## MAPE del modelo XGBoost: 13017.31cat("MSE del modelo XGBoost:", mse_completo, "\n\n")## MSE del modelo XGBoost: 14345.21# Paso 10: Análisis de importancia de variables
# Calcular importancia de variables
importancia <- xgb.importance(
feature_names = colnames(datos_modelo)[colnames(datos_modelo) != "Venta"],
model = modelo_final
)
# Mostrar importancia de variables
cat("Importancia de variables:\n")## Importancia de variables:print(importancia)## Feature Gain Cover Frequency
## <char> <num> <num> <num>
## 1: Costo_Venta 6.938318e-01 3.196518e-01 0.274414851
## 2: Cant 2.526698e-01 3.139154e-01 0.276836158
## 3: Costo_Devolucion 3.128394e-02 1.234007e-01 0.095238095
## 4: Descuento_Porcentaje 1.920351e-02 1.504914e-01 0.149313963
## 5: Precio_Final_Unitario 1.893748e-03 5.920807e-02 0.096045198
## 6: Tiempo 3.997053e-04 2.306582e-03 0.011299435
## 7: Ajus_Sistema 3.503513e-04 1.181762e-02 0.032284100
## 8: Ajuste_Manual 2.485567e-04 1.828190e-02 0.029862793
## 9: Semana 7.612725e-05 1.306590e-04 0.023405973
## 10: Mes 2.510037e-05 8.487821e-05 0.008878128
## 11: Precio_Lista_Unitario 1.739289e-05 7.109386e-04 0.002421308# Graficar importancia de variables
xgb.plot.importance(importance_matrix = importancia,
main = "Importancia de Variables - Producto 3929788 (XGBoost)")
# Paso 11: Visualizaciones para evaluación
# Gráfico 1: Valores observados vs predichos
datos_grafico <- data.frame(
Observado = datos_modelo$Venta,
Predicho = predicciones_completo
)
ggplot(datos_grafico, aes(x = Observado, y = Predicho)) +
geom_point(alpha = 0.5) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(
title = "Valores Observados vs Predicciones - Producto 3929788 (XGBoost)",
x = "Ventas Observadas",
y = "Ventas Predichas"
) +
theme_minimal()
# Gráfico 2: Análisis de residuos
errores <- datos_modelo$Venta - predicciones_completo
# Histograma de errores
hist(errores,
main = "Distribución de Errores - Producto 3929788 (XGBoost)",
xlab = "Error (Observado - Predicho)",
col = "skyblue",
breaks = 30)
# Gráfico 3: Errores vs Predicciones
ggplot(data.frame(Predicho = predicciones_completo, Error = errores), aes(x = Predicho, y = Error)) +
geom_point(alpha = 0.5) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Error vs Predicción - Producto 3929788 (XGBoost)",
x = "Ventas Predichas",
y = "Error (Observado - Predicho)"
) +
theme_minimal()
# Guardar métricas de XGBoost para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3929788", # Cambia este ID para cada producto
Modelo = "XGBoost",
R2 = r2_completo, # Usamos las métricas del conjunto completo
RMSE = rmse_completo,
MAPE = mape_completo,
MSE = mse_completo,
AIC = aic_completo
))##PRODUCTO 3904152
# Preparar datos para el modelo (eliminar columnas no necesarias)
datos_modelo <- datos_3904152 %>%
select(-Trx_Fecha, -Fecha)
# Paso 2: Dividir los datos en conjuntos de entrenamiento (80%) y prueba (20%)
set.seed(123) # Para reproducibilidad
train_index <- createDataPartition(datos_modelo$Venta, p = 0.8, list = FALSE)
train_data <- datos_modelo[train_index, ]
test_data <- datos_modelo[-train_index, ]
# Preparar matrices para XGBoost
train_x <- as.matrix(train_data[, colnames(train_data) != "Venta"])
train_y <- train_data$Venta
test_x <- as.matrix(test_data[, colnames(test_data) != "Venta"])
test_y <- test_data$Venta
# Crear DMatrix para XGBoost
dtrain <- xgb.DMatrix(data = train_x, label = train_y)
dtest <- xgb.DMatrix(data = test_x, label = test_y)
# Paso 3: Definir la rejilla de hiperparámetros para Grid Search
param_grid <- expand.grid(
eta = c(0.01, 0.05, 0.1, 0.3), # Learning rate
max_depth = c(3, 6, 9), # Profundidad máxima
min_child_weight = c(1, 3, 5), # Peso mínimo de nodo hijo
subsample = c(0.7, 0.9), # Proporción de observaciones
colsample_bytree = c(0.7, 0.9), # Proporción de variables
gamma = c(0, 0.1, 0.3) # Regularización gamma
)
# Mostrar dimensiones de la rejilla
cat("Grid Search para XGBoost - Producto 3904152\n")## Grid Search para XGBoost - Producto 3904152cat("Número total de combinaciones de hiperparámetros:", nrow(param_grid), "\n\n")## Número total de combinaciones de hiperparámetros: 432# Para este ejemplo, limitar a 12 combinaciones para ahorrar tiempo
# En un escenario real, podrías evaluar todas o usar una estrategia más eficiente
set.seed(456)
if (nrow(param_grid) > 12) {
selected_indices <- sample(1:nrow(param_grid), 12)
param_grid <- param_grid[selected_indices, ]
cat("Seleccionando 12 combinaciones aleatorias para evaluación.\n\n")
}## Seleccionando 12 combinaciones aleatorias para evaluación.# Paso 4: Implementar Grid Search
resultados <- data.frame()
cat("Iniciando Grid Search...\n")## Iniciando Grid Search...for (i in 1:nrow(param_grid)) {
# Extraer parámetros de la combinación actual
params <- list(
objective = "reg:squarederror", # Objetivo de regresión
eval_metric = "rmse", # Métrica de evaluación
eta = param_grid$eta[i],
max_depth = param_grid$max_depth[i],
min_child_weight = param_grid$min_child_weight[i],
subsample = param_grid$subsample[i],
colsample_bytree = param_grid$colsample_bytree[i],
gamma = param_grid$gamma[i]
)
cat("Evaluando combinación", i, "de", nrow(param_grid), ":\n")
cat(" eta =", params$eta,
", max_depth =", params$max_depth,
", min_child_weight =", params$min_child_weight,
", subsample =", params$subsample,
", colsample_bytree =", params$colsample_bytree,
", gamma =", params$gamma, "\n")
# Validación cruzada para encontrar el número óptimo de iteraciones
cv_model <- xgb.cv(
params = params,
data = dtrain,
nrounds = 200, # Máximo número de iteraciones
nfold = 5, # 5-fold validación cruzada
early_stopping_rounds = 20, # Detener si no hay mejora en 20 rondas
verbose = 0 # Suprimir mensajes
)
# Extraer mejor iteración y su RMSE
best_iteration <- cv_model$best_iteration
best_rmse <- min(cv_model$evaluation_log$test_rmse_mean)
cat(" Mejor iteración:", best_iteration, "\n")
cat(" RMSE en validación cruzada:", best_rmse, "\n\n")
# Guardar resultados
resultado_actual <- data.frame(
eta = params$eta,
max_depth = params$max_depth,
min_child_weight = params$min_child_weight,
subsample = params$subsample,
colsample_bytree = params$colsample_bytree,
gamma = params$gamma,
nrounds = best_iteration,
rmse_cv = best_rmse
)
resultados <- rbind(resultados, resultado_actual)
}## Evaluando combinación 1 de 12 :
## eta = 0.01 , max_depth = 9 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 200
## RMSE en validación cruzada: 2648.028
##
## Evaluando combinación 2 de 12 :
## eta = 0.1 , max_depth = 9 , min_child_weight = 3 , subsample = 0.9 , colsample_bytree = 0.9 , gamma = 0.3
## Mejor iteración: 56
## RMSE en validación cruzada: 1081.465
##
## Evaluando combinación 3 de 12 :
## eta = 0.05 , max_depth = 3 , min_child_weight = 1 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0
## Mejor iteración: 200
## RMSE en validación cruzada: 713.0338
##
## Evaluando combinación 4 de 12 :
## eta = 0.3 , max_depth = 9 , min_child_weight = 5 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 61
## RMSE en validación cruzada: 1446.25
##
## Evaluando combinación 5 de 12 :
## eta = 0.1 , max_depth = 6 , min_child_weight = 5 , subsample = 0.9 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 179
## RMSE en validación cruzada: 1651.384
##
## Evaluando combinación 6 de 12 :
## eta = 0.01 , max_depth = 6 , min_child_weight = 5 , subsample = 0.9 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 200
## RMSE en validación cruzada: 2933.108
##
## Evaluando combinación 7 de 12 :
## eta = 0.05 , max_depth = 3 , min_child_weight = 5 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0.1
## Mejor iteración: 193
## RMSE en validación cruzada: 1157.382
##
## Evaluando combinación 8 de 12 :
## eta = 0.1 , max_depth = 3 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.7 , gamma = 0.1
## Mejor iteración: 122
## RMSE en validación cruzada: 935.0852
##
## Evaluando combinación 9 de 12 :
## eta = 0.05 , max_depth = 6 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0.3
## Mejor iteración: 200
## RMSE en validación cruzada: 867.3906
##
## Evaluando combinación 10 de 12 :
## eta = 0.1 , max_depth = 9 , min_child_weight = 1 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0.3
## Mejor iteración: 200
## RMSE en validación cruzada: 839.3202
##
## Evaluando combinación 11 de 12 :
## eta = 0.05 , max_depth = 6 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0
## Mejor iteración: 184
## RMSE en validación cruzada: 833.8956
##
## Evaluando combinación 12 de 12 :
## eta = 0.1 , max_depth = 3 , min_child_weight = 3 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0.3
## Mejor iteración: 194
## RMSE en validación cruzada: 1102.008# Ordenar resultados por RMSE (de menor a mayor)
resultados <- resultados[order(resultados$rmse_cv), ]
# Paso 5: Mostrar resultados del Grid Search
cat("Resultados del Grid Search ordenados por RMSE:\n")## Resultados del Grid Search ordenados por RMSE:print(resultados)## eta max_depth min_child_weight subsample colsample_bytree gamma nrounds
## 3 0.05 3 1 0.9 0.7 0.0 200
## 11 0.05 6 3 0.7 0.9 0.0 184
## 10 0.10 9 1 0.9 0.7 0.3 200
## 9 0.05 6 3 0.7 0.9 0.3 200
## 8 0.10 3 3 0.7 0.7 0.1 122
## 2 0.10 9 3 0.9 0.9 0.3 56
## 12 0.10 3 3 0.9 0.7 0.3 194
## 7 0.05 3 5 0.9 0.7 0.1 193
## 4 0.30 9 5 0.7 0.9 0.1 61
## 5 0.10 6 5 0.9 0.9 0.1 179
## 1 0.01 9 3 0.7 0.9 0.1 200
## 6 0.01 6 5 0.9 0.9 0.1 200
## rmse_cv
## 3 713.0338
## 11 833.8956
## 10 839.3202
## 9 867.3906
## 8 935.0852
## 2 1081.4649
## 12 1102.0078
## 7 1157.3825
## 4 1446.2505
## 5 1651.3839
## 1 2648.0279
## 6 2933.1083# Visualizar resultados del Grid Search
ggplot(resultados, aes(x = reorder(paste("Comb", 1:nrow(resultados)), rmse_cv), y = rmse_cv)) +
geom_bar(stat = "identity", fill = "steelblue") +
labs(
title = "Resultados del Grid Search - Producto 3904152",
x = "Combinación de Hiperparámetros",
y = "RMSE en Validación Cruzada"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Paso 6: Seleccionar los mejores hiperparámetros
mejores_params <- list(
objective = "reg:squarederror",
eval_metric = "rmse",
eta = resultados$eta[1],
max_depth = resultados$max_depth[1],
min_child_weight = resultados$min_child_weight[1],
subsample = resultados$subsample[1],
colsample_bytree = resultados$colsample_bytree[1],
gamma = resultados$gamma[1]
)
mejor_nrounds <- resultados$nrounds[1]
cat("\nMejores hiperparámetros encontrados:\n")##
## Mejores hiperparámetros encontrados:print(mejores_params)## $objective
## [1] "reg:squarederror"
##
## $eval_metric
## [1] "rmse"
##
## $eta
## [1] 0.05
##
## $max_depth
## [1] 3
##
## $min_child_weight
## [1] 1
##
## $subsample
## [1] 0.9
##
## $colsample_bytree
## [1] 0.7
##
## $gamma
## [1] 0cat("Número óptimo de rondas:", mejor_nrounds, "\n\n")## Número óptimo de rondas: 200# Paso 7: Entrenar el modelo final con los mejores hiperparámetros
cat("Entrenando modelo final con los mejores hiperparámetros...\n")## Entrenando modelo final con los mejores hiperparámetros...modelo_final <- xgb.train(
params = mejores_params,
data = dtrain,
nrounds = mejor_nrounds,
watchlist = list(train = dtrain, test = dtest),
verbose = 0
)
modelo_xgb_3904152 <- modelo_final
# Paso 8: Evaluar el modelo
# Predicciones en conjunto de prueba
predicciones_test <- predict(modelo_final, dtest)
# Calcular métricas
# R²
r2_test <- 1 - sum((test_y - predicciones_test)^2) / sum((test_y - mean(test_y))^2)
# RMSE
rmse_test <- sqrt(mean((test_y - predicciones_test)^2))
# MAPE
mape_test <- mean(abs((test_y - predicciones_test) / pmax(test_y, 0.01))) * 100
# MSE
mse_test <- mean((test_y - predicciones_test)^2)
# AIC aproximado
n_test <- length(test_y)
k <- length(mejores_params) + 1 # +1 por número de iteraciones
aic_test <- n_test * log(mse_test) + 2 * k
# Mostrar métricas en conjunto de prueba
cat("\nMétricas en conjunto de prueba:\n")##
## Métricas en conjunto de prueba:cat("R² del modelo XGBoost:", r2_test, "\n")## R² del modelo XGBoost: 0.9967232cat("AIC aproximado del modelo XGBoost:", aic_test, "\n")## AIC aproximado del modelo XGBoost: 6685.934cat("RMSE del modelo XGBoost:", rmse_test, "\n")## RMSE del modelo XGBoost: 594.0182cat("MAPE del modelo XGBoost:", mape_test, "\n")## MAPE del modelo XGBoost: 109448.9cat("MSE del modelo XGBoost:", mse_test, "\n\n")## MSE del modelo XGBoost: 352857.7# Paso 9: Predicciones en el conjunto completo
# Hacer predicciones en todo el conjunto de datos para comparación con otros modelos
x_completo <- as.matrix(datos_modelo[, colnames(datos_modelo) != "Venta"])
predicciones_completo <- predict(modelo_final, x_completo)
# Calcular métricas en conjunto completo
r2_completo <- 1 - sum((datos_modelo$Venta - predicciones_completo)^2) /
sum((datos_modelo$Venta - mean(datos_modelo$Venta))^2)
rmse_completo <- sqrt(mean((datos_modelo$Venta - predicciones_completo)^2))
mape_completo <- mean(abs((datos_modelo$Venta - predicciones_completo) /
pmax(datos_modelo$Venta, 0.01))) * 100
mse_completo <- mean((datos_modelo$Venta - predicciones_completo)^2)
n_completo <- nrow(datos_modelo)
aic_completo <- n_completo * log(mse_completo) + 2 * k
# Mostrar métricas en conjunto completo
cat("Métricas en conjunto completo:\n")## Métricas en conjunto completo:cat("R² del modelo XGBoost:", r2_completo, "\n")## R² del modelo XGBoost: 0.9988617cat("AIC aproximado del modelo XGBoost:", aic_completo, "\n")## AIC aproximado del modelo XGBoost: 30836.16cat("RMSE del modelo XGBoost:", rmse_completo, "\n")## RMSE del modelo XGBoost: 361.5213cat("MAPE del modelo XGBoost:", mape_completo, "\n")## MAPE del modelo XGBoost: 82192.45cat("MSE del modelo XGBoost:", mse_completo, "\n\n")## MSE del modelo XGBoost: 130697.6# Paso 10: Análisis de importancia de variables
# Calcular importancia de variables
importancia <- xgb.importance(
feature_names = colnames(datos_modelo)[colnames(datos_modelo) != "Venta"],
model = modelo_final
)
# Mostrar importancia de variables
cat("Importancia de variables:\n")## Importancia de variables:print(importancia)## Feature Gain Cover Frequency
## <char> <num> <num> <num>
## 1: Costo_Venta 5.156831e-01 0.324161514 0.272058824
## 2: Cant 4.502473e-01 0.337535166 0.334558824
## 3: Ajuste_Manual 1.311345e-02 0.050321996 0.066176471
## 4: Semana 1.051072e-02 0.026144641 0.037683824
## 5: Costo_Devolucion 6.458166e-03 0.096981990 0.094669118
## 6: Precio_Final_Unitario 2.255694e-03 0.075948045 0.077205882
## 7: Tiempo 9.305080e-04 0.020539247 0.028492647
## 8: Descuento_Porcentaje 5.375740e-04 0.055687563 0.052389706
## 9: Ajus_Sistema 1.184746e-04 0.005400966 0.017463235
## 10: Precio_Lista_Unitario 7.533472e-05 0.004857595 0.010110294
## 11: Mes 6.969343e-05 0.002421275 0.009191176# Graficar importancia de variables
xgb.plot.importance(importance_matrix = importancia,
main = "Importancia de Variables - Producto 3904152 (XGBoost)")
# Paso 11: Visualizaciones para evaluación
# Gráfico 1: Valores observados vs predichos
datos_grafico <- data.frame(
Observado = datos_modelo$Venta,
Predicho = predicciones_completo
)
ggplot(datos_grafico, aes(x = Observado, y = Predicho)) +
geom_point(alpha = 0.5) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(
title = "Valores Observados vs Predicciones - Producto 3904152 (XGBoost)",
x = "Ventas Observadas",
y = "Ventas Predichas"
) +
theme_minimal()
# Gráfico 2: Análisis de residuos
errores <- datos_modelo$Venta - predicciones_completo
# Histograma de errores
hist(errores,
main = "Distribución de Errores - Producto 3904152 (XGBoost)",
xlab = "Error (Observado - Predicho)",
col = "skyblue",
breaks = 30)
# Gráfico 3: Errores vs Predicciones
ggplot(data.frame(Predicho = predicciones_completo, Error = errores), aes(x = Predicho, y = Error)) +
geom_point(alpha = 0.5) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Error vs Predicción - Producto 3904152 (XGBoost)",
x = "Ventas Predichas",
y = "Error (Observado - Predicho)"
) +
theme_minimal()
# Guardar métricas de XGBoost para producto
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3904152", # Cambia este ID para cada producto
Modelo = "XGBoost",
R2 = r2_completo, # Usamos las métricas del conjunto completo
RMSE = rmse_completo,
MAPE = mape_completo,
MSE = mse_completo,
AIC = aic_completo
))##PRODUCTO 155002
# Preparar datos para el modelo (eliminar columnas no necesarias)
datos_modelo <- datos_155002 %>%
select(-Trx_Fecha, -Fecha)
# Paso 2: Dividir los datos en conjuntos de entrenamiento (80%) y prueba (20%)
set.seed(123) # Para reproducibilidad
train_index <- createDataPartition(datos_modelo$Venta, p = 0.8, list = FALSE)
train_data <- datos_modelo[train_index, ]
test_data <- datos_modelo[-train_index, ]
# Preparar matrices para XGBoost
train_x <- as.matrix(train_data[, colnames(train_data) != "Venta"])
train_y <- train_data$Venta
test_x <- as.matrix(test_data[, colnames(test_data) != "Venta"])
test_y <- test_data$Venta
# Crear DMatrix para XGBoost
dtrain <- xgb.DMatrix(data = train_x, label = train_y)
dtest <- xgb.DMatrix(data = test_x, label = test_y)
# Paso 3: Definir la rejilla de hiperparámetros para Grid Search
param_grid <- expand.grid(
eta = c(0.01, 0.05, 0.1, 0.3), # Learning rate
max_depth = c(3, 6, 9), # Profundidad máxima
min_child_weight = c(1, 3, 5), # Peso mínimo de nodo hijo
subsample = c(0.7, 0.9), # Proporción de observaciones
colsample_bytree = c(0.7, 0.9), # Proporción de variables
gamma = c(0, 0.1, 0.3) # Regularización gamma
)
# Mostrar dimensiones de la rejilla
cat("Grid Search para XGBoost - Producto 155002\n")## Grid Search para XGBoost - Producto 155002cat("Número total de combinaciones de hiperparámetros:", nrow(param_grid), "\n\n")## Número total de combinaciones de hiperparámetros: 432# Para este ejemplo, limitar a 12 combinaciones para ahorrar tiempo
# En un escenario real, podrías evaluar todas o usar una estrategia más eficiente
set.seed(456)
if (nrow(param_grid) > 12) {
selected_indices <- sample(1:nrow(param_grid), 12)
param_grid <- param_grid[selected_indices, ]
cat("Seleccionando 12 combinaciones aleatorias para evaluación.\n\n")
}## Seleccionando 12 combinaciones aleatorias para evaluación.# Paso 4: Implementar Grid Search
resultados <- data.frame()
cat("Iniciando Grid Search...\n")## Iniciando Grid Search...for (i in 1:nrow(param_grid)) {
# Extraer parámetros de la combinación actual
params <- list(
objective = "reg:squarederror", # Objetivo de regresión
eval_metric = "rmse", # Métrica de evaluación
eta = param_grid$eta[i],
max_depth = param_grid$max_depth[i],
min_child_weight = param_grid$min_child_weight[i],
subsample = param_grid$subsample[i],
colsample_bytree = param_grid$colsample_bytree[i],
gamma = param_grid$gamma[i]
)
cat("Evaluando combinación", i, "de", nrow(param_grid), ":\n")
cat(" eta =", params$eta,
", max_depth =", params$max_depth,
", min_child_weight =", params$min_child_weight,
", subsample =", params$subsample,
", colsample_bytree =", params$colsample_bytree,
", gamma =", params$gamma, "\n")
# Validación cruzada para encontrar el número óptimo de iteraciones
cv_model <- xgb.cv(
params = params,
data = dtrain,
nrounds = 200, # Máximo número de iteraciones
nfold = 5, # 5-fold validación cruzada
early_stopping_rounds = 20, # Detener si no hay mejora en 20 rondas
verbose = 0 # Suprimir mensajes
)
# Extraer mejor iteración y su RMSE
best_iteration <- cv_model$best_iteration
best_rmse <- min(cv_model$evaluation_log$test_rmse_mean)
cat(" Mejor iteración:", best_iteration, "\n")
cat(" RMSE en validación cruzada:", best_rmse, "\n\n")
# Guardar resultados
resultado_actual <- data.frame(
eta = params$eta,
max_depth = params$max_depth,
min_child_weight = params$min_child_weight,
subsample = params$subsample,
colsample_bytree = params$colsample_bytree,
gamma = params$gamma,
nrounds = best_iteration,
rmse_cv = best_rmse
)
resultados <- rbind(resultados, resultado_actual)
}## Evaluando combinación 1 de 12 :
## eta = 0.01 , max_depth = 9 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 200
## RMSE en validación cruzada: 1475.996
##
## Evaluando combinación 2 de 12 :
## eta = 0.1 , max_depth = 9 , min_child_weight = 3 , subsample = 0.9 , colsample_bytree = 0.9 , gamma = 0.3
## Mejor iteración: 53
## RMSE en validación cruzada: 970.7542
##
## Evaluando combinación 3 de 12 :
## eta = 0.05 , max_depth = 3 , min_child_weight = 1 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0
## Mejor iteración: 200
## RMSE en validación cruzada: 954.6884
##
## Evaluando combinación 4 de 12 :
## eta = 0.3 , max_depth = 9 , min_child_weight = 5 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 25
## RMSE en validación cruzada: 1013.716
##
## Evaluando combinación 5 de 12 :
## eta = 0.1 , max_depth = 6 , min_child_weight = 5 , subsample = 0.9 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 84
## RMSE en validación cruzada: 980.0891
##
## Evaluando combinación 6 de 12 :
## eta = 0.01 , max_depth = 6 , min_child_weight = 5 , subsample = 0.9 , colsample_bytree = 0.9 , gamma = 0.1
## Mejor iteración: 200
## RMSE en validación cruzada: 1487.462
##
## Evaluando combinación 7 de 12 :
## eta = 0.05 , max_depth = 3 , min_child_weight = 5 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0.1
## Mejor iteración: 200
## RMSE en validación cruzada: 1092.613
##
## Evaluando combinación 8 de 12 :
## eta = 0.1 , max_depth = 3 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.7 , gamma = 0.1
## Mejor iteración: 157
## RMSE en validación cruzada: 1065.109
##
## Evaluando combinación 9 de 12 :
## eta = 0.05 , max_depth = 6 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0.3
## Mejor iteración: 136
## RMSE en validación cruzada: 921.6584
##
## Evaluando combinación 10 de 12 :
## eta = 0.1 , max_depth = 9 , min_child_weight = 1 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0.3
## Mejor iteración: 200
## RMSE en validación cruzada: 1045.834
##
## Evaluando combinación 11 de 12 :
## eta = 0.05 , max_depth = 6 , min_child_weight = 3 , subsample = 0.7 , colsample_bytree = 0.9 , gamma = 0
## Mejor iteración: 132
## RMSE en validación cruzada: 925.3794
##
## Evaluando combinación 12 de 12 :
## eta = 0.1 , max_depth = 3 , min_child_weight = 3 , subsample = 0.9 , colsample_bytree = 0.7 , gamma = 0.3
## Mejor iteración: 80
## RMSE en validación cruzada: 1146.463# Ordenar resultados por RMSE (de menor a mayor)
resultados <- resultados[order(resultados$rmse_cv), ]
# Paso 5: Mostrar resultados del Grid Search
cat("Resultados del Grid Search ordenados por RMSE:\n")## Resultados del Grid Search ordenados por RMSE:print(resultados)## eta max_depth min_child_weight subsample colsample_bytree gamma nrounds
## 9 0.05 6 3 0.7 0.9 0.3 136
## 11 0.05 6 3 0.7 0.9 0.0 132
## 3 0.05 3 1 0.9 0.7 0.0 200
## 2 0.10 9 3 0.9 0.9 0.3 53
## 5 0.10 6 5 0.9 0.9 0.1 84
## 4 0.30 9 5 0.7 0.9 0.1 25
## 10 0.10 9 1 0.9 0.7 0.3 200
## 8 0.10 3 3 0.7 0.7 0.1 157
## 7 0.05 3 5 0.9 0.7 0.1 200
## 12 0.10 3 3 0.9 0.7 0.3 80
## 1 0.01 9 3 0.7 0.9 0.1 200
## 6 0.01 6 5 0.9 0.9 0.1 200
## rmse_cv
## 9 921.6584
## 11 925.3794
## 3 954.6884
## 2 970.7542
## 5 980.0891
## 4 1013.7159
## 10 1045.8342
## 8 1065.1087
## 7 1092.6131
## 12 1146.4628
## 1 1475.9963
## 6 1487.4619# Visualizar resultados del Grid Search
ggplot(resultados, aes(x = reorder(paste("Comb", 1:nrow(resultados)), rmse_cv), y = rmse_cv)) +
geom_bar(stat = "identity", fill = "steelblue") +
labs(
title = "Resultados del Grid Search - Producto 155002",
x = "Combinación de Hiperparámetros",
y = "RMSE en Validación Cruzada"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Paso 6: Seleccionar los mejores hiperparámetros
mejores_params <- list(
objective = "reg:squarederror",
eval_metric = "rmse",
eta = resultados$eta[1],
max_depth = resultados$max_depth[1],
min_child_weight = resultados$min_child_weight[1],
subsample = resultados$subsample[1],
colsample_bytree = resultados$colsample_bytree[1],
gamma = resultados$gamma[1]
)
mejor_nrounds <- resultados$nrounds[1]
cat("\nMejores hiperparámetros encontrados:\n")##
## Mejores hiperparámetros encontrados:print(mejores_params)## $objective
## [1] "reg:squarederror"
##
## $eval_metric
## [1] "rmse"
##
## $eta
## [1] 0.05
##
## $max_depth
## [1] 6
##
## $min_child_weight
## [1] 3
##
## $subsample
## [1] 0.7
##
## $colsample_bytree
## [1] 0.9
##
## $gamma
## [1] 0.3cat("Número óptimo de rondas:", mejor_nrounds, "\n\n")## Número óptimo de rondas: 136# Paso 7: Entrenar el modelo final con los mejores hiperparámetros
cat("Entrenando modelo final con los mejores hiperparámetros...\n")## Entrenando modelo final con los mejores hiperparámetros...modelo_final <- xgb.train(
params = mejores_params,
data = dtrain,
nrounds = mejor_nrounds,
watchlist = list(train = dtrain, test = dtest),
verbose = 0
)
modelo_xgb_155002 <- modelo_final
# Paso 8: Evaluar el modelo
# Predicciones en conjunto de prueba
predicciones_test <- predict(modelo_final, dtest)
# Calcular métricas
# R²
r2_test <- 1 - sum((test_y - predicciones_test)^2) / sum((test_y - mean(test_y))^2)
# RMSE
rmse_test <- sqrt(mean((test_y - predicciones_test)^2))
# MAPE
mape_test <- mean(abs((test_y - predicciones_test) / pmax(test_y, 0.01))) * 100
# MSE
mse_test <- mean((test_y - predicciones_test)^2)
# AIC aproximado
n_test <- length(test_y)
k <- length(mejores_params) + 1 # +1 por número de iteraciones
aic_test <- n_test * log(mse_test) + 2 * k
# Mostrar métricas en conjunto de prueba
cat("\nMétricas en conjunto de prueba:\n")##
## Métricas en conjunto de prueba:cat("R² del modelo XGBoost:", r2_test, "\n")## R² del modelo XGBoost: 0.8988434cat("AIC aproximado del modelo XGBoost:", aic_test, "\n")## AIC aproximado del modelo XGBoost: 17402.7cat("RMSE del modelo XGBoost:", rmse_test, "\n")## RMSE del modelo XGBoost: 1728.217cat("MAPE del modelo XGBoost:", mape_test, "\n")## MAPE del modelo XGBoost: 116446.2cat("MSE del modelo XGBoost:", mse_test, "\n\n")## MSE del modelo XGBoost: 2986732# Paso 9: Predicciones en el conjunto completo
# Hacer predicciones en todo el conjunto de datos para comparación con otros modelos
x_completo <- as.matrix(datos_modelo[, colnames(datos_modelo) != "Venta"])
predicciones_completo <- predict(modelo_final, x_completo)
# Calcular métricas en conjunto completo
r2_completo <- 1 - sum((datos_modelo$Venta - predicciones_completo)^2) /
sum((datos_modelo$Venta - mean(datos_modelo$Venta))^2)
rmse_completo <- sqrt(mean((datos_modelo$Venta - predicciones_completo)^2))
mape_completo <- mean(abs((datos_modelo$Venta - predicciones_completo) /
pmax(datos_modelo$Venta, 0.01))) * 100
mse_completo <- mean((datos_modelo$Venta - predicciones_completo)^2)
n_completo <- nrow(datos_modelo)
aic_completo <- n_completo * log(mse_completo) + 2 * k
# Mostrar métricas en conjunto completo
cat("Métricas en conjunto completo:\n")## Métricas en conjunto completo:cat("R² del modelo XGBoost:", r2_completo, "\n")## R² del modelo XGBoost: 0.9691126cat("AIC aproximado del modelo XGBoost:", aic_completo, "\n")## AIC aproximado del modelo XGBoost: 80227.98cat("RMSE del modelo XGBoost:", rmse_completo, "\n")## RMSE del modelo XGBoost: 963.741cat("MAPE del modelo XGBoost:", mape_completo, "\n")## MAPE del modelo XGBoost: 123048.4cat("MSE del modelo XGBoost:", mse_completo, "\n\n")## MSE del modelo XGBoost: 928796.8# Paso 10: Análisis de importancia de variables
# Calcular importancia de variables
importancia <- xgb.importance(
feature_names = colnames(datos_modelo)[colnames(datos_modelo) != "Venta"],
model = modelo_final
)
# Mostrar importancia de variables
cat("Importancia de variables:\n")## Importancia de variables:print(importancia)## Feature Gain Cover Frequency
## <char> <num> <num> <num>
## 1: Cant 6.467925e-01 5.161683e-01 0.3652173913
## 2: Costo_Venta 3.220975e-01 1.938607e-01 0.2059496568
## 3: Costo_Devolucion 1.646820e-02 5.713636e-02 0.0352402746
## 4: Precio_Final_Unitario 9.547623e-03 1.691554e-01 0.2343249428
## 5: Descuento_Porcentaje 2.053813e-03 4.279673e-02 0.0677345538
## 6: Tiempo 9.806248e-04 9.489108e-03 0.0228832952
## 7: Ajus_Sistema 7.954456e-04 8.214508e-03 0.0173913043
## 8: Semana 6.948506e-04 2.158267e-03 0.0311212815
## 9: Ajuste_Manual 5.547172e-04 8.454442e-04 0.0169336384
## 10: Mes 1.214225e-05 1.464579e-04 0.0027459954
## 11: Precio_Lista_Unitario 2.654852e-06 2.876175e-05 0.0004576659# Graficar importancia de variables
xgb.plot.importance(importance_matrix = importancia,
main = "Importancia de Variables - Producto 155002 (XGBoost)")
# Paso 11: Visualizaciones para evaluación
# Gráfico 1: Valores observados vs predichos
datos_grafico <- data.frame(
Observado = datos_modelo$Venta,
Predicho = predicciones_completo
)
ggplot(datos_grafico, aes(x = Observado, y = Predicho)) +
geom_point(alpha = 0.5) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(
title = "Valores Observados vs Predicciones - Producto 155002 (XGBoost)",
x = "Ventas Observadas",
y = "Ventas Predichas"
) +
theme_minimal()
# Gráfico 2: Análisis de residuos
errores <- datos_modelo$Venta - predicciones_completo
# Histograma de errores
hist(errores,
main = "Distribución de Errores - Producto 155002 (XGBoost)",
xlab = "Error (Observado - Predicho)",
col = "skyblue",
breaks = 30)
# Gráfico 3: Errores vs Predicciones
ggplot(data.frame(Predicho = predicciones_completo, Error = errores), aes(x = Predicho, y = Error)) +
geom_point(alpha = 0.5) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Error vs Predicción - Producto 155002 (XGBoost)",
x = "Ventas Predichas",
y = "Error (Observado - Predicho)"
) +
theme_minimal()
# Guardar métricas de XGBoost para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "155002", # Cambia este ID para cada producto
Modelo = "XGBoost",
R2 = r2_completo, # Usamos las métricas del conjunto completo
RMSE = rmse_completo,
MAPE = mape_completo,
MSE = mse_completo,
AIC = aic_completo
))##PRODUCTO 3678055
# Preparar datos para el modelo (eliminar columnas no necesarias)
datos_modelo <- datos_3678055 %>%
select(-Trx_Fecha, -Fecha)
# Paso 2: Dividir los datos en conjuntos de entrenamiento (80%) y prueba (20%)
set.seed(123) # Para reproducibilidad
train_index <- createDataPartition(datos_modelo$Venta, p = 0.8, list = FALSE)
train_data <- datos_modelo[train_index, ]
test_data <- datos_modelo[-train_index, ]
# Preparar matrices para XGBoost
train_x <- as.matrix(train_data[, colnames(train_data) != "Venta"])
train_y <- train_data$Venta
test_x <- as.matrix(test_data[, colnames(test_data) != "Venta"])
test_y <- test_data$Venta
# Crear DMatrix para XGBoost
dtrain <- xgb.DMatrix(data = train_x, label = train_y)
dtest <- xgb.DMatrix(data = test_x, label = test_y)
# Paso 3: Definir la rejilla de hiperparámetros
param_grid <- expand.grid(
eta = c(0.01, 0.05, 0.1, 0.3),
max_depth = c(3, 6, 9),
min_child_weight = c(1, 3, 5),
subsample = c(0.7, 0.9),
colsample_bytree = c(0.7, 0.9),
gamma = c(0, 0.1, 0.3)
)
cat("Grid Search para XGBoost - Producto 3678055\n")## Grid Search para XGBoost - Producto 3678055cat("Número total de combinaciones de hiperparámetros:", nrow(param_grid), "\n\n")## Número total de combinaciones de hiperparámetros: 432# Selección aleatoria de 12 combinaciones (si se desea limitar)
set.seed(456)
if (nrow(param_grid) > 12) {
param_grid <- param_grid[sample(1:nrow(param_grid), 12), ]
cat("Seleccionando 12 combinaciones aleatorias para evaluación.\n\n")
}## Seleccionando 12 combinaciones aleatorias para evaluación.# Paso 4: Implementar Grid Search
resultados <- data.frame()
cat("Iniciando Grid Search...\n")## Iniciando Grid Search...for (i in 1:nrow(param_grid)) {
params <- list(
objective = "reg:squarederror",
eval_metric = "rmse",
eta = param_grid$eta[i],
max_depth = param_grid$max_depth[i],
min_child_weight = param_grid$min_child_weight[i],
subsample = param_grid$subsample[i],
colsample_bytree = param_grid$colsample_bytree[i],
gamma = param_grid$gamma[i]
)
cat("Evaluando combinación", i, "de", nrow(param_grid), "...\n")
cv_model <- xgb.cv(
params = params,
data = dtrain,
nrounds = 200,
nfold = 5,
early_stopping_rounds = 20,
verbose = 0
)
best_iteration <- cv_model$best_iteration
best_rmse <- min(cv_model$evaluation_log$test_rmse_mean)
resultado_actual <- data.frame(
eta = params$eta,
max_depth = params$max_depth,
min_child_weight = params$min_child_weight,
subsample = params$subsample,
colsample_bytree = params$colsample_bytree,
gamma = params$gamma,
nrounds = best_iteration,
rmse_cv = best_rmse
)
resultados <- rbind(resultados, resultado_actual)
}## Evaluando combinación 1 de 12 ...
## Evaluando combinación 2 de 12 ...
## Evaluando combinación 3 de 12 ...
## Evaluando combinación 4 de 12 ...
## Evaluando combinación 5 de 12 ...
## Evaluando combinación 6 de 12 ...
## Evaluando combinación 7 de 12 ...
## Evaluando combinación 8 de 12 ...
## Evaluando combinación 9 de 12 ...
## Evaluando combinación 10 de 12 ...
## Evaluando combinación 11 de 12 ...
## Evaluando combinación 12 de 12 ...resultados <- resultados[order(resultados$rmse_cv), ]
# Paso 5: Mostrar resultados
print(resultados)## eta max_depth min_child_weight subsample colsample_bytree gamma nrounds
## 2 0.10 9 3 0.9 0.9 0.3 181
## 11 0.05 6 3 0.7 0.9 0.0 157
## 3 0.05 3 1 0.9 0.7 0.0 200
## 8 0.10 3 3 0.7 0.7 0.1 139
## 9 0.05 6 3 0.7 0.9 0.3 186
## 12 0.10 3 3 0.9 0.7 0.3 118
## 5 0.10 6 5 0.9 0.9 0.1 200
## 7 0.05 3 5 0.9 0.7 0.1 195
## 4 0.30 9 5 0.7 0.9 0.1 57
## 10 0.10 9 1 0.9 0.7 0.3 200
## 6 0.01 6 5 0.9 0.9 0.1 200
## 1 0.01 9 3 0.7 0.9 0.1 200
## rmse_cv
## 2 578.6299
## 11 644.8336
## 3 651.5129
## 8 747.9975
## 9 755.7634
## 12 793.6352
## 5 852.7920
## 7 928.5016
## 4 969.0866
## 10 1101.3671
## 6 2332.5742
## 1 2394.6539# Visualización
ggplot(resultados, aes(x = reorder(paste("Comb", 1:nrow(resultados)), rmse_cv), y = rmse_cv)) +
geom_bar(stat = "identity", fill = "steelblue") +
labs(
title = "Resultados del Grid Search - Producto 3678055",
x = "Combinación de Hiperparámetros",
y = "RMSE"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
# Paso 6: Seleccionar los mejores hiperparámetros
mejores_params <- list(
objective = "reg:squarederror",
eval_metric = "rmse",
eta = resultados$eta[1],
max_depth = resultados$max_depth[1],
min_child_weight = resultados$min_child_weight[1],
subsample = resultados$subsample[1],
colsample_bytree = resultados$colsample_bytree[1],
gamma = resultados$gamma[1]
)
mejor_nrounds <- resultados$nrounds[1]
# Paso 7: Entrenar modelo final
modelo_final <- xgb.train(
params = mejores_params,
data = dtrain,
nrounds = mejor_nrounds,
watchlist = list(train = dtrain, test = dtest),
verbose = 0
)
modelo_xgb_3678055 <- modelo_final
# Paso 8: Evaluar modelo
predicciones_test <- predict(modelo_final, dtest)
r2_test <- 1 - sum((test_y - predicciones_test)^2) / sum((test_y - mean(test_y))^2)
rmse_test <- sqrt(mean((test_y - predicciones_test)^2))
mape_test <- mean(abs((test_y - predicciones_test) / pmax(test_y, 0.01))) * 100
mse_test <- mean((test_y - predicciones_test)^2)
aic_test <- length(test_y) * log(mse_test) + 2 * (length(mejores_params) + 1)
# Paso 9: Predicción en todo el conjunto
x_completo <- as.matrix(datos_modelo[, colnames(datos_modelo) != "Venta"])
predicciones_completo <- predict(modelo_final, x_completo)
r2_completo <- 1 - sum((datos_modelo$Venta - predicciones_completo)^2) /
sum((datos_modelo$Venta - mean(datos_modelo$Venta))^2)
rmse_completo <- sqrt(mean((datos_modelo$Venta - predicciones_completo)^2))
mape_completo <- mean(abs((datos_modelo$Venta - predicciones_completo) / pmax(datos_modelo$Venta, 0.01))) * 100
mse_completo <- mean((datos_modelo$Venta - predicciones_completo)^2)
aic_completo <- nrow(datos_modelo) * log(mse_completo) + 2 * (length(mejores_params) + 1)
# Paso 10: Importancia de variables
importancia <- xgb.importance(
feature_names = colnames(datos_modelo)[colnames(datos_modelo) != "Venta"],
model = modelo_final
)
xgb.plot.importance(importancia,
main = "Importancia de Variables - Producto 3678055 (XGBoost)")
# Paso 11: Gráficos de evaluación
datos_grafico <- data.frame(Observado = datos_modelo$Venta, Predicho = predicciones_completo)
ggplot(datos_grafico, aes(x = Observado, y = Predicho)) +
geom_point(alpha = 0.5) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "red") +
labs(title = "Observado vs Predicho - Producto 3678055", x = "Venta Observada", y = "Venta Predicha") +
theme_minimal()
errores <- datos_modelo$Venta - predicciones_completo
hist(errores,
main = "Distribución de Errores - Producto 3678055 (XGBoost)",
xlab = "Error (Observado - Predicho)",
col = "skyblue", breaks = 30)
ggplot(data.frame(Predicho = predicciones_completo, Error = errores), aes(x = Predicho, y = Error)) +
geom_point(alpha = 0.5) +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(title = "Errores vs Predicción - Producto 3678055", x = "Venta Predicha", y = "Error") +
theme_minimal()
# Guardar métricas de XGBoost para producto 155001
if(!exists("metricas_comparativas")) {
metricas_comparativas <- data.frame(
Producto = character(),
Modelo = character(),
R2 = numeric(),
RMSE = numeric(),
MAPE = numeric(),
MSE = numeric(),
AIC = numeric(),
stringsAsFactors = FALSE
)
}
metricas_comparativas <- rbind(metricas_comparativas, data.frame(
Producto = "3678055", # Cambia este ID para cada producto
Modelo = "XGBoost",
R2 = r2_completo, # Usamos las métricas del conjunto completo
RMSE = rmse_completo,
MAPE = mape_completo,
MSE = mse_completo,
AIC = aic_completo
))#Visualización de Métricas
# Definir los colores para cada modelo
colores_modelos <- c(
"ARMA/SARIMA" = "#1f77b4", # Azul
"Regresión Lineal" = "#ff7f0e", # Naranja
"Random Forest" = "#2ca02c", # Verde
"XGBoost" = "#d62728" # Rojo
)##Producto 155001
# Primero, veamos qué datos tenemos realmente
print("Datos actuales para el producto 155001:")## [1] "Datos actuales para el producto 155001:"print(metricas_comparativas %>% filter(Producto == "155001"))## Producto Modelo R2 RMSE MAPE MSE
## 1 155001 ARMA/SARIMA 0.1923463 216622.3497 17.48586 4.692524e+10
## 2 155001 Regresión Lineal 0.9887468 770.0434 15.90447 5.929668e+05
## 3 155001 Random Forest 0.9784171 1066.4276 156067.23553 1.137268e+06
## 4 155001 XGBoost 0.9985430 277.0827 40544.68377 7.677481e+04
## AIC
## 1 664.0425
## 2 139748.7359
## 3 120806.1350
## 4 97453.6495# Crear un dataframe manualmente con los 4 modelos para el producto 155001
# (con valores de ejemplo si es necesario)
datos_155001_completo <- data.frame(
Producto = rep("155001", 4),
Modelo = c("ARMA/SARIMA", "Regresión Lineal", "Random Forest", "XGBoost"),
stringsAsFactors = FALSE
)
# Unir con los datos existentes
datos_155001_completo <- left_join(
datos_155001_completo,
metricas_comparativas %>% filter(Producto == "155001"),
by = c("Producto", "Modelo")
)
# Ahora asigna valores para las métricas de los modelos faltantes
# Si tienes los valores, reemplaza los 0 con los valores correctos
# O toma nota de cuáles son NA para reemplazarlos con los valores reales
# Valores para Regresión Lineal (reemplaza estos con los valores reales)
if (is.na(datos_155001_completo$R2[2])) {
datos_155001_completo$R2[2] <- r2_155001 # O el valor correcto
}
if (is.na(datos_155001_completo$RMSE[2])) {
datos_155001_completo$RMSE[2] <- rmse_155001 # O el valor correcto
}
if (is.na(datos_155001_completo$MAPE[2])) {
datos_155001_completo$MAPE[2] <- mape_155001 # O el valor correcto
}
if (is.na(datos_155001_completo$MSE[2])) {
datos_155001_completo$MSE[2] <- mse_155001 # O el valor correcto
}
if (is.na(datos_155001_completo$AIC[2])) {
datos_155001_completo$AIC[2] <- aic_155001 # O el valor correcto
}
# Valores para Random Forest (reemplaza estos con los valores reales)
# Si ya ejecutaste la sección de Random Forest para el producto 155001,
# usa las variables r2_rf, rmse_rf, etc.
if (is.na(datos_155001_completo$R2[3]) && exists("r2_rf")) {
datos_155001_completo$R2[3] <- r2_rf
}
if (is.na(datos_155001_completo$RMSE[3]) && exists("rmse_rf")) {
datos_155001_completo$RMSE[3] <- rmse_rf
}
if (is.na(datos_155001_completo$MAPE[3]) && exists("mape_rf")) {
datos_155001_completo$MAPE[3] <- mape_rf
}
if (is.na(datos_155001_completo$MSE[3]) && exists("mse_rf")) {
datos_155001_completo$MSE[3] <- mse_rf
}
if (is.na(datos_155001_completo$AIC[3]) && exists("aic_rf")) {
datos_155001_completo$AIC[3] <- aic_rf
}
# Valores para XGBoost (reemplaza estos con los valores reales)
# Si ya ejecutaste la sección de XGBoost para el producto 155001,
# usa las variables r2_completo, rmse_completo, etc.
if (is.na(datos_155001_completo$R2[4]) && exists("r2_completo")) {
datos_155001_completo$R2[4] <- r2_completo
}
if (is.na(datos_155001_completo$RMSE[4]) && exists("rmse_completo")) {
datos_155001_completo$RMSE[4] <- rmse_completo
}
if (is.na(datos_155001_completo$MAPE[4]) && exists("mape_completo")) {
datos_155001_completo$MAPE[4] <- mape_completo
}
if (is.na(datos_155001_completo$MSE[4]) && exists("mse_completo")) {
datos_155001_completo$MSE[4] <- mse_completo
}
if (is.na(datos_155001_completo$AIC[4]) && exists("aic_completo")) {
datos_155001_completo$AIC[4] <- aic_completo
}
# Ver los datos completos
print("Datos completos para el producto 155001:")## [1] "Datos completos para el producto 155001:"print(datos_155001_completo)## Producto Modelo R2 RMSE MAPE MSE
## 1 155001 ARMA/SARIMA 0.1923463 216622.3497 17.48586 4.692524e+10
## 2 155001 Regresión Lineal 0.9887468 770.0434 15.90447 5.929668e+05
## 3 155001 Random Forest 0.9784171 1066.4276 156067.23553 1.137268e+06
## 4 155001 XGBoost 0.9985430 277.0827 40544.68377 7.677481e+04
## AIC
## 1 664.0425
## 2 139748.7359
## 3 120806.1350
## 4 97453.6495# Crear el gráfico con los datos completos
ggplot(datos_155001_completo, aes(x = Modelo, y = R2, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(R2, 3)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 155001",
subtitle = "Métrica: R² (valores más altos indican mejor ajuste)",
x = "",
y = "R²"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_155001_completo$R2, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para RMSE
ggplot(datos_155001_completo, aes(x = Modelo, y = RMSE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(RMSE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 155001",
subtitle = "Métrica: RMSE (valores más bajos indican mejor precisión)",
x = "",
y = "RMSE"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_155001_completo$RMSE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para MAPE
ggplot(datos_155001_completo, aes(x = Modelo, y = MAPE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(MAPE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 155001",
subtitle = "Métrica: MAPE (valores más bajos indican mejor precisión)",
x = "",
y = "MAPE (%)"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_155001_completo$MAPE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para MSE
ggplot(datos_155001_completo, aes(x = Modelo, y = MSE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(MSE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 155001",
subtitle = "Métrica: MSE (valores más bajos indican mejor precisión)",
x = "",
y = "MSE"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_155001_completo$MSE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para AIC
ggplot(datos_155001_completo, aes(x = Modelo, y = AIC, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(AIC, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 155001",
subtitle = "Métrica: AIC (valores más bajos indican mejor modelo)",
x = "",
y = "AIC"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_155001_completo$AIC, na.rm = TRUE) * 1.1) # Ajustar el límite Y
##PRODUCTO 3929788
# Primero, veamos qué datos tenemos realmente
print("Datos actuales para el producto 3929788:")## [1] "Datos actuales para el producto 3929788:"print(metricas_comparativas %>% filter(Producto == "3929788"))## Producto Modelo R2 RMSE MAPE MSE
## 1 3929788 ARMA/SARIMA 0.2466637 144234.4597 13.19875 2.080358e+10
## 2 3929788 Regresión Lineal 0.9949995 222.3941 29141.99432 4.945916e+04
## 3 3929788 Random Forest 0.9955214 210.4673 36102.66985 4.429649e+04
## 4 3929788 XGBoost 0.9985496 119.7715 13017.30953 1.434521e+04
## AIC
## 1 619.6674
## 2 189113.7773
## 3 148262.6435
## 4 132636.1536# Crear un dataframe manualmente con los 4 modelos para el producto 3929788
datos_3929788_completo <- data.frame(
Producto = rep("3929788", 4),
Modelo = c("ARMA/SARIMA", "Regresión Lineal", "Random Forest", "XGBoost"),
stringsAsFactors = FALSE
)
# Unir con los datos existentes
datos_3929788_completo <- left_join(
datos_3929788_completo,
metricas_comparativas %>% filter(Producto == "3929788"),
by = c("Producto", "Modelo")
)
# Ahora asigna valores para las métricas de los modelos faltantes
# Valores para Regresión Lineal
if (is.na(datos_3929788_completo$R2[2])) {
datos_3929788_completo$R2[2] <- r2_3929788
}
if (is.na(datos_3929788_completo$RMSE[2])) {
datos_3929788_completo$RMSE[2] <- rmse_3929788
}
if (is.na(datos_3929788_completo$MAPE[2])) {
datos_3929788_completo$MAPE[2] <- mape_3929788
}
if (is.na(datos_3929788_completo$MSE[2])) {
datos_3929788_completo$MSE[2] <- mse_3929788
}
if (is.na(datos_3929788_completo$AIC[2])) {
datos_3929788_completo$AIC[2] <- aic_3929788
}
# Valores para Random Forest
# Si ya ejecutaste la sección de Random Forest para el producto 3929788
if (is.na(datos_3929788_completo$R2[3]) && exists("r2_rf")) {
datos_3929788_completo$R2[3] <- r2_rf
}
if (is.na(datos_3929788_completo$RMSE[3]) && exists("rmse_rf")) {
datos_3929788_completo$RMSE[3] <- rmse_rf
}
if (is.na(datos_3929788_completo$MAPE[3]) && exists("mape_rf")) {
datos_3929788_completo$MAPE[3] <- mape_rf
}
if (is.na(datos_3929788_completo$MSE[3]) && exists("mse_rf")) {
datos_3929788_completo$MSE[3] <- mse_rf
}
if (is.na(datos_3929788_completo$AIC[3]) && exists("aic_rf")) {
datos_3929788_completo$AIC[3] <- aic_rf
}
# Valores para XGBoost
if (is.na(datos_3929788_completo$R2[4]) && exists("r2_completo")) {
datos_3929788_completo$R2[4] <- r2_completo
}
if (is.na(datos_3929788_completo$RMSE[4]) && exists("rmse_completo")) {
datos_3929788_completo$RMSE[4] <- rmse_completo
}
if (is.na(datos_3929788_completo$MAPE[4]) && exists("mape_completo")) {
datos_3929788_completo$MAPE[4] <- mape_completo
}
if (is.na(datos_3929788_completo$MSE[4]) && exists("mse_completo")) {
datos_3929788_completo$MSE[4] <- mse_completo
}
if (is.na(datos_3929788_completo$AIC[4]) && exists("aic_completo")) {
datos_3929788_completo$AIC[4] <- aic_completo
}
# Ver los datos completos
print("Datos completos para el producto 3929788:")## [1] "Datos completos para el producto 3929788:"print(datos_3929788_completo)## Producto Modelo R2 RMSE MAPE MSE
## 1 3929788 ARMA/SARIMA 0.2466637 144234.4597 13.19875 2.080358e+10
## 2 3929788 Regresión Lineal 0.9949995 222.3941 29141.99432 4.945916e+04
## 3 3929788 Random Forest 0.9955214 210.4673 36102.66985 4.429649e+04
## 4 3929788 XGBoost 0.9985496 119.7715 13017.30953 1.434521e+04
## AIC
## 1 619.6674
## 2 189113.7773
## 3 148262.6435
## 4 132636.1536# Definir colores para los modelos
colores_modelos <- c("ARMA/SARIMA" = "#1f77b4",
"Regresión Lineal" = "#ff7f0e",
"Random Forest" = "#2ca02c",
"XGBoost" = "#d62728")
# Gráfico para R²
ggplot(datos_3929788_completo, aes(x = Modelo, y = R2, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(R2, 3)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3929788",
subtitle = "Métrica: R² (valores más altos indican mejor ajuste)",
x = "",
y = "R²"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3929788_completo$R2, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para RMSE
ggplot(datos_3929788_completo, aes(x = Modelo, y = RMSE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(RMSE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3929788",
subtitle = "Métrica: RMSE (valores más bajos indican mejor precisión)",
x = "",
y = "RMSE"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3929788_completo$RMSE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para MAPE
ggplot(datos_3929788_completo, aes(x = Modelo, y = MAPE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(MAPE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3929788",
subtitle = "Métrica: MAPE (valores más bajos indican mejor precisión)",
x = "",
y = "MAPE (%)"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3929788_completo$MAPE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para MSE
ggplot(datos_3929788_completo, aes(x = Modelo, y = MSE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(MSE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3929788",
subtitle = "Métrica: MSE (valores más bajos indican mejor precisión)",
x = "",
y = "MSE"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3929788_completo$MSE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para AIC
ggplot(datos_3929788_completo, aes(x = Modelo, y = AIC, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(AIC, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3929788",
subtitle = "Métrica: AIC (valores más bajos indican mejor modelo)",
x = "",
y = "AIC"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3929788_completo$AIC, na.rm = TRUE) * 1.1) # Ajustar el límite Y
##PRODUCTO 3904152
# Primero, veamos qué datos tenemos realmente
print("Datos actuales para el producto 3904152:")## [1] "Datos actuales para el producto 3904152:"print(metricas_comparativas %>% filter(Producto == "3904152"))## Producto Modelo R2 RMSE MAPE MSE
## 1 3904152 ARMA/SARIMA 0.0000000 159913.0499 16.18578 2.557218e+10
## 2 3904152 Regresión Lineal 0.9987051 385.5886 128319.29509 1.486786e+05
## 3 3904152 Random Forest 0.9948033 772.4580 148033.10769 5.966914e+05
## 4 3904152 XGBoost 0.9988617 361.5213 82192.45094 1.306976e+05
## AIC
## 1 647.2636
## 2 38603.2484
## 3 34812.5905
## 4 30836.1592# Crear un dataframe manualmente con los 4 modelos para el producto 3904152
datos_3904152_completo <- data.frame(
Producto = rep("3904152", 4),
Modelo = c("ARMA/SARIMA", "Regresión Lineal", "Random Forest", "XGBoost"),
stringsAsFactors = FALSE
)
# Unir con los datos existentes
datos_3904152_completo <- left_join(
datos_3904152_completo,
metricas_comparativas %>% filter(Producto == "3904152"),
by = c("Producto", "Modelo")
)
# Ahora asigna valores para las métricas de los modelos faltantes
# Valores para Regresión Lineal
if (is.na(datos_3904152_completo$R2[2])) {
datos_3904152_completo$R2[2] <- r2_3904152
}
if (is.na(datos_3904152_completo$RMSE[2])) {
datos_3904152_completo$RMSE[2] <- rmse_3904152
}
if (is.na(datos_3904152_completo$MAPE[2])) {
datos_3904152_completo$MAPE[2] <- mape_3904152
}
if (is.na(datos_3904152_completo$MSE[2])) {
datos_3904152_completo$MSE[2] <- mse_3904152
}
if (is.na(datos_3904152_completo$AIC[2])) {
datos_3904152_completo$AIC[2] <- aic_3904152
}
# Valores para Random Forest
# Si ya ejecutaste la sección de Random Forest para el producto 3904152
if (is.na(datos_3904152_completo$R2[3]) && exists("r2_rf")) {
datos_3904152_completo$R2[3] <- r2_rf
}
if (is.na(datos_3904152_completo$RMSE[3]) && exists("rmse_rf")) {
datos_3904152_completo$RMSE[3] <- rmse_rf
}
if (is.na(datos_3904152_completo$MAPE[3]) && exists("mape_rf")) {
datos_3904152_completo$MAPE[3] <- mape_rf
}
if (is.na(datos_3904152_completo$MSE[3]) && exists("mse_rf")) {
datos_3904152_completo$MSE[3] <- mse_rf
}
if (is.na(datos_3904152_completo$AIC[3]) && exists("aic_rf")) {
datos_3904152_completo$AIC[3] <- aic_rf
}
# Valores para XGBoost
if (is.na(datos_3904152_completo$R2[4]) && exists("r2_completo")) {
datos_3904152_completo$R2[4] <- r2_completo
}
if (is.na(datos_3904152_completo$RMSE[4]) && exists("rmse_completo")) {
datos_3904152_completo$RMSE[4] <- rmse_completo
}
if (is.na(datos_3904152_completo$MAPE[4]) && exists("mape_completo")) {
datos_3904152_completo$MAPE[4] <- mape_completo
}
if (is.na(datos_3904152_completo$MSE[4]) && exists("mse_completo")) {
datos_3904152_completo$MSE[4] <- mse_completo
}
if (is.na(datos_3904152_completo$AIC[4]) && exists("aic_completo")) {
datos_3904152_completo$AIC[4] <- aic_completo
}
# Ver los datos completos
print("Datos completos para el producto 3904152:")## [1] "Datos completos para el producto 3904152:"print(datos_3904152_completo)## Producto Modelo R2 RMSE MAPE MSE
## 1 3904152 ARMA/SARIMA 0.0000000 159913.0499 16.18578 2.557218e+10
## 2 3904152 Regresión Lineal 0.9987051 385.5886 128319.29509 1.486786e+05
## 3 3904152 Random Forest 0.9948033 772.4580 148033.10769 5.966914e+05
## 4 3904152 XGBoost 0.9988617 361.5213 82192.45094 1.306976e+05
## AIC
## 1 647.2636
## 2 38603.2484
## 3 34812.5905
## 4 30836.1592# Definir colores para los modelos
colores_modelos <- c("ARMA/SARIMA" = "#1f77b4",
"Regresión Lineal" = "#ff7f0e",
"Random Forest" = "#2ca02c",
"XGBoost" = "#d62728")
# Gráfico para R²
ggplot(datos_3904152_completo, aes(x = Modelo, y = R2, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(R2, 3)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3904152",
subtitle = "Métrica: R² (valores más altos indican mejor ajuste)",
x = "",
y = "R²"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3904152_completo$R2, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para RMSE
ggplot(datos_3904152_completo, aes(x = Modelo, y = RMSE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(RMSE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3904152",
subtitle = "Métrica: RMSE (valores más bajos indican mejor precisión)",
x = "",
y = "RMSE"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3904152_completo$RMSE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para MAPE
ggplot(datos_3904152_completo, aes(x = Modelo, y = MAPE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(MAPE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3904152",
subtitle = "Métrica: MAPE (valores más bajos indican mejor precisión)",
x = "",
y = "MAPE (%)"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3904152_completo$MAPE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para MSE
ggplot(datos_3904152_completo, aes(x = Modelo, y = MSE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(MSE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3904152",
subtitle = "Métrica: MSE (valores más bajos indican mejor precisión)",
x = "",
y = "MSE"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3904152_completo$MSE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para AIC
ggplot(datos_3904152_completo, aes(x = Modelo, y = AIC, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(AIC, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3904152",
subtitle = "Métrica: AIC (valores más bajos indican mejor modelo)",
x = "",
y = "AIC"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3904152_completo$AIC, na.rm = TRUE) * 1.1) # Ajustar el límite Y
##PRODUCTO 155002
# Primero, veamos qué datos tenemos realmente
print("Datos actuales para el producto 155002:")## [1] "Datos actuales para el producto 155002:"print(metricas_comparativas %>% filter(Producto == "155002"))## Producto Modelo R2 RMSE MAPE MSE
## 1 155002 ARMA/SARIMA 0.2341854 188967.2199 25.93817 3.570861e+10
## 2 155002 Regresión Lineal 0.9571086 1135.6762 238027.63306 1.289760e+06
## 3 155002 Random Forest 0.9871784 620.9267 102855.51366 3.855500e+05
## 4 155002 XGBoost 0.9691126 963.7410 123048.41843 9.287968e+05
## AIC
## 1 659.9971
## 2 98715.0862
## 3 75099.9813
## 4 80227.9833# Crear un dataframe manualmente con los 4 modelos para el producto 155002
datos_155002_completo <- data.frame(
Producto = rep("155002", 4),
Modelo = c("ARMA/SARIMA", "Regresión Lineal", "Random Forest", "XGBoost"),
stringsAsFactors = FALSE
)
# Unir con los datos existentes
datos_155002_completo <- left_join(
datos_155002_completo,
metricas_comparativas %>% filter(Producto == "155002"),
by = c("Producto", "Modelo")
)
# Ahora asigna valores para las métricas de los modelos faltantes
# Valores para Regresión Lineal
if (is.na(datos_155002_completo$R2[2])) {
datos_155002_completo$R2[2] <- r2_155002
}
if (is.na(datos_155002_completo$RMSE[2])) {
datos_155002_completo$RMSE[2] <- rmse_155002
}
if (is.na(datos_155002_completo$MAPE[2])) {
datos_155002_completo$MAPE[2] <- mape_155002
}
if (is.na(datos_155002_completo$MSE[2])) {
datos_155002_completo$MSE[2] <- mse_155002
}
if (is.na(datos_155002_completo$AIC[2])) {
datos_155002_completo$AIC[2] <- aic_155002
}
# Valores para Random Forest
# Si ya ejecutaste la sección de Random Forest para el producto 155002
if (is.na(datos_155002_completo$R2[3]) && exists("r2_rf")) {
datos_155002_completo$R2[3] <- r2_rf
}
if (is.na(datos_155002_completo$RMSE[3]) && exists("rmse_rf")) {
datos_155002_completo$RMSE[3] <- rmse_rf
}
if (is.na(datos_155002_completo$MAPE[3]) && exists("mape_rf")) {
datos_155002_completo$MAPE[3] <- mape_rf
}
if (is.na(datos_155002_completo$MSE[3]) && exists("mse_rf")) {
datos_155002_completo$MSE[3] <- mse_rf
}
if (is.na(datos_155002_completo$AIC[3]) && exists("aic_rf")) {
datos_155002_completo$AIC[3] <- aic_rf
}
# Valores para XGBoost
if (is.na(datos_155002_completo$R2[4]) && exists("r2_completo")) {
datos_155002_completo$R2[4] <- r2_completo
}
if (is.na(datos_155002_completo$RMSE[4]) && exists("rmse_completo")) {
datos_155002_completo$RMSE[4] <- rmse_completo
}
if (is.na(datos_155002_completo$MAPE[4]) && exists("mape_completo")) {
datos_155002_completo$MAPE[4] <- mape_completo
}
if (is.na(datos_155002_completo$MSE[4]) && exists("mse_completo")) {
datos_155002_completo$MSE[4] <- mse_completo
}
if (is.na(datos_155002_completo$AIC[4]) && exists("aic_completo")) {
datos_155002_completo$AIC[4] <- aic_completo
}
# Ver los datos completos
print("Datos completos para el producto 155002:")## [1] "Datos completos para el producto 155002:"print(datos_155002_completo)## Producto Modelo R2 RMSE MAPE MSE
## 1 155002 ARMA/SARIMA 0.2341854 188967.2199 25.93817 3.570861e+10
## 2 155002 Regresión Lineal 0.9571086 1135.6762 238027.63306 1.289760e+06
## 3 155002 Random Forest 0.9871784 620.9267 102855.51366 3.855500e+05
## 4 155002 XGBoost 0.9691126 963.7410 123048.41843 9.287968e+05
## AIC
## 1 659.9971
## 2 98715.0862
## 3 75099.9813
## 4 80227.9833# Definir colores para los modelos
colores_modelos <- c("ARMA/SARIMA" = "#1f77b4",
"Regresión Lineal" = "#ff7f0e",
"Random Forest" = "#2ca02c",
"XGBoost" = "#d62728")
# Gráfico para R²
ggplot(datos_155002_completo, aes(x = Modelo, y = R2, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(R2, 3)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 155002",
subtitle = "Métrica: R² (valores más altos indican mejor ajuste)",
x = "",
y = "R²"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_155002_completo$R2, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para RMSE
ggplot(datos_155002_completo, aes(x = Modelo, y = RMSE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(RMSE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 155002",
subtitle = "Métrica: RMSE (valores más bajos indican mejor precisión)",
x = "",
y = "RMSE"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_155002_completo$RMSE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para MAPE
ggplot(datos_155002_completo, aes(x = Modelo, y = MAPE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(MAPE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 155002",
subtitle = "Métrica: MAPE (valores más bajos indican mejor precisión)",
x = "",
y = "MAPE (%)"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_155002_completo$MAPE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para MSE
ggplot(datos_155002_completo, aes(x = Modelo, y = MSE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(MSE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 155002",
subtitle = "Métrica: MSE (valores más bajos indican mejor precisión)",
x = "",
y = "MSE"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_155002_completo$MSE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para AIC
ggplot(datos_155002_completo, aes(x = Modelo, y = AIC, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(AIC, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 155002",
subtitle = "Métrica: AIC (valores más bajos indican mejor modelo)",
x = "",
y = "AIC"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_155002_completo$AIC, na.rm = TRUE) * 1.1) # Ajustar el límite Y
##PRODUCTO 3678055
# Primero, veamos qué datos tenemos realmente
print("Datos actuales para el producto 3678055:")## [1] "Datos actuales para el producto 3678055:"print(metricas_comparativas %>% filter(Producto == "3678055"))## Producto Modelo R2 RMSE MAPE MSE
## 1 3678055 ARMA/SARIMA 0.0000000 169884.0442 22.22443 2.886059e+10
## 2 3678055 Regresión Lineal 0.9977194 482.1191 236820.81905 2.324388e+05
## 3 3678055 Random Forest 0.9918288 912.5829 441446.58433 8.328075e+05
## 4 3678055 XGBoost 0.9841601 1270.5921 325628.93709 1.614404e+06
## AIC
## 1 650.1669
## 2 26051.7663
## 3 23374.5716
## 4 24504.4383# Crear un dataframe manualmente con los 4 modelos para el producto 3678055
datos_3678055_completo <- data.frame(
Producto = rep("3678055", 4),
Modelo = c("ARMA/SARIMA", "Regresión Lineal", "Random Forest", "XGBoost"),
stringsAsFactors = FALSE
)
# Unir con los datos existentes
datos_3678055_completo <- left_join(
datos_3678055_completo,
metricas_comparativas %>% filter(Producto == "3678055"),
by = c("Producto", "Modelo")
)
# Ahora asigna valores para las métricas de los modelos faltantes
# Valores para Regresión Lineal
if (is.na(datos_3678055_completo$R2[2])) {
datos_3678055_completo$R2[2] <- r2_3678055
}
if (is.na(datos_3678055_completo$RMSE[2])) {
datos_3678055_completo$RMSE[2] <- rmse_3678055
}
if (is.na(datos_3678055_completo$MAPE[2])) {
datos_3678055_completo$MAPE[2] <- mape_3678055
}
if (is.na(datos_3678055_completo$MSE[2])) {
datos_3678055_completo$MSE[2] <- mse_3678055
}
if (is.na(datos_3678055_completo$AIC[2])) {
datos_3678055_completo$AIC[2] <- aic_3678055
}
# Valores para Random Forest
# Si ya ejecutaste la sección de Random Forest para el producto 3678055
if (is.na(datos_3678055_completo$R2[3]) && exists("r2_rf")) {
datos_3678055_completo$R2[3] <- r2_rf
}
if (is.na(datos_3678055_completo$RMSE[3]) && exists("rmse_rf")) {
datos_3678055_completo$RMSE[3] <- rmse_rf
}
if (is.na(datos_3678055_completo$MAPE[3]) && exists("mape_rf")) {
datos_3678055_completo$MAPE[3] <- mape_rf
}
if (is.na(datos_3678055_completo$MSE[3]) && exists("mse_rf")) {
datos_3678055_completo$MSE[3] <- mse_rf
}
if (is.na(datos_3678055_completo$AIC[3]) && exists("aic_rf")) {
datos_3678055_completo$AIC[3] <- aic_rf
}
# Valores para XGBoost
if (is.na(datos_3678055_completo$R2[4]) && exists("r2_completo")) {
datos_3678055_completo$R2[4] <- r2_completo
}
if (is.na(datos_3678055_completo$RMSE[4]) && exists("rmse_completo")) {
datos_3678055_completo$RMSE[4] <- rmse_completo
}
if (is.na(datos_3678055_completo$MAPE[4]) && exists("mape_completo")) {
datos_3678055_completo$MAPE[4] <- mape_completo
}
if (is.na(datos_3678055_completo$MSE[4]) && exists("mse_completo")) {
datos_3678055_completo$MSE[4] <- mse_completo
}
if (is.na(datos_3678055_completo$AIC[4]) && exists("aic_completo")) {
datos_3678055_completo$AIC[4] <- aic_completo
}
# Ver los datos completos
print("Datos completos para el producto 3678055:")## [1] "Datos completos para el producto 3678055:"print(datos_3678055_completo)## Producto Modelo R2 RMSE MAPE MSE
## 1 3678055 ARMA/SARIMA 0.0000000 169884.0442 22.22443 2.886059e+10
## 2 3678055 Regresión Lineal 0.9977194 482.1191 236820.81905 2.324388e+05
## 3 3678055 Random Forest 0.9918288 912.5829 441446.58433 8.328075e+05
## 4 3678055 XGBoost 0.9841601 1270.5921 325628.93709 1.614404e+06
## AIC
## 1 650.1669
## 2 26051.7663
## 3 23374.5716
## 4 24504.4383# Definir colores para los modelos
colores_modelos <- c("ARMA/SARIMA" = "#1f77b4",
"Regresión Lineal" = "#ff7f0e",
"Random Forest" = "#2ca02c",
"XGBoost" = "#d62728")
# Gráfico para R²
ggplot(datos_3678055_completo, aes(x = Modelo, y = R2, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(R2, 3)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3678055",
subtitle = "Métrica: R² (valores más altos indican mejor ajuste)",
x = "",
y = "R²"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3678055_completo$R2, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para RMSE
ggplot(datos_3678055_completo, aes(x = Modelo, y = RMSE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(RMSE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3678055",
subtitle = "Métrica: RMSE (valores más bajos indican mejor precisión)",
x = "",
y = "RMSE"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3678055_completo$RMSE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para MAPE
ggplot(datos_3678055_completo, aes(x = Modelo, y = MAPE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(MAPE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3678055",
subtitle = "Métrica: MAPE (valores más bajos indican mejor precisión)",
x = "",
y = "MAPE (%)"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3678055_completo$MAPE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para MSE
ggplot(datos_3678055_completo, aes(x = Modelo, y = MSE, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(MSE, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3678055",
subtitle = "Métrica: MSE (valores más bajos indican mejor precisión)",
x = "",
y = "MSE"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3678055_completo$MSE, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# Gráfico para AIC
ggplot(datos_3678055_completo, aes(x = Modelo, y = AIC, fill = Modelo)) +
geom_bar(stat = "identity", width = 0.6) +
geom_text(aes(label = round(AIC, 1)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = colores_modelos) +
labs(
title = "Comparación de modelos para Producto 3678055",
subtitle = "Métrica: AIC (valores más bajos indican mejor modelo)",
x = "",
y = "AIC"
) +
theme_minimal() +
theme(
legend.position = "none",
plot.title = element_text(size = 12, face = "bold"),
plot.subtitle = element_text(size = 10),
axis.text.x = element_text(angle = 45, hjust = 1)
) +
ylim(0, max(datos_3678055_completo$AIC, na.rm = TRUE) * 1.1) # Ajustar el límite Y
# ESTIMACIÓN DE PRECIOS
Preparación de datos
# Función para preparar datos de un producto
prepare_price_data <- function(df, product_id) {
product_data <- df %>%
filter(ID_Inventario == product_id) %>%
arrange(Trx_Fecha) %>%
select(
Trx_Fecha, Precio_Final_Unitario, Cant, Venta,
Costo_Venta, Descuento_Porcentaje, Semana, Mes
) %>%
mutate(
Dia_Semana = wday(Trx_Fecha),
Mes_Num = month(Trx_Fecha),
Anio = year(Trx_Fecha),
Dias_Desde_Inicio = as.numeric(difftime(Trx_Fecha, min(Trx_Fecha), units = "days")),
Margen_Unitario = (Venta / Cant) - (Costo_Venta / Cant),
Precio_Unitario_Calc = Venta / Cant,
ID_Inventario = product_id
)
return(product_data)
}
# Asegúrate de que 'datos' sea tu data.frame cargado correctamente
# Por ejemplo, si vienes de un archivo .csv:
# datos <- read.csv("archivo.csv")
# Aplicar la función a todos los productos
ids <- unique(datos$ID_Inventario)
productos_preparados <- map_df(ids, function(id) {
prepare_price_data(datos, id)
})
# Mostrar una parte del resultado
head(productos_preparados)## # A tibble: 6 × 15
## Trx_Fecha Precio_Final_Unitario Cant Venta Costo_Venta
## <dttm> <dbl> <dbl> <dbl> <dbl>
## 1 2023-01-02 00:00:00 980 1 980 727.
## 2 2023-01-03 00:00:00 728 1 728 905.
## 3 2023-01-03 00:00:00 840 6 5040 3598.
## 4 2023-01-04 00:00:00 1120 1 1120 577.
## 5 2023-01-04 00:00:00 728 8 5824 6619.
## 6 2023-01-04 00:00:00 980 10 9800 7273.
## # ℹ 10 more variables: Descuento_Porcentaje <dbl>, Semana <dbl>, Mes <dbl>,
## # Dia_Semana <dbl>, Mes_Num <dbl>, Anio <dbl>, Dias_Desde_Inicio <dbl>,
## # Margen_Unitario <dbl>, Precio_Unitario_Calc <dbl>, ID_Inventario <dbl># Vector con productos (debe ir primero)
productos_ids <- top_ids
# Función para entrenar modelo ARMA por producto
train_arma_model <- function(data, product_id) {
library(forecast) # Asegúrate de cargar forecast si no está cargado aún
product_data <- data %>% filter(ID_Inventario == product_id)
serie_ts <- ts(product_data$Venta, frequency = 12)
modelo_arma <- auto.arima(serie_ts, seasonal = FALSE, stepwise = FALSE, approximation = FALSE)
return(modelo_arma)
}
# Crear lista de modelos ARMA por producto
modelos_arma_lista <- setNames(
lapply(productos_ids, function(id) train_arma_model(datos, id)),
as.character(productos_ids)
)
# Función para modelo regresión lineal
train_reg_model <- function(data, product_id) {
product_data <- data %>% filter(ID_Inventario == product_id)
modelo_reg <- lm(Venta ~ Precio_Final_Unitario, data = product_data)
return(modelo_reg)
}
# Función para modelo Random Forest
train_rf_model <- function(data, product_id) {
product_data <- data %>% filter(ID_Inventario == product_id)
predictors <- c("Precio_Final_Unitario", "Cant", "Descuento_Porcentaje")
rf_data <- product_data %>% select(all_of(predictors), Venta)
modelo_rf <- randomForest(Venta ~ ., data = rf_data, ntree = 100)
return(modelo_rf)
}
# Función para modelo XGBoost
train_xgb_model <- function(data, product_id) {
product_data <- data %>% filter(ID_Inventario == product_id)
predictors <- c("Precio_Final_Unitario", "Cant", "Descuento_Porcentaje")
train_matrix <- xgb.DMatrix(data = as.matrix(product_data[, predictors]), label = product_data$Venta)
params <- list(objective = "reg:squarederror")
modelo_xgb <- xgb.train(params = params, data = train_matrix, nrounds = 50, verbose = 0)
return(modelo_xgb)
}
# Crear listas de modelos
modelos_reg_lista <- setNames(lapply(productos_ids, function(id) train_reg_model(datos, id)), as.character(productos_ids))
modelos_rf_lista <- setNames(lapply(productos_ids, function(id) train_rf_model(datos, id)), as.character(productos_ids))
modelos_xgb_lista <- setNames(lapply(productos_ids, function(id) train_xgb_model(datos, id)), as.character(productos_ids))Entrenar modelos de predicción de precios
# Función para entrenar modelos de predicción de precios
train_price_models <- function(data, product_id, test_size = 0.2) {
price_data <- prepare_price_data(data, product_id) %>%
drop_na() %>%
select(
Precio_Final_Unitario,
Cant, Costo_Venta, Descuento_Porcentaje,
Dia_Semana, Mes_Num, Anio, Dias_Desde_Inicio,
Margen_Unitario
)
# Evitar fallos si hay muy pocos datos
if (nrow(price_data) < 10) {
warning(paste("Producto", product_id, "tiene menos de 10 registros. Se omite."))
return(NULL)
}
set.seed(123)
train_index <- createDataPartition(price_data$Precio_Final_Unitario, p = 1 - test_size, list = FALSE)
train_data <- price_data[train_index, ]
test_data <- price_data[-train_index, ]
# 1. Regresión Lineal
lm_model <- lm(Precio_Final_Unitario ~ ., data = train_data)
# 2. Random Forest
rf_model <- randomForest(
Precio_Final_Unitario ~ .,
data = train_data,
ntree = 500,
importance = TRUE
)
# 3. XGBoost
features <- setdiff(names(train_data), "Precio_Final_Unitario")
x_train <- as.matrix(train_data[, features])
y_train <- train_data$Precio_Final_Unitario
x_test <- as.matrix(test_data[, features])
y_test <- test_data$Precio_Final_Unitario
dtrain <- xgb.DMatrix(data = x_train, label = y_train)
dtest <- xgb.DMatrix(data = x_test, label = y_test)
xgb_params <- list(
objective = "reg:squarederror",
eval_metric = "rmse",
eta = 0.1,
max_depth = 6,
min_child_weight = 3,
subsample = 0.8,
colsample_bytree = 0.8
)
xgb_model <- xgb.train(
params = xgb_params,
data = dtrain,
nrounds = 100,
watchlist = list(train = dtrain, test = dtest),
early_stopping_rounds = 10,
verbose = 0
)
# Evaluación
lm_pred <- predict(lm_model, newdata = test_data)
rf_pred <- predict(rf_model, newdata = test_data)
xgb_pred <- predict(xgb_model, x_test)
lm_rmse <- sqrt(mean((lm_pred - test_data$Precio_Final_Unitario)^2))
rf_rmse <- sqrt(mean((rf_pred - test_data$Precio_Final_Unitario)^2))
xgb_rmse <- sqrt(mean((xgb_pred - test_data$Precio_Final_Unitario)^2))
lm_r2 <- 1 - sum((test_data$Precio_Final_Unitario - lm_pred)^2) /
sum((test_data$Precio_Final_Unitario - mean(test_data$Precio_Final_Unitario))^2)
rf_r2 <- 1 - sum((test_data$Precio_Final_Unitario - rf_pred)^2) /
sum((test_data$Precio_Final_Unitario - mean(test_data$Precio_Final_Unitario))^2)
xgb_r2 <- 1 - sum((test_data$Precio_Final_Unitario - xgb_pred)^2) /
sum((test_data$Precio_Final_Unitario - mean(test_data$Precio_Final_Unitario))^2)
metrics <- data.frame(
Model = c("Linear Regression", "Random Forest", "XGBoost"),
RMSE = c(lm_rmse, rf_rmse, xgb_rmse),
R2 = c(lm_r2, rf_r2, xgb_r2)
)
return(list(metrics = metrics))
}
# IDs de los 5 productos a modelar
productos_ids <- c(155001, 3929788, 3904152, 155002, 3678055)
# Aplicar modelo a cada producto
resultados_modelos <- map(productos_ids, function(id) {
resultado <- train_price_models(datos, product_id = id)
if (!is.null(resultado)) {
resultado$metrics %>% mutate(ID_Inventario = id)
} else {
NULL
}
}) %>% compact() %>% bind_rows()
# Mostrar resultados
resultados_modelos## Model RMSE R2 ID_Inventario
## 1 Linear Regression 27.8569974 0.9339966 155001
## 2 Random Forest 8.8116639 0.9933959 155001
## 3 XGBoost 4.6423427 0.9981670 155001
## 4 Linear Regression 1.0354097 0.9723146 3929788
## 5 Random Forest 0.7375616 0.9859517 3929788
## 6 XGBoost 0.3550644 0.9967443 3929788
## 7 Linear Regression 78.6144671 0.8453402 3904152
## 8 Random Forest 16.2846491 0.9933636 3904152
## 9 XGBoost 14.4248035 0.9947929 3904152
## 10 Linear Regression 26.4586449 0.9325659 155002
## 11 Random Forest 15.3168150 0.9774014 155002
## 12 XGBoost 5.9783665 0.9965572 155002
## 13 Linear Regression 144.4530566 0.8041448 3678055
## 14 Random Forest 31.0470451 0.9909526 3678055
## 15 XGBoost 21.4261835 0.9956911 3678055# Lista con los IDs de productos (puedes usar top_ids que ya definiste)
productos_ids <- top_ids
# Entrenar modelos para cada producto y guardar en lista
modelos_precio_lista <- setNames(
lapply(productos_ids, function(id) train_price_models(datos, id)),
as.character(productos_ids)
)Estimar precios óptimos
estimate_optimal_prices <- function(data, product_id, price_models, demand_models = NULL, future_dates = NULL) {
price_steps <- 20
best_price_model_idx <- which.max(price_models$metrics$R2)
best_price_model_name <- price_models$metrics$Model[best_price_model_idx]
product_data <- data %>% filter(ID_Inventario == product_id)
min_price <- min(product_data$Precio_Final_Unitario, na.rm = TRUE)
max_price <- max(product_data$Precio_Final_Unitario, na.rm = TRUE)
price_range <- seq(min_price, max_price, length.out = price_steps)
future_scenarios <- data.frame()
for (future_date in future_dates) {
future_date <- as.Date(future_date)
mes_actual <- lubridate::month(future_date)
mes_data <- product_data %>% filter(lubridate::month(Trx_Fecha) == mes_actual)
if (nrow(mes_data) < 5) mes_data <- product_data
costo_mes <- median(mes_data$Costo_Venta, na.rm = TRUE)
cant_mes <- median(mes_data$Cant, na.rm = TRUE)
desc_mes <- median(mes_data$Descuento_Porcentaje, na.rm = TRUE)
if (is.na(costo_mes)) costo_mes <- median(product_data$Costo_Venta, na.rm = TRUE)
if (is.na(cant_mes) || cant_mes == 0) cant_mes <- median(product_data$Cant, na.rm = TRUE)
if (is.na(desc_mes)) desc_mes <- median(product_data$Descuento_Porcentaje, na.rm = TRUE)
date_df <- data.frame(
Trx_Fecha = rep(future_date, price_steps),
Precio_Final_Unitario = price_range,
Cant = cant_mes,
Costo_Venta = costo_mes,
Descuento_Porcentaje = desc_mes,
Dia_Semana = lubridate::wday(future_date),
Mes_Num = mes_actual,
Anio = lubridate::year(future_date),
Dias_Desde_Inicio = as.numeric(difftime(future_date, min(product_data$Trx_Fecha), units = "days")),
Margen_Unitario = NA
)
future_scenarios <- rbind(future_scenarios, date_df)
}
future_scenarios$Margen_Unitario <- future_scenarios$Precio_Final_Unitario -
(future_scenarios$Costo_Venta / future_scenarios$Cant)
product_data <- product_data %>% arrange(Trx_Fecha)
elasticity_df <- product_data %>%
filter(!is.na(Cant) & !is.na(Precio_Final_Unitario)) %>%
mutate(
P_lag = lag(Precio_Final_Unitario),
Q_lag = lag(Cant),
dP = Precio_Final_Unitario - P_lag,
dQ = Cant - Q_lag,
elasticity_point = (dQ / Q_lag) / (dP / P_lag)
) %>%
filter(!is.na(elasticity_point), is.finite(elasticity_point))
elasticity <- median(elasticity_df$elasticity_point, na.rm = TRUE)
if (is.na(elasticity) || !is.finite(elasticity)) elasticity <- 1.5
results <- future_scenarios %>%
mutate(Venta_Esperada = 0, Margen_Total = 0)
for (i in 1:nrow(results)) {
baseline_price <- median(product_data$Precio_Final_Unitario, na.rm = TRUE)
price_ratio <- baseline_price / results$Precio_Final_Unitario[i]
adjusted_quantity <- results$Cant[i] * (price_ratio ^ elasticity)
results$Venta_Esperada[i] <- results$Precio_Final_Unitario[i] * adjusted_quantity
results$Margen_Total[i] <- adjusted_quantity * results$Margen_Unitario[i]
}
optimal_prices <- results %>%
group_by(Trx_Fecha) %>%
slice_max(Venta_Esperada, n = 1) %>%
select(Trx_Fecha, Precio_Optimal = Precio_Final_Unitario, Venta_Esperada, Margen_Total)
return(list(
resultados = results,
precios_optimos = optimal_prices,
elasticidad = elasticity
))
}Visualizar resultados
dates_future <- seq.Date(as.Date("2025-01-01"), by = "month", length.out = 6)
precios_optimos_lista <- list()
for (id in productos_ids) {
cat("Estimando precios óptimos para producto:", id, "\n")
modelo_precio <- modelos_precio_lista[[as.character(id)]]
if (!is.null(modelo_precio)) {
precios_optimos_lista[[as.character(id)]] <- estimate_optimal_prices(
data = datos,
product_id = id,
price_models = modelo_precio,
future_dates = dates_future
)
}
}## Estimando precios óptimos para producto: 155001
## Estimando precios óptimos para producto: 3929788
## Estimando precios óptimos para producto: 3904152
## Estimando precios óptimos para producto: 155002
## Estimando precios óptimos para producto: 3678055graficas_individuales <- list()
for (id in names(precios_optimos_lista)) {
df_optimo <- precios_optimos_lista[[id]]$precios_optimos
p <- ggplot(df_optimo, aes(x = Trx_Fecha, y = Precio_Optimal)) +
geom_line(color = "#1f77b4", linewidth = 1.2) +
geom_point(color = "#1f77b4", size = 2) +
labs(
title = paste("Precio Óptimo por Mes - Producto", id),
x = "Fecha",
y = "Precio Óptimo"
) +
scale_x_date(date_labels = "%b %Y", date_breaks = "1 month") +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1)
)
graficas_individuales[[id]] <- p
}
for (id in names(graficas_individuales)) {
print(graficas_individuales[[id]])
}
Integración de precios óptimos y modelos
integrate_with_existing_models <- function(data, product_id, price_opt_results,
arma_model = NULL, reg_model = NULL,
rf_model = NULL, xgb_model = NULL) {
optimal_prices <- price_opt_results[[as.character(product_id)]]$precios_optimos
if (is.null(optimal_prices) || nrow(optimal_prices) == 0) {
warning(paste("No se encontraron precios óptimos para el producto", product_id))
return(data.frame())
}
future_data <- data.frame(
Fecha = optimal_prices$Trx_Fecha,
Precio_Final_Unitario = optimal_prices$Precio_Optimal
)
hist_data <- data %>%
filter(ID_Inventario == product_id) %>%
arrange(Trx_Fecha)
future_features <- data.frame()
for (i in 1:nrow(optimal_prices)) {
future_date <- optimal_prices$Trx_Fecha[i]
future_price <- optimal_prices$Precio_Optimal[i]
mes_data <- hist_data %>% filter(lubridate::month(Trx_Fecha) == lubridate::month(future_date))
if (nrow(mes_data) < 5) mes_data <- hist_data
avg_features <- mes_data %>%
summarise(
Cant = median(Cant, na.rm = TRUE),
Costo_Venta = median(Costo_Venta, na.rm = TRUE),
Costo_Devolucion = median(Costo_Devolucion, na.rm = TRUE),
Ajus_Sistema = median(Ajus_Sistema, na.rm = TRUE),
Ajuste_Manual = median(Ajuste_Manual, na.rm = TRUE),
Precio_Lista_Unitario = median(Precio_Lista_Unitario, na.rm = TRUE),
Descuento_Porcentaje = median(Descuento_Porcentaje, na.rm = TRUE),
Semana = lubridate::week(future_date),
Mes = lubridate::month(future_date),
Dia_Semana = lubridate::wday(future_date),
Tiempo = as.numeric(difftime(future_date, min(hist_data$Trx_Fecha), units = "days")) / 30
)
avg_features$Precio_Final_Unitario <- future_price
avg_features$Trx_Fecha <- future_date
future_features <- rbind(future_features, avg_features)
}
if (!is.null(arma_model)) {
arma_forecast <- forecast(arma_model, h = nrow(optimal_prices))
future_data$Venta_ARMA <- as.numeric(arma_forecast$mean)
ref_price <- median(hist_data$Precio_Final_Unitario, na.rm = TRUE)
elasticity <- 1.5
future_data$Venta_ARMA_Ajustada <- future_data$Venta_ARMA *
(ref_price / future_data$Precio_Final_Unitario)^elasticity
}
if (!is.null(reg_model)) {
tryCatch({
future_data$Venta_RegLineal <- predict(reg_model, newdata = future_features)
}, error = function(e) {
future_data$Venta_RegLineal <- NA
})
}
if (!is.null(rf_model)) {
tryCatch({
future_data$Venta_RandomForest <- predict(rf_model, newdata = future_features)
}, error = function(e) {
future_data$Venta_RandomForest <- NA
})
}
if (!is.null(xgb_model)) {
tryCatch({
features <- xgb_model$feature_names
if (is.null(features)) {
features <- setdiff(names(future_features), "Venta")
}
xgb_matrix <- as.matrix(future_features[, features, drop = FALSE])
future_data$Venta_XGBoost <- predict(xgb_model, xgb_matrix)
}, error = function(e) {
future_data$Venta_XGBoost <- NA
})
}
avg_cost_per_unit <- median(hist_data$Costo_Venta / hist_data$Cant, na.rm = TRUE)
for (model in c("ARMA_Ajustada", "RegLineal", "RandomForest", "XGBoost")) {
vcol <- paste0("Venta_", model)
if (vcol %in% names(future_data)) {
ucol <- paste0("Unidades_", model)
ccol <- paste0("Costo_", model)
mcol <- paste0("Margen_", model)
future_data[[ucol]] <- future_data[[vcol]] / future_data$Precio_Final_Unitario
future_data[[ccol]] <- future_data[[ucol]] * avg_cost_per_unit
future_data[[mcol]] <- future_data[[vcol]] - future_data[[ccol]]
}
}
pred_cols <- c("Venta_ARMA_Ajustada", "Venta_RegLineal", "Venta_RandomForest", "Venta_XGBoost")
pred_cols <- pred_cols[pred_cols %in% names(future_data)]
tryCatch({
if (length(pred_cols) > 0 && ncol(future_data[, pred_cols, drop = FALSE]) > 0) {
future_data$Venta_Consenso <- rowMeans(future_data[, pred_cols, drop = FALSE], na.rm = TRUE)
future_data$Unidades_Consenso <- future_data$Venta_Consenso / future_data$Precio_Final_Unitario
future_data$Costo_Consenso <- future_data$Unidades_Consenso * avg_cost_per_unit
future_data$Margen_Consenso <- future_data$Venta_Consenso - future_data$Costo_Consenso
}
}, error = function(e) {
warning(paste("No se pudo calcular el consenso para producto", product_id, ":", e$message))
})
return(future_data)
}
resultados_futuros_lista <- list()
for (id in productos_ids) {
cat("Integrando modelos para producto:", id, "\n")
resultado <- integrate_with_existing_models(
data = datos,
product_id = id,
price_opt_results = precios_optimos_lista,
arma_model = modelos_arma_lista[[as.character(id)]],
reg_model = modelos_reg_lista[[as.character(id)]],
rf_model = modelos_rf_lista[[as.character(id)]],
xgb_model = modelos_xgb_lista[[as.character(id)]]
)
resultados_futuros_lista[[as.character(id)]] <- resultado
}## Integrando modelos para producto: 155001
## Integrando modelos para producto: 3929788
## Integrando modelos para producto: 3904152
## Integrando modelos para producto: 155002
## Integrando modelos para producto: 3678055Pipeline correcto
corregir_formato_fechas <- function(datos) {
if ("Trx_Fecha" %in% colnames(datos)) {
datos$Trx_Fecha_Original <- datos$Trx_Fecha
if (is.character(datos$Trx_Fecha) &&
any(grepl("^\\d{7}-\\d{2}-\\d{2}$", datos$Trx_Fecha))) {
cat("Corrigiendo formato de fechas extraño...\n")
datos$Trx_Fecha <- sapply(datos$Trx_Fecha, function(fecha) {
if (is.na(fecha) || !is.character(fecha)) return(NA)
partes <- strsplit(fecha, "-")[[1]]
if (length(partes) == 3) {
fecha_corregida <- paste("2023", partes[2], partes[3], sep = "-")
return(fecha_corregida)
} else {
return(NA)
}
})
datos$Trx_Fecha <- as.Date(datos$Trx_Fecha)
cat("Fechas corregidas exitosamente.\n")
} else if (!inherits(datos$Trx_Fecha, "Date")) {
cat("Intentando convertir fechas a formato Date...\n")
datos$Trx_Fecha <- as.Date(datos$Trx_Fecha)
}
}
return(datos)
}
# Aplicar la corrección a tu dataframe antes de usarlo
datos_filtrados <- corregir_formato_fechas(datos_filtrados)## Intentando convertir fechas a formato Date...dates_future <- seq.Date(as.Date("2023-01-01"), by = "month", length.out = 6)
precios_optimos_lista <- list()
for (id in productos_ids) {
cat("Estimando precios óptimos para producto:", id, "\n")
modelo_precio <- modelos_precio_lista[[as.character(id)]]
if (!is.null(modelo_precio)) {
precios_optimos_lista[[as.character(id)]] <- estimate_optimal_prices(
data = datos_filtrados,
product_id = id,
price_models = modelo_precio,
future_dates = dates_future
)
}
}## Estimando precios óptimos para producto: 155001
## Estimando precios óptimos para producto: 3929788
## Estimando precios óptimos para producto: 3904152
## Estimando precios óptimos para producto: 155002
## Estimando precios óptimos para producto: 3678055for (id in names(precios_optimos_lista)) {
df_optimo <- precios_optimos_lista[[id]]$precios_optimos
if (!inherits(df_optimo$Trx_Fecha, "Date")) {
df_optimo$Trx_Fecha <- as.Date(df_optimo$Trx_Fecha)
}
p <- ggplot(df_optimo, aes(x = Trx_Fecha, y = Precio_Optimal)) +
geom_line(color = "#1f77b4", linewidth = 1.2) +
geom_point(color = "#1f77b4", size = 2) +
labs(
title = paste("Precio Óptimo por Mes - Producto", id),
x = "Fecha",
y = "Precio Óptimo"
) +
scale_x_date(date_labels = "%b %Y", date_breaks = "1 month") +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1)
)
print(p)
}
# Función para correr optimización de precios para todos los productos
run_price_optimization <- function(data, product_ids, future_dates = NULL, modelos_precio_lista = NULL) {
if (is.null(future_dates)) {
future_dates <- seq.Date(Sys.Date(), by = "month", length.out = 6)
}
precios_optimos_lista <- list()
for (id in product_ids) {
cat("Estimando precios óptimos para producto:", id, "\n")
price_model <- NULL
if (!is.null(modelos_precio_lista)) {
price_model <- modelos_precio_lista[[as.character(id)]]
}
precios_optimos_lista[[as.character(id)]] <- estimate_optimal_prices(
data = data,
product_id = id,
price_models = price_model,
future_dates = future_dates
)
}
return(precios_optimos_lista)
}
# Función principal que integra todo el pipeline
run_complete_analysis <- function(data, top_ids, modelos_arma, modelos_reg, modelos_rf, modelos_xgb, modelos_precio_lista = NULL) {
# 1. Ejecutar optimización de precios para todos los productos
all_results <- run_price_optimization(data, top_ids, modelos_precio_lista = modelos_precio_lista)
# 2. Integrar con modelos existentes para cada producto
integrated_results <- list()
for (i in seq_along(top_ids)) {
pid <- top_ids[i]
pid_str <- as.character(pid)
arma_model <- if(length(modelos_arma) >= i) modelos_arma[[i]] else NULL
reg_model <- if(length(modelos_reg) >= i) modelos_reg[[i]] else NULL
rf_model <- if(length(modelos_rf) >= i) modelos_rf[[i]] else NULL
xgb_model <- if(length(modelos_xgb) >= i) modelos_xgb[[i]] else NULL
future_predictions <- integrate_with_existing_models(
data = data,
product_id = pid,
price_opt_results = all_results,
arma_model = arma_model,
reg_model = reg_model,
rf_model = rf_model,
xgb_model = xgb_model
)
integrated_results[[pid_str]] <- future_predictions
if (nrow(future_predictions) > 0) {
p_sales <- ggplot(future_predictions)
if ("Venta_ARMA_Ajustada" %in% names(future_predictions)) {
p_sales <- p_sales + geom_point(aes(x = Fecha, y = Venta_ARMA_Ajustada, color = "ARMA"), size = 3, na.rm = TRUE)
}
if ("Venta_RegLineal" %in% names(future_predictions)) {
p_sales <- p_sales + geom_point(aes(x = Fecha, y = Venta_RegLineal, color = "Regresión Lineal"), size = 3, na.rm = TRUE)
}
if ("Venta_RandomForest" %in% names(future_predictions)) {
p_sales <- p_sales + geom_point(aes(x = Fecha, y = Venta_RandomForest, color = "Random Forest"), size = 3, na.rm = TRUE)
}
if ("Venta_XGBoost" %in% names(future_predictions)) {
p_sales <- p_sales + geom_point(aes(x = Fecha, y = Venta_XGBoost, color = "XGBoost"), size = 3, na.rm = TRUE)
}
if ("Venta_Consenso" %in% names(future_predictions)) {
p_sales <- p_sales + geom_line(aes(x = Fecha, y = Venta_Consenso, color = "Consenso"), size = 1.5)
}
p_sales <- p_sales +
labs(
title = paste("Predicciones de ventas con precios óptimos - Producto", pid),
x = "Fecha",
y = "Ventas estimadas ($)",
color = "Modelo"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold"),
axis.title = element_text(face = "bold"),
legend.position = "bottom"
)
p_margins <- ggplot(future_predictions)
if ("Margen_Consenso" %in% names(future_predictions)) {
p_margins <- p_margins +
geom_col(aes(x = Fecha, y = Margen_Consenso), fill = "steelblue", width = 15) +
geom_text(aes(x = Fecha, y = Margen_Consenso, label = round(Margen_Consenso, 0)),
vjust = -0.5, size = 3.5)
}
p_margins <- p_margins +
labs(
title = paste("Margen esperado con precios óptimos - Producto", pid),
x = "Fecha",
y = "Margen estimado ($)"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold"),
axis.title = element_text(face = "bold")
)
all_results[[pid_str]]$integrated_plots <- list(
sales = p_sales,
margins = p_margins
)
}
}
# 3. Visualizar resultados comparativos
all_optimal_prices <- data.frame()
for (pid in top_ids) {
pid_str <- as.character(pid)
if (pid_str %in% names(all_results)) {
opt_prices <- all_results[[pid_str]]$precios_optimos %>%
mutate(ID_Inventario = pid)
all_optimal_prices <- rbind(all_optimal_prices, opt_prices)
}
}
p_comparison <- ggplot(all_optimal_prices,
aes(x = Trx_Fecha, y = Precio_Optimal, color = factor(ID_Inventario))) +
geom_line(size = 1.2) +
geom_point(size = 3) +
labs(
title = "Comparación de Precios Óptimos por Producto",
x = "Fecha",
y = "Precio Óptimo",
color = "ID Producto"
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold"),
axis.title = element_text(face = "bold"),
legend.position = "bottom"
)
metricas_optimas <- data.frame()
for (pid in top_ids) {
pid_str <- as.character(pid)
if (pid_str %in% names(integrated_results)) {
pred_data <- integrated_results[[pid_str]]
if ("Margen_Consenso" %in% names(pred_data)) {
metrics_row <- data.frame(
ID_Inventario = pid,
Precio_Promedio = mean(pred_data$Precio_Final_Unitario, na.rm = TRUE),
Venta_Total = sum(pred_data$Venta_Consenso, na.rm = TRUE),
Margen_Total = sum(pred_data$Margen_Consenso, na.rm = TRUE),
Margen_Porcentual = 100 * sum(pred_data$Margen_Consenso, na.rm = TRUE) /
sum(pred_data$Venta_Consenso, na.rm = TRUE)
)
metricas_optimas <- rbind(metricas_optimas, metrics_row)
}
}
}
return(list(
resultados = all_results,
integracion = integrated_results,
precios_optimos = all_optimal_prices,
metricas_optimas = metricas_optimas,
grafico_comparativo = p_comparison
))
}
# Ejecutar el análisis completo
resultado_completo <- run_complete_analysis(
data = datos,
top_ids = productos_ids,
modelos_arma = modelos_arma_lista,
modelos_reg = modelos_reg_lista,
modelos_rf = modelos_rf_lista,
modelos_xgb = modelos_xgb_lista,
modelos_precio_lista = modelos_precio_lista # Pasa esta lista si la tienes, o NULL
)## Estimando precios óptimos para producto: 155001
## Estimando precios óptimos para producto: 3929788
## Estimando precios óptimos para producto: 3904152
## Estimando precios óptimos para producto: 155002
## Estimando precios óptimos para producto: 3678055# Mostrar métricas si estás en modo interactivo
if (interactive()) View(resultado_completo$metricas_optimas)
cat("Gráfico comparativo de precios óptimos por producto:\n")## Gráfico comparativo de precios óptimos por producto:print(resultado_completo$grafico_comparativo)
cat("Gráficos individuales por producto:\n")## Gráficos individuales por producto:for (pid in names(resultado_completo$resultados)) {
plots <- resultado_completo$resultados[[pid]]$integrated_plots
if (!is.null(plots)) {
cat("Producto:", pid, "\n")
print(plots$sales)
print(plots$margins)
}
}## Producto: 155001
## Producto: 3929788
## Producto: 3904152
## Producto: 155002
## Producto: 3678055
