0. Detalles

Los datos y resultados de este proyecto se enmarcan como un derivable de una evaluación aplicada del curso Aplicaciones de Machine Learning en Economía (EAE3709).

Este producto no incluye el método Cross Validation que sí está procesado en el Script del código original, este puede ser encontrado en el Github del proyecto

Para ver en detalle la estructura y código de este proceso, por favor visita el Repositorio del proyecto

1. Introducción y Carga de Dependencias

Este cuaderno registra el flujo de trabajo analítico para predecir la propensión de compra de pasajes aéreos a partir de datos de cotizaciones. El enfoque metodológico prioriza la eficiencia operativa del negocio, calibrando los modelos para capturar al menos el 80% de los compradores reales (Sensibilidad) y desempatando las arquitecturas mediante la maximización de la Especificidad.

2. Análisis Exploratorio de Datos (EDA) e Ingeniería de Detalles

En este módulo se importan las bases de datos originales, se limpian las inconsistencias operativas (valores nulos y días de anticipación negativos) y se extraen características temporales de valor predictivo.

# Carga de datos de origen
cotizaciones <- read_csv("TAREA/cotizaciones_tabla.csv")
cotizaciones_dic <- read_delim("TAREA/cotizaciones_diccionario.csv", delim = ",", skip = 1)

# Tratamiento de valores ausentes (NA)
cotizaciones$precio_usd_index <- NULL
cotizaciones <- cotizaciones[!is.na(cotizaciones$pais_geolocalizacion), ]

# Construcción de variables temporales (Fecha de cotización)
cotizaciones$mes <- month(cotizaciones$fecha_cotizacion)
cotizaciones$dia_semana <- wday(cotizaciones$fecha_cotizacion)
cotizaciones$trimestre <- quarter(cotizaciones$fecha_cotizacion)
cotizaciones$semestre <- semester(cotizaciones$fecha_cotizacion)
cotizaciones$finde <- case_when(
  cotizaciones$dia_semana %in% c(6, 7) ~ 1,
  TRUE ~ 0
)

# Construcción de variables temporales (Fecha de vuelo)
cotizaciones$anio_vuelo <- year(cotizaciones$fecha_vuelo)
cotizaciones$mes_vuelo <- month(cotizaciones$fecha_vuelo)
cotizaciones$dia_semana_vuelo <- wday(cotizaciones$fecha_vuelo)
cotizaciones$trimestre_vuelo <- quarter(cotizaciones$fecha_vuelo)
cotizaciones$semestre_vuelo <- semester(cotizaciones$fecha_vuelo)
cotizaciones$semana_vuelo <- week(cotizaciones$fecha_vuelo)
cotizaciones$finde_vuelo <- case_when(
  cotizaciones$dia_semana_vuelo %in% c(6, 7) ~ 1,
  TRUE ~ 0
)

# Ingeniería de bloques horarios de búsqueda
cotizaciones$hora <- hour(cotizaciones$fecha_hora_cotizacion)
cotizaciones <- cotizaciones %>%
  mutate(
    bloque_horario = case_when(
      hora >= 0  & hora < 6  ~ 1,
      hora >= 6  & hora < 12 ~ 2,
      hora >= 12 & hora < 18 ~ 3,
      hora >= 18 & hora < 24 ~ 4
    ),
    hora_dia = paste0(bloque_horario, "-", dia_semana),
    decil = ntile(precio_usd_imputado_index, 10)
  )

# Identificación secuencial de cotizaciones por usuario único
cotizaciones <- cotizaciones %>%
  arrange(user_anon_id, fecha_hora_cotizacion) %>%
  group_by(user_anon_id) %>%
  mutate(cotizacion_numero = row_number()) %>%
  ungroup()

# Depuración de registros con días de anticipación inconsistentes (Negativos)
cotizaciones <- cotizaciones[!(cotizaciones$anticipacion_dias < 0), ]

# Variable de origen geográfico
cotizaciones$from_chile <- case_when(
  cotizaciones$pais_geolocalizacion == "Chile" ~ 1,
  TRUE ~ 0
)

# Distribución de la variable dependiente comercial (Prevalencia)
table(cotizaciones$compro)
## 
##    0    1 
## 8896 1078

3. Configuración de Matrices y Split de Entrenamiento

Preparación de las variables categóricas mediante codificación en matriz de diseño (One-Hot Encoding) y división del conjunto en 80% entrenamiento y 20% prueba.

y <- cotizaciones$compro

