Análisis de Datos y Big Data

Universidad Central

Dirección de Educación Continua.

Regresión logística - Clasificación binaria

Contamos con una base de datos con información de reservaciones de vuelos. Algunas reservaciones son completadas efectivamente, y otras no.

Para mejorar la experiencia de usuario, la aerolínea desea ofrecer una promoción especial a las reservas que usualmente solicitan alimentación durante el vuelo.

Para esto, la idea es que antes de que un usuario indique querer alimentación durante el vuelo, la aerolínea le ofrezca unas entradas gratis. Esto debería mejorar las calificaciones de experiencia de reservación, mitigando los costos (no ofreciéndole comida gratis a todo el mundo).

Para esto queremos entrenar una máquina que prediga qué reservaciones van a solicitar alimentación, a partir de otras características insertadas.

# Cargar la librería necesaria para graficar
library(ggplot2)

# Definir la función sigmoide
sigmoid <- function(x) {
  return(1 / (1 + exp(-x)))
}

# Crear datos para la gráfica
# Usamos seq() para generar una secuencia de números
x <- seq(-10, 10, length.out = 100)
y <- sigmoid(x)

# Crear un dataframe para ggplot
df_sigmoid <- data.frame(x = x, y = y)

# Crear la gráfica con ggplot2
ggplot(df_sigmoid, aes(x = x, y = y)) +
  geom_line(color = "blue", size = 1) +
  labs(
    title = 'Gráfica de la Función Sigmoide',
    x = 'x',
    y = 'Sigmoid(x)'
  ) +
  theme_minimal() +
  geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray") +
  geom_vline(xintercept = 0, linetype = "dashed", color = "gray")
## 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.

  # Se elimina la línea "+ grid()" que causaba el error

Carga y exploración inicial

Primero, cargamos las librerías que utilizaremos para la manipulación de datos, modelado y visualización.

# Librerías para manipulación de datos y lectura de archivos
library(readr)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tidyr)

# Librerías para visualización
library(ggplot2)
library(pheatmap)

# Librerías para modelado y evaluación
library(caTools) # Para dividir datos en entrenamiento/prueba
library(caret)   # Para la matriz de confusión y métricas
## Loading required package: lattice
library(ROCR)    # Para la curva ROC (no está en el original, pero es útil)
# Cargar los datos desde la URL de GitHub
url <- "https://raw.githubusercontent.com/jazaineam1/Andes_ADDBD/main/Sesion13/Passanger_booking_data.csv"
booking <- read_csv(url)
## Rows: 50002 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (5): sales_channel, trip_type, flight_day, route, booking_origin
## dbl (9): num_passengers, purchase_lead, length_of_stay, flight_hour, wants_e...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Descripción del Conjunto de Datos: Reservas de Vuelos de Clientes

Este conjunto de datos contiene un registro de 50,002 sesiones de reserva de vuelos de clientes a través de una agencia de viajes o aerolínea. Cada fila representa una sesión de búsqueda y selección de un itinerario de vuelo específico, y las 14 columnas describen varios atributos de esa sesión, desde los detalles del viaje hasta las preferencias del cliente y el resultado final de la reserva.

El objetivo principal de este conjunto de datos es, por lo general, predecir si un cliente completará la compra de un vuelo (booking_complete) basándose en las otras características de la sesión.


Contexto y Aplicación

Este conjunto de datos es una versión anonimizada y procesada de datos de clientes de la aerolínea “British Airways”. Es ampliamente utilizado en la comunidad de ciencia de datos para tareas de modelado predictivo, específicamente para problemas de clasificación binaria.

Las empresas del sector de viajes (aerolíneas, agencias online, etc.) utilizan análisis de este tipo para:

  • Optimizar la Tasa de Conversión: Entender qué factores llevan a un cliente a abandonar el proceso de compra y qué factores lo incentivan a completarlo.
  • Marketing Personalizado: Identificar segmentos de clientes y dirigirles ofertas personalizadas.
  • Venta de Servicios Adicionales (Ancillary Revenue): Predecir la probabilidad de que un cliente compre extras como equipaje adicional, asientos preferentes o comidas a bordo, y así optimizar su presentación y precio.
  • Gestión de la Demanda: Analizar patrones en las rutas, días de vuelo y antelación de compra para ajustar la oferta y los precios.

