Dirección de Educación Continua.
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
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.
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.
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:
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
Vamos a utilizar un modelo lineal y uno logístico para predecir:
A partir de las características de la reserva:
# 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
Siempre que queremos hacer predictiva queremos no usar la base de datos completa para calibrar el modelo.
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
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:
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:
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).
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
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
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)")
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
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
##