Objetivos del trabajo

El 15 de abril de 1912, durante su viaje inaugural, el transatlántico británico RMS Titanic se hundió después de chocar con un iceberg. Desafortunadamente, no había suficientes botes salvavidas para todos a bordo, lo que resultó en la muerte de 1502 de 2224 pasajeros y tripulantes.

Si bien hubo algún elemento de suerte involucrado en la supervivencia, parece que algunos grupos de personas tenían más probabilidades de sobrevivir que otros.

En este trabajo deberán crear un modelo de regresión logística para clasificar si una persona que viajaba a bordo del Titanic sobrevivió o no.

# Cargo los paquetes a utilizar:

library(readr)
library(readxl)
library(tidyverse)
library(broom)
library(ISLR)
library(GGally)
library(modelr)
library(pROC)
library(cowplot)
library(OneR)
library(rlang)
library(caret)
library(kableExtra)
library(knitr)
library(ggplot2)
library(gridExtra)
library(gtable)
library(grid)
set.seed(12345)

Conjunto de datos

El dataset original se puede encontrar aquí. Algunos faltantes ya se han imputado para ciertas variables y solamente trabajaré con las siguientes variables:

# Creo una tabla con la descripción de las variables

tabladatos <- read_excel("./Datos.xlsx")

kable(tabladatos) %>%
  kable_styling(bootstrap_options = c("striped", "hover"))
Variable Definición Key
PassegerId Número de identificación de pasajero NA
Survived Sobrevivió o no 0 = No, 1 = Si
Pclass Tipod e clase del boleto 1 = 1era, 2 = 2da, 3 = 3ra
Sex Sexo NA
Age Edad en años NA
SibSp # hermanos / conyugue a bordo del Titanic NA
Parch # padres / hijos a bordo del Titanic NA
fare Tarifa del pasajero NA
embarked Puerto de embarcación C = Cherbourg, Q = Queenstown, S = Southampton 
# Como primer paso, cargo el dataset y transformo a factor las variables correspondientes

ttrain <- read_csv("./titanic_complete_train.csv")
ttrain <- ttrain[,c("PassengerId","Survived", "Pclass", "Sex", "Age", "SibSp", "Parch", "Fare", "Embarked")]
ttrain$Survived <- as.factor(ttrain$Survived)
ttrain$Pclass <- as.factor(ttrain$Pclass)
ttrain$Embarked <- as.factor(ttrain$Embarked)
ttrain$Sex <- as.factor(ttrain$Sex)

# Muestro un resumen de los datos

summary(ttrain)
##   PassengerId    Survived Pclass      Sex           Age            SibSp      
##  Min.   :  1.0   0:549    1:216   female:314   Min.   : 0.42   Min.   :0.000  
##  1st Qu.:223.5   1:342    2:184   male  :577   1st Qu.:21.75   1st Qu.:0.000  
##  Median :446.0            3:491                Median :26.51   Median :0.000  
##  Mean   :446.0                                 Mean   :29.32   Mean   :0.523  
##  3rd Qu.:668.5                                 3rd Qu.:36.00   3rd Qu.:1.000  
##  Max.   :891.0                                 Max.   :80.00   Max.   :8.000  
##      Parch             Fare        Embarked  
##  Min.   :0.0000   Min.   :  0.00   C   :168  
##  1st Qu.:0.0000   1st Qu.:  7.91   Q   : 77  
##  Median :0.0000   Median : 14.45   S   :644  
##  Mean   :0.3816   Mean   : 32.20   NA's:  2  
##  3rd Qu.:0.0000   3rd Qu.: 31.00             
##  Max.   :6.0000   Max.   :512.33

Del resumen de los datos se puede observar que la clase Survived se encuentra desbalanceada, hay 549 personas que no sobrevivieron y 342 que si lo hicieron. También se puede observar que hay más del doble de personas en tercera clase que en primera y y un poco más de tres veces que de segunda clase. La mayoría de la gente embarcó en el puerto de Cherbourg y más de la mitad no viajaban con familiares (hijos, esposos o padres). Como última observación, el promedio de la tarifa de los pasajeros es 32.20 pero hay gente que pagó hasta 512.23 y hubo gente que viajó gratis.

# Realizo un gráfico exploratorio completo para ver el comportamiento y las relaciones entre las variables. El color rojo designa a quienes no defaultean y el azul a los que sí. 