Descripción Detallada de las Columnas

A continuación se detalla cada una de las 14 variables del conjunto de datos:

Nombre de la Columna Tipo de Dato Descripción
num_passengers Numérico (<dbl>) El número de pasajeros incluidos en la reserva.
sales_channel Categórico (<chr>) El canal a través del cual se realizó la reserva (p. ej., “Internet”, “Mobile”).
trip_type Categórico (<chr>) El tipo de viaje reservado (p. ej., “RoundTrip” - Ida y vuelta, “OneWay” - Solo ida).
purchase_lead Numérico (<dbl>) El número de días entre la fecha de la reserva y la fecha de salida del vuelo.
length_of_stay Numérico (<dbl>) La duración total de la estancia en el destino, en días.
flight_hour Numérico (<dbl>) La hora del día (0-23) en la que está programado el vuelo de salida.
flight_day Categórico (<chr>) El día de la semana en que sale el vuelo (p. ej., “Mon”, “Tue”, “Wed”).
route Categórico (<chr>) El código que representa la ruta del vuelo (combinación de aeropuerto de origen y destino).
booking_origin Categórico (<chr>) El país desde donde se originó la sesión de reserva.
wants_extra_baggage Binario (<dbl>) Indica si el cliente seleccionó la opción de equipaje extra (1 = sí, 0 = no).
wants_preferred_seat Binario (<dbl>) Indica si el cliente seleccionó la opción de asiento preferente (1 = sí, 0 = no).
wants_in_flight_meals Binario (<dbl>) Indica si el cliente seleccionó la opción de comidas a bordo (1 = sí, 0 = no).
flight_duration Numérico (<dbl>) La duración total del vuelo en horas.
booking_complete Variable Objetivo (<dbl>) Indica si la reserva fue completada y pagada (1 = sí, 0 = no/abandonada).

A continuación, exploramos la estructura y las primeras filas del conjunto de datos.

# Ver la estructura del dataframe (equivalente a .info())
glimpse(booking)
## Rows: 50,002
## Columns: 14
## $ num_passengers        <dbl> 1, 2, 1, 2, 1, 2, 1, 3, 2, 1, 1, 2, 1, 4, 1, 1, …
## $ sales_channel         <chr> "Internet", "Internet", "Internet", "Internet", …
## $ trip_type             <chr> "RoundTrip", "RoundTrip", "RoundTrip", "RoundTri…
## $ purchase_lead         <dbl> 21, 262, 112, 243, 96, 68, 3, 201, 238, 80, 378,…
## $ length_of_stay        <dbl> 12, 19, 20, 22, 31, 22, 48, 33, 19, 22, 30, 25, …
## $ flight_hour           <dbl> 6, 7, 3, 17, 4, 15, 20, 6, 14, 4, 12, 14, 2, 19,…
## $ flight_day            <chr> "Tue", "Sat", "Sat", "Wed", "Sat", "Wed", "Thu",…
## $ route                 <chr> "AKLHGH", "AKLDEL", "AKLDEL", "AKLDEL", "AKLDEL"…
## $ booking_origin        <chr> "Australia", "New Zealand", "New Zealand", "Indi…
## $ wants_extra_baggage   <dbl> 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, …
## $ wants_preferred_seat  <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, …
## $ wants_in_flight_meals <dbl> 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, …
## $ flight_duration       <dbl> 7.21, 5.52, 5.52, 5.52, 5.52, 5.52, 5.52, 5.52, …
## $ booking_complete      <dbl> 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
# Ver las primeras filas (equivalente a .head())
head(booking)
## # A tibble: 6 × 14
##   num_passengers sales_channel trip_type purchase_lead length_of_stay
##            <dbl> <chr>         <chr>             <dbl>          <dbl>
## 1              1 Internet      RoundTrip            21             12
## 2              2 Internet      RoundTrip           262             19
## 3              1 Internet      RoundTrip           112             20
## 4              2 Internet      RoundTrip           243             22
## 5              1 Internet      RoundTrip            96             31
## 6              2 Internet      RoundTrip            68             22
## # ℹ 9 more variables: flight_hour <dbl>, flight_day <chr>, route <chr>,
## #   booking_origin <chr>, wants_extra_baggage <dbl>,
## #   wants_preferred_seat <dbl>, wants_in_flight_meals <dbl>,
## #   flight_duration <dbl>, booking_complete <dbl>
# Contar valores nulos por columna (equivalente a .isna().sum())
sapply(booking, function(x) sum(is.na(x)))
##        num_passengers         sales_channel             trip_type 
##                     0                     0                     0 
##         purchase_lead        length_of_stay           flight_hour 
##                     0                     0                     0 
##            flight_day                 route        booking_origin 
##                     0                     0                     0 
##   wants_extra_baggage  wants_preferred_seat wants_in_flight_meals 
##                     0                     0                     0 
##       flight_duration      booking_complete 
##                     0                     0
# Ver la distribución de algunas variables categóricas (equivalente a .value_counts())
cat("\nConteo de 'booking_complete':\n")
## 
## Conteo de 'booking_complete':
print(table(booking$booking_complete))
## 
##     0     1 
## 42523  7479
cat("\nConteo de 'sales_channel':\n")
## 
## Conteo de 'sales_channel':
print(table(booking$sales_channel))
## 
## Internet   Mobile 
##    44383     5619
cat("\nConteo de 'trip_type':\n")
## 
## Conteo de 'trip_type':
print(table(booking$trip_type))
## 
## CircleTrip     OneWay  RoundTrip 
##        117        387      49498