X <- cotizaciones %>% select(
  -compro, -user_anon_id, -fecha_cotizacion, -fecha_hora_cotizacion,
  -pais_geolocalizacion, -fecha_vuelo, -pais_pos, -platform_type,
  -precio_es_imputado, -avanzo_a_carrito, -numero_sesion, -decil
)

# Filtro de seguridad para columnas con varianza cero
X <- X[, sapply(X, function(x) length(unique(x)) > 1)]

# Conversión explícita a factores estructurados
vars_factor <- c(
  "travel_type", "cabin_type", "device_type", "channel_type", "from_chile",
  "tier_fidelizacion", "sistema_operativo", "tipo_flujo", "mes", "dia_semana",
  "anio_vuelo", "mes_vuelo", "dia_semana_vuelo", "trimestre_vuelo",
  "semestre_vuelo", "semana_vuelo", "finde_vuelo", "bloque_horario",
  "hora_dia", "cotizacion_numero"
)
X[vars_factor] <- lapply(X[vars_factor], factor)

# Generación de la matriz de diseño dummificada
dummies <- model.matrix(~ . - 1, data = X)

# Particionamiento balanceado
set.seed(123)
y <- as.numeric(y)
train_index <- createDataPartition(y, p = 0.8, list = FALSE)

X_train <- dummies[train_index, ]
X_test  <- dummies[-train_index, ]
y_train <- y[train_index]
y_test  <- y[-train_index]

# Estructuras nativas para XGBoost
dtrain <- xgb.DMatrix(data = X_train, label = y_train)
dtest  <- xgb.DMatrix(data = X_test, label = y_test)

# Cálculo de balanceo analítico de clases (Inversa de la prevalencia)
scale_pos_weight <- sum(y_train == 0) / sum(y_train == 1)

4. Modelo Campeón: Extreme Gradient Boosting (XGBoost)

4.1 Entrenamiento y Ajuste con Hiperparámetros Óptimos

Utilizando el mejor set de hiperparámetros derivado de la exploración de mallas espaciales (Grid Search).

best_params <- list(
  objective = "binary:logistic",
  eval_metric = "auc",
  scale_pos_weight = scale_pos_weight,
  max_depth = 5,
  min_child_weight = 5,
  gamma = 1,
  eta = 0.05,
  subsample = 0.8,
  colsample_bytree = 0.8
)

modelo_final <- xgb.train(
  params = best_params,
  data = dtrain,
  nrounds = 295,
  seed = 123
)

# Predicción probabilística
pred_xgb <- predict(modelo_final, dtest)

4.2 Métricas Globales y Calibración del Umbral de Negocio Determinamos el punto crítico de frontera matemática que garantice una Sensibilidad \(\ge 80\%\).

roc_xgb <- roc(y_test, pred_xgb)
cat("ROC-AUC Global XGBoost:", auc(roc_xgb), "\n")
## ROC-AUC Global XGBoost: 0.8571577
coords_xgb <- coords(roc_xgb, x = "all", ret = c("threshold", "sensitivity", "specificity")) %>% 
  as.data.frame()

mejor_xgb <- coords_xgb %>%
  filter(sensitivity >= 0.80) %>%
  arrange(desc(specificity)) %>% 
  slice(1)

umbral_xgb <- mejor_xgb$threshold
cat("Umbral Crítico Calibrado (Tau):", umbral_xgb, "\n")
## Umbral Crítico Calibrado (Tau): 0.3189896

4.3 Matriz de Confusión Gráfica y Feature Importance

pred_class_xgb <- ifelse(pred_xgb > umbral_xgb, 1, 0)
cm_xgb_raw <- confusionMatrix(factor(pred_class_xgb, levels=c(0,1)), factor(y_test, levels=c(0,1)), positive = "1")
cm_xgb_df <- as.data.frame(cm_xgb_raw$table)

# Graficar Matriz de Confusión
ggplot(cm_xgb_df, aes(x = Reference, y = Prediction, fill = Freq)) +
  geom_tile() +
  geom_text(aes(label = Freq), size = 6) +
  scale_fill_gradient(low = "white", high = "steelblue") +
  labs(title = "Matriz de Confusión - XGBoost", x = "Valor Real", y = "Predicción") +
  theme_minimal()

# Análisis de Importancia de Variables (Top 10)
importancia <- xgb.importance(feature_names = colnames(X_train), model = modelo_final)
top_10_importancia <- importancia %>% slice_max(order_by = Gain, n = 10)