ggpairs(ttrain,mapping = aes(colour= Survived)) + theme(axis.text.x = element_text(angle = 90, hjust = 1)) + theme_bw()

  • El color celeste representa a las personas que sobrevivieron y el rosa a las que no, el gráfico de Survived muestra que hay más de gente que no sobrevivió que la que si lo hizo.
  • La variable Sex muestra que hay una proporción mayor de sobrevivientes en las mujeres que en los hombres y que hay una gran cantidad de gente de la tercera clase que no sobrevivieron.
  • La edad promedio es 29 años y correlación positiva con la tarifa pagada pero negativa con cantidad de hermanos o pareja y con cantidad de padres o hijos a bordo del Titanic.
  • La mayoría de las personas que embarcaron lo hicieron en la costa de Southampton.

Para entrenar el modelo y validarlo se utilizan diferentes datasets, el de entrenamiento y el de validación. Como quiero que las clases me queden balanceadas, utilizo la función createDataPartition del paquete caret.

# Realizo una partición entre dataset de entrenamiento (70%) y testeo (30%) usando la función `createDataPartition` del paquete *caret*, con el mismo me aseguro la misma proporción de casos positivos y negativos en los dataset de entrenamiento y validación. 

trainIndex <- createDataPartition(ttrain$Survived, p = .7, 
                                  list = FALSE, 
                                  times = 1)

tentrenamiento <- ttrain[ trainIndex,]  %>% as_tibble()
tvalidacion  <- ttrain[-trainIndex,] %>% as_tibble()
# Chequeo la distribución de las clases para confirmar que se mantuvo:

clases_train <- ttrain %>% group_by(Survived) %>% summarise(numero_casos=n())
clases_entrenamiento <- tentrenamiento %>% group_by(Survived) %>% summarise(numero_casos=n())
clases_validacion <- tvalidacion %>% group_by(Survived) %>% summarise(numero_casos=n())

g1 <- ggplot(clases_train, aes(x=Survived, y=numero_casos, fill = Survived)) + geom_col() + labs(subtitle = "Dataset Train", x = "Clasificación supervivencia", y = "Número de casos") + guides(fill = "none") + theme_bw()
g2 <- ggplot(clases_entrenamiento, aes(x=Survived, y=numero_casos, fill = Survived)) + geom_col() + labs(subtitle = "Dataset Entrenamiento", x = "Clasificación  supervivencia", y = "Número de casos") + guides(fill = "none") + theme_bw()
g3 <- ggplot(clases_validacion, aes(x=Survived, y=numero_casos, fill = Survived)) + geom_col() + labs(subtitle = "Dataset Validación", x = "Clasificación supervivencia", y = "Número de casos") + guides(fill = "none") + theme_bw()

grid.arrange(
  g1,
  g2,
  g3,
  nrow = 1,
  top = "Balanceo de clases en los distintos datasets",
  bottom = textGrob(
    "1 corresponde a sobrevivientes",
    gp = gpar(fontface = 3, fontsize = 9),
    hjust = 1,
    x = 1
  )
)

En el gráfico anterior se puede comparar la cantidad de sobrevivientes y no sobrevivientes para cada dataset. En cada uno de los datasets hay una proporción mayor de gente que no sobrevivió pero la misma se mantiene constante para todos.

Predicciones

En la regresión logística, la probabilidad predicha de supervivencia está dada por la siguiente ecuación:

\(P(Y=1|X)= \frac{e^{\beta_0 + \sum\limits_{j=1}^p \beta_j X}}{1+e^{\beta_0 + \sum\limits_{j=1}^p \beta_j X}}\)

A diferencia de la regresión lineal, en estos modelos, las variables ya no tienen una relación lineal con la probabilidad predicha. Un coeficiente positivo indica que frente a aumentos de dicha variable la probabilidad predicha aumenta mientras que un coeficiente negativo nos indica lo contrario pero no en que proporción se da esta relación.

En primera instancia realizo una regresión logística para predecir la supervivencia en función de Pclass, Sex y Age. La probabilidad predicha del evento de que la persona sobreviva se puede expresar de manera más simplificada así:

\(\pi_i=expit(\beta_0+\beta_1.X_{Pclass}+\beta_2.X_{Sex}+\beta_3.X_{Age})\)

La probabilidad predicha de no supervivencia sería entonces \(1-\pi_i\).

# Utilizo el paquete ISRL que contiene la función glm para realizar la regresión, la misma permite crear un modelo lineal generalizado (Generalized Linear Model). Se debe explicitar que la familia es binomial para que sea logística.