Predicción

Vamos a utilizar un modelo lineal y uno logístico para predecir:

  • Si una reserva prefiere comidas en el vuelo

A partir de las características de la reserva:

  • Si indica silla preferida
  • Si desea equipaje extra
  • Longitud de la estadía
# Seleccionamos las columnas numéricas de interés
numeric_vars <- booking %>%
  select(booking_complete, flight_duration, wants_preferred_seat, 
         wants_extra_baggage, length_of_stay, wants_in_flight_meals)

# Calculamos la matriz de correlación
cor_matrix <- cor(numeric_vars)

# Graficamos el heatmap
pheatmap(cor_matrix, display_numbers = TRUE, main = "Matriz de Correlación")

Definimos nuestras variables predictoras (X) y la variable objetivo (y).

# Seleccionamos las variables predictoras y la variable a predecir
X <- booking %>% 
  select(wants_preferred_seat, wants_extra_baggage, length_of_stay)

y <- booking$wants_in_flight_meals

# Mostramos las primeras filas para verificar
cat("Variables predictoras (X):\n")
## Variables predictoras (X):
print(head(X))
## # A tibble: 6 × 3
##   wants_preferred_seat wants_extra_baggage length_of_stay
##                  <dbl>               <dbl>          <dbl>
## 1                    0                   0             12
## 2                    0                   1             19
## 3                    0                   0             20
## 4                    1                   1             22
## 5                    0                   0             31
## 6                    0                   1             22
cat("\nVariable objetivo (y):\n")
## 
## Variable objetivo (y):
print(head(y))
## [1] 0 0 0 0 1 1

Separación de datos

Siempre que queremos hacer predictiva queremos no usar la base de datos completa para calibrar el modelo.

  • Queremos usar una parte (70%) para estimar a partir de los datos.
  • Queremos usar una parte (30%) para evaluar con datos que el modelo nunca ha visto.

Usamos la función sample.split de la librería caTools para crear una división reproducible.

# Fijamos una semilla para reproducibilidad
set.seed(16) 

# Creamos la división de datos
split <- sample.split(y, SplitRatio = 0.7)

# Separamos los dataframes de entrenamiento y prueba
X_train <- subset(X, split == TRUE)
X_test <- subset(X, split == FALSE)
y_train <- subset(y, split == TRUE)
y_test <- subset(y, split == FALSE)

cat("Dimensiones de los datos de entrenamiento (X_train):", dim(X_train), "\n")
## Dimensiones de los datos de entrenamiento (X_train): 35002 3
cat("Dimensiones de los datos de prueba (X_test):", dim(X_test), "\n")
## Dimensiones de los datos de prueba (X_test): 15000 3

Modelo lineal

