Titanic

El 15 de abril de 1912, durante su viaje inaugural, el Titanic se hundió después de chocar con un iceberg, matando a 1502 de 2224 personas, contando pasajeros y tripulación.

Una de las razones por las que el naufragio dió lugar a esa pérdida de vidas fue que no había suficientes botes salvavidas para los pasajerosy la tripulación. Aunque hubo algún elemento de suerte involucrado en sobrevivir al hundimiento, algunos grupos de personas tenían más probabilidades de sobrevivir que otros, como las mujeres, los niños y aquellos de la clase alta.

library(tidyverse)
library(caret)
library(plotly)
library(data.table)
library(GGally)
library(tidymodels)
library(car)
library(scales)
library(lmtest)
library(dplyr)
library(MASS)
library(ggpubr)
library(pander)
library(ggthemes)
library(e1071)
library(partykit)
library(ROCR)
library(class)
options(scipen = 100, max.print = 1e+06)

Dataset

dataset <- read.csv("data/titanic3.csv")
str(dataset)
## 'data.frame':    1310 obs. of  14 variables:
##  $ pclass   : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ survived : int  1 1 0 0 0 1 1 0 1 0 ...
##  $ name     : chr  "Allen, Miss. Elisabeth Walton" "Allison, Master. Hudson Trevor" "Allison, Miss. Helen Loraine" "Allison, Mr. Hudson Joshua Creighton" ...
##  $ sex      : chr  "female" "male" "female" "male" ...
##  $ age      : num  29 0.917 2 30 25 ...
##  $ sibsp    : int  0 1 1 1 1 0 1 0 2 0 ...
##  $ parch    : int  0 2 2 2 2 0 0 0 0 0 ...
##  $ ticket   : chr  "24160" "113781" "113781" "113781" ...
##  $ fare     : num  211 152 152 152 152 ...
##  $ cabin    : chr  "B5" "C22 C26" "C22 C26" "C22 C26" ...
##  $ embarked : chr  "S" "S" "S" "S" ...
##  $ boat     : chr  "2" "11" "" "" ...
##  $ body     : int  NA NA NA 135 NA NA NA NA NA 22 ...
##  $ home.dest: chr  "St Louis, MO" "Montreal, PQ / Chesterville, ON" "Montreal, PQ / Chesterville, ON" "Montreal, PQ / Chesterville, ON" ...
titanic <- dataset %>% 
  mutate(survived=ifelse(survived==1,"Survived","Dead")) %>% 
    mutate(survived = as.factor(survived),
         pclass=as.factor(pclass),
         sex=as.factor(sex),
         embarked=as.factor(embarked))

glimpse(titanic)
## Rows: 1,310
## Columns: 14
## $ pclass    <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ survived  <fct> Survived, Survived, Dead, Dead, Dead, Survived, Survived, De…
## $ name      <chr> "Allen, Miss. Elisabeth Walton", "Allison, Master. Hudson Tr…
## $ sex       <fct> female, male, female, male, female, male, female, male, fema…
## $ age       <dbl> 29.0000, 0.9167, 2.0000, 30.0000, 25.0000, 48.0000, 63.0000,…
## $ sibsp     <int> 0, 1, 1, 1, 1, 0, 1, 0, 2, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ parch     <int> 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, …
## $ ticket    <chr> "24160", "113781", "113781", "113781", "113781", "19952", "1…
## $ fare      <dbl> 211.3375, 151.5500, 151.5500, 151.5500, 151.5500, 26.5500, 7…
## $ cabin     <chr> "B5", "C22 C26", "C22 C26", "C22 C26", "C22 C26", "E12", "D7…
## $ embarked  <fct> S, S, S, S, S, S, S, S, S, C, C, C, C, S, S, S, C, C, C, C, …
## $ boat      <chr> "2", "11", "", "", "", "3", "10", "", "D", "", "", "4", "9",…
## $ body      <int> NA, NA, NA, 135, NA, NA, NA, NA, NA, 22, 124, NA, NA, NA, NA…
## $ home.dest <chr> "St Louis, MO", "Montreal, PQ / Chesterville, ON", "Montreal…

Edad

Fueron los niños priorizados frente a los adultos?

