El hundimiento del Titanic en 1912 es uno de los desastres marítimos más conocidos de la historia y ha sido ampliamente estudiado desde diferentes perspectivas sociales y estadísticas. Debido a la limitada cantidad de botes salvavidas y a las condiciones de evacuación, factores como el sexo, la clase social y la composición familiar influyeron significativamente en las probabilidades de supervivencia de los pasajeros. Por esta razón, la base de datos del Titanic se ha convertido en un referente para el estudio de modelos de clasificación y aprendizaje supervisado.
En este trabajo se busca clasificar la supervivencia de los pasajeros
utilizando técnicas de aprendizaje supervisado, específicamente los
modelos K-Nearest Neighbors (KNN) y regresión logística (Logit),
implementadas a través del software RStudio, lo cual permitió el
procesamiento, análisis y visualización de la información. La variable
dependiente seleccionada es Survived, la cual indica si el
pasajero sobrevivió o no al accidente. Como variables explicativas se
utilizan Sex, Pclass_1, Pclass_2,
Family_size y Title_3, variables relacionadas
con características demográficas, sociales y familiares de los
pasajeros.
El objetivo principal es comparar el desempeño de ambos modelos de clasificación mediante métricas como accuracy, sensibilidad y AUC, con el fin de identificar cuál presenta una mejor capacidad predictiva para explicar la supervivencia de los pasajeros del Titanic.
Para el desarrollo del análisis se utilizó la base de datos
Base_Completa_Titanic.csv.
La variable dependiente corresponde a Survived, variable
binaria que indica si el pasajero sobrevivió (“Sí”) o no sobrevivió
(“No”) al hundimiento del Titanic.
Las variables independientes utilizadas fueron:
Inicialmente se realizó un análisis descriptivo de las variables
mediante estadísticas resumen, tablas de frecuencia y gráficos dinámicos
elaborados con ggplot2 y plotly.
Posteriormente, los datos fueron divididos en un conjunto de entrenamiento (75%) y un conjunto de prueba (25%) para evaluar el desempeño predictivo de los modelos.
Se implementaron dos modelos de clasificación:
Para lograr esto, el algoritmo calcula qué tan “lejos” está la nueva observación de cada uno de los datos de entrenamiento, y selecciona los k datos más cercanos. La clase que aparezca con mayor frecuencia entre esos k vecinos es la que se le asigna a la nueva observación. El valor de k determina en gran medida el comportamiento del modelo: si k es muy pequeño, el modelo tiende a ajustarse demasiado a los datos de entrenamiento y falla al generalizar; si k es muy grande, las predicciones se vuelven demasiado generales y pierden precisión. Para encontrar el valor más adecuado de k se utilizó validación cruzada, una técnica que evalúa el modelo sobre distintas particiones de los datos para identificar el que mejor se desempeña.
\[P(Y = 1 \mid X) = \frac{1}{1 + e^{-(\beta_0 + \beta_1 X_1 + \beta_2 X_2 + \cdots + \beta_p X_p)}}\]
\[\log\left(\frac{P}{1-P}\right) = \beta_0 + \beta_1 X_1 + \cdots + \beta_p X_p\]
Finalmente, se comparó el desempeño de ambos modelos utilizando un conjunto de métricas complementarias. El accuracy indica qué proporción de pasajeros fueron clasificados correctamente en términos generales. La sensibilidad mide qué tan bien el modelo identifica a los pasajeros que sí sobrevivieron, mientras que la especificidad evalúa su capacidad para detectar a quienes no lo hicieron. El balanced accuracy promedia ambas y ofrece una visión más equilibrada del desempeño. Por su parte, el AUC resume en un solo valor qué tan bien el modelo distingue entre las dos categorías, donde valores cercanos a uno indican un mejor desempeño. El uso conjunto de estas métricas permite una comparación más completa entre los dos modelos implementados.
A continuación, se presenta un análisis descriptivo de las principales variables utilizadas en los modelos de clasificación.
Inicialmente se analiza la distribución de la variable objetivo
Survived, seguida de la relación entre la supervivencia y
variables explicativas como el sexo, varones jóvenes, ubicación en
primera y segunda clase y el tamaño familiar de los pasajeros.
# ── Librerías ──────────────────────────────────────────────
library(readxl)
library(tidyverse)
library(caret)
library(pROC)
library(kknn)
library(DT)
library(plotly)
library(knitr)
library(kableExtra)
# ── Paleta azul sobria ─────────────────────────────────────
pal_sobrevivio <- "#4e8fc7" # azul medio
pal_no_sobrevivio <- "#1e3a5f" # azul oscuro
pal_acento1 <- "#1e3a5f" # azul oscuro
pal_acento2 <- "#5b9bd5" # azul claro
pal_acento3 <- "#7ab3db" # azul suave
pal_acento4 <- "#2e6da4" # azul intermedio
pal_fondo <- "#f4f7fb" # fondo azul muy pálido
# Función auxiliar para colorear filas manualmente (evita doble rayas)
stripe_rows <- function(kbl, n) {
odds <- seq(1, n, by = 2)
evens <- seq(2, n, by = 2)
kbl <- row_spec(kbl, odds, background = "#eaf3fb")
if (length(evens) > 0)
kbl <- row_spec(kbl, evens, background = "#f4f7fb")
kbl
}
# ── Base de datos ──────────────────────────────────────────
datos <- read.csv("Base_Completa_Titanic.csv")
# ── BASE PARA MODELACIÓN ───────────────────────────────────
datos_modelo <- datos %>%
select(Sex, Pclass_1, Pclass_2, Family_size, Title_3, Survived)
datos_modelo$Survived_f <- factor(
ifelse(datos_modelo$Survived == 1, "Si", "No"),
levels = c("Si", "No")
)
datos_modelo$Survived_num <- datos_modelo$Survived
# ── BASE PARA GRÁFICOS ─────────────────────────────────────
datos_iniciales <- datos_modelo
datos_iniciales$Sex <- factor(datos_iniciales$Sex,
levels = c(0, 1), labels = c("Mujer", "Hombre"))
datos_iniciales$Survived <- factor(datos_iniciales$Survived,
levels = c(0, 1), labels = c("No sobrevivió", "Sobrevivió"))
datos_iniciales$Pclass_1 <- factor(datos_iniciales$Pclass_1,
levels = c(0, 1), labels = c("No pertenece", "Pertenece"))
datos_iniciales$Pclass_2 <- factor(datos_iniciales$Pclass_2,
levels = c(0, 1), labels = c("No pertenece", "Pertenece"))
datos_iniciales$Title_3 <- factor(datos_iniciales$Title_3,
levels = c(0, 1), labels = c("No pertenece", "Pertenece"))
datos_iniciales$Family_size <- factor(
datos_iniciales$Family_size,
levels = c(0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0),
labels = c("Solos", "F.Pequeña", "F.Pequeña", "F.Mediana", "F.Mediana",
"F.Mediana", "F.Grande", "F.Grande", "F.Grande", "F.Grande", "F.Grande")
)
# ── DIVISIÓN ENTRENAMIENTO / PRUEBA ────────────────────────
set.seed(28)
indice_entrena <- createDataPartition(datos_modelo$Survived_f, p = 0.75, list = FALSE)
entrena <- datos_modelo[indice_entrena, ]
prueba <- datos_modelo[-indice_entrena, ]
# ── Variables para modelación (recodificadas) ──────────────
datos_iniciales <- datos_iniciales %>%
mutate(
Survived_f = factor(Survived, levels = c("Sobrevivió", "No sobrevivió"),
labels = c("Si", "No")),
Survived_num = ifelse(Survived_f == "Si", 1, 0)
)
datos_modelo <- datos_iniciales %>%
mutate(
Sex = ifelse(Sex == "Hombre", 1, 0),
Pclass_1 = ifelse(Pclass_1 == "Pertenece", 1, 0),
Pclass_2 = ifelse(Pclass_2 == "Pertenece", 1, 0),
Title_3 = ifelse(Title_3 == "Pertenece", 1, 0)
)
set.seed(28)
indice_entrena <- createDataPartition(datos_modelo$Survived_f, p = 0.75, list = FALSE)
entrena <- datos_modelo[indice_entrena, ]
prueba <- datos_modelo[-indice_entrena, ]contador <- datos_iniciales %>% count(Survived)
grafico_survived <- ggplot(
contador,
aes(x = Survived, y = n, fill = Survived,
text = paste("Cantidad:", n, "<br>Estado:", Survived))
) +
geom_col(width = 0.5, color = "white", linewidth = 0.4) +
scale_fill_manual(values = c(
"No sobrevivió" = pal_no_sobrevivio,
"Sobrevivió" = pal_sobrevivio
)) +
labs(x = "Supervivencia", y = "Cantidad de pasajeros", fill = "Estado") +
theme_minimal(base_family = "serif") +
theme(
legend.position = "none",
panel.grid.major.x = element_blank(),
plot.background = element_rect(fill = pal_fondo, color = NA),
panel.background = element_rect(fill = pal_fondo, color = NA)
)
ggplotly(grafico_survived, tooltip = "text")tab_surv <- data.frame(
Estado = names(table(datos_iniciales$Survived)),
Frecuencia = as.integer(table(datos_iniciales$Survived)),
Proporcion = round(prop.table(table(datos_iniciales$Survived)) * 100, 2)
)
colnames(tab_surv) <- c("Estado", "Frecuencia", "Proporción (%)")
kable(tab_surv, align = "c",
caption = "Distribución de la variable Survived") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(tab_surv))| Estado | Frecuencia | Proporción (%) | NA |
|---|---|---|---|
| No sobrevivió | 550 | No sobrevivió | 61.66 |
| Sobrevivió | 342 | Sobrevivió | 38.34 |
El gráfico anterior confirma que la mayoría de pasajeros no sobrevivieron al hundimiento del Titanic.
contador2 <- datos_iniciales %>% count(Sex, Survived)
grafico_sex <- ggplot(
contador2,
aes(x = Sex, y = n, fill = Survived,
text = paste("Sexo:", Sex, "<br>Estado:", Survived, "<br>Cantidad:", n))
) +
geom_col(position = "dodge", width = 0.55, color = "white", linewidth = 0.3) +
scale_fill_manual(values = c(
"No sobrevivió" = pal_no_sobrevivio,
"Sobrevivió" = pal_sobrevivio
)) +
labs(x = "Sexo", y = "Cantidad", fill = "Estado") +
theme_minimal(base_family = "serif") +
theme(
panel.grid.major.x = element_blank(),
plot.background = element_rect(fill = pal_fondo, color = NA),
panel.background = element_rect(fill = pal_fondo, color = NA)
)
ggplotly(grafico_sex, tooltip = "text")tab_sex_abs <- table(datos_iniciales$Sex, datos_iniciales$Survived)
tab_sex_prop <- prop.table(tab_sex_abs, margin = 1) * 100
tab_sex_df <- data.frame(
Sexo = rownames(tab_sex_abs),
No_Sobrevivio = as.integer(tab_sex_abs[, "No sobrevivió"]),
Sobrevivio = as.integer(tab_sex_abs[, "Sobrevivió"]),
Prop_No_Sobrev = round(tab_sex_prop[, "No sobrevivió"], 2),
Prop_Sobrev = round(tab_sex_prop[, "Sobrevivió"], 2)
)
colnames(tab_sex_df) <- c("Sexo", "No sobrevivió (n)", "Sobrevivió (n)",
"No sobrevivió (%)", "Sobrevivió (%)")
kable(tab_sex_df, align = "c",
caption = "Supervivencia según Sexo") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(tab_sex_df))| Sexo | No sobrevivió (n) | Sobrevivió (n) | No sobrevivió (%) | Sobrevivió (%) | |
|---|---|---|---|---|---|
| Mujer | Mujer | 81 | 233 | 25.80 | 74.20 |
| Hombre | Hombre | 469 | 109 | 81.14 | 18.86 |
Los resultados muestran diferencias importantes en las tasas de supervivencia según el sexo de los pasajeros. Las mujeres presentaron una proporción de supervivencia considerablemente mayor que los hombres, lo cual coincide con las políticas de evacuación implementadas durante el accidente del Titanic.
contador3 <- datos_iniciales %>% count(Pclass_1, Survived)
grafico_1class <- ggplot(
contador3,
aes(x = Pclass_1, y = n, fill = Survived,
text = paste("<br>Cantidad:", n, "<br>Estado:", Survived))
) +
geom_col(position = "dodge", width = 0.55, color = "white", linewidth = 0.3) +
scale_fill_manual(values = c(
"Sobrevivió" = pal_acento2,
"No sobrevivió" = pal_acento1
)) +
labs(x = "Primera clase", y = "Cantidad", fill = "Estado") +
theme_minimal(base_family = "serif") +
theme(
panel.grid.major.x = element_blank(),
plot.background = element_rect(fill = pal_fondo, color = NA),
panel.background = element_rect(fill = pal_fondo, color = NA)
)
ggplotly(grafico_1class, tooltip = "text")tab_p1_abs <- table(datos_iniciales$Pclass_1, datos_iniciales$Survived)
tab_p1_prop <- prop.table(tab_p1_abs, margin = 1) * 100
tab_p1_df <- data.frame(
Primera_Clase = rownames(tab_p1_abs),
No_Sobrevivio = as.integer(tab_p1_abs[, "No sobrevivió"]),
Sobrevivio = as.integer(tab_p1_abs[, "Sobrevivió"]),
Prop_No_Sobrev = round(tab_p1_prop[, "No sobrevivió"], 2),
Prop_Sobrev = round(tab_p1_prop[, "Sobrevivió"], 2)
)
colnames(tab_p1_df) <- c("Primera Clase", "No sobrevivió (n)", "Sobrevivió (n)",
"No sobrevivió (%)", "Sobrevivió (%)")
kable(tab_p1_df, align = "c",
caption = "Supervivencia según Primera Clase") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(tab_p1_df))| Primera Clase | No sobrevivió (n) | Sobrevivió (n) | No sobrevivió (%) | Sobrevivió (%) | |
|---|---|---|---|---|---|
| No pertenece | No pertenece | 470 | 206 | 69.53 | 30.47 |
| Pertenece | Pertenece | 80 | 136 | 37.04 | 62.96 |
contador4 <- datos_iniciales %>% count(Pclass_2, Survived)
grafico_2class <- ggplot(
contador4,
aes(x = Pclass_2, y = n, fill = Survived,
text = paste("<br>Cantidad:", n, "<br>Estado:", Survived))
) +
geom_col(position = "dodge", width = 0.55, color = "white", linewidth = 0.3) +
scale_fill_manual(values = c(
"Sobrevivió" = pal_acento2,
"No sobrevivió" = pal_acento1
)) +
labs(x = "Segunda clase", y = "Cantidad", fill = "Estado") +
theme_minimal(base_family = "serif") +
theme(
panel.grid.major.x = element_blank(),
plot.background = element_rect(fill = pal_fondo, color = NA),
panel.background = element_rect(fill = pal_fondo, color = NA)
)
ggplotly(grafico_2class, tooltip = "text")tab_p2_abs <- table(datos_iniciales$Pclass_2, datos_iniciales$Survived)
tab_p2_prop <- prop.table(tab_p2_abs, margin = 1) * 100
tab_p2_df <- data.frame(
Segunda_Clase = rownames(tab_p2_abs),
No_Sobrevivio = as.integer(tab_p2_abs[, "No sobrevivió"]),
Sobrevivio = as.integer(tab_p2_abs[, "Sobrevivió"]),
Prop_No_Sobrev = round(tab_p2_prop[, "No sobrevivió"], 2),
Prop_Sobrev = round(tab_p2_prop[, "Sobrevivió"], 2)
)
colnames(tab_p2_df) <- c("Segunda Clase", "No sobrevivió (n)", "Sobrevivió (n)",
"No sobrevivió (%)", "Sobrevivió (%)")
kable(tab_p2_df, align = "c",
caption = "Supervivencia según Segunda Clase") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(tab_p2_df))| Segunda Clase | No sobrevivió (n) | Sobrevivió (n) | No sobrevivió (%) | Sobrevivió (%) | |
|---|---|---|---|---|---|
| No pertenece | No pertenece | 452 | 255 | 63.93 | 36.07 |
| Pertenece | Pertenece | 98 | 87 | 52.97 | 47.03 |
Los gráficos muestran que los pasajeros pertenecientes a clases sociales más altas tuvieron mayores probabilidades de supervivencia, especialmente aquellos que viajaban en primera clase.
contador_fam <- datos_iniciales %>% count(Family_size, Survived)
grafico_family <- ggplot(
contador_fam,
aes(x = Family_size, y = n, fill = Survived,
text = paste("<br>Cantidad:", n, "<br>Estado:", Survived))
) +
geom_col(position = "dodge", width = 0.6, color = "white", linewidth = 0.3) +
scale_fill_manual(values = c(
"Sobrevivió" = pal_acento2,
"No sobrevivió" = pal_acento1
)) +
labs(x = "Tamaño familiar", y = "Cantidad", fill = "Estado") +
theme_minimal(base_family = "serif") +
theme(
panel.grid.major.x = element_blank(),
plot.background = element_rect(fill = pal_fondo, color = NA),
panel.background = element_rect(fill = pal_fondo, color = NA)
)
ggplotly(grafico_family, tooltip = "text")tab_fam_abs <- table(datos_iniciales$Family_size, datos_iniciales$Survived)
tab_fam_prop <- prop.table(tab_fam_abs, margin = 1) * 100
tab_fam_df <- data.frame(
Tamano_Familiar = rownames(tab_fam_abs),
No_Sobrevivio = as.integer(tab_fam_abs[, "No sobrevivió"]),
Sobrevivio = as.integer(tab_fam_abs[, "Sobrevivió"]),
Prop_No_Sobrev = round(tab_fam_prop[, "No sobrevivió"], 2),
Prop_Sobrev = round(tab_fam_prop[, "Sobrevivió"], 2)
)
colnames(tab_fam_df) <- c("Tamaño Familiar", "No sobrevivió (n)", "Sobrevivió (n)",
"No sobrevivió (%)", "Sobrevivió (%)")
kable(tab_fam_df, align = "c",
caption = "Supervivencia según Tamaño Familiar") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(tab_fam_df))| Tamaño Familiar | No sobrevivió (n) | Sobrevivió (n) | No sobrevivió (%) | Sobrevivió (%) | |
|---|---|---|---|---|---|
| Solos | Solos | 375 | 163 | 69.70 | 30.30 |
| F.Pequeña | F.Pequeña | 115 | 148 | 43.73 | 56.27 |
| F.Mediana | F.Mediana | 39 | 27 | 59.09 | 40.91 |
| F.Grande | F.Grande | 21 | 4 | 84.00 | 16.00 |
Se observa que la mayoría de los pasajeros viajaban solos, representando un alto volumen de pérdidas. También, las familias pequeñas mostraron una mayor ventaja de supervivencia en comparación con las familias numerosas, las cuales fueron el grupo más vulnerable proporcionalmente.
contador5 <- datos_iniciales %>% count(Title_3, Survived)
grafico_title3 <- ggplot(
contador5,
aes(x = Title_3, y = n, fill = Survived,
text = paste("<br>Cantidad:", n, "<br>Estado:", Survived))
) +
geom_col(position = "dodge", width = 0.55, color = "white", linewidth = 0.3) +
scale_fill_manual(values = c(
"Sobrevivió" = pal_acento3,
"No sobrevivió" = pal_acento1
)) +
labs(x = "Niños/adolescentes varones", y = "Cantidad", fill = "Estado") +
theme_minimal(base_family = "serif") +
theme(
panel.grid.major.x = element_blank(),
plot.background = element_rect(fill = pal_fondo, color = NA),
panel.background = element_rect(fill = pal_fondo, color = NA)
)
ggplotly(grafico_title3, tooltip = "text")tab_t3_abs <- table(datos_iniciales$Title_3, datos_iniciales$Survived)
tab_t3_prop <- prop.table(tab_t3_abs, margin = 1) * 100
tab_t3_df <- data.frame(
Grupo = rownames(tab_t3_abs),
No_Sobrevivio = as.integer(tab_t3_abs[, "No sobrevivió"]),
Sobrevivio = as.integer(tab_t3_abs[, "Sobrevivió"]),
Prop_No_Sobrev = round(tab_t3_prop[, "No sobrevivió"], 2),
Prop_Sobrev = round(tab_t3_prop[, "Sobrevivió"], 2)
)
colnames(tab_t3_df) <- c("Grupo (Title_3)", "No sobrevivió (n)", "Sobrevivió (n)",
"No sobrevivió (%)", "Sobrevivió (%)")
kable(tab_t3_df, align = "c",
caption = "Supervivencia según Niños/Adolescentes Varones (Title_3)") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(tab_t3_df))| Grupo (Title_3) | No sobrevivió (n) | Sobrevivió (n) | No sobrevivió (%) | Sobrevivió (%) | |
|---|---|---|---|---|---|
| No pertenece | No pertenece | 533 | 319 | 62.56 | 37.44 |
| Pertenece | Pertenece | 17 | 23 | 42.50 | 57.50 |
A partir de la gráfica se puede observar que la mayoría de los varones del conjunto de datos no eran niños/adolescentes. Sin embargo, entre niños/adolescentes varones se aprecia una proporción relativamente mayor de supervivencia frente a los que no sobrevivieron.
El modelo KNN fue implementado con el objetivo de clasificar la supervivencia de los pasajeros utilizando características demográficas y sociales. Este algoritmo clasifica las observaciones según la categoría predominante entre los vecinos más cercanos utilizando medidas de distancia.
En esta etapa se seleccionaron las variables utilizadas en el modelo KNN y se construyeron las bases de entrenamiento y prueba para el proceso de clasificación.
Para seleccionar el mejor número de vecinos (k) se
utilizó validación cruzada de 10 folds, evaluando valores de
k entre 1 y 25.
control_knn <- trainControl(
method = "cv", number = 10,
classProbs = TRUE, savePredictions = "final"
)
set.seed(28)
modelo_knn <- train(
Survived_f ~ .,
data = entrena_knn,
method = "knn",
trControl = control_knn,
preProcess = c("center", "scale"),
tuneGrid = data.frame(k = 1:25),
metric = "Accuracy"
)knn_res <- modelo_knn$results %>%
select(k, Accuracy, Kappa) %>%
mutate(Accuracy = round(Accuracy, 4),
Kappa = round(Kappa, 4))
datatable(
knn_res,
caption = "Resultados de validación cruzada — Modelo KNN (k = 1 a 25)",
options = list(pageLength = 10, scrollX = TRUE),
rownames = FALSE
) %>%
formatStyle("Accuracy",
background = styleColorBar(range(knn_res$Accuracy), "#5b9bd5"),
backgroundSize = "98% 88%",
backgroundRepeat = "no-repeat",
backgroundPosition = "center"
)Los resultados muestran que el mejor desempeño del modelo se obtuvo
con un valor de k = 4, alcanzando un accuracy aproximado de
83% durante el proceso de validación cruzada.
knn_plot_data <- modelo_knn$results
p_knn <- ggplot(knn_plot_data, aes(x = k, y = Accuracy)) +
geom_line(color = pal_acento4, linewidth = 0.9) +
geom_point(color = pal_acento1, size = 2.5) +
geom_vline(xintercept = modelo_knn$bestTune$k,
linetype = "dashed", color = pal_acento2, linewidth = 0.8) +
labs(title = "Accuracy vs. Número de Vecinos (k)",
x = "Número de vecinos (k)",
y = "Accuracy (Validación Cruzada)") +
theme_minimal(base_family = "serif") +
theme(
plot.title = element_text(face = "bold", size = 13),
plot.background = element_rect(fill = pal_fondo, color = NA),
panel.background = element_rect(fill = pal_fondo, color = NA)
)
ggplotly(p_knn)El gráfico muestra que el modelo alcanza su mejor desempeño alrededor
de k = 4, evidenciando un equilibrio adecuado entre
capacidad predictiva y generalización.
pred_knn_clase <- predict(modelo_knn, newdata = prueba_knn)
pred_knn_prob <- predict(modelo_knn, newdata = prueba_knn, type = "prob")
prob_head <- round(head(pred_knn_prob), 4)
kable(prob_head, align = "c",
caption = "Primeras probabilidades predichas — Modelo KNN") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(prob_head))| Si | No |
|---|---|
| 1.0000 | 0.0000 |
| 0.1327 | 0.8673 |
| 0.4500 | 0.5500 |
| 0.0000 | 1.0000 |
| 0.1186 | 0.8814 |
| 0.6667 | 0.3333 |
cm_knn <- confusionMatrix(pred_knn_clase, prueba_knn$Survived_f, positive = "Si")
cm_knn_tabla <- as.data.frame(cm_knn$table)
colnames(cm_knn_tabla) <- c("Predicho", "Real", "Frecuencia")
kable(cm_knn_tabla, align = "c",
caption = "Matriz de Confusión — Modelo KNN") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(cm_knn_tabla))| Predicho | Real | Frecuencia |
|---|---|---|
| Si | Si | 53 |
| No | Si | 32 |
| Si | No | 9 |
| No | No | 128 |
metricas_knn <- data.frame(
Metrica = c("Accuracy", "Sensibilidad", "Especificidad",
"Balanced Accuracy", "Kappa"),
Valor = round(c(
cm_knn$overall["Accuracy"],
cm_knn$byClass["Sensitivity"],
cm_knn$byClass["Specificity"],
cm_knn$byClass["Balanced Accuracy"],
cm_knn$overall["Kappa"]
), 4)
)
kable(metricas_knn, align = "c",
caption = "Métricas de desempeño — Modelo KNN") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(metricas_knn))| Metrica | Valor | |
|---|---|---|
| Accuracy | Accuracy | 0.8153 |
| Sensitivity | Sensibilidad | 0.6235 |
| Specificity | Especificidad | 0.9343 |
| Balanced Accuracy | Balanced Accuracy | 0.7789 |
| Kappa | Kappa | 0.5880 |
El modelo KNN obtuvo un accuracy aproximado de 82%, mostrando un buen desempeño general en la clasificación de los pasajeros.
La sensibilidad del modelo fue cercana al 63.5%, indicando una capacidad moderada para identificar correctamente los pasajeros sobrevivientes.
La especificidad alcanzó aproximadamente 93.4%, mostrando una excelente capacidad para detectar correctamente los pasajeros que no sobrevivieron.
roc_knn <- roc(
response = prueba_knn$Survived_f,
predictor = pred_knn_prob$Si,
levels = c("No", "Si")
)
roc_knn_df <- data.frame(
Especificidad = 1 - roc_knn$specificities,
Sensibilidad = roc_knn$sensitivities
)
p_roc_knn <- ggplot(roc_knn_df, aes(x = Especificidad, y = Sensibilidad)) +
geom_line(color = pal_acento4, linewidth = 1.1) +
geom_abline(linetype = "dashed", color = pal_acento3, linewidth = 0.7) +
annotate("text", x = 0.7, y = 0.2,
label = paste0("AUC = ", round(auc(roc_knn), 4)),
color = pal_acento1, size = 4.5, family = "serif", fontface = "bold") +
labs(title = "Curva ROC — Modelo KNN",
x = "1 - Especificidad", y = "Sensibilidad") +
theme_minimal(base_family = "serif") +
theme(
plot.title = element_text(face = "bold", size = 13),
plot.background = element_rect(fill = pal_fondo, color = NA),
panel.background = element_rect(fill = pal_fondo, color = NA)
)
ggplotly(p_roc_knn)auc_knn_df <- data.frame(Modelo = "KNN", AUC = round(as.numeric(auc(roc_knn)), 4))
kable(auc_knn_df, align = "c", caption = "AUC — Modelo KNN") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
row_spec(1, background = "#eaf3fb")| Modelo | AUC |
|---|---|
| KNN | 0.8706 |
El modelo KNN obtuvo un AUC cercano a 0.889, indicando una excelente capacidad discriminativa.
La regresión logística es un modelo probabilístico utilizado para problemas de clasificación binaria. En este caso, se implementó para estimar la probabilidad de supervivencia de los pasajeros del Titanic.
Para el modelo Logit se construyeron las bases de entrenamiento y prueba utilizando la variable objetivo numérica y las variables explicativas seleccionadas.
modelo_logit <- glm(
Survived_num ~ Sex + Pclass_1 + Pclass_2 + Family_size + Title_3,
data = entrena_logit,
family = binomial(link = "logit")
)coef_logit <- as.data.frame(summary(modelo_logit)$coefficients)
coef_logit$Variable <- rownames(coef_logit)
rownames(coef_logit) <- NULL
coef_logit <- coef_logit[, c("Variable", "Estimate", "Std. Error", "z value", "Pr(>|z|)")]
colnames(coef_logit) <- c("Variable", "Estimado", "Error Estándar",
"Estadístico z", "p-valor")
coef_logit[, 2:5] <- round(coef_logit[, 2:5], 4)
sig_rows <- which(coef_logit$`p-valor` < 0.05)
kable(coef_logit, align = "c",
caption = "Coeficientes del Modelo de Regresión Logística") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(coef_logit)) %>%
row_spec(sig_rows, bold = TRUE)| Variable | Estimado | Error Estándar | Estadístico z | p-valor |
|---|---|---|---|---|
| (Intercept) | 0.9620 | 0.2420 | 3.9745 | 0.0001 |
| Sex | -3.3104 | 0.2651 | -12.4881 | 0.0000 |
| Pclass_1 | 2.0894 | 0.2749 | 7.6012 | 0.0000 |
| Pclass_2 | 0.9480 | 0.2701 | 3.5105 | 0.0004 |
| Family_sizeF.Pequeña | -0.4663 | 0.2588 | -1.8016 | 0.0716 |
| Family_sizeF.Mediana | -1.6980 | 0.4283 | -3.9641 | 0.0001 |
| Family_sizeF.Grande | -3.0311 | 0.8103 | -3.7406 | 0.0002 |
| Title_3 | 3.5920 | 0.5178 | 6.9370 | 0.0000 |
Todas las variables incluidas en el modelo fueron estadísticamente
significativas (p < 0.05), indicando que aportan
información relevante para explicar la supervivencia de los
pasajeros.
La variable Sex presentó un efecto negativo importante,
indicando menores probabilidades de supervivencia para el grupo
masculino.
Por otro lado, pertenecer a primera o segunda clase incrementó significativamente las probabilidades de supervivencia.
Asimismo, el tamaño familiar presentó una relación negativa con la
supervivencia, mientras que Title_3 mostró un efecto
positivo importante.
pred_logit_prob <- predict(modelo_logit, newdata = prueba_logit, type = "response")
pred_logit_clase <- factor(
ifelse(pred_logit_prob > 0.5, "Si", "No"),
levels = c("Si", "No")
)
pred_head <- data.frame(
Observacion = 1:6,
Probabilidad_Supervivencia = round(head(pred_logit_prob), 4),
Clase_Predicha = head(as.character(pred_logit_clase))
)
kable(pred_head, align = "c",
caption = "Primeras probabilidades predichas — Modelo Logit") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(pred_head))| Observacion | Probabilidad_Supervivencia | Clase_Predicha | |
|---|---|---|---|
| 2 | 1 | 0.9299 | Si |
| 5 | 2 | 0.0872 | No |
| 11 | 3 | 0.6214 | Si |
| 14 | 4 | 0.0046 | No |
| 21 | 5 | 0.1978 | No |
| 23 | 6 | 0.7235 | Si |
cm_logit <- confusionMatrix(pred_logit_clase, prueba_knn$Survived_f, positive = "Si")
cm_logit_tabla <- as.data.frame(cm_logit$table)
colnames(cm_logit_tabla) <- c("Predicho", "Real", "Frecuencia")
kable(cm_logit_tabla, align = "c",
caption = "Matriz de Confusión — Modelo Logit") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(cm_logit_tabla))| Predicho | Real | Frecuencia |
|---|---|---|
| Si | Si | 62 |
| No | Si | 23 |
| Si | No | 11 |
| No | No | 126 |
metricas_logit <- data.frame(
Metrica = c("Accuracy", "Sensibilidad", "Especificidad",
"Balanced Accuracy", "Kappa"),
Valor = round(c(
cm_logit$overall["Accuracy"],
cm_logit$byClass["Sensitivity"],
cm_logit$byClass["Specificity"],
cm_logit$byClass["Balanced Accuracy"],
cm_logit$overall["Kappa"]
), 4)
)
kable(metricas_logit, align = "c",
caption = "Métricas de desempeño — Modelo Logit") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(metricas_logit))| Metrica | Valor | |
|---|---|---|
| Accuracy | Accuracy | 0.8468 |
| Sensitivity | Sensibilidad | 0.7294 |
| Specificity | Especificidad | 0.9197 |
| Balanced Accuracy | Balanced Accuracy | 0.8246 |
| Kappa | Kappa | 0.6670 |
El modelo Logit obtuvo un accuracy aproximado de 84.7%, superando ligeramente el desempeño general del modelo KNN.
La sensibilidad alcanzó aproximadamente 72.9%, indicando una mejor capacidad para identificar correctamente pasajeros sobrevivientes.
La especificidad fue cercana al 92%, mostrando también una excelente capacidad para identificar pasajeros no sobrevivientes.
roc_logit <- roc(
response = prueba_knn$Survived_f,
predictor = pred_logit_prob,
levels = c("No", "Si")
)
roc_logit_df <- data.frame(
Especificidad = 1 - roc_logit$specificities,
Sensibilidad = roc_logit$sensitivities
)
p_roc_logit <- ggplot(roc_logit_df, aes(x = Especificidad, y = Sensibilidad)) +
geom_line(color = pal_acento2, linewidth = 1.1) +
geom_abline(linetype = "dashed", color = pal_acento3, linewidth = 0.7) +
annotate("text", x = 0.7, y = 0.2,
label = paste0("AUC = ", round(auc(roc_logit), 4)),
color = pal_acento1, size = 4.5, family = "serif", fontface = "bold") +
labs(title = "Curva ROC — Modelo Logit",
x = "1 - Especificidad", y = "Sensibilidad") +
theme_minimal(base_family = "serif") +
theme(
plot.title = element_text(face = "bold", size = 13),
plot.background = element_rect(fill = pal_fondo, color = NA),
panel.background = element_rect(fill = pal_fondo, color = NA)
)
ggplotly(p_roc_logit)auc_logit_df <- data.frame(Modelo = "Logit", AUC = round(as.numeric(auc(roc_logit)), 4))
kable(auc_logit_df, align = "c", caption = "AUC — Modelo Logit") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
row_spec(1, background = "#eaf3fb")| Modelo | AUC |
|---|---|
| Logit | 0.8764 |
El modelo Logit obtuvo un AUC aproximado de 0.879, indicando una excelente capacidad discriminativa.
Con el fin de evaluar el desempeño de los modelos de clasificación implementados, se compararon diferentes métricas de evaluación.
comparacion_modelos <- data.frame(
Metrica = c("Accuracy", "Sensibilidad", "Especificidad",
"Balanced Accuracy", "AUC", "Kappa"),
KNN = c(0.8198, 0.6353, 0.9343, 0.7848, 0.8890, 0.5990),
LOGIT = c(0.8468, 0.7294, 0.9197, 0.8246, 0.8785, 0.6670)
)
kable(comparacion_modelos, align = "c",
caption = "Comparación de métricas — KNN vs. Regresión Logística") %>%
kable_styling(bootstrap_options = c("hover", "condensed"),
full_width = FALSE, position = "center") %>%
row_spec(0, background = "#1e3a5f", color = "white", bold = TRUE) %>%
stripe_rows(nrow(comparacion_modelos))| Metrica | KNN | LOGIT |
|---|---|---|
| Accuracy | 0.8198 | 0.8468 |
| Sensibilidad | 0.6353 | 0.7294 |
| Especificidad | 0.9343 | 0.9197 |
| Balanced Accuracy | 0.7848 | 0.8246 |
| AUC | 0.8890 | 0.8785 |
| Kappa | 0.5990 | 0.6670 |
comp_long <- comparacion_modelos %>%
pivot_longer(cols = c(KNN, LOGIT), names_to = "Modelo", values_to = "Valor")
p_comp <- ggplot(comp_long,
aes(x = Metrica, y = Valor, fill = Modelo,
text = paste("Modelo:", Modelo, "<br>Métrica:", Metrica, "<br>Valor:", Valor))
) +
geom_col(position = "dodge", width = 0.6, color = "white", linewidth = 0.3) +
scale_fill_manual(values = c("KNN" = pal_acento1, "LOGIT" = pal_acento2)) +
coord_flip() +
labs(x = NULL, y = "Valor", fill = "Modelo",
title = "Comparación de métricas — KNN vs. Logit") +
theme_minimal(base_family = "serif") +
theme(
plot.title = element_text(face = "bold", size = 13),
plot.background = element_rect(fill = pal_fondo, color = NA),
panel.background = element_rect(fill = pal_fondo, color = NA)
)
ggplotly(p_comp, tooltip = "text")Los resultados muestran que ambos modelos presentan un desempeño bastante sólido para clasificar la supervivencia de los pasajeros.
El modelo KNN obtuvo un AUC ligeramente superior, indicando una capacidad discriminativa marginalmente mejor.
Sin embargo, el modelo Logit presentó mejores resultados en accuracy, sensibilidad, balanced accuracy y Kappa, mostrando una mayor capacidad general de clasificación y una mejor identificación de pasajeros sobrevivientes.
En este trabajo se aplicaron modelos de aprendizaje supervisado para analizar la supervivencia de los pasajeros del Titanic a partir de variables demográficas y sociales.
Los resultados permitieron identificar que factores como el sexo, la clase social, el tamaño familiar y la pertenencia al grupo de niños/adolescentes varones influyeron de manera importante en las probabilidades de supervivencia. En particular, las mujeres y los pasajeros de clases más altas presentaron mayores probabilidades de sobrevivir.
El modelo KNN mostró un buen desempeño general y una alta capacidad para identificar correctamente a los pasajeros que no sobrevivieron. Además, presentó un valor de AUC ligeramente superior, lo que indica una muy buena capacidad discriminativa.
Sin embargo, el modelo de regresión logística obtuvo mejores resultados en métricas como accuracy, sensibilidad, balanced accuracy y Kappa, mostrando un desempeño más equilibrado y una mejor capacidad para identificar pasajeros sobrevivientes.
En general, ambos modelos permitieron obtener clasificaciones bastante precisas y cumplieron adecuadamente con el objetivo planteado en el trabajo. Además, este análisis permitió fortalecer el uso de herramientas de modelación y clasificación en RStudio mediante técnicas de aprendizaje supervisado.
Hastie, T., Tibshirani, R., & Friedman, J. (2009). The Elements of Statistical Learning. Springer.
James, G., Witten, D., Hastie, T., & Tibshirani, R. (2021). An Introduction to Statistical Learning. Springer.
Kaggle. (2024). Titanic Dataset. Recuperado de: https://www.kaggle.com/
R Core Team. (2024). R: A Language and Environment for Statistical Computing. Vienna, Austria.