glm.fit <- glm(Survived ~ Pclass + Sex + Age, data = tentrenamiento, family = "binomial")
summary(glm.fit)
## 
## Call:
## glm(formula = Survived ~ Pclass + Sex + Age, family = "binomial", 
##     data = tentrenamiento)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.4909  -0.6564  -0.3936   0.6033   2.5703  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  4.065836   0.478648   8.494  < 2e-16 ***
## Pclass2     -1.444957   0.320141  -4.513 6.38e-06 ***
## Pclass3     -2.890284   0.325801  -8.871  < 2e-16 ***
## Sexmale     -2.624263   0.230073 -11.406  < 2e-16 ***
## Age         -0.040380   0.009232  -4.374 1.22e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 832.49  on 624  degrees of freedom
## Residual deviance: 547.87  on 620  degrees of freedom
## AIC: 557.87
## 
## Number of Fisher Scoring iterations: 5

Todos los coeficientes correspondientes a variables son significativos y negativos, esto significa que hay menor probabilidad predicha de supervivencia si la persona es hombre, está en segunda o tercera clase y a medida que aumenta la edad de la persona.

Es así como, Rose que es una mujer de 17 años que viaja en primera clase tendría más probabilidad de sobrevivir que Jack que es un hombre de 20 años viajando en tercera clase. Para obtener el valor exacto de la probabilidad predicha de cada uno generamos las predicciones con los datos de cada pasajero:

#Creo dos dataframes con los valores correspondientes a las variables de Rose y Jack y los utilizo como nueva data dentro de la predicción.

rose <- data.frame(Pclass = factor(1, levels = levels(ttrain$Pclass)), 
                      Sex = factor("female", levels = levels(ttrain$Sex)),
                      Age = 17)
prob_rose <- predict(object = glm.fit, newdata = rose, type = "response")

jack <- data.frame(Pclass = factor(3, levels = levels(ttrain$Pclass)), 
                      Sex = factor("male", levels = levels(ttrain$Sex)),
                      Age = 20)
prob_jack <- predict(object = glm.fit, newdata = jack, type = "response")

prob_rose
##         1 
## 0.9670535
prob_jack
##         1 
## 0.0948059

Como se esperaba, dado este modelo, Rose tiene una probabilidad predicha de sobrevivir del 96.7% mientras que Jack únicamente de 9.4%.

Generación de modelos

En esta parte del trabajo, se generarán 3 modelos de regresión logística sobre el dataset de entrenamiento utilizando diferentes combinaciones de variables:

  • Modelo 1: Probabilidad de sobrevivir en función de sexo, edad y cantidad de hijos/padres en el Titanic.

\(\pi_i=expit(\beta_0+\beta_1.X_{Sex}+\beta_2.X_{Age}+\beta_3.X_{Parch})\)

  • Modelo 2: Probabilidad de sobrevivir en función de clase, sexo y puerto de embarcación al Titanic.

\(\pi_i=expit(\beta_0+\beta_1.X_{Pclass}+\beta_2.X_{Sex}+\beta_3.X_{Embarked})\)

  • Modelo 3: Probabilidad de sobrevivir en función de clase, sexo, edad y cantidad de hermanos/pareja en el Titanic.

\(\pi_i=expit(\beta_0+\beta_1.X_{Pclass}+\beta_2.X_{Sex}+\beta_3.X_{Age}+\beta_4.X_{SibSp})\)

# Para aplicar la regresion logistica primero uso la funcion formulas del paquete modelr y así creo un objeto que contiene todas las fórmulas a utilizar. En response se especifica la variable respuesta y luego se nombra las fórmulas a armar.

logit_formulas <- formulas(.response = ~Survived,
                            modelo0 = ~Pclass + Sex + Age,
                            modelo1 = ~Sex + Age + Parch,
                            modelo2 = ~Pclass + Sex + Embarked,
                            modelo3 = ~Pclass + Sex + Age + SibSp
                            )
models <- data_frame(logit_formulas) %>% # dataframe a partir del objeto formulas
             mutate(models = names(logit_formulas), # columna con los nombres de las formulas
                    expression = paste(logit_formulas), # columna con las expresiones de las formulas
                    mod = map(logit_formulas, ~glm(.,family = 'binomial', data = tentrenamiento))) 
# La función tidy se usa para obtener los parámetros estimados para estos tres modelos.

