Titanic

Em 1912, o RMS Titanic afundou algumas horas depois de colidir com um gigantesco iceberg. Este foi um navio de passageiros britânico operado pela White Star Line e construído pelos estaleiros da Harland and Wolff em Belfast. Por sua vez não havia botes salva-vidas para todos os passageiros, com os registros do acidente. Este trabalho tem por objetivo análisar as infomaçõees dsponibilizadas e criar uma predição que consiga identificar a chance de uma pessoa, dado alguns aspectos sobre ela, sobreviver ou não ao naufragio nas condições do titanic. Em particular utilizando ferramentas estatisticas para prever quais passageiros sobreviveram à tragédia.

Descrição da base de dados

Teremos duas bases, uma para o treinamento, realaizção das analises iniciais e uma base de teste, aplicar o modelo e observvar se conseguimos um bom resultado.

A base é definida como:

survival: variável binária que representa se o indivíduo sobreviveu (1) ou não (0);

pclass: classe dos bilhetes;

name: nome do passageiro;

sex: Sexo do passageiro;

age: idade do passageiro;

sibsp: número de esposos e/ou irmãos à bordo;

parch: número de pais ou filhos à bordo;

ticket: número da passagem;

fare: preço pago pela passagem;

cabin: número da cabine em que estava alojado;

embarked: Porto de embarcação

Analises

Para entendimento dos dados, observa-se o total de observações, a quantidade de variaveis e categoria das mesmas.

ncol(train)
## [1] 12
nrow(train)
## [1] 891
str(train)
## 'data.frame':    891 obs. of  12 variables:
##  $ PassengerId: int  1 2 3 4 5 6 7 8 9 10 ...
##  $ Survived   : int  0 1 1 1 0 0 0 0 1 1 ...
##  $ Pclass     : int  3 1 3 1 3 3 1 3 3 2 ...
##  $ Name       : Factor w/ 891 levels "Abbing, Mr. Anthony",..: 109 191 358 277 16 559 520 629 417 581 ...
##  $ Sex        : Factor w/ 2 levels "female","male": 2 1 1 1 2 2 2 2 1 1 ...
##  $ Age        : num  22 38 26 35 35 NA 54 2 27 14 ...
##  $ SibSp      : int  1 1 0 1 0 0 0 3 0 1 ...
##  $ Parch      : int  0 0 0 0 0 0 0 1 2 0 ...
##  $ Ticket     : Factor w/ 681 levels "110152","110413",..: 524 597 670 50 473 276 86 396 345 133 ...
##  $ Fare       : num  7.25 71.28 7.92 53.1 8.05 ...
##  $ Cabin      : Factor w/ 148 levels "","A10","A14",..: 1 83 1 57 1 1 131 1 1 1 ...
##  $ Embarked   : Factor w/ 4 levels "","C","Q","S": 4 2 4 4 4 3 4 4 4 2 ...

Tem-se 891 observações, onde cada observação contem 12 variaveeis. As variaveis são divididas em numericas e categoricas.

Observando apenas a sobrevivência observa-se que a maior parte dos tripulantes não sobreviveu ao acidente, separando por genero, observa-se que dentro dos que sobreviveram a maior parte foi do genero feminino.

Tem-se que mais de 60% dos passageiros não sobreviveram.

Apesar de um numero alto de passageiros na terceira classe, a maior parte dos sobreviventes são da primeira classe.

## Warning: Removed 177 rows containing non-finite values (stat_bin).

Maior parte dos passageiros tinham idades entre 20 e 40 anos.

Analise estatistica

Observando os graficos vemos que a proporção de sobreviventes homens e mulheres são diferentes, então iremos realizae um teste estatistico para confirmar, ou nao, a suposição

t.test(
  train$Survived[
  train$Sex == 'male' 
  ]
  ,
  train$Survived[
    train$Sex == 'female'
  ]
)
## 
##  Welch Two Sample t-test
## 
## data:  train$Survived[train$Sex == "male"] and train$Survived[train$Sex == "female"]
## t = -18.672, df = 584.43, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.6113121 -0.4949481
## sample estimates:
## mean of x mean of y 
## 0.1889081 0.7420382