ggplot(titanic[], aes(x=age, fill=survived, color=survived)) + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+ geom_histogram(aes(y=..density..), color="grey17") + 
geom_density(alpha=.2, fill="yellow") +
  theme(legend.position = "top")

ggplot(titanic[], aes(x=age, fill=sex, color=sex)) + facet_wrap(~survived, ncol=1) + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs() + geom_histogram(aes(y=..density..), color="grey17") + 
geom_density(alpha=.2, fill="yellow") +
  theme(legend.position = "top")

Según el gráfico, hubo más niños supervivientes que muertos. En el caso de los adultos, el número parece igual. Si combinamos las variables de género y edad, el número de varones que sobrevivieron fue elevado. Sin embargo, aún no está claro si el género influye en las posibilidades de supervivencia.

Pagos

ggplot(titanic[], aes(x=fare, fill=survived, color=survived))  + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+ geom_histogram(aes(y=..density..), color="grey17") + 
geom_density(alpha=.2, fill="yellow") +
  theme(legend.position = "right")

La mayoría de los pasajeros del Titanic pagaron menos de 50 dólares. Sin embargo, la tasa de supervivencia es muy baja para los pasajeros con tarifa inferior a 25 dólares.

Familia

La SibSp define las relaciones familiares de la siguiente manera Hermano = hermano, hermana, hermanastro, hermanastra Cónyuge = marido, mujer (se ignoran las amantes y los prometidos).

Parch define las relaciones familiares de la siguiente manera Padre = madre, padre Hijo = hija, hijo, hijastra, hijastro Algunos niños viajaron sólo con una niñera, por lo que parch = 0 para ellos.

sibling <- titanic[] %>% 
  group_by(sibsp, survived) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count*100/sum(count))

plot_sibling <- ggplot(sibling, aes(x=as.factor(sibsp), y=perc, fill=survived, colour=survived)) + 
geom_col(position = "fill") + scale_x_discrete(breaks = seq(0, 8, 1))+ ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+   geom_text(aes(label = count), position = position_fill(vjust = .5), col = "white") +ggtitle("Number of Siblings and Spouse")+theme(plot.title = element_text(hjust = 0.5),
    legend.position = "bottom")

parch <- titanic[] %>% 
  group_by(parch, survived) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count))

plot_parch <- ggplot(parch, aes(x=as.factor(parch), y=perc, fill=survived, colour=survived)) + 
geom_col(position = "fill") + scale_x_discrete(breaks = seq(0, 6, 1))+ ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+  geom_text(aes(label = count), position = position_fill(vjust = .5), col = "white")+ggtitle("Number of Parents and Children")+theme(plot.title = element_text(hjust = 0.5),
    legend.position = "bottom")


ggarrange(plot_sibling, plot_parch, common.legend=T, ncol=2, legend = "bottom")

La tasa de supervivencia tiende a ser menor cuando el número de hermanos y cónyuge es mayor. Sin embargo, no ocurre lo mismo con el número de padres e hijos.

titanic$Family_Size <- 1+titanic$parch+titanic$sibsp

family <- titanic[] %>% 
  group_by(Family_Size, survived) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count))

ggplot(family, aes(x=as.factor(Family_Size), y=perc, fill=survived, colour=survived)) + 
geom_col(position = "fill") + scale_x_discrete(breaks = seq(1, 11, 1))+ ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+   geom_text(aes(label = count), position = position_fill(vjust = .5), col = "white")

En resumen, había muchos pasajeros que viajaban solos. La tasa de supervivencia es alta para los pasajeros que viajaban con 1 a 3 miembros de la familia, sin embargo la probabilidad es mucho menor cuando viajaban con más de 3 miembros de la familia.

Análisis de variables de tipo categóricas

Sexo

Se privilegió el sexo femenino en la supervivencia?.

ggplot(titanic[], aes(x=sex, fill=survived, colour=survived)) + geom_bar() + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()

ggplot(titanic[], aes(x=sex, fill=survived)) + geom_bar(position = "fill") + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()

De los datos se desprende que las hembras tienen más posibilidades de sobrevivir que los machos. Esta indicación será muy importante para nuestro modelo.

Clase

class <- titanic[] %>% 
  group_by(pclass, survived) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count))