models %>% 
  filter(models %in% c('modelo1','modelo2','modelo3')) %>%
    mutate(tidy = map(mod,tidy)) %>%
      unnest(tidy, .drop = TRUE) %>% 
        mutate(estimate=round(estimate,5), p.value=round(p.value,4))

Análisis modelo 1

Los coeficientes de Sex y Parch resultaron significativos, no así Age cuyo p-value es 0.91. Al igual que el modelo anterior, las personas de sexo masculino tienen un coeficiente negativo y disminuyen las probabilidades de sobrevivir. Lo mismo sucede con la variable Parch, es decir, también disminuyen las chances al tener una mayor cantidad de padres o hijos.

Análisis modelo 2

Los coeficientes correspondientes a las variables Pclass y Sex resultaron significativas. Embarked de Queenstown y de Southampton no lo fueron con un p-value de 0.33 y 0.7 respectivamente. Los coeficientes de las variables de segunda o tercera, de sexo hombre y de embarque en Southampton son negativas por lo cual es menor la probabilidad de supervivencia si una persona cumple con esas características.

Análisis modelo 3

En este modelo no cuenta con variables cuyo coeficiente sea no significativo. Al igual que en los modelos anteriores, la clase y la edad son variables significativas pero negativas. El coeficiente de la cantidad de hermanos o pareja también es negativa, es decir que a mayor cantidad de ellos, menor es la probabilidad de sobrevivir.

# Calculo las medidas de evaluación para cada modelo
models <- models %>% 
  # La función glance trae la información importante de cada modelo
  mutate(glance = map(mod,glance))

# Obtener las medidas de evaluacion de interes
models %>% 
  # Con unnest se ve la evaluacion de cada modelo
  unnest(glance, .drop = TRUE) %>%
    # Calculo de la deviance explicada
    mutate(perc_explained_dev = 1-deviance/null.deviance) %>% 
      select(-c(models, df.null, AIC, BIC)) %>% 
        # Ordeno los modelos por el deviance
        arrange(deviance)

Con esta información, pasamos a evaluar cada modelo comparando su valor de deviance: el modelo 3 es el que minimiza más el deviance (535) respecto al valor de deviance nula (832). Su deviance explicada es de 35% mientras que para el segundo mejor modelo es de 34%.

Evaluación del modelo

Para evaluar este mejor modelo, gráfico la curva ROC y obtengo el área bajo la misma.

# Añadir las predicciones

models <- models %>% 
  mutate(pred= map(mod,augment, type.predict = "response"))
# Modelo completo

prediction <- models %>% 
  filter(models=="modelo3") %>% 
    unnest(pred, .drop=TRUE)
# Calculao de la curva ROC

roc <- roc(response=prediction$Survived, predictor=prediction$.fitted)

# Grafico la curva ROC

ggroc(roc, color = "pink", size = 2) + geom_abline(slope = 1, intercept = 1, linetype ='dashed') + labs(title = "Curva ROC") + theme_bw() 

print(paste('AUC: Modelo completo', roc$auc))
## [1] "AUC: Modelo completo 0.864523809523809"

La curva ROC es la representación de la razón o ratio de verdaderos positivos, es decir, la proporción del total de sobrevivientes que el algoritmo clasifica de manera correcta (TPR = True Positive Rate), frente al ratio de falsos positivos que es la proporción del total de no sobrevivientes que nuestra regresión clasifica correctamente (FPR = False Positive Rate), de acuerdo a un umbral de discriminación dado por el valor a partir del cual se decide que un caso es un positivo. Para ganar en sensitividad (clasificar más positivos correctamente) se debe reducir la especificidad (clasificar más positivos incorrectamente). En este caso, el área bajo la curva es de 86.4%, se puede considerar un valor mayor que el azar.

# Gráfico de violin

violin = ggplot(prediction, aes(x=Survived, y=.fitted, group=Survived, fill=Survived)) + 
           geom_violin() +
           theme_bw() +
           guides(fill=FALSE) +
           labs(title='Violin plot del Modelo 3', x ='Clasificación supervivencia', y='Probabilidad predicha')
violin