Ajustamos un modelo de regresión lineal simple para predecir la probabilidad. Combinamos los datos de entrenamiento en un solo dataframe para facilitar el uso de la fórmula en lm().

# Combinamos X_train y y_train para el entrenamiento
train_data_lin <- cbind(X_train, wants_in_flight_meals = y_train)

# Entrenamos el modelo lineal
modeloLin <- lm(wants_in_flight_meals ~ ., data = train_data_lin)

# Hacemos predicciones sobre el conjunto de prueba
y_probabilidades_lin <- predict(modeloLin, newdata = X_test)

# Mostramos las primeras predicciones
cat("Primeras 6 predicciones de 'probabilidad' del modelo lineal:\n")
## Primeras 6 predicciones de 'probabilidad' del modelo lineal:
print(head(y_probabilidades_lin))
##         1         2         3         4         5         6 
## 0.2367585 0.3978658 0.2359032 0.7120262 0.7043285 0.2418902

Graficamos las predicciones del modelo lineal. Observamos que algunas “probabilidades” predichas están por fuera del rango [0, 1].

# Creamos un dataframe para la visualización
plot_data_lin <- data.frame(
  length_of_stay = X_test$length_of_stay,
  wants_preferred_seat = as.factor(X_test$wants_preferred_seat),
  probabilidad = y_probabilidades_lin
)

# Graficamos las predicciones
ggplot(plot_data_lin, aes(x = length_of_stay, y = probabilidad, color = wants_preferred_seat)) +
  geom_point(alpha = 0.5) +
  labs(
    title = 'Predicciones en base de prueba (Lineal)',
    y = 'Probabilidad de solicitar comida',
    x = 'Longitud de la estadía',
    color = 'Quiere silla preferida'
  ) +
  theme_minimal()

Observamos que:

  • Hay cuatro grupos de predicciones (eso corresponde a que los valores esperados dependen de las otras variables dummy: equipaje y preferencia de silla).
  • Pero más aún: ¡Algunas probabilidades son mayores a 1 y otras menores a 0! Esto es un problema conceptual de usar regresión lineal para un problema de probabilidad.

Modelo Logístico

Ahora, ajustamos un modelo de regresión logística, que es el apropiado para este tipo de problema de clasificación binaria. Usamos la función glm con family = "binomial".

# Combinamos X_train y y_train para el entrenamiento
train_data_log <- cbind(X_train, wants_in_flight_meals = y_train)

# Entrenamos el modelo logístico
modeloLog <- glm(wants_in_flight_meals ~ ., data = train_data_log, family = "binomial")

# Hacemos predicciones de probabilidad en el conjunto de prueba
probabilidades <- predict(modeloLog, newdata = X_test, type = "response")

# Mostramos los coeficientes del modelo
cat("Intercepto del modelo logístico:\n")
## Intercepto del modelo logístico:
print(coef(modeloLog))
##          (Intercept) wants_preferred_seat  wants_extra_baggage 
##           -1.2972411            1.3024057            0.7435390 
##       length_of_stay 
##            0.0040692
cat("\nCoeficientes de las variables:\n")
## 
## Coeficientes de las variables:
print(coef(modeloLog)[-1])
## wants_preferred_seat  wants_extra_baggage       length_of_stay 
##            1.3024057            0.7435390            0.0040692
# Mostramos las primeras probabilidades predichas
cat("\nPrimeras 6 predicciones de probabilidad del modelo logístico:\n")
## 
## Primeras 6 predicciones de probabilidad del modelo logístico:
print(head(probabilidades))
##         1         2         3         4         5         6 
## 0.2366570 0.3966559 0.2359226 0.7157912 0.7082823 0.2410959

Graficamos las predicciones del modelo logístico. Ahora todas las probabilidades están correctamente acotadas entre 0 y 1.

# Creamos un dataframe para la visualización
plot_data_log <- data.frame(
  length_of_stay = X_test$length_of_stay,
  wants_preferred_seat = as.factor(X_test$wants_preferred_seat),
  probabilidad = probabilidades
)