class
## # A tibble: 7 x 4
## # Groups:   pclass [4]
##   pclass survived count  perc
##   <fct>  <fct>    <int> <dbl>
## 1 1      Dead       123 0.381
## 2 1      Survived   200 0.619
## 3 2      Dead       158 0.570
## 4 2      Survived   119 0.430
## 5 3      Dead       528 0.745
## 6 3      Survived   181 0.255
## 7 <NA>   <NA>         1 1
class <- titanic[] %>% 
  group_by(pclass, survived) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count))

ggplot(class, aes(x=pclass, y=perc, fill= survived)) + geom_col(position="fill") + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+  geom_text(aes(label = count), position = position_fill(vjust = .5), col = "white")

Puerto de embarque

Embarcado es el puerto de embarque, la ciudad donde los pasajeros subieron al barco. C = Cherburgo, Q = Queenstown, S = Southampton.

emb <- titanic[] %>% 
  group_by(embarked, survived) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count))
emb <- emb[complete.cases(emb),]

ggplot(emb, aes(x=embarked, y=perc, fill= survived)) + geom_col(position="fill") + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+  geom_text(aes(label = count), position = position_fill(vjust = .5), col = "white")

Parece que los pasajeros de Cherburgo tienen la mejor tasa de supervivencia. ¿Pero por qué?

fareembarked <- titanic[]
fareembarked <- fareembarked[complete.cases(fareembarked),]

plot_fe <- ggplot(fareembarked, aes(x=fare, fill=embarked, color=embarked))  + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+
geom_density(alpha=.2) +
  theme(legend.position = "right") 

classembarked <- titanic[]
classembarked <- classembarked[complete.cases(classembarked),] %>% 
  group_by(pclass, embarked) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count))

plot_ce <- ggplot(classembarked, aes(x=pclass, y=count, fill=embarked, color=embarked))  + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+
geom_col(position = "dodge") +
  theme(legend.position = "right")

ggarrange(plot_fe, plot_ce, ncol = 1)

Cabina

cab <- titanic[] %>% 
  mutate(cabin=as.factor(cabin))


#cab <- cab[complete.cases(cab),]
levels(cab$cabin)[startsWith(levels(cab$cabin), "A")] <- "A" 
levels(cab$cabin)[startsWith(levels(cab$cabin), "B")] <- "B"
levels(cab$cabin)[startsWith(levels(cab$cabin), "C")] <- "C"
levels(cab$cabin)[startsWith(levels(cab$cabin), "D")] <- "D"
levels(cab$cabin)[startsWith(levels(cab$cabin), "E")] <- "E"
levels(cab$cabin)[startsWith(levels(cab$cabin), "F")] <- "F"
levels(cab$cabin)[startsWith(levels(cab$cabin), "G")] <- "G"  

cab <- cab %>% 
  group_by(cabin, survived) %>% 
  summarise(count=n(), .groups = NULL) %>% 
  mutate(perc=count/sum(count))
ggplot(cab, aes(x=cabin, y=perc, fill= survived)) + geom_col(position="fill") + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+ geom_text(aes(label = count), position = position_fill(vjust = .5), col = "white")

La tasa de supervivencia es buena en la cabina B, D y E. Sin embargo, hay demasiados valores perdidos, entre el 77% de los datos. Lamentablemente, no podemos utilizar la variable.

Titulos

titanic$title <- gsub("(.*\\,|\\..*)", "", titanic$name) %>%
gsub("[[:space:]]", "", .)

titanic$title[titanic$title %in% c("Jonkheer", "Dr")] <- "Honorific Titles"
titanic$title[titanic$title %in% c("Ms", "Mme", "Mlle", "Lady","Dona","theCountess")] <- "Mrs"
titanic$title[titanic$title %in% c("Don", "Sir")] <- "Mr"
titanic$title[titanic$title %in% c("Capt", "Col", "Major", "Rev")] <- "Officers"

titanic$title <- as.factor(titanic$title)
levels(titanic$title)
## [1] ""                 "Honorific Titles" "Master"           "Miss"            
## [5] "Mr"               "Mrs"              "Officers"
ttl <- titanic[] %>% 
  group_by(title, survived) %>% 
  summarise(count=n()) %>% 
  mutate(perc=count/sum(count))