El diagrama de violín se utiliza para visualizar la distribución de la cantidad de observaciones por su clase real y la probabilidad que le asigna el modelo. Para el caso de la clasificación 0 de la variable sobreviviente, se ve una densidad elevada desde la probabilidad predicha 0 a aproximadamente 0.18 luego la variable tiene una densidad casi constante hasta la probabilidad 0.72 y luego disminuye hasta casi llegar a densidad 0. El caso contrario sucede con la clasificación 1 de la variable supervivencia, la mayoría de la densidad se encuentra en valores altos de probabilidad predicha, aproximadamente desde la probabilidad 0.58 hasta llegar a 1. Se podría considerar una probabilidad casi constante en la parte media y media baja de las probabilidades con un leve aumento de densidad cuando la probabilidad es baja.

Elección del punto de corte sobre el dataset de validación

Para poder elegir el punto de corte, es necesario definir el trade-off que se hará entre las distintas métricas de acuerdo al tipo de problema a analizar. Las métricas a tener en cuenta son:

\(Accuracy = \frac{TP+TN}{P+N}\)

\(Sensitivity = Recall = \frac{TP}{TP+FN}\)

\(Specificity = \frac{TN}{TN+FP}\)

\(Precision = \frac{TP}{TP+FP}\)

Siendo:

  • P = Cantidad de casos positivos
  • N = Cantidad de casos negativos
  • TP = Cantidad de casos positivos predichos como positivos
  • TN = Cantidad de casos negativos predichos como negativos
  • FP = Cantidad de casos negativos predichos como positivos
  • FN = Cantidad de casos positivos predichos como negativos
# El punto de corte se elige sobre el dataset de validación, para ello se deben hacer las predicciones correspondientes

models_val <- models %>% 
  filter(models=="modelo3") %>% 
  mutate(val= map(mod,augment, newdata=tvalidacion, type.predict = "response"))

prediction_val <-  models_val %>%
  unnest(val, .drop=TRUE)

prediction_val
# Creación de un función con las métricas a graficar para los distintos puntos de corte

prediction_metrics <- function(cutoff, predictions=prediction_val){
  table <- predictions %>% 
    mutate(predicted_class=if_else(.fitted>cutoff, 1, 0) %>% as.factor(),
           Survived= factor(Survived))
  
  confusionMatrix(table$predicted_class, table$Survived, positive = "1") %>%
    tidy() %>%
    select(term, estimate) %>%
    filter(term %in% c('accuracy', 'sensitivity', 'specificity', 'precision','recall')) %>%
    mutate(cutoff=cutoff)
  
}

# Creación del gráfico de Accuracy, Sensitivity, Specificity, Recall y Precision en función de distintos puntos de corte.

cutoffs = seq(0.01,0.95,0.01)

logit_pred= map_dfr(cutoffs, prediction_metrics)%>% mutate(term=as.factor(term))

ggplot(logit_pred, aes(cutoff,estimate, group=term, color=term)) + geom_line(size=1) + theme_bw() +
       labs(title= 'Accuracy, Sensitivity, Specificity, Recall y Precision', subtitle= 'Modelo 3', color="") + geom_vline(xintercept=0.37, linetype="dashed", color = "black")

En este modelo, el valor positivo es 1, sobrevivir. La métrica de Accuracy representa la cantidad de aciertos (ya sean positivos o negativos) que predice el modelo. La medida de Recall o de sensibilidad da idea de la proporción de gente que el modelo predice que sobrevivió respecto del total de gente que realmente sobrevivió. Por otro lado, Specificity se refiere a la proporción de gente que el modelo predice que no sobrevivió respecto del total de personas que no sobrevivieron realmente. Precision es la probabilidad que tiene una predicción positiva de ser realmente positiva. En este problema podemos asumir que no hay una métrica más importante que la otra, como puede suceder en el área de medicina donde se busca la optimización de alguna de ellas. Al no haber preferencia por alguna métrica, el trade-off que creo adecuado es el máximo valor de que pueden tener estás métricas en conjunto, esto se da en 0.37. Allí es donde se interceptan las curvas de Accuracy, Sensitivity y Specificity. Si se aumentara el valor del punto de corte, la sensibilidad o Recall pasa a ser menor que el Accuracy y la Specificity y al revés si disminuyera el valor.

Matriz de confusión en función del punto de corte e interpretación

La matriz de confusión permite un rápida visualización del desempeño del modelo de predicción. Cada columna de la matriz representa el número de predicciones de cada clase, mientras que cada fila representa a las instancias en la clase real. Uno de los beneficios de las matrices de confusión es que facilitan ver si el sistema está confundiendo dos clases.

# Se define el punto de corte

sel_cutoff = 0.37