Como eperado, rejeita-se a hipotese que a proporção de sobreviventes são iguais. criando o modelo

mod1<- glm(Survived ~Sex + Age + Fare + Pclass + Embarked, data = train)
mod2<- glm(Survived ~Sex + Age + Fare + Pclass , data = train)


summary(mod1)
## 
## Call:
## glm(formula = Survived ~ Sex + Age + Fare + Pclass + Embarked, 
##     data = train)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.07533  -0.24189  -0.07142   0.22998   1.00827  
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.463e+00  2.829e-01   5.171 3.04e-07 ***
## Sexmale     -4.761e-01  3.094e-02 -15.386  < 2e-16 ***
## Age         -5.350e-03  1.093e-03  -4.895 1.22e-06 ***
## Fare        -4.523e-05  3.368e-04  -0.134    0.893    
## Pclass      -1.920e-01  2.287e-02  -8.392 2.60e-16 ***
## EmbarkedC   -9.953e-02  2.752e-01  -0.362    0.718    
## EmbarkedQ   -2.194e-01  2.838e-01  -0.773    0.440    
## EmbarkedS   -1.782e-01  2.743e-01  -0.650    0.516    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1477614)
## 
##     Null deviance: 172.21  on 713  degrees of freedom
## Residual deviance: 104.32  on 706  degrees of freedom
##   (177 observations deleted due to missingness)
## AIC: 670.92
## 
## Number of Fisher Scoring iterations: 2
summary(mod2)
## 
## Call:
## glm(formula = Survived ~ Sex + Age + Fare + Pclass, data = train)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.11594  -0.25268  -0.06392   0.22965   1.00662  
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.317e+00  7.699e-02  17.104  < 2e-16 ***
## Sexmale     -4.787e-01  3.084e-02 -15.518  < 2e-16 ***
## Age         -5.426e-03  1.091e-03  -4.975  8.2e-07 ***
## Fare         6.801e-05  3.321e-04   0.205    0.838    
## Pclass      -2.004e-01  2.250e-02  -8.907  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1481173)
## 
##     Null deviance: 172.21  on 713  degrees of freedom
## Residual deviance: 105.02  on 709  degrees of freedom
##   (177 observations deleted due to missingness)
## AIC: 669.66
## 
## Number of Fisher Scoring iterations: 2

No primeiro modelo temos que a variavael fare e emabarked, nao sao significativas, no caso a cidade em que os passeiros embarcaram não foi significante ao modelo. No segundo caso, fare continuou sem apresentar significancia.

Para um modelo inicial estamos com um modelo razoavel, porem vamos tentar fazer modificaçoes em algumas variaveis, separar outras, paara tentar um melhor resulltado.

Buscando outros ajustes

Como temos dados faltantes para as idades, vai ser inserido a media da idade para cada infomação sem valor, acrescentar spara as infomaçoes faltando em posto de embarque e transformar as variaveis categoricas.

train$Age[is.na(train$Age)] <- median(train$Age)
train$Embarked[is.na(train$Embarked)]<-"S"
train$Survived<-as.factor(train$Survived)
train$Sex<-as.factor(train$Sex)
train$Embarked<-as.factor(train$Embarked)
train$Pclass<-as.factor(train$Pclass)

Para realizar o teste de acerto do modelo, a base test foi dividada em duas, uma para aplicar o modelo escolhido e a outra para verificar o ajuste.

set.seed(100)
var.treino<-sample(1:891,713)
treino<-train[var.treino,]
teste_comp<-train[-var.treino,] 
teste<-teste_comp
teste$Survived<-NULL

Teremos independente do ajuste uma formula fixa, para facilitar as analises.

formula_analise <- as.formula("Survived ~ Sex + Pclass + Age + SibSp + Parch + Fare + Embarked")

Os ajustes serão realizados por: Regressão logistica, Árvore de cassificação, RandomForest , Boosting e Bagging.

ajuste.logistico<-glm(formula = formula_analise,
                      data=treino,family = binomial)
ajuste.arvore <- tree(formula = formula_analise,
                      data=treino)

Resultado modelo logistico.

## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.898

Resultado modelo arvoré de cassificação

## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.882