ggplot(ttl, aes(x=title, y=perc, fill= survived)) + geom_col(position="fill") + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+  geom_text(aes(label = count), position = position_fill(vjust = .5), col = "white") + coord_flip()

El título de Sr., que indicaría un varón adulto, tiene una tasa de supervivencia realmente mala de alrededor del 20%. En cambio, la tasa de supervivencia de la Sra., la Srta. y el Sr. es superior al 50%. Como se ha indicado anteriormente, las mujeres y los niños tienen más prioridad.

Valores perdidos

Existen muchos valores nulos en edad,cabina, embarcado y costo.

colSums(is.na(titanic))
##      pclass    survived        name         sex         age       sibsp 
##           1           1           0           0         264           1 
##       parch      ticket        fare       cabin    embarked        boat 
##           1           0           2           0           0           0 
##        body   home.dest Family_Size       title 
##        1189           0           1           0

Edad

table(is.na(titanic))
## 
## FALSE  TRUE 
## 19500  1460

En nuestros datos, hay 1188 filas con valores perdidos de Edad. Por lo tanto, en lugar de eliminar la fila con valores perdidos, intentaremos predecir el valor basándonos en la correlación de la edad con otras variables.

ggplot(titanic, aes(x=sex, y=age, fill=sex)) + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()+ geom_boxplot()

ggplot(titanic, aes(x=embarked, y=age, fill=embarked)) + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs() + geom_boxplot() 

ggplot(titanic, aes(x=pclass, y=age, fill=pclass)) + geom_boxplot() + ggthemes::theme_economist() + scale_color_gdocs() + ggthemes::scale_fill_gdocs()

If we look into Pclass, we could conclude that there were older passengers in first class than second class which also have older passengers than the third class.

From the boxplot above, we could conclude that the median values from each class are 37, 29 and 24.

missingvalues_age <- which(is.na(titanic$age))

for(x in levels(titanic$pclass)) {
titanic[missingvalues_age, "age"] <- median(subset(titanic, pclass == x & is.na(age) == F)$age)
}

Costo

missingvalues_fare <- which(is.na(titanic$fare))

titanic[missingvalues_fare, "fare"] <- median(subset(titanic, is.na(fare) == F)$fare)

Embarque

missingvalues_embarked <- which(is.na(titanic$embarked))

titanic[missingvalues_embarked, "embarked"] <- "S"

Variable

titanic[] %>% 
  pull(survived) %>% 
  table() %>% 
  prop.table()
## .
##     Dead Survived 
## 0.618029 0.381971

Correlación entre variables

ggcorr(titanic,
       label = T,
       label_size = 2.9,
       hjust = 1,
       layout.exp = 1)

Predicción de supervivencia (Keras)

library(reshape2)
library(keras)

Mini EDA

titanic %>% 
  keep(is.numeric) %>% 
  gather() %>% 
  ggplot(aes(value)) +
  facet_wrap(~ key, scales = "free") +
  geom_histogram()

 ggplot(titanic)+
  geom_density(aes(age, color=as.factor(survived)),size=1)

Entrenamiento

Separarlos datos en entrenamiento y test.

split<-sample(nrow(titanic),nrow(titanic)*0.8)
# datos de entrenamiento
titanic.train <- titanic[split,] 
# datos para testeo
titanic.test <- titanic[-split,]

Clasificación

library(rpart)
library(rattle)
library(rpart.plot)

classifier = rpart(formula = survived ~ age +sex+ pclass,
                   data = titanic.train, method = "class")
rpart.plot(classifier)

#fancyRpartPlot(classifier)

El valor superior es la predicción para el grupo (dead o survived).

classifier = rpart(formula = survived ~ age +sex+ pclass + fare,
                   data = titanic.train, method = "class")
rpart.plot(classifier)

# l <- list(supervivencia= titanic.train$survived, edad= titanic.train$age,
#     clase= titanic.train$pclass,
#     sexo= titanic.train$sex) 
# 
# titanic.train
# titanic.train <- as_data_frame(l) %>% fill(age)
# 
# L <- list(supervivencia= titanic.test$survived, edad= titanic.test$age,
#     clase= titanic.test$pclass,
#     sexo= titanic.test$sex) 
# 
# titanic.test <- as_data_frame(L) %>% fill(edad)