# Graficamos las predicciones
ggplot(plot_data_log, aes(x = length_of_stay, y = probabilidad, color = wants_preferred_seat)) +
  geom_point(alpha = 0.5) +
  labs(
    title = 'Predicciones en base de prueba (Logístico)',
    y = 'Probabilidad de solicitar comida',
    x = 'Longitud de la estadía',
    color = 'Quiere silla preferida'
  ) +
  theme_minimal() +
  ylim(0, 1) # Aseguramos que el eje Y vaya de 0 a 1

Vemos que:

  • Las predicciones de la probabilidad ahora son curvas, no lineales, gracias a la función sigmoide.
  • No hay probabilidades por encima de 1 o por debajo de cero.

Clasificación a partir de las probabilidades

Para clasificar predecimos las filas con probabilidad superior a un umbral (generalmente 0.5) como una categoría (1), y las demás como la contraria (0).

Lineal

Convertimos las “probabilidades” del modelo lineal en clases binarias.

# Clasificamos usando un umbral de 0.5
pred_lineales <- ifelse(y_probabilidades_lin > 0.5, 1, 0)

# Contamos las predicciones
cat("Conteo de predicciones (Modelo Lineal):\n")
## Conteo de predicciones (Modelo Lineal):
print(table(pred_lineales))
## pred_lineales
##     0     1 
## 10466  4534

Logístico

Convertimos las probabilidades del modelo logístico en clases binarias. Esto es equivalente a usar predict(..., type = "response") y luego aplicar un umbral, o directamente predict(..., type = "link") y verificar el signo. El método predict con type="response" nos da la probabilidad de la clase “1”.

# Fijamos un umbral de 0.5
umbral <- 0.5

# Convertimos las probabilidades a clases (0 o 1)
y_pred_log_umbral <- ifelse(probabilidades > umbral, 1, 0)

# Contamos las predicciones
cat("Conteo de predicciones (Modelo Logístico con umbral 0.5):\n")
## Conteo de predicciones (Modelo Logístico con umbral 0.5):
print(table(y_pred_log_umbral))
## y_pred_log_umbral
##     0     1 
## 10439  4561

Matrices de confusión

Una matriz de confusión nos permite visualizar el rendimiento de un algoritmo de clasificación. Las filas representan las clases reales y las columnas las clases predichas.

# Creamos la matriz de confusión para el modelo logístico
matriz_log <- table(Observado = y_test, Predicho = y_pred_log_umbral)

cat("Matriz de confusión (Modelo Logístico):\n")
## Matriz de confusión (Modelo Logístico):
print(matriz_log)
##          Predicho
## Observado    0    1
##         0 7052 1541
##         1 3387 3020
# Visualizamos la matriz con un heatmap
pheatmap(matriz_log, display_numbers = TRUE, fmt = 'd', 
         cluster_rows = FALSE, cluster_cols = FALSE,
         main = "Matriz de Confusión (Logístico)")

# Creamos la matriz de confusión para el modelo lineal
matriz_lin <- table(Observado = y_test, Predicho = pred_lineales)

cat("Matriz de confusión (Modelo Lineal):\n")
## Matriz de confusión (Modelo Lineal):
print(matriz_lin)
##          Predicho
## Observado    0    1
##         0 7066 1527
##         1 3400 3007
# Visualizamos la matriz con un heatmap
pheatmap(matriz_lin, display_numbers = TRUE, fmt = 'd', 
         cluster_rows = FALSE, cluster_cols = FALSE,
         main = "Matriz de Confusión (Lineal)")

Métricas

Calculemos el Accuracy, Precision y Recall. * Accuracy: ¿Del total de predicciones cuántas hizo bien? (TP + TN) / Total * Precision: ¿De los que dijo que eran positivos, en cuántos atinó? TP / (TP + FP) * Recall (Sensibilidad): ¿De todos los que eran positivos, cuántos logró atrapar? TP / (TP + FN)

La librería caret nos facilita el cálculo de estas y otras métricas.

# Para usar confusionMatrix, ambas variables deben ser factores con los mismos niveles
y_test_factor <- as.factor(y_test)
y_pred_factor <- as.factor(y_pred_log_umbral)
levels(y_pred_factor) <- levels(y_test_factor) # Aseguramos niveles iguales

