Análisis Predictivo de Ingresos con Regresión LASSO 📈
Esteban
2025-07-21
Este documento detalla un Análisis Predictivo de Ingresos (Sum.Revenue) empleando un modelo de Regresión LASSO. Nuestro principal objetivo es identificar las variables más influyentes que determinan el comportamiento de los ingresos mensuales, ofreciendo una comprensión profunda de su dinámica y una evaluación detallada del impacto de estas variables en meses clave. El flujo de trabajo abarca desde la preparación exhaustiva de los datos y la ingeniería de características, hasta la modelación predictiva y la interpretación de los resultados clave.
Importante: Esta misma metodología se podrá abordar para otro tipo de datos y para otro tipo de preguntas
2. Preparación y Transformación de Datos 🧹
Esta sección es crucial para el análisis, ya que se enfoca en la importación, limpieza y transformación de los datos crudos. El objetivo es estructurarlos adecuadamente para que sean aptos para el análisis exploratorio y, posteriormente, para la construcción del modelo de regresión LASSO. Una preparación rigurosa minimiza errores
2.1. Configuración de Ruta y Carga de Datos
Se carga el archivo de datos principal, el cual servirá como base para todo el análisis. La carga se realiza utilizando la ruta definida previamente para garantizar el acceso al recurso.
2.2. Preprocesamiento y Limpieza de Datos 🧼
Este paso aborda la limpieza inicial del dataset, que incluye la conversión de columnas numéricas (con formato de texto, como comas) y fechas a sus tipos de datos correctos (numeric y Date, respectivamente). Adicionalmente, se elimina la columna Order.ID, ya que no se considera relevante para la construcción del modelo estadístico.
# Reemplaza las comas y convierte a numérico
data$Total.Revenue <- as.numeric(gsub(",", "", data$Total.Revenue))
data$Total.Cost <- as.numeric(gsub(",", "", data$Total.Cost))
data$Total.Profit <- as.numeric(gsub(",", "", data$Total.Profit))
# Convertir columnas tipo factor a tipo Date
data$Invoice.Date <- as.Date(as.character(data$Invoice.Date), format = "%m/%d/%Y")
data$Revenue.Recognition.Date <- as.Date(as.character(data$Revenue.Recognition.Date), format = "%m/%d/%Y")
data$Purchase.Order.Date <- as.Date(as.character(data$Purchase.Order.Date), format = "%Y-%m-%d %H:%M:%S")
#Se elimina la columna dado que este valor no tiene lógica para el modelo estadístico
data <- data %>%
select(-Order.ID)2.3. Ingeniería de Características: Creación de Nuevas Variables ⚙️
Para enriquecer la capacidad predictiva del modelo y capturar relaciones más complejas en los datos, se generan nuevas variables (Revenue_Unit, Gross_Margin, Days_to_Recognize, etc.) a partir de las columnas existentes. Estas características derivadas proporcionan perspectivas adicionales sobre el negocio y pueden mejorar la relación que tiene los indicadores con la variable objetivo.
data <- data %>%
# Calcular ingreso, costo y ganancia por unidad por factura
mutate(
Revenue_Unit = Total.Revenue / Units.Sold,
Cost_Unit = Total.Cost / Units.Sold,
Profit_Unit = Total.Profit / Units.Sold,
Gross_Margin = Total.Profit/ Total.Revenue,
Cost_Share = Total.Cost / Total.Revenue,
Revenue_Cost_Ratio = Total.Revenue/Total.Cost,
Days_to_Recognize = Revenue.Recognition.Date - Invoice.Date,
Days_PO_Invoice = Invoice.Date - Purchase.Order.Date,
Profit_per_Recognition_Day = Total.Profit / as.numeric(Days_to_Recognize)
)2.4. Establecimiento de Granularidad Mensual 🗓
Se crea una nueva columna Month en formato AAAA-MM a partir de la fecha de reconocimiento de ingresos. Esta granularidad mensual es fundamental para el análisis de series de tiempo y la agregación de datos, permitiendo observar tendencias y patrones a lo largo del tiempo.
data <- data %>%
mutate(Month = format(Revenue.Recognition.Date, "%Y-%m")) # formato: "2025-03", etc.2.5. Agregación de Indicadores Promedio Mensual 📊
Los indicadores cuantitativos recién creados se agregan a nivel mensual calculando su promedio. Esta tabla (tb_indicadores_Avg) es crucial para el análisis exploratorio y la evaluación de la correlación con la variable objetivo a una granularidad temporal relevante. La flexibilidad en la granularidad permite adaptar el análisis a diferentes necesidades (ej. Month, Item.Type, Region).
tb_indicadores_Avg <- data %>%
group_by(Month) %>% #Se podría definir otra granularidad,
summarise(
Avg_Revenue_Unit = mean(Revenue_Unit, na.rm = TRUE),
Avg_Cost_Unit = mean(Cost_Unit, na.rm = TRUE),
Avg_Profit_Unit = mean(Profit_Unit, na.rm = TRUE),
Avg_Gross_Margin = mean(Gross_Margin, na.rm = TRUE),
Avg_Cost_Share = mean(Cost_Share, na.rm = TRUE),
Avg_Revenue_Cost_Ratio = mean(Revenue_Cost_Ratio, na.rm = TRUE),
Avg_Days_to_Recognize = mean(Days_to_Recognize, na.rm = TRUE),
Avg_Days_PO_Invoice = mean(Days_PO_Invoice, na.rm = TRUE),
.groups = "drop" # Esto quita la agrupación después de resumir
)
head(tb_indicadores_Avg)## # A tibble: 6 × 9
## Month Avg_Revenue_Unit Avg_Cost_Unit Avg_Profit_Unit Avg_Gross_Margin
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 2025-01 245. 171. 74.2 0.343
## 2 2025-02 263. 178. 84.3 0.359
## 3 2025-03 271. 199. 72.5 0.330
## 4 2025-04 306. 219. 86.9 0.332
## 5 2025-05 252. 179. 72.8 0.343
## 6 2025-06 245. 174. 71.1 0.354
## # ℹ 4 more variables: Avg_Cost_Share <dbl>, Avg_Revenue_Cost_Ratio <dbl>,
## # Avg_Days_to_Recognize <drtn>, Avg_Days_PO_Invoice <drtn>2.6. Agregación de Ventas Mensuales (Variable Objetivo) 🎯
Se consolida la variable objetivo del análisis, Sum.Revenue, mediante la suma del Total.Revenue a nivel mensual. Esta tabla (tb_ventas) representa la serie de tiempo que el modelo LASSO intentará predecir y explicar.
# Calcular la suma de Total.Revenue agrupada por mes
tb_ventas <- data %>%
group_by(Month) %>%
summarise(
Sum.Revenue = sum(Total.Revenue, na.rm = TRUE),
.groups = "drop"
)
head(tb_ventas)## # A tibble: 6 × 2
## Month Sum.Revenue
## <chr> <dbl>
## 1 2025-01 104352417.
## 2 2025-02 110418511.
## 3 2025-03 130919551.
## 4 2025-04 104269757.
## 5 2025-05 110400514.
## 6 2025-06 110283538.2.7. Creación de Variables Explicativas mediante Pivotado Dinámico 🔄
Para la modelación LASSO, se transforman variables categóricas clave (Region, Item.Type, Sales.Channel) en un formato pivoteado. Esto genera una multitud de nuevas características que representan combinaciones únicas (ej. “Region_Sales.Channel_Total.Revenue_Middle East and North Africa_Online”). Este enfoque permite al modelo identificar la contribución específica de cada combinación a los Total.Revenue mensuales, capturando interacciones complejas sin necesidad de crear variables dummy manualmente.
# Define las variables categóricas que deseas combinar
# Puedes modificar este vector según tus necesidades
factors_to_combine <- c(
"Region",
"Item.Type",
"Sales.Channel"
)
# Define la métrica que deseas sumar
metric_to_sum <- "Total.Revenue"
# Función para generar todas las combinaciones de un vector
# Incluye combinaciones de 1, 2, ..., hasta n elementos.
get_all_combinations <- function(vec) {
all_combos <- list()
for (i in 1:length(vec)) {
combos_i <- combn(vec, i, simplify = FALSE)
all_combos <- c(all_combos, combos_i)
}
return(all_combos)
}
# Generar todas las combinaciones posibles de los factores
all_variable_combinations <- get_all_combinations(factors_to_combine)
# Función para construir el pivot para un conjunto de factores y una métrica
make_dynamic_pivot <- function(df, vars, metric) {
# Crea un prefijo para los nombres de las columnas basado en las variables combinadas
prefix <- paste(vars, collapse = "_")
df %>%
group_by(Month, across(all_of(vars))) %>%
summarise(
Sum_Metric = sum(.data[[metric]], na.rm = TRUE),
.groups = "drop"
) %>%
# Usa unite() para crear una columna de combinación única
unite(
col = "combo_name",
all_of(vars),
sep = "_",
remove = FALSE # Mantenemos originales para pivot si se necesitan
) %>%
pivot_wider(
id_cols = Month,
names_from = combo_name,
values_from = Sum_Metric,
names_prefix = paste0(prefix, "_", metric, "_"), # Prefijo claro para cada grupo
values_fill = 0
)
}
# Generar una lista de tablas pivot para cada combinación
pivot_list_dynamic <- map(all_variable_combinations, function(vars_combo) {
message(glue("Generando pivot para: {paste(vars_combo, collapse = ', ')}"))
make_dynamic_pivot(data, vars_combo, metric_to_sum)
})## Generando pivot para: Region## Generando pivot para: Item.Type## Generando pivot para: Sales.Channel## Generando pivot para: Region, Item.Type## Generando pivot para: Region, Sales.Channel## Generando pivot para: Item.Type, Sales.Channel## Generando pivot para: Region, Item.Type, Sales.Channel# Unir todas las tablas pivot en un único dataframe grande
# Usamos full_join para asegurarnos de no perder ningún mes
tb_indicadores <- pivot_list_dynamic %>%
reduce(full_join, by = "Month")
# Asegúrate de que las columnas numéricas que son 'NA' por el join
# (por ejemplo, si una combinación no existió para un mes) se conviertan a 0
tb_indicadores <- tb_indicadores %>%
mutate(across(where(is.numeric), ~replace_na(., 0)))
head(tb_indicadores)## # A tibble: 6 × 299
## Month Region_Total.Revenue_A…¹ Region_Total.Revenue…² Region_Total.Revenue…³
## <chr> <dbl> <dbl> <dbl>
## 1 2025-01 23555888. 8030358. 10673928.
## 2 2025-02 13124362. 13495490. 16882697.
## 3 2025-03 11789251. 11466347. 13798798.
## 4 2025-04 10605472. 2938957. 14572776.
## 5 2025-05 11054876. 9301759. 8745069.
## 6 2025-06 14971238. 6300985. 15089456.
## # ℹ abbreviated names: ¹Region_Total.Revenue_Asia,
## # ²`Region_Total.Revenue_Australia and Oceania`,
## # ³`Region_Total.Revenue_Central America and the Caribbean`
## # ℹ 295 more variables: Region_Total.Revenue_Europe <dbl>,
## # `Region_Total.Revenue_Middle East and North Africa` <dbl>,
## # `Region_Total.Revenue_North America` <dbl>,
## # `Region_Total.Revenue_Sub-Saharan Africa` <dbl>, …2.8. Filtrado de Datos por Período de Análisis 🔍
Se aplica un filtro para excluir meses específicos del análisis. Este paso es fundamental para enfocar el estudio en períodos de tiempo relevantes o para eliminar datos atípicos que puedan sesgar el modelo. Los filtros se aplican tanto a la tabla de indicadores (tb_indicadores) como a la de ventas (tb_ventas) para mantener la consistencia.
# Define tu vector de meses a excluir
# Puedes modificar este vector fácilmente para excluir otros meses
vector_filtro_mes <- c() # Si aparece c() es por que no se va filtrar ningún mes en particular.
# Aplicar el filtro a tb_indicadores
tb_indicadores <- tb_indicadores %>%
filter(!Month %in% vector_filtro_mes)
tb_indicadores_filtrada <- tb_indicadores
# Aplicar el filtro a tb_ventas
tb_ventas <- tb_ventas %>%
filter(!Month %in% vector_filtro_mes)
tb_ventas_filtrada <- tb_ventas
#Aplicar filtro a los indicadores promedio
tb_indicadores_Avg_filrada <- tb_indicadores_Avg %>%
filter(!Month %in% vector_filtro_mes)3. Análisis Descriptivo de Indicadores Promedio vs. Ventas 📈📉
Esta sección se dedica a la exploración de la relación entre los indicadores promedio mensuales y las ventas totales (Sum.Revenue). Mediante el cálculo de coeficientes de correlación y la visualización de dispersión, buscamos identificar las variables más influyentes y entender su asociación con la variable objetivo antes de la modelación.
3.1. Correlación
Se unen las tablas de indicadores promedio y ventas para calcular el coeficiente de correlación de Pearson entre cada indicador y Sum.Revenue. Este análisis permite identificar rápidamente qué variables están más fuertemente (positiva o negativamente) asociadas con los ingresos totales, sirviendo como una primera aproximación a la relevancia de las características.
tabla_unida <- left_join(tb_indicadores_Avg, tb_ventas, by = "Month")
tabla_unida_numerica <- tabla_unida %>%
mutate(
Avg_Days_to_Recognize = as.numeric(Avg_Days_to_Recognize, units = "days"),
Avg_Days_PO_Invoice = as.numeric(Avg_Days_PO_Invoice, units = "days")
) %>%
select(where(is.numeric)) # Seleccionar solo columnas numéricas
# Calcular correlaciones con Sum.Revenue
correlaciones <- as.data.frame(cor(tabla_unida_numerica$Sum.Revenue, tabla_unida_numerica %>% select(-Sum.Revenue)))
correlaciones_df <- data.frame(
Variable = names(correlaciones),
Correlacion = as.numeric(correlaciones[1, ]) # Tomar la primera fila de la matriz de correlación
)
# Es importante considerar el valor absoluto para identificar la correlación más fuerte,
# ya sea positiva o negativa.
correlaciones_ordenadas <- correlaciones_df %>%
mutate(Abs_Correlacion = abs(Correlacion)) %>%
arrange(desc(Abs_Correlacion))
# Obtener la variable más correlacionada
variable_mas_correlacionada <- correlaciones_ordenadas$Variable[1]
valor_correlacion_maxima <- correlaciones_ordenadas$Correlacion[1]
head(correlaciones_ordenadas)## Variable Correlacion Abs_Correlacion
## 1 Avg_Days_PO_Invoice 0.7193766 0.7193766
## 2 Avg_Cost_Unit 0.4253516 0.4253516
## 3 Avg_Revenue_Unit 0.3765657 0.3765657
## 4 Avg_Cost_Share 0.3214107 0.3214107
## 5 Avg_Gross_Margin -0.3214107 0.3214107
## 6 Avg_Revenue_Cost_Ratio -0.2915581 0.2915581message(paste("La variable más correlacionada con Sum.Revenue es:", variable_mas_correlacionada))## La variable más correlacionada con Sum.Revenue es: Avg_Days_PO_Invoicemessage(paste("El coeficiente de correlación es:", round(valor_correlacion_maxima, 4)))## El coeficiente de correlación es: 0.71943.2. Visualización de la Relación Clave: Gráfico de Dispersión 📈
Se genera un gráfico de dispersión para visualizar la relación entre Sum.Revenue y la variable identificada como la más correlacionada. Este gráfico, junto con una línea de tendencia lineal, proporciona una inspección visual de la dirección y la fuerza de la relación, ayudando a validar las correlaciones calculadas.
data_para_grafico_cor <- tabla_unida_numerica %>%
select(Sum.Revenue, all_of(variable_mas_correlacionada))
ggplot(
data_para_grafico_cor, aes(x = .data[[variable_mas_correlacionada]], y = Sum.Revenue)) +
geom_point(color = "darkgreen", size = 3, alpha = 0.7)
4. Preparación Final de Datos para el Modelo LASSO 🔬
Esta sección se enfoca en la fase final de preparación de los datos antes de aplicar el modelo de regresión LASSO. El objetivo es asegurar que el conjunto de datos sea óptimo para el entrenamiento, identificando y manejando características que no aportan valor predictivo, como aquellas con varianza cero.
4.1. Identificación de Columnas con Varianza Cero
Se realiza una inspección para detectar columnas numéricas dentro del conjunto de datos de indicadores (tb_indicadores_filtrada) que presentan varianza de cero. Estas columnas no varían en sus valores a lo largo del tiempo o entre observaciones, por lo que no aportan información para la modelación y deben ser identificadas para su posterior eliminación.
# Cargar librerías necesarias (si no están cargadas)
# 1. Seleccionar solo las columnas numéricas de tb_indicadores_filtrada
# Excluir la columna 'Month' ya que es de tipo caracter.
numeric_cols <- tb_indicadores_filtrada %>%
select(where(is.numeric)) # Selecciona solo columnas donde la función is.numeric devuelve TRUE
# 2. Calcular la varianza de cada columna numérica y verificar si es cero
# Usamos map_lgl para aplicar la función var() a cada columna y obtener un vector lógico
# na.rm = TRUE es importante para manejar posibles NA en el cálculo de la varianza.
zero_variance_check <- numeric_cols %>%
map_lgl(~ var(., na.rm = TRUE) == 0) # La tilde (~) es para funciones anónimas en purrr
# 3. Identificar los nombres de las columnas con varianza cero
cols_with_zero_variance <- names(numeric_cols)[zero_variance_check]
# 4. Contar cuántas columnas tienen varianza cero
num_cols_with_zero_variance <- length(cols_with_zero_variance)
# Mostrar los resultados
message(glue("Número de columnas numéricas con varianza cero: {num_cols_with_zero_variance}"))## Número de columnas numéricas con varianza cero: 0if (num_cols_with_zero_variance > 0) {
message("\nNombres de las columnas con varianza cero:")
# Imprimir cada nombre en una nueva línea para mayor legibilidad
for (col_name in cols_with_zero_variance) {
message(paste("- ", col_name))
}
# (Opcional) Mostrar los valores únicos de una de estas columnas para verificar
# if (num_cols_with_zero_variance > 0) {
# message(glue("\nValores únicos de la primera columna con varianza cero ('{cols_with_zero_variance[1]}'):"))
# print(unique(tb_indicadores_filtrada[[cols_with_zero_variance[1]]]))
# }
} else {
message("\n¡Ninguna columna numérica tiene varianza cero! Todas las variables numéricas varían.")
}##
## ¡Ninguna columna numérica tiene varianza cero! Todas las variables numéricas varían.4.2. Eliminación de Columnas con Varianza Cero (Si Aplica) 🗑️
Las columnas identificadas con varianza cero, al no aportar información útil, son eliminadas del conjunto de datos tb_indicadores. Este paso es crucial para optimizar el modelo, reducir la dimensionalidad y evitar posibles inestabilidades en el entrenamiento. En este caso particular, se ha verificado que no existen columnas con varianza cero, por lo que no se realiza ninguna eliminación.
4.3. Conversión a Formato Matricial para glmnet 🔄
La librería glmnet, utilizada para la regresión LASSO, requiere que las variables predictoras (x) y la variable objetivo (y) estén en un formato de matriz. En este paso, se transforma tb_indicadores_filtrada (sin la columna Month) en la matriz de predictoras x, y tb_ventas_filtrada (también sin Month) en la matriz de respuesta y.
y <- tb_ventas_filtrada %>%
select(-Month)
x <- tb_indicadores_filtrada %>%
select(-Month)
head(x)## # A tibble: 6 × 298
## Region_Total.Revenue_Asia Region_Total.Revenue_Austra…¹ Region_Total.Revenue…²
## <dbl> <dbl> <dbl>
## 1 23555888. 8030358. 10673928.
## 2 13124362. 13495490. 16882697.
## 3 11789251. 11466347. 13798798.
## 4 10605472. 2938957. 14572776.
## 5 11054876. 9301759. 8745069.
## 6 14971238. 6300985. 15089456.
## # ℹ abbreviated names: ¹`Region_Total.Revenue_Australia and Oceania`,
## # ²`Region_Total.Revenue_Central America and the Caribbean`
## # ℹ 295 more variables: Region_Total.Revenue_Europe <dbl>,
## # `Region_Total.Revenue_Middle East and North Africa` <dbl>,
## # `Region_Total.Revenue_North America` <dbl>,
## # `Region_Total.Revenue_Sub-Saharan Africa` <dbl>,
## # `Item.Type_Total.Revenue_Baby Food` <dbl>, …head(y)## # A tibble: 6 × 1
## Sum.Revenue
## <dbl>
## 1 104352417.
## 2 110418511.
## 3 130919551.
## 4 104269757.
## 5 110400514.
## 6 110283538.5. Modelado con Regresión LASSO: Selección de Variables 🧠
Esta sección se enfoca en la aplicación de la regresión LASSO, una técnica poderosa para la selección de variables y la regularización del modelo. El proceso iterativo ayuda a identificar un conjunto robusto de predictores clave, mejorando la interpretabilidad y la eficiencia del modelo predictivo.
5.1. Ejecución Iterativa de Regresión LASSO (Bootstrap/Subsampling) 🔄
Se implementa un proceso de validación cruzada (cv.glmnet) repetido n_iter veces para entrenar el modelo LASSO. Cada iteración selecciona un subconjunto de datos (o una semilla aleatoria para la validación cruzada interna), lo que permite observar la frecuencia con la que cada variable es seleccionada por el modelo. Este enfoque iterativo mitiga la variabilidad inherente en la selección de variables de LASSO, proporcionando un conjunto más estable de características importantes.
# 1) Número de simulaciones (iteraciones de Bootstrap/Subsampling para la selección de variables)
n_iter <- 50
# 2) Lista para guardar resultados de variables seleccionadas en cada iteración
selected_vars <- vector("list", n_iter)
# 3) Bucle de simulaciones
for (i in seq_len(n_iter)) {
# Establecer una semilla aleatoria para reproducibilidad en cada iteración
# Usar set.seed(NULL) para verdadera aleatoriedad si no se necesita reproducibilidad de iteración
set.seed(sample.int(1e6, 1))
# Ajuste LASSO con validación cruzada
# cv.glmnet selecciona automáticamente el mejor lambda (lambda.min y lambda.1se)
cvfit <- cv.glmnet(
x = as.matrix(x), # Matriz de variables predictoras
y = as.matrix(y), # Matriz/vector de la variable respuesta
family = "gaussian", # Tipo de modelo: regresión lineal para respuesta continua
alpha = 1, # Elasticnet mixing parameter: 1 para LASSO puro
type.measure = "mse", # Métrica de error para la validación cruzada: Mean Squared Error
nfolds = 3, # Número de pliegues para la validación cruzada
standardize = TRUE, # Estandarizar variables predictoras (muy recomendado para LASSO)
nlambda = 200, # Número de valores de lambda a explorar
lambda.min.ratio= 1e-5 # Rango de valores de lambda a explorar
)
# 4) Extraer coeficientes (excepto el intercepto) que no son cero en lambda.min
# lambda.min es el valor de lambda que minimiza el error de validación cruzada.
coefs_at_lambda_min <- as.numeric(coef(cvfit, s = "lambda.min"))
# Obtener los nombres de las variables correspondientes a los coeficientes
var_names_at_lambda_min <- rownames(coef(cvfit, s = "lambda.min"))
# Excluir el intercepto y filtrar variables con coeficientes diferentes de cero
# El intercepto es siempre el primer elemento en la lista de coeficientes
non_zero_coef_indices <- which(coefs_at_lambda_min[-1] != 0) # Excluir el intercepto (índice 1)
vars_i <- var_names_at_lambda_min[-1][non_zero_coef_indices] # Obtener nombres de las variables seleccionadas
selected_vars[[i]] <- vars_i
}
# 5) Crear tabla de frecuencia y porcentaje de selección de cada variable
summary_tbl <- tibble(feature = unlist(selected_vars)) %>%
count(feature, name = "times") %>%
mutate(
percent = times / n_iter * 100
) %>%
arrange(desc(times))
# Mostrar un resumen de la tabla
summary_tbl## # A tibble: 14 × 3
## feature times percent
## <chr> <int> <dbl>
## 1 Region_Item.Type_Sales.Channel_Total.Revenue_Australia and Oce… 12 24
## 2 Region_Item.Type_Total.Revenue_Middle East and North Africa_Me… 7 14
## 3 Region_Item.Type_Sales.Channel_Total.Revenue_Central America a… 6 12
## 4 Region_Item.Type_Sales.Channel_Total.Revenue_Sub-Saharan Afric… 6 12
## 5 Region_Item.Type_Sales.Channel_Total.Revenue_Middle East and N… 5 10
## 6 Region_Sales.Channel_Total.Revenue_Middle East and North Afric… 4 8
## 7 Region_Total.Revenue_Central America and the Caribbean 4 8
## 8 Region_Item.Type_Total.Revenue_Middle East and North Africa_Co… 3 6
## 9 Item.Type_Total.Revenue_Vegetables 2 4
## 10 Region_Item.Type_Total.Revenue_North America_Office Supplies 2 4
## 11 Region_Item.Type_Total.Revenue_Sub-Saharan Africa_Household 2 4
## 12 Region_Item.Type_Sales.Channel_Total.Revenue_Middle East and N… 1 2
## 13 Region_Item.Type_Sales.Channel_Total.Revenue_North America_Off… 1 2
## 14 Region_Item.Type_Sales.Channel_Total.Revenue_Sub-Saharan Afric… 1 25.2. Análisis de Contribución de Variables LASSO Seleccionadas 💰
Una vez identificadas las variables más frecuentemente seleccionadas por el modelo LASSO, esta subsección profundiza en su impacto. Se analiza cómo estas variables contribuyen a los ingresos totales y, específicamente, a su crecimiento, proporcionando una visión accionable de los factores clave del negocio.
5.2.1. Contribución al Valor Nominal de Ventas (Marzo 2025) 📈
Se calcula y visualiza la contribución porcentual de cada variable seleccionada por LASSO al Sum.Revenue del mes de Marzo de 2025. Este análisis permite identificar cuáles de las características identificadas por el modelo tuvieron el mayor impacto en el volumen total de ingresos de ese mes, ofreciendo una perspectiva directa sobre la composición de las ventas.
# 1. Extraer los nombres de las características (features) de summary_tbl
lasso_selected_features <- summary_tbl %>%
pull(feature)
# 2. Seleccionar las columnas de tb_indicadores y unirlas con tb_ventas
# Nota: Si tb_indicadores_filtrada ya fue el resultado de una selección previa,
# asegúrate de que contiene los datos de Marzo.
data_combined_for_analysis <- tb_indicadores_filtrada %>%
select(Month, all_of(lasso_selected_features)) %>%
left_join(tb_ventas, by = "Month")
# 3. Filtrar los datos para el mes de "2025-03"
march_data <- data_combined_for_analysis %>%
filter(Month == "2025-03")
# Verificar si hay datos para marzo
if (nrow(march_data) == 0) {
message("No se encontraron datos para el mes '2025-03' después del filtrado. Verifique el nombre del mes y los datos.")
} else {
total_revenue_march <- march_data$Sum.Revenue[1] # [1] porque solo esperamos una fila para el mes
# 4. Calcular el porcentaje de contribución de cada variable a Sum.Revenue en marzo
contribution_march <- march_data %>%
select(-Month, -Sum.Revenue) %>% # Excluir Month y Sum.Revenue para pivotar las variables predictoras
pivot_longer(
cols = everything(), # Todas las columnas restantes son las variables predictoras
names_to = "Variable",
values_to = "Value_in_March"
) %>%
mutate(
Percentage_Contribution = (Value_in_March / total_revenue_march) * 100
) %>%
arrange(desc(abs(Percentage_Contribution))) # Ordenar por el valor absoluto del porcentaje para ver las más influyentes
# *** ESTA ES LA PARTE QUE SE HA ELIMINADO PARA QUITAR LA PRIMERA TABLA ***
# message(glue("Contribución de las variables predictoras al Sum.Revenue de Marzo de 2025 (Total: {format(total_revenue_march, big.mark = ',', scientific = FALSE)}):"))
# knitr::kable(contribution_march,
# caption = "Porcentaje de Contribución de Variables Predictoras en Marzo 2025",
# col.names = c("Variable", "Valor en Marzo", "Contribución (%)"))
# **************************************************************************
# Opcional: Mostrar la tabla de las contribuciones principales usando kable
top_n_to_display <- 5 # Muestra las 5 variables con mayor contribución
# Filtrar por contribuciones positivas y tomar el top N
# Si deseas incluir contribuciones negativas en el top, elimina el filtro `Value_in_March > 0`
contribution_march_top_kable <- contribution_march %>%
filter(Value_in_March > 0) %>% # Solo mostrar contribuciones positivas si tiene sentido para ventas
head(top_n_to_display)
if (nrow(contribution_march_top_kable) > 0) {
message(glue("\nTop {top_n_to_display} Contribuciones de Variables al Sum.Revenue en Marzo de 2025:"))
knitr::kable(
contribution_march_top_kable,
caption = glue("Top {top_n_to_display} Contribuciones en Marzo 2025 (Total: {format(total_revenue_march, big.mark = ',', scientific = FALSE)})"),
col.names = c("Variable", "Valor en Marzo", "Contribución (%)"),
digits = 2 # Redondear los valores numéricos para mejor lectura
)
} else {
message("\nNo hay variables con contribución positiva significativa para mostrar en la tabla en marzo.")
}
}## Top 5 Contribuciones de Variables al Sum.Revenue en Marzo de 2025:| Variable | Valor en Marzo | Contribución (%) |
|---|---|---|
| Region_Sales.Channel_Total.Revenue_Middle East and North Africa_Online | 18527534 | 14.15 |
| Region_Total.Revenue_Central America and the Caribbean | 13798798 | 10.54 |
| Region_Item.Type_Total.Revenue_Sub-Saharan Africa_Household | 11518034 | 8.80 |
| Item.Type_Total.Revenue_Vegetables | 6575281 | 5.02 |
| Region_Item.Type_Sales.Channel_Total.Revenue_Australia and Oceania_Baby Food_Online | 3477981 | 2.66 |
5.2.2. Contribución al Crecimiento Mensual de Ventas (Marzo vs. Febrero) 🚀
Para entender mejor la dinámica del crecimiento, esta sección analiza cuáles variables contribuyeron a la variación neta de ventas entre Febrero y Marzo de 2025. Esto significa identificar qué factores impulsaron el aumento (o disminución) en los ingresos, no solo su valor absoluto, sino su impacto en el cambio intermensual.
# --- Paso 1: Preparar los datos para el análisis de variación ---
# Extraer los nombres de las características seleccionadas por LASSO
lasso_selected_features <- summary_tbl %>%
pull(feature)
# Unir tb_indicadores con tb_ventas y seleccionar solo las variables relevantes
# Asegurarse de que todas las variables seleccionadas sean numéricas
data_for_growth_analysis <- tb_indicadores %>%
select(Month, all_of(lasso_selected_features)) %>%
mutate(across(all_of(lasso_selected_features), as.numeric)) %>% # Asegurar que las features son numéricas
left_join(tb_ventas, by = "Month")
# Filtrar los datos para los meses de Febrero y Marzo de 2025
feb_mar_data_full <- data_for_growth_analysis %>%
filter(Month %in% c("2025-02", "2025-03")) %>%
arrange(Month) # Asegurarse de que el orden sea cronológico
if (nrow(feb_mar_data_full) < 2) {
stop("No se encontraron datos para Febrero y Marzo de 2025. Revise los datos de entrada.")
}
# --- Paso 2: Calcular la variación para Sum.Revenue y cada indicador ---
# Obtener los valores de Sum.Revenue para febrero y marzo
sum_revenue_feb <- feb_mar_data_full %>% filter(Month == "2025-02") %>% pull(Sum.Revenue)
sum_revenue_mar <- feb_mar_data_full %>% filter(Month == "2025-03") %>% pull(Sum.Revenue)
delta_sum_revenue <- sum_revenue_mar - sum_revenue_feb
# Crear un data frame para almacenar los resultados de la variación y contribución
detailed_contribution_df <- tibble(
Variable = character(),
Valor_Febrero = numeric(),
Valor_Marzo = numeric(),
Variacion_Absoluta = numeric(),
Variacion_Porcentual_Variable = numeric(),
Relacion_Var_Categoria_Sobre_Var_Ventas = numeric()
)
# Iterar sobre cada variable seleccionada por LASSO
for (feature_name in lasso_selected_features) {
value_feb <- feb_mar_data_full %>% filter(Month == "2025-02") %>% pull(!!sym(feature_name))
value_mar <- feb_mar_data_full %>% filter(Month == "2025-03") %>% pull(!!sym(feature_name))
delta_value <- value_mar - value_feb
# Calcular variación porcentual de la variable
# Manejar división por cero si Valor_Febrero es 0 para la variación porcentual
if (value_feb == 0) {
perc_var_variable <- NA # O Inf si quieres indicar un crecimiento desde cero
} else {
perc_var_variable <- (delta_value / value_feb) * 100
}
# Calcular la relación de la variación de la categoría sobre la variación de las ventas totales
# Manejar división por cero si delta_sum_revenue es 0
if (abs(delta_sum_revenue) < 1e-6) { # Usar un umbral para considerar "casi cero"
relation_category_vs_sales <- NA
} else {
relation_category_vs_sales <- (delta_value / delta_sum_revenue) * 100
}
detailed_contribution_df <- detailed_contribution_df %>%
add_row(
Variable = feature_name,
Valor_Febrero = value_feb,
Valor_Marzo = value_mar,
Variacion_Absoluta = delta_value,
Variacion_Porcentual_Variable = perc_var_variable,
Relacion_Var_Categoria_Sobre_Var_Ventas = relation_category_vs_sales
)
}
# Ordenar la tabla por la relación de la variación de la categoría sobre la variación de ventas (magnitud)
final_contribution_summary <- detailed_contribution_df %>%
arrange(desc(abs(Relacion_Var_Categoria_Sobre_Var_Ventas))) %>%
# Formatear las columnas numéricas para tener separadores de miles y sin decimales
# Excluir 'Variacion_Porcentual_Variable' y 'Relacion_Var_Categoria_Sobre_Var_Ventas' de este formato
mutate(
Valor_Febrero = format(round(Valor_Febrero, 0), big.mark = ",", scientific = FALSE),
Valor_Marzo = format(round(Valor_Marzo, 0), big.mark = ",", scientific = FALSE),
Variacion_Absoluta = format(round(Variacion_Absoluta, 0), big.mark = ",", scientific = FALSE),
# Las columnas porcentuales pueden mantener decimales o redondearse según se prefiera
# Aquí las redondeamos a 2 decimales para la presentación en porcentaje
Variacion_Porcentual_Variable = paste0(round(Variacion_Porcentual_Variable, 2), "%"),
Relacion_Var_Categoria_Sobre_Var_Ventas = paste0(round(Relacion_Var_Categoria_Sobre_Var_Ventas, 2), "%")
)
# Formatear el valor delta_sum_revenue para el encabezado de la columna
formatted_delta_sum_revenue <- format(round(delta_sum_revenue, 0), big.mark = ",", scientific = FALSE)
message(glue("Resumen Detallado de la Contribución al Crecimiento de Ventas (Marzo vs. Febrero)"))## Resumen Detallado de la Contribución al Crecimiento de Ventas (Marzo vs. Febrero)knitr::kable(final_contribution_summary,
caption = "Análisis Detallado de Contribución por Variable (Marzo vs. Febrero)",
col.names = c(
"Variable", "Valor Feb.", "Valor Mar.", "Variación Abs.",
"Var. % (Variable)",
glue("Contribución al Crecimiento (%) (Total: {formatted_delta_sum_revenue})") # Columna dinámica
),
align = c('l', rep('r', 5)) # Ajustar alineación, ahora son 5 columnas a la derecha
)| Variable | Valor Feb. | Valor Mar. | Variación Abs. | Var. % (Variable) | Contribución al Crecimiento (%) (Total: 20,501,040) |
|---|---|---|---|---|---|
| Region_Sales.Channel_Total.Revenue_Middle East and North Africa_Online | 8,346,235 | 18,527,534 | 10,181,299 | 121.99% | 49.66% |
| Region_Item.Type_Total.Revenue_Sub-Saharan Africa_Household | 3,133,518 | 11,518,034 | 8,384,516 | 267.58% | 40.9% |
| Region_Item.Type_Sales.Channel_Total.Revenue_Sub-Saharan Africa_Office Supplies_Offline | 5,908,428 | 0 | -5,908,428 | -100% | -28.82% |
| Region_Item.Type_Sales.Channel_Total.Revenue_Australia and Oceania_Baby Food_Online | 0 | 3,477,981 | 3,477,981 | NA% | 16.96% |
| Region_Item.Type_Total.Revenue_Middle East and North Africa_Cosmetics | 3,289,056 | 0 | -3,289,056 | -100% | -16.04% |
| Region_Total.Revenue_Central America and the Caribbean | 16,882,697 | 13,798,798 | -3,083,899 | -18.27% | -15.04% |
| Region_Item.Type_Sales.Channel_Total.Revenue_Middle East and North Africa_Cereal_Online | 0 | 1,848,009 | 1,848,009 | NA% | 9.01% |
| Item.Type_Total.Revenue_Vegetables | 4,960,732 | 6,575,281 | 1,614,549 | 32.55% | 7.88% |
| Region_Item.Type_Sales.Channel_Total.Revenue_Middle East and North Africa_Office Supplies_Online | 0 | 822,817 | 822,817 | NA% | 4.01% |
| Region_Item.Type_Total.Revenue_Middle East and North Africa_Meat | 417,671 | 0 | -417,671 | -100% | -2.04% |
| Region_Item.Type_Sales.Channel_Total.Revenue_Central America and the Caribbean_Baby Food_Offline | 0 | 0 | 0 | NA% | 0% |
| Region_Item.Type_Sales.Channel_Total.Revenue_Sub-Saharan Africa_Fruits_Online | 0 | 0 | 0 | NA% | 0% |
| Region_Item.Type_Total.Revenue_North America_Office Supplies | 0 | 0 | 0 | NA% | 0% |
| Region_Item.Type_Sales.Channel_Total.Revenue_North America_Office Supplies_Online | 0 | 0 | 0 | NA% | 0% |
6. Visualización de Tendencias y Contribuciones Clave 📊
Esta sección se dedica a la visualización de las principales tendencias identificadas en el análisis. Se presentará un gráfico de series de tiempo combinado que muestra la evolución de las ventas totales junto con la contribución de los factores más influyentes, ofreciendo una visión integral de su dinámica a lo largo del tiempo.
6.1. Gráfico de Series de Tiempo Combinado: Ventas y Factores Clave 📈
Se genera un gráfico de series de tiempo con doble eje Y que compara la Tendencia de Ventas Totales (eje primario) con la Contribución Acumulada de los Factores Clave (eje secundario) identificados por el modelo LASSO. Esta visualización permite observar la evolución conjunta de los ingresos y el impacto de los factores más relevantes a lo largo del tiempo.
# --- 1. Identify the top 2 variables from final_contribution_summary ---
# Asumo que final_contribution_summary ya está disponible y ordenado
top_2_vars_names <- final_contribution_summary[1:2, 1] %>% pull(Variable)
message(glue("Variables seleccionadas para la serie de tiempo (acumulada): {paste(top_2_vars_names, collapse = ' y ')}"))## Variables seleccionadas para la serie de tiempo (acumulada): Region_Sales.Channel_Total.Revenue_Middle East and North Africa_Online y Region_Item.Type_Total.Revenue_Sub-Saharan Africa_Household# --- 2. Prepare and combine data for the single time series plot ---
# Data for top variables from tb_indicadores_filtrada
# Convert Month to factor for correct chronological ordering on x-axis
# Pivot to long format for easier plotting of multiple variables
top_vars_long_data <- tb_indicadores_filtrada %>%
select(Month, all_of(top_2_vars_names)) %>%
mutate(Month = factor(Month, levels = unique(Month))) %>%
pivot_longer(
cols = -Month,
names_to = "Variable",
values_to = "Value_Factor"
) %>%
# Asegurarse de que los valores numéricos sean tratados como tales
mutate(Value_Factor = as.numeric(Value_Factor))
# Data for total sales from tb_ventas_filtrada
sales_data <- tb_ventas_filtrada %>%
mutate(Month = factor(Month, levels = unique(Month)))
# Calcular la suma acumulada de las dos variables principales por mes
# Esto crea el "total" de las dos variables para el eje Y derecho.
cumulative_factors_data <- top_vars_long_data %>%
group_by(Month) %>%
summarise(Cumulative_Factor_Value = sum(Value_Factor, na.rm = TRUE)) %>%
ungroup()
# Combinar todos los datos para el gráfico
# Unir ventas totales con los valores acumulados de los factores
combined_ts_data <- sales_data %>%
left_join(cumulative_factors_data, by = "Month") %>%
# Ahora, unir también los valores individuales de las top_vars para el geom_area
left_join(top_vars_long_data %>% pivot_wider(names_from = Variable, values_from = Value_Factor), by = "Month")
# --- 3. Determine scaling factor for the secondary axis ---
# This is crucial for correctly mapping the two Y-axes.
# The ratio helps align the scale of factors to total revenue.
max_revenue <- max(combined_ts_data$Sum.Revenue, na.rm = TRUE)
max_cumulative_factors <- max(combined_ts_data$Cumulative_Factor_Value, na.rm = TRUE)
# Avoid division by zero if max_cumulative_factors is 0
scaling_factor <- ifelse(max_cumulative_factors == 0, 1, max_revenue / max_cumulative_factors)
# --- 4. Create the combined plot ---
# Construir los vectores de colores/rellenos de forma programática
# Colores para las líneas (Ventas Totales y puntos de los factores)
color_values_manual <- c("Ventas Totales" = "darkblue")
color_values_manual[top_2_vars_names[1]] <- "red"
color_values_manual[top_2_vars_names[2]] <- "turquoise"
# Colores para los rellenos (áreas de los factores)
fill_values_manual <- c() # Inicializar vector vacío
fill_values_manual[top_2_vars_names[1]] <- "red"
fill_values_manual[top_2_vars_names[2]] <- "turquoise"
# Base plot with total revenue on the primary Y-axis
p_combined <- ggplot(combined_ts_data, aes(x = Month)) +
# Line for Total Sales (primary Y-axis)
geom_line(aes(y = Sum.Revenue, group = 1, color = "Ventas Totales"), linewidth = 1) +
geom_point(aes(y = Sum.Revenue, group = 1, color = "Ventas Totales"), size = 2) +
# Stacked area for the two factors (mapped to secondary Y-axis)
# Data for geom_area should be top_vars_long_data to use 'Variable' for fill/grouping
geom_area(data = top_vars_long_data,
aes(y = Value_Factor * scaling_factor, fill = Variable, group = Variable),
position = "stack", alpha = 0.6) +
# Add points for the stacked area (optional, but good for clarity)
# Use top_vars_long_data and ensure 'Variable' is correctly mapped for color/group
geom_point(data = top_vars_long_data,
aes(y = Value_Factor * scaling_factor, color = Variable, group = Variable),
size = 2, shape = 21, fill = "white", stroke = 1) +
scale_y_continuous(
labels = scales::comma,
name = "Ventas Totales (Revenue)",
sec.axis = sec_axis(~ . / scaling_factor,
name = glue("Valor Acumulado Factores ({top_2_vars_names[1]} + {top_2_vars_names[2]})"),
labels = scales::comma)
) +
labs(
title = "Tendencia de Ventas Totales vs. Contribución Acumulada de Factores Clave",
x = "Mes"
) +
# Custom colors for lines and fills using the programmatically built vectors
scale_color_manual(name = "Serie",
values = color_values_manual,
breaks = names(color_values_manual)) + # Ensure all mapped items appear in legend
scale_fill_manual(name = "Factor",
values = fill_values_manual,
breaks = top_2_vars_names) + # Explicitly set breaks to control legend order
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom",
legend.box = "horizontal"
)
# Imprimir el gráfico combinado
p_combined
6.2. Gráfico de Series de Tiempo Combinado: Ventas y Factores Clave en Diff 📈
Para profundizar en la explicación del crecimiento de los ingresos, esta sección se centra en la transformación de las variables a sus diferencias intermensuales. Al analizar las variaciones (cambio de un mes a otro) en lugar de los valores absolutos, podemos evaluar directamente cómo los cambios en los factores predictivos se relacionan con los cambios en la variable objetivo (Sum.Revenue). Este enfoque es crucial para comprender la causalidad y el impacto marginal de las variables, permitiendo evaluar mejor el modelo LASSO.
En este paso, se calcula la diferencia (lag) de cada variable numérica en tb_indicadores y tb_ventas con respecto al mes anterior. Las nuevas columnas resultantes (Diff_Variable) representan la variación absoluta mensual de cada indicador y de las ventas totales. La primera fila (correspondiente a enero, o el primer mes del dataset), que no tiene un mes anterior para calcular la diferencia, se elimina.
Para complementar el análisis de la contribución al crecimiento, esta sección visualiza la tendencia de las variaciones mensuales tanto de las ventas totales como de los factores clave identificados por LASSO. Al graficar las diferencias mes a mes, se puede observar directamente si los aumentos o disminuciones en las ventas se alinean con los cambios en los indicadores principales, proporcionando una validación visual de la influencia de las variables y la capacidad del modelo para explicar los movimientos de la variable objetivo.
# 1. Calcular variaciones para tb_indicadores
tb_indicadores_diff <- tb_indicadores %>%
# Asegurarse de que 'Month' esté ordenado para un cálculo correcto de lag
arrange(Month) %>%
# Convertir todas las columnas numéricas (excepto Month) a diferencias
mutate(across(-Month, ~ . - lag(.), .names = "Diff_{.col}")) %>%
# Seleccionar solo las columnas de diferencia y Month
select(Month, starts_with("Diff_")) %>%
# Eliminar la fila de Enero (que tendrá NA por no tener mes anterior)
filter(Month != "2025-01")
# 2. Calcular variaciones para tb_ventas
tb_ventas_diff <- tb_ventas %>%
# Asegurarse de que 'Month' esté ordenado
arrange(Month) %>%
mutate(Diff_Sum.Revenue = Sum.Revenue - lag(Sum.Revenue)) %>%
# Eliminar la fila de Enero
filter(Month != "2025-01")
message("Estructura de tb_indicadores_diff (primeras filas):")
print(head(tb_indicadores_diff))## # A tibble: 6 × 299
## Month Diff_Region_Total.Reve…¹ Diff_Region_Total.Re…² Diff_Region_Total.Re…³
## <chr> <dbl> <dbl> <dbl>
## 1 2025-02 -10431526. 5465131. 6208768.
## 2 2025-03 -1335112. -2029142. -3083899.
## 3 2025-04 -1183778. -8527390. 773978.
## 4 2025-05 449404. 6362802. -5827706.
## 5 2025-06 3916362. -3000774. 6344386.
## 6 2025-07 5182017. -4487455. -8683288.
## # ℹ abbreviated names: ¹Diff_Region_Total.Revenue_Asia,
## # ²`Diff_Region_Total.Revenue_Australia and Oceania`,
## # ³`Diff_Region_Total.Revenue_Central America and the Caribbean`
## # ℹ 295 more variables: Diff_Region_Total.Revenue_Europe <dbl>,
## # `Diff_Region_Total.Revenue_Middle East and North Africa` <dbl>,
## # `Diff_Region_Total.Revenue_North America` <dbl>,
## # `Diff_Region_Total.Revenue_Sub-Saharan Africa` <dbl>, …message("\nEstructura de tb_ventas_diff (primeras filas):")
print(head(tb_ventas_diff))## # A tibble: 6 × 3
## Month Sum.Revenue Diff_Sum.Revenue
## <chr> <dbl> <dbl>
## 1 2025-02 110418511. 6066094.
## 2 2025-03 130919551. 20501040.
## 3 2025-04 104269757. -26649794.
## 4 2025-05 110400514. 6130757.
## 5 2025-06 110283538. -116977.
## 6 2025-07 105626846. -4656692.8. Contribución de las variaciones mes a mes
Este gráfico de series de tiempo de doble eje Y presenta la variación mensual de las ventas totales (Diff_Sum.Revenue) en el eje primario y la variación acumulada de los dos factores más influyentes (identificados previamente) en el eje secundario. La escala se ajusta para permitir una comparación visual significativa entre las magnitudes de las variaciones. Esta visualización es clave para comprender si los cambios en las variables explicativas realmente impulsan los cambios observados en los ingresos.
# --- 1. Identify the top 2 variables from final_contribution_summary ---
# (Asumimos que final_contribution_summary sigue siendo el mismo y que las variables
# principales son las mismas, pero ahora buscamos sus diferencias)
top_2_vars_names <- final_contribution_summary[1:2, 1] %>% pull(Variable)
# Asegurarse de que los nombres de las columnas en tb_indicadores_diff coincidan
# con el formato "Diff_OriginalName"
top_2_vars_diff_names <- paste0("Diff_", top_2_vars_names)
message(glue("Variables de diferencia seleccionadas para la serie de tiempo (acumulada): {paste(top_2_vars_diff_names, collapse = ' y ')}"))
# --- 2. Prepare and combine data for the single time series plot (with differences) ---
# Data para las variables principales diferenciadas desde tb_indicadores_diff
top_vars_long_diff_data <- tb_indicadores_diff %>%
select(Month, all_of(top_2_vars_diff_names)) %>%
# Convertir Month a factor para el orden cronológico
mutate(Month = factor(Month, levels = unique(Month))) %>%
pivot_longer(
cols = -Month,
names_to = "Variable",
values_to = "Value_Factor_Diff"
) %>%
mutate(Value_Factor_Diff = as.numeric(Value_Factor_Diff)) # Asegurar tipo numérico
# Data para las ventas totales diferenciadas desde tb_ventas_diff
sales_diff_data <- tb_ventas_diff %>%
mutate(Month = factor(Month, levels = unique(Month)))
# Calcular la suma acumulada de las dos variables principales diferenciadas por mes
cumulative_factors_diff_data <- top_vars_long_diff_data %>%
group_by(Month) %>%
summarise(Cumulative_Factor_Diff_Value = sum(Value_Factor_Diff, na.rm = TRUE)) %>%
ungroup()
# Combinar todos los datos para el gráfico
combined_diff_ts_data <- sales_diff_data %>%
left_join(cumulative_factors_diff_data, by = "Month") %>%
# Unir también los valores individuales de las top_vars_diff para geom_area
left_join(top_vars_long_diff_data %>% pivot_wider(names_from = Variable, values_from = Value_Factor_Diff), by = "Month")
# --- 3. Determine scaling factor for the secondary axis (with differences) ---
# Usamos los valores diferenciados para el cálculo del factor de escala
max_revenue_diff <- max(combined_diff_ts_data$Diff_Sum.Revenue, na.rm = TRUE)
min_revenue_diff <- min(combined_diff_ts_data$Diff_Sum.Revenue, na.rm = TRUE)
max_cumulative_factors_diff <- max(combined_diff_ts_data$Cumulative_Factor_Diff_Value, na.rm = TRUE)
min_cumulative_factors_diff <- min(combined_diff_ts_data$Cumulative_Factor_Diff_Value, na.rm = TRUE)
# Para ejes duales con diferencias (que pueden ser negativas), es útil escalar a un rango.
# Una forma es alinear los puntos cero y luego escalar los rangos máximos/mínimos.
# Simplificaremos el factor de escala a la proporción de los máximos absolutos
# para mantener la lógica previa, ajustando para valores negativos si es necesario.
range_revenue_diff <- max_revenue_diff - min_revenue_diff
range_cumulative_factors_diff <- max_cumulative_factors_diff - min_cumulative_factors_diff
# Evitar división por cero
scaling_factor_diff <- ifelse(range_cumulative_factors_diff == 0, 1, range_revenue_diff / range_cumulative_factors_diff)
# Si tienes valores negativos en ambos lados, una buena aproximación es alinear los ceros.
# A veces, ajustar un factor basado en un punto común (como el cero o el máximo absoluto)
# ayuda a que los ejes duales sean más interpretables cuando hay valores positivos y negativos.
# Para simplificar y mantener la consistencia con el enfoque anterior, usaremos
# la proporción de los valores máximos absolutos para el factor de escala,
# asegurando que los valores negativos se mapeen correctamente si el rango lo permite.
# Podemos usar el max absoluto de ambos ejes para el factor de escala, o la razón de rangos.
# La razón de rangos es más robusta para datos que cruzan cero.
# scaling_factor_diff <- max(abs(max_revenue_diff), abs(min_revenue_diff)) /
# max(abs(max_cumulative_factors_diff), abs(min_cumulative_factors_diff))
# Revertimos a la proporción de máximos para una visualización más directa de "magnitud superior"
# Ajustado para evitar problemas si los máximos son 0.
scaling_factor_diff_abs <- ifelse(max(abs(cumulative_factors_diff_data$Cumulative_Factor_Diff_Value), na.rm = TRUE) == 0, 1,
max(abs(sales_diff_data$Diff_Sum.Revenue), na.rm = TRUE) / max(abs(cumulative_factors_diff_data$Cumulative_Factor_Diff_Value), na.rm = TRUE))
message(glue("Factor de escala para las diferencias: {scaling_factor_diff_abs}"))
# --- 4. Create the combined plot (with differences) ---
# Construir los vectores de colores/rellenos de forma programática para las diferencias
color_values_diff_manual <- c("Variación Ventas Totales" = "darkblue")
color_values_diff_manual[top_2_vars_diff_names[1]] <- "red"
color_values_diff_manual[top_2_vars_diff_names[2]] <- "turquoise"
fill_values_diff_manual <- c()
fill_values_diff_manual[top_2_vars_diff_names[1]] <- "red"
fill_values_diff_manual[top_2_vars_diff_names[2]] <- "turquoise"
# Base plot con la variación de ventas totales en el eje Y primario
p_combined_diff <- ggplot(combined_diff_ts_data, aes(x = Month)) +
# Line for Total Sales Differences (primary Y-axis)
geom_line(aes(y = Diff_Sum.Revenue, group = 1, color = "Variación Ventas Totales"), linewidth = 1) +
geom_point(aes(y = Diff_Sum.Revenue, group = 1, color = "Variación Ventas Totales"), size = 2) +
# Stacked area for the two factor differences (mapped to secondary Y-axis)
geom_area(data = top_vars_long_diff_data,
# Multiplicar por scaling_factor_diff_abs para alinear al eje primario
aes(y = Value_Factor_Diff * scaling_factor_diff_abs, fill = Variable, group = Variable),
position = "stack", alpha = 0.6) +
# Add points for the stacked area (optional)
geom_point(data = top_vars_long_diff_data,
aes(y = Value_Factor_Diff * scaling_factor_diff_abs, color = Variable, group = Variable),
size = 2, shape = 21, fill = "white", stroke = 1) +
scale_y_continuous(
labels = scales::comma,
name = "Variación Ventas Totales (Revenue)",
# Secondary axis for the cumulative factor differences
sec.axis = sec_axis(~ . / scaling_factor_diff_abs,
name = glue("Variación Acumulada Factores ({top_2_vars_names[1]} + {top_2_vars_names[2]})"),
labels = scales::comma)
) +
labs(
title = "Tendencia de Variación Mensual: Ventas Totales vs. Factores Clave",
x = "Mes"
) +
# Custom colors for lines and fills using the programmatically built vectors
scale_color_manual(name = "Serie",
values = color_values_diff_manual,
breaks = names(color_values_diff_manual)) +
scale_fill_manual(name = "Factor",
values = fill_values_diff_manual,
breaks = top_2_vars_diff_names) + # Usa los nombres "Diff_" para la leyenda del fill
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom",
legend.box = "horizontal"
)
# Imprimir el gráfico combinado de variaciones
p_combined_diff