## Creo una tabla que compara la predicción y el valor verdadero de acuerdo al punto de corte

tabla <- prediction_val %>% 
    mutate(predicted_class=if_else(.fitted>sel_cutoff,"1", "0") %>% as.factor(),
           Survived= factor(Survived)) %>% select(predicted_class,Survived)

confusionMatrix(table(tabla$predicted_class, tabla$Survived), positive = "1") 
## Confusion Matrix and Statistics
## 
##    
##       0   1
##   0 125  24
##   1  39  78
##                                           
##                Accuracy : 0.7632          
##                  95% CI : (0.7074, 0.8129)
##     No Information Rate : 0.6165          
##     P-Value [Acc > NIR] : 2.657e-07       
##                                           
##                   Kappa : 0.5127          
##                                           
##  Mcnemar's Test P-Value : 0.07776         
##                                           
##             Sensitivity : 0.7647          
##             Specificity : 0.7622          
##          Pos Pred Value : 0.6667          
##          Neg Pred Value : 0.8389          
##              Prevalence : 0.3835          
##          Detection Rate : 0.2932          
##    Detection Prevalence : 0.4398          
##       Balanced Accuracy : 0.7635          
##                                           
##        'Positive' Class : 1               
##

Con ese punto de corte podemos ver que dada la clase positiva 1, sobreviviente, los valores para las métricas en el conjunto de validación son:

  • Accuracy: 0.7632
  • Precision: 0.7622
  • Sensitibity: 0.7290
  • Specificity: 0.7622

Testeo

Para probar realmente como se desempeña el modelo se realiza una comprobación con datos que no fueron utilizados para entrenar ni elegir el punto de corte del modelo. Este dataset fue separado desde un principio y con él se hacen nuevas predicciones para poder obtener la matriz de confusión.

# Como primer paso, cargo el dataset y transformo a factor las variables correspondientes

ttest <- read_csv("./titanic_complete_test.csv")
ttest <- ttest[,c("PassengerId","Survived", "Pclass", "Sex", "Age", "SibSp", "Parch", "Fare", "Embarked")]
ttest$Survived <- as.factor(ttest$Survived)
ttest$Pclass <- as.factor(ttest$Pclass)
ttest$Embarked <- as.factor(ttest$Embarked)
ttest$Sex <- as.factor(ttest$Sex)
# Creo la tabla con los valores predichos de acuerdo al punto de corte y los valores originales. El entrenamiento se hace con los datos de entrenamiento y validaciión juntos.

models_test <- glm(logit_formulas$modelo3, family = 'binomial', data = ttrain)
table= augment(x=models_test, newdata=ttest, type.predict='response') 

# Se clasifica utilizando el punto de corte

table=table %>% mutate(predicted_class=if_else(.fitted>sel_cutoff, 1, 0) %>% as.factor(),
           Survived= factor(Survived))

# Matriz de confusión

confusionMatrix(table(table$Survived, table$predicted_class), positive = "1")
## Confusion Matrix and Statistics
## 
##    
##       0   1
##   0 192  69
##   1  40 117
##                                           
##                Accuracy : 0.7392          
##                  95% CI : (0.6943, 0.7807)
##     No Information Rate : 0.555           
##     P-Value [Acc > NIR] : 5.383e-15       
##                                           
##                   Kappa : 0.4638          
##                                           
##  Mcnemar's Test P-Value : 0.00732         
##                                           
##             Sensitivity : 0.6290          
##             Specificity : 0.8276          
##          Pos Pred Value : 0.7452          
##          Neg Pred Value : 0.7356          
##              Prevalence : 0.4450          
##          Detection Rate : 0.2799          
##    Detection Prevalence : 0.3756          
##       Balanced Accuracy : 0.7283          
##                                           
##        'Positive' Class : 1               
##

Con ese punto de corte podemos ver que dada la clase positiva, sobreviviente, los valores para las métricas en el conjunto de test son:

  • Accuracy: 0.7392
  • Precision: 0.7452
  • Sensitibity: 0.6290
  • Specificity: 0.8276

Las principales métricas de performance sobre el dataset de testeo disminuyen debido a que el modelo está construido en base al dataset de training y el punto de corte optimizado usando el de validación. A pesar de ello, esta disminución no es significativa. El Accuracy pasa de 0.7632 a 0.7392, la Precision de 0.7622 a 0.7452, la Sensitibity de 0.7290 a 0.6290 y la Specificity aumenta de 0.7622 a 0.8276.