# Calculamos las métricas usando caret
metricas <- confusionMatrix(data = y_pred_factor, reference = y_test_factor, positive = "1")

cat("Métricas completas del modelo logístico:\n")
## Métricas completas del modelo logístico:
print(metricas)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 7052 3387
##          1 1541 3020
##                                          
##                Accuracy : 0.6715         
##                  95% CI : (0.6639, 0.679)
##     No Information Rate : 0.5729         
##     P-Value [Acc > NIR] : < 2.2e-16      
##                                          
##                   Kappa : 0.3031         
##                                          
##  Mcnemar's Test P-Value : < 2.2e-16      
##                                          
##             Sensitivity : 0.4714         
##             Specificity : 0.8207         
##          Pos Pred Value : 0.6621         
##          Neg Pred Value : 0.6755         
##              Prevalence : 0.4271         
##          Detection Rate : 0.2013         
##    Detection Prevalence : 0.3041         
##       Balanced Accuracy : 0.6460         
##                                          
##        'Positive' Class : 1              
## 
# Extrayendo métricas individuales
accuracy  <- metricas$overall['Accuracy']
precision <- metricas$byClass['Precision']
recall    <- metricas$byClass['Recall']
f1_score  <- metricas$byClass['F1']

cat(paste("\nAccuracy:", round(accuracy, 4)))
## 
## Accuracy: 0.6715
cat(paste("\nPrecision:", round(precision, 4)))
## 
## Precision: 0.6621
cat(paste("\nRecall:", round(recall, 4)))
## 
## Recall: 0.4714
cat(paste("\nF1-Score:", round(f1_score, 4)))
## 
## F1-Score: 0.5507

Podemos buscar el mejor umbral para optimizar una métrica específica, como el F1-Score.

# Generamos una secuencia de umbrales
umbrales <- seq(0, 1, by = 0.01)
mejor_f1 <- 0
mejor_umbral_f1 <- 0

for (umbral in umbrales) {
  # Clasificamos con el umbral actual
  y_pred_temp <- ifelse(probabilidades > umbral, 1, 0)
  
  # Calculamos F1-Score (necesitamos los verdaderos positivos, falsos positivos, etc.)
  # Para evitar errores con divisiones por cero, lo hacemos manualmente
  TP <- sum(y_pred_temp == 1 & y_test == 1)
  FP <- sum(y_pred_temp == 1 & y_test == 0)
  FN <- sum(y_pred_temp == 0 & y_test == 1)
  
  precision_temp <- ifelse((TP + FP) > 0, TP / (TP + FP), 0)
  recall_temp <- ifelse((TP + FN) > 0, TP / (TP + FN), 0)
  
  f1 <- ifelse((precision_temp + recall_temp) > 0, 2 * (precision_temp * recall_temp) / (precision_temp + recall_temp), 0)
  
  if (f1 > mejor_f1) {
    mejor_f1 <- f1
    mejor_umbral_f1 <- umbral
  }
}

cat(paste("Este es el mejor f1-score:", round(mejor_f1, 4), "\n"))
## Este es el mejor f1-score: 0.6234
cat(paste("Este es el mejor umbral para F1-score:", mejor_umbral_f1, "\n"))
## Este es el mejor umbral para F1-score: 0.37

También podemos buscar el umbral que maximiza la exactitud (Accuracy).

mejor_accuracy <- 0
mejor_umbral_acc <- 0

for (umbral in umbrales) {
  y_pred_temp <- ifelse(probabilidades > umbral, 1, 0)
  accuracy <- sum(y_pred_temp == y_test) / length(y_test)
  
  if (accuracy > mejor_accuracy) {
    mejor_accuracy <- accuracy
    mejor_umbral_acc <- umbral
  }
}

cat(paste("Este es el mejor accuracy:", round(mejor_accuracy, 4), "\n"))
## Este es el mejor accuracy: 0.6803
cat(paste("Este es el mejor umbral para accuracy:", mejor_umbral_acc, "\n"))
## Este es el mejor umbral para accuracy: 0.59

Ejercicio

Objetivo: Vamos a utilizar regresión logística para tratar de predecir si un pasajero del Titanic sobrevivió o no.