ggplot(top_10_importancia, aes(x = reorder(Feature, Gain), y = Gain)) +
  geom_bar(stat = "identity", fill = "steelblue", width = 0.6) +
  coord_flip() +
  labs(title = "Top 10 Variables Determinantes (XGBoost)", x = "Variables", y = "Ganancia Relativa") +
  theme_minimal()

5. Arquitecturas de Contraste y Desempate Operativo

5.1 Regresión Logística Ponderada (Logit)

datos_logit <- cotizaciones %>%
  select(compro, precio_usd_imputado_index, anticipacion_dias, hora, travel_type, tier_fidelizacion, device_type)

datos_logit$travel_type <- factor(datos_logit$travel_type)
datos_logit$tier_fidelizacion <- factor(datos_logit$tier_fidelizacion)
datos_logit$device_type <- factor(datos_logit$device_type)

train_logit <- datos_logit[train_index, ]
test_logit  <- datos_logit[-train_index, ]

peso_clase_positiva <- sum(train_logit$compro == 0) / sum(train_logit$compro == 1)
pesos_entrenamiento <- ifelse(train_logit$compro == 1, peso_clase_positiva, 1)

modelo_logit <- glm(compro ~ ., data = train_logit, family = binomial(), weights = pesos_entrenamiento)
pred_logit <- predict(modelo_logit, newdata = test_logit, type = "response")

# Calibración bajo restricción
roc_logit <- roc(y_test, pred_logit)
mejor_logit <- coords(roc_logit, x = "all", ret = c("threshold", "sensitivity", "specificity")) %>% 
  as.data.frame() %>% filter(sensitivity >= 0.80) %>% arrange(desc(specificity)) %>% slice(1)

pred_class_logit <- ifelse(pred_logit > mejor_logit$threshold, 1, 0)
cm_logit_df <- as.data.frame(confusionMatrix(factor(pred_class_logit, levels=c(0,1)), factor(y_test, levels=c(0,1)), positive="1")$table)

ggplot(cm_logit_df, aes(x = Reference, y = Prediction, fill = Freq)) +
  geom_tile() + geom_text(aes(label = Freq), size = 6) +
  scale_fill_gradient(low = "white", high = "steelblue") +
  labs(title = "Matriz de Confusión - Logit", x = "Valor Real", y = "Predicción") +
  theme_minimal()

5.2 Ensambles de Árboles Paralelos: Random Forest (Ranger)

train_rf <- as.data.frame(X_train); train_rf$compro <- factor(y_train)
test_rf  <- as.data.frame(X_test);  test_rf$compro  <- factor(y_test)
names(train_rf) <- make.names(names(train_rf)); names(test_rf) <- make.names(names(test_rf))

pesos_clase <- c("0" = 1, "1" = peso_clase_positiva)

modelo_rf <- ranger(
  compro ~ ., data = train_rf, probability = TRUE, num.trees = 500,
  importance = "impurity", class.weights = pesos_clase, seed = 123
)

pred_rf <- predict(modelo_rf, data = test_rf)$predictions[, 2]

# Calibración bajo restricción
roc_rf <- roc(y_test, pred_rf)
mejor_rf <- coords(roc_rf, x = "all", ret = c("threshold", "sensitivity", "specificity")) %>% 
  as.data.frame() %>% filter(sensitivity >= 0.80) %>% arrange(desc(specificity)) %>% slice(1)

pred_class_rf <- ifelse(pred_rf > mejor_rf$threshold, 1, 0)
cm_rf_df <- as.data.frame(confusionMatrix(factor(pred_class_rf, levels=c(0,1)), factor(y_test, levels=c(0,1)), positive="1")$table)

ggplot(cm_rf_df, aes(x = Reference, y = Prediction, fill = Freq)) +
  geom_tile() + geom_text(aes(label = Freq), size = 6) +
  scale_fill_gradient(low = "white", high = "steelblue") +
  labs(title = "Matriz de Confusión - Random Forest", x = "Valor Real", y = "Predicción") +
  theme_minimal()

6. Conclusiones Estadísticas de la Evaluación

Al comparar los tres modelos bajo la restricción exógena fija de capturar el 80% de los compradores reales para blindar los ingresos por pasajes aéreos, XGBoost se consolida como el modelo óptimo.

Mientras que la Regresión Logística tradicional degrada drásticamente su capacidad operativa incurriendo en un volumen masivo de 921 Falsos Positivos (debido a las complejas relaciones no lineales del set de datos), XGBoost aprovecha de forma eficiente las interacciones de variables, conteniendo los errores de mercadeo inútil a solo 516 Falsos Positivos y maximizando la Especificidad al 71.3%.