Pasos: 1. Cargar el conjunto de datos. 2. Preprocesar los datos (manejar faltantes y categóricas). 3. Entrenar el modelo de regresión logística. 4. Evaluar el rendimiento del modelo usando métricas de clasificación.

# 1. Cargar los datos
# Usamos el paquete `datasets` que ya contiene 'Titanic' pero el del notebook original
# es de seaborn, que es más detallado. Es mejor cargarlo directamente.
titanic_url <- "https://raw.githubusercontent.com/mwaskom/seaborn-data/master/titanic.csv"
titanic <- read_csv(titanic_url)
## Rows: 891 Columns: 15
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): sex, embarked, class, who, deck, embark_town, alive
## dbl (6): survived, pclass, age, sibsp, parch, fare
## lgl (2): adult_male, alone
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Seleccionamos las variables
data <- titanic %>% 
  select(survived, sex, age, fare)

# 2. Preprocesar los datos
# Rellenamos NA en 'age' con la media
data$age[is.na(data$age)] <- mean(data$age, na.rm = TRUE)

# Convertimos 'sex' a factor y luego a numérico (0 y 1)
# R lo hace automáticamente en la fórmula de glm, pero para ser consistentes, lo hacemos manual.
data <- data %>%
  mutate(sex = if_else(sex == "male", 0, 1))

# Verificamos que no haya NAs y la estructura
glimpse(data)
## Rows: 891
## Columns: 4
## $ survived <dbl> 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0…
## $ sex      <dbl> 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0…
## $ age      <dbl> 22.00000, 38.00000, 26.00000, 35.00000, 35.00000, 29.69912, 5…
## $ fare     <dbl> 7.2500, 71.2833, 7.9250, 53.1000, 8.0500, 8.4583, 51.8625, 21…
cat("\nValores nulos después del preprocesamiento:\n")
## 
## Valores nulos después del preprocesamiento:
print(sapply(data, function(x) sum(is.na(x))))
## survived      sex      age     fare 
##        0        0        0        0
# Definimos X e y
X_titanic <- data %>% select(sex, age, fare)
y_titanic <- data$survived

# Dividimos en entrenamiento y prueba
set.seed(16)
split_titanic <- sample.split(y_titanic, SplitRatio = 0.7)
X_train_t <- subset(X_titanic, split_titanic == TRUE)
X_test_t <- subset(X_titanic, split_titanic == FALSE)
y_train_t <- subset(y_titanic, split_titanic == TRUE)
y_test_t <- subset(y_titanic, split_titanic == FALSE)

# Creamos dataframes para el modelo
train_data_t <- cbind(X_train_t, survived = y_train_t)

# 3. Entrenar el modelo
modeloLogTitanic <- glm(survived ~ ., data = train_data_t, family = "binomial")

# 4. Evaluar el rendimiento
# Predecimos clases usando umbral de 0.5
prob_titanic <- predict(modeloLogTitanic, newdata = X_test_t, type = "response")
y_pred_titanic <- ifelse(prob_titanic > 0.5, 1, 0)

# Convertimos a factores para confusionMatrix
y_test_t_factor <- factor(y_test_t, levels = c(0, 1))
y_pred_t_factor <- factor(y_pred_titanic, levels = c(0, 1))

# Mostramos el reporte de clasificación
cat("\nReporte de Clasificación - Titanic:\n")
## 
## Reporte de Clasificación - Titanic:
print(confusionMatrix(y_pred_t_factor, y_test_t_factor, positive = "1"))
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 145  27
##          1  20  76
##                                           
##                Accuracy : 0.8246          
##                  95% CI : (0.7737, 0.8682)
##     No Information Rate : 0.6157          
##     P-Value [Acc > NIR] : 8.934e-14       
##                                           
##                   Kappa : 0.6246          
##                                           
##  Mcnemar's Test P-Value : 0.3815          
##                                           
##             Sensitivity : 0.7379          
##             Specificity : 0.8788          
##          Pos Pred Value : 0.7917          
##          Neg Pred Value : 0.8430          
##              Prevalence : 0.3843          
##          Detection Rate : 0.2836          
##    Detection Prevalence : 0.3582          
##       Balanced Accuracy : 0.8083          
##                                           
##        'Positive' Class : 1               
##