options(warn=-1)
library(tidyverse)
library(titanic)
library(caret)
library(rpart)

For the analysis, we will first make a preprocessing step, cleaning the data and factoring some informations. All missing Ages are replaced by the median value. We will consider the following informations from the training data:
    - Survived: Passenger Survival Indicator
    - Pclass: Passenger Class
    - Sex: Sex
    - Age: Age
    - SibSp: Number of Sibling/Spouses Aboard
    - Parch: Number of Parents/Children Aboard
    - Fare: Passenger Fare
    - Embarked: Port of Embarkation

titanic <- titanic_train %>%
  select(Survived, Pclass, Sex, Age, SibSp, Parch, Fare, Embarked) %>%
  mutate(Survived = factor(Survived),
         Pclass = factor(Pclass),
         Age = ifelse(is.na(Age), median(Age, na.rm = TRUE), Age),
         Embarked = factor(ifelse(Embarked == 'C', 0, ifelse(Embarked == 'Q', 1, 2))))
titanic %>% as_tibble() %>% head()

A tibble: 6 × 8

Survived	Pclass	Sex	Age	SibSp	Parch	Fare	Embarked
<fct>	<fct>	<chr>	<dbl>	<int>	<int>	<dbl>	<fct>
0	3	male	22	1	0	7.2500	2
1	1	female	38	1	0	71.2833	0
1	3	female	26	0	0	7.9250	2
1	1	female	35	1	0	53.1000	2
0	3	male	35	0	0	8.0500	2
0	3	male	28	0	0	8.4583	1

Creation of train and test partitions based on Survival:

test_index <- createDataPartition(titanic$Survived, times = 1, p = 0.2, list = FALSE)
test_set <- titanic[test_index,]
train_set <- titanic[-test_index,]

Baseline prediction by guessing the outcome

We will first try to guess the outcome of Survival, only by chance.
This will guide following machine learning algorithm predictors.

y_hat <- sample(c(0, 1), length(test_index), replace = TRUE) %>% factor()
confusionMatrix(data = y_hat, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 58 40
         1 52 29
                                          
               Accuracy : 0.486           
                 95% CI : (0.4108, 0.5617)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 0.9998          
                                          
                  Kappa : -0.0508         
                                          
 Mcnemar's Test P-Value : 0.2515          
                                          
            Sensitivity : 0.5273          
            Specificity : 0.4203          
         Pos Pred Value : 0.5918          
         Neg Pred Value : 0.3580          
             Prevalence : 0.6145          
         Detection Rate : 0.3240          
   Detection Prevalence : 0.5475          
      Balanced Accuracy : 0.4738          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat, reference = test_set$Survived))

Accuracy: 0.486033519553073

F1 Score: 0.5576923

Since we are guessing only by chance, the accuracy is expected to be around 0.5.
We now apply some machine learning techniques, with several different predictors and parameters.

Linear Discriminant Analysis (LDA)

Survival by Sex

Our first approach will be using only the sex to predict survival.
We can look on the survival rate by sex on the training set:

train_set %>%
  group_by(Sex) %>%
  summarize(rate = mean(Survived == 1))

A tibble: 2 × 2

Sex	rate
<chr>	<dbl>
female	0.7440000
male	0.1883117

From the survival rate by sex on the training set, we can predict survival for all individuals of a sex over 0.5 (female) and predict death for all individuals of a sex under 0.5 (male). This is equivalent to applying LDA with Sex as predictor.

train_lda <- train(Survived ~ Sex, method = "lda", data = train_set)
train_lda$finalModel

Call:
lda(x, grouping = y)

Prior probabilities of groups:
       0        1 
0.616573 0.383427 

Group means:
    Sexmale
0 0.8542141
1 0.3186813

Coefficients of linear discriminants:
             LD1
Sexmale 2.496219

y_hat_lda <- predict(train_lda, test_set)
confusionMatrix(data = y_hat_lda, reference = test_set$Survived)

# Same result
# y_hat_sex <- ifelse(test_set$Sex == 'male', 0, 1) %>% factor()
# confusionMatrix(data = y_hat_sex, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 93 22
         1 17 47
                                          
               Accuracy : 0.7821          
                 95% CI : (0.7144, 0.8402)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 1.268e-06       
                                          
                  Kappa : 0.5338          
                                          
 Mcnemar's Test P-Value : 0.5218          
                                          
            Sensitivity : 0.8455          
            Specificity : 0.6812          
         Pos Pred Value : 0.8087          
         Neg Pred Value : 0.7344          
             Prevalence : 0.6145          
         Detection Rate : 0.5196          
   Detection Prevalence : 0.6425          
      Balanced Accuracy : 0.7633          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_lda, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_lda, reference = test_set$Survived))

Accuracy: 0.782122905027933

F1 Score: 0.8266667

LDA

Survival by Passenger Class

Now we will use the passenger class as the predictor of survival.
We already saw the survival status by passenger class with graphics. Now we summarize these rates:

train_set %>%
  group_by(Pclass) %>%
  summarize(rate = mean(Survived == 1))

A tibble: 3 × 2

Pclass	rate
<fct>	<dbl>
1	0.6190476
2	0.4829932
3	0.2468514

Similar to the model built on sex, we know predict survival for classes that have a rate over 0.5 and predict death for the classes with rate under 0.5. This is equivalent to applying LDA with Passenger Class as predictor.

train_lda <- train(Survived ~ Pclass, method = "lda", data = train_set)
train_lda$finalModel

Call:
lda(x, grouping = y)

Prior probabilities of groups:
       0        1 
0.616573 0.383427 

Group means:
    Pclass2   Pclass3
0 0.1731207 0.6810934
1 0.2600733 0.3589744

Coefficients of linear discriminants:
               LD1
Pclass2 -0.9000483
Pclass3 -2.4622101

y_hat_lda <- predict(train_lda, test_set)
confusionMatrix(data = y_hat_lda, reference = test_set$Survived)

# Same result
# y_hat_class <- ifelse(test_set$Pclass == 1, 1, 0) %>% factor
# confusionMatrix(data = y_hat_class, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 94 37
         1 16 32
                                          
               Accuracy : 0.7039          
                 95% CI : (0.6312, 0.7697)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 0.007877        
                                          
                  Kappa : 0.3375          
                                          
 Mcnemar's Test P-Value : 0.006010        
                                          
            Sensitivity : 0.8545          
            Specificity : 0.4638          
         Pos Pred Value : 0.7176          
         Neg Pred Value : 0.6667          
             Prevalence : 0.6145          
         Detection Rate : 0.5251          
   Detection Prevalence : 0.7318          
      Balanced Accuracy : 0.6592          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_lda, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_lda, reference = test_set$Survived))

Accuracy: 0.70391061452514

F1 Score: 0.780083

LDA

Survival by Fare

We will look now the prediction of survival based on the fare as predictor.
Since the fare is not a binary outcome, we will show only the outcome of applying the LDA modelling.

train_lda <- train(Survived ~ Fare, method = "lda", data = train_set)
train_lda$finalModel

Call:
lda(x, grouping = y)

Prior probabilities of groups:
       0        1 
0.616573 0.383427 

Group means:
      Fare
0 22.48402
1 46.33185

Coefficients of linear discriminants:
            LD1
Fare 0.02019686

y_hat_lda <- predict(train_lda, test_set)
confusionMatrix(data = y_hat_lda, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction   0   1
         0 108  55
         1   2  14
                                          
               Accuracy : 0.6816          
                 95% CI : (0.6079, 0.7491)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 0.03747         
                                          
                  Kappa : 0.2156          
                                          
 Mcnemar's Test P-Value : 5.675e-12       
                                          
            Sensitivity : 0.9818          
            Specificity : 0.2029          
         Pos Pred Value : 0.6626          
         Neg Pred Value : 0.8750          
             Prevalence : 0.6145          
         Detection Rate : 0.6034          
   Detection Prevalence : 0.9106          
      Balanced Accuracy : 0.5924          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_lda, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_lda, reference = test_set$Survived))

Accuracy: 0.681564245810056

F1 Score: 0.7912088

LDA

Survival by all predictors

We apply LDA with all predictors.

train_lda <- train(Survived ~ ., method = "lda", data = train_set)
train_lda$finalModel

Call:
lda(x, grouping = y)

Prior probabilities of groups:
       0        1 
0.616573 0.383427 

Group means:
    Pclass2   Pclass3   Sexmale      Age     SibSp     Parch     Fare
0 0.1731207 0.6810934 0.8542141 29.52164 0.5740319 0.3553531 22.48402
1 0.2600733 0.3589744 0.3186813 28.01619 0.4688645 0.4615385 46.33185
   Embarked1 Embarked2
0 0.07972665 0.7767654
1 0.09523810 0.6263736

Coefficients of linear discriminants:
                    LD1
Pclass2   -0.6198554683
Pclass3   -1.4613454384
Sexmale   -2.1774753229
Age       -0.0237494889
SibSp     -0.2038785398
Parch     -0.0638750241
Fare       0.0004976597
Embarked1 -0.0184751726
Embarked2 -0.3276711208

y_hat_lda <- predict(train_lda, test_set)
confusionMatrix(data = y_hat_lda, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 93 20
         1 17 49
                                          
               Accuracy : 0.7933          
                 95% CI : (0.7265, 0.8501)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 2.276e-07       
                                          
                  Kappa : 0.5601          
                                          
 Mcnemar's Test P-Value : 0.7423          
                                          
            Sensitivity : 0.8455          
            Specificity : 0.7101          
         Pos Pred Value : 0.8230          
         Neg Pred Value : 0.7424          
             Prevalence : 0.6145          
         Detection Rate : 0.5196          
   Detection Prevalence : 0.6313          
      Balanced Accuracy : 0.7778          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_lda, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_lda, reference = test_set$Survived))

Accuracy: 0.793296089385475

F1 Score: 0.8340807

By analyzing the LDA models fitted, we can see that by using all predictors, we get the best accuracy and F1 Score. However the values are close to the model using only the Sex as predictor.
We will now apply QDA with the same predictors, to compare them with LDA.

Quadratic Discriminant Analysis (QDA)

Survival by Sex

Since the predictor Sex has only 2 classes the LDA model has the same standard deviation and correlation as the QDA model. Thus the QDA model will have the same confusion matrix.

train_qda <- train(Survived ~ Sex, method = "qda", data = train_set)
train_qda$finalModel

Call:
qda(x, grouping = y)

Prior probabilities of groups:
       0        1 
0.616573 0.383427 

Group means:
    Sexmale
0 0.8542141
1 0.3186813

y_hat_qda <- predict(train_qda, test_set)
confusionMatrix(data = y_hat_qda, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 93 22
         1 17 47
                                          
               Accuracy : 0.7821          
                 95% CI : (0.7144, 0.8402)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 1.268e-06       
                                          
                  Kappa : 0.5338          
                                          
 Mcnemar's Test P-Value : 0.5218          
                                          
            Sensitivity : 0.8455          
            Specificity : 0.6812          
         Pos Pred Value : 0.8087          
         Neg Pred Value : 0.7344          
             Prevalence : 0.6145          
         Detection Rate : 0.5196          
   Detection Prevalence : 0.6425          
      Balanced Accuracy : 0.7633          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_qda, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_qda, reference = test_set$Survived))

Accuracy: 0.782122905027933

F1 Score: 0.8266667

QDA

Survival by Passenger Class

The passenger class has more than 2 classes, so the QDA confusion matrix is different to the LDA model.

train_qda <- train(Survived ~ Pclass, method = "qda", data = train_set)
train_qda$finalModel

Call:
qda(x, grouping = y)

Prior probabilities of groups:
       0        1 
0.616573 0.383427 

Group means:
    Pclass2   Pclass3
0 0.1731207 0.6810934
1 0.2600733 0.3589744

y_hat_qda <- predict(train_qda, test_set)
confusionMatrix(data = y_hat_qda, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 73 21
         1 37 48
                                          
               Accuracy : 0.676           
                 95% CI : (0.6021, 0.7439)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 0.05225         
                                          
                  Kappa : 0.3444          
                                          
 Mcnemar's Test P-Value : 0.04888         
                                          
            Sensitivity : 0.6636          
            Specificity : 0.6957          
         Pos Pred Value : 0.7766          
         Neg Pred Value : 0.5647          
             Prevalence : 0.6145          
         Detection Rate : 0.4078          
   Detection Prevalence : 0.5251          
      Balanced Accuracy : 0.6796          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_qda, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_qda, reference = test_set$Survived))

Accuracy: 0.675977653631285

F1 Score: 0.7156863

QDA

Survival by Fare

train_qda <- train(Survived ~ Fare, method = "qda", data = train_set)
train_qda$finalModel

Call:
qda(x, grouping = y)

Prior probabilities of groups:
       0        1 
0.616573 0.383427 

Group means:
      Fare
0 22.48402
1 46.33185

y_hat_qda <- predict(train_qda, test_set)
confusionMatrix(data = y_hat_qda, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction   0   1
         0 106  49
         1   4  20
                                          
               Accuracy : 0.7039          
                 95% CI : (0.6312, 0.7697)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 0.007877        
                                          
                  Kappa : 0.2886          
                                          
 Mcnemar's Test P-Value : 1.505e-09       
                                          
            Sensitivity : 0.9636          
            Specificity : 0.2899          
         Pos Pred Value : 0.6839          
         Neg Pred Value : 0.8333          
             Prevalence : 0.6145          
         Detection Rate : 0.5922          
   Detection Prevalence : 0.8659          
      Balanced Accuracy : 0.6267          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_qda, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_qda, reference = test_set$Survived))

Accuracy: 0.70391061452514

F1 Score: 0.8

QDA

Survival by all predictors

Since the FamilySize is a redundant predictor as SibSp and Parch, we remove it from the training setting.

train_qda <- train(Survived ~ ., method = "qda", data = train_set)
train_qda$finalModel

Call:
qda(x, grouping = y)

Prior probabilities of groups:
       0        1 
0.616573 0.383427 

Group means:
    Pclass2   Pclass3   Sexmale      Age     SibSp     Parch     Fare
0 0.1731207 0.6810934 0.8542141 29.52164 0.5740319 0.3553531 22.48402
1 0.2600733 0.3589744 0.3186813 28.01619 0.4688645 0.4615385 46.33185
   Embarked1 Embarked2
0 0.07972665 0.7767654
1 0.09523810 0.6263736

y_hat_qda <- predict(train_qda, test_set)
confusionMatrix(data = y_hat_qda, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 94 21
         1 16 48
                                          
               Accuracy : 0.7933          
                 95% CI : (0.7265, 0.8501)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 2.276e-07       
                                          
                  Kappa : 0.5577          
                                          
 Mcnemar's Test P-Value : 0.5108          
                                          
            Sensitivity : 0.8545          
            Specificity : 0.6957          
         Pos Pred Value : 0.8174          
         Neg Pred Value : 0.7500          
             Prevalence : 0.6145          
         Detection Rate : 0.5251          
   Detection Prevalence : 0.6425          
      Balanced Accuracy : 0.7751          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_qda, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_qda, reference = test_set$Survived))

Accuracy: 0.793296089385475

F1 Score: 0.8355556

We can see that the QDA models had similar outcomes compared to LDA. The best model was also using all predictors. However the accuracy was still not better than 0.8 and the specificity was still low.

Logistic regression

Survival by Sex

We will start by applying only Sex as predictor with logistic regression.

train_glm <- train(Survived ~ Sex, method = "glm", data = train_set)
train_glm$finalModel

Call:  NULL

Coefficients:
(Intercept)      Sexmale  
      1.067       -2.528  

Degrees of Freedom: 711 Total (i.e. Null);  710 Residual
Null Deviance:	    948 
Residual Deviance: 731.4 	AIC: 735.4

y_hat_glm <- predict(train_glm, test_set)
confusionMatrix(data = y_hat_glm, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 93 22
         1 17 47
                                          
               Accuracy : 0.7821          
                 95% CI : (0.7144, 0.8402)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 1.268e-06       
                                          
                  Kappa : 0.5338          
                                          
 Mcnemar's Test P-Value : 0.5218          
                                          
            Sensitivity : 0.8455          
            Specificity : 0.6812          
         Pos Pred Value : 0.8087          
         Neg Pred Value : 0.7344          
             Prevalence : 0.6145          
         Detection Rate : 0.5196          
   Detection Prevalence : 0.6425          
      Balanced Accuracy : 0.7633          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_glm, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_glm, reference = test_set$Survived))

Accuracy: 0.782122905027933

F1 Score: 0.8266667

Logistic regression

Survival by Sex, Class, Fare and Age

Now we will apply Sex, Class, Fare and Age as predictors.

train_glm <- train(Survived ~ Sex + Pclass + Fare + Age, method = "glm", data = train_set)
train_glm$finalModel

Call:  NULL

Coefficients:
(Intercept)      Sexmale      Pclass2      Pclass3         Fare          Age  
  3.5490169   -2.6913595   -1.0957062   -2.3800005   -0.0004804   -0.0308464  

Degrees of Freedom: 711 Total (i.e. Null);  706 Residual
Null Deviance:	    948 
Residual Deviance: 642.1 	AIC: 654.1

y_hat_glm <- predict(train_glm, test_set)
confusionMatrix(data = y_hat_glm, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 95 20
         1 15 49
                                          
               Accuracy : 0.8045          
                 95% CI : (0.7387, 0.8599)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 3.582e-08       
                                          
                  Kappa : 0.5816          
                                          
 Mcnemar's Test P-Value : 0.499           
                                          
            Sensitivity : 0.8636          
            Specificity : 0.7101          
         Pos Pred Value : 0.8261          
         Neg Pred Value : 0.7656          
             Prevalence : 0.6145          
         Detection Rate : 0.5307          
   Detection Prevalence : 0.6425          
      Balanced Accuracy : 0.7869          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_glm, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_glm, reference = test_set$Survived))

Accuracy: 0.804469273743017

F1 Score: 0.8444444

Logistic regression

Survival by all predictors

train_glm <- train(Survived ~ ., method = "glm", data = train_set)
train_glm$finalModel

Call:  NULL

Coefficients:
(Intercept)      Pclass2      Pclass3      Sexmale          Age        SibSp  
  4.3269546   -0.9448976   -2.2626546   -2.8456935   -0.0380048   -0.3767974  
      Parch         Fare    Embarked1    Embarked2  
 -0.0793839    0.0008006   -0.0664178   -0.5202704  

Degrees of Freedom: 711 Total (i.e. Null);  702 Residual
Null Deviance:	    948 
Residual Deviance: 620 	AIC: 640

y_hat_glm <- predict(train_glm, test_set)
confusionMatrix(data = y_hat_glm, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 93 21
         1 17 48
                                          
               Accuracy : 0.7877          
                 95% CI : (0.7205, 0.8452)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 5.459e-07       
                                          
                  Kappa : 0.547           
                                          
 Mcnemar's Test P-Value : 0.6265          
                                          
            Sensitivity : 0.8455          
            Specificity : 0.6957          
         Pos Pred Value : 0.8158          
         Neg Pred Value : 0.7385          
             Prevalence : 0.6145          
         Detection Rate : 0.5196          
   Detection Prevalence : 0.6369          
      Balanced Accuracy : 0.7706          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_glm, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_glm, reference = test_set$Survived))

Accuracy: 0.787709497206704

F1 Score: 0.8303571

Logistic regression had a slightly better accuracy than previous models. By comparing all predictors, we can see that the number of family members and embarked port don't have valuable information as predictors.

K-nearest neighbors (Knn)

Survival by all predictors

We apply all predictors to knn. This method uses bootstrap samples for tuning the parameter k.

train_knn <- train(Survived ~ ., method = "knn",
                   data = train_set,
                   tuneGrid = data.frame(k = seq(3, 51, 2)))
train_knn$bestTune
train_knn$finalModel

A data.frame: 1 × 1

	k
	<dbl>
10	21

21-nearest neighbor model
Training set outcome distribution:

  0   1 
439 273 

y_hat_knn <- predict(train_knn, test_set, type = "raw")
confusionMatrix(data = y_hat_knn, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 93 33
         1 17 36
                                         
               Accuracy : 0.7207         
                 95% CI : (0.6488, 0.785)
    No Information Rate : 0.6145         
    P-Value [Acc > NIR] : 0.001895       
                                         
                  Kappa : 0.3838         
                                         
 Mcnemar's Test P-Value : 0.033895       
                                         
            Sensitivity : 0.8455         
            Specificity : 0.5217         
         Pos Pred Value : 0.7381         
         Neg Pred Value : 0.6792         
             Prevalence : 0.6145         
         Detection Rate : 0.5196         
   Detection Prevalence : 0.7039         
      Balanced Accuracy : 0.6836         
                                         
       'Positive' Class : 0              
                                         

confusionMatrix(data = y_hat_knn, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_knn, reference = test_set$Survived))

Accuracy: 0.720670391061452

F1 Score: 0.7881356

ggplot(train_knn, highlight = TRUE)

Knn

Survival by all predictors with 10-fold Cross-validation

The default parameter for the knn in this method is to use 25-fold cross-validation, with 25% of the data. We will apply 10-fold cross-validation, with 10% of the data.

control <- trainControl(method = "cv", number = 10, p = .9)
train_knn_cv <- train(Survived ~ ., method = "knn",
                   data = train_set,
                   tuneGrid = data.frame(k = seq(3, 51, 2)),
                   trControl = control)
train_knn_cv$bestTune
train_knn_cv$finalModel

A data.frame: 1 × 1

	k
	<dbl>
9	19

19-nearest neighbor model
Training set outcome distribution:

  0   1 
439 273 

y_hat_knn_cv <- predict(train_knn_cv, test_set, type = "raw")
confusionMatrix(data = y_hat_knn_cv, reference = test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 89 31
         1 21 38
                                          
               Accuracy : 0.7095          
                 95% CI : (0.6371, 0.7748)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 0.005023        
                                          
                  Kappa : 0.3698          
                                          
 Mcnemar's Test P-Value : 0.212003        
                                          
            Sensitivity : 0.8091          
            Specificity : 0.5507          
         Pos Pred Value : 0.7417          
         Neg Pred Value : 0.6441          
             Prevalence : 0.6145          
         Detection Rate : 0.4972          
   Detection Prevalence : 0.6704          
      Balanced Accuracy : 0.6799          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_knn_cv, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_knn_cv, reference = test_set$Survived))

Accuracy: 0.709497206703911

F1 Score: 0.773913

ggplot(train_knn_cv, highlight = TRUE)

Classification tree

Survival by all predictors

The classification tree uses cross-validation to find the best complexity parameter (cp) for the model, calculated by the Gini Index or the Entropy.

train_rpart <- train(Survived ~ ., method = "rpart", 
                   data = train_set,
                   tuneGrid = data.frame(cp = seq(0, 0.05, 0.002)))
train_rpart$bestTune
train_rpart$finalModel

A data.frame: 1 × 1

	cp
	<dbl>
7	0.012

n= 712 

node), split, n, loss, yval, (yprob)
      * denotes terminal node

 1) root 712 273 0 (0.61657303 0.38342697)  
   2) Sexmale>=0.5 462  87 0 (0.81168831 0.18831169)  
     4) Age>=13 429  69 0 (0.83916084 0.16083916)  
       8) Fare< 26.26875 317  32 0 (0.89905363 0.10094637) *
       9) Fare>=26.26875 112  37 0 (0.66964286 0.33035714)  
        18) Fare>=30.5979 80  19 0 (0.76250000 0.23750000) *
        19) Fare< 30.5979 32  14 1 (0.43750000 0.56250000)  
          38) Age>=38 16   5 0 (0.68750000 0.31250000) *
          39) Age< 38 16   3 1 (0.18750000 0.81250000) *
     5) Age< 13 33  15 1 (0.45454545 0.54545455)  
      10) SibSp>=2 15   1 0 (0.93333333 0.06666667) *
      11) SibSp< 2 18   1 1 (0.05555556 0.94444444) *
   3) Sexmale< 0.5 250  64 1 (0.25600000 0.74400000)  
     6) Pclass3>=0.5 120  59 1 (0.49166667 0.50833333)  
      12) Fare>=24.80835 22   2 0 (0.90909091 0.09090909) *
      13) Fare< 24.80835 98  39 1 (0.39795918 0.60204082) *
     7) Pclass3< 0.5 130   5 1 (0.03846154 0.96153846) *

plot(train_rpart$finalModel, margin = 0.1)
text(train_rpart$finalModel, cex = 1)

y_hat_rpart <- predict(train_rpart, test_set, type = "raw")
confusionMatrix(y_hat_rpart, test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 88 20
         1 22 49
                                          
               Accuracy : 0.7654          
                 95% CI : (0.6964, 0.8254)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 1.317e-05       
                                          
                  Kappa : 0.5074          
                                          
 Mcnemar's Test P-Value : 0.8774          
                                          
            Sensitivity : 0.8000          
            Specificity : 0.7101          
         Pos Pred Value : 0.8148          
         Neg Pred Value : 0.6901          
             Prevalence : 0.6145          
         Detection Rate : 0.4916          
   Detection Prevalence : 0.6034          
      Balanced Accuracy : 0.7551          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_rpart, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_rpart, reference = test_set$Survived))

Accuracy: 0.76536312849162

F1 Score: 0.8073394

ggplot(train_rpart, highlight = TRUE)

Random Forest

Survival by all predictors

Random Forest improves prediction performance and reduces instability of decision tree by averaging multiple decision trees, obtained through bootstrap samples.

train_rf <- train(Survived ~ ., method = "rf",
                  data = train_set,
                  ntree = 100,
                  tuneGrid = data.frame(mtry = seq(1:7)))
train_rf$bestTune
train_rf$finalModel

A data.frame: 1 × 1

	mtry
	<int>
3	3

Call:
 randomForest(x = x, y = y, ntree = 100, mtry = min(param$mtry,      ncol(x))) 
               Type of random forest: classification
                     Number of trees: 100
No. of variables tried at each split: 3

        OOB estimate of  error rate: 17.42%
Confusion matrix:
    0   1 class.error
0 399  40  0.09111617
1  84 189  0.30769231

y_hat_rf <- predict(train_rf, test_set, type = "raw")
confusionMatrix(y_hat_rf, test_set$Survived)

Confusion Matrix and Statistics

          Reference
Prediction  0  1
         0 97 19
         1 13 50
                                          
               Accuracy : 0.8212          
                 95% CI : (0.7571, 0.8744)
    No Information Rate : 0.6145          
    P-Value [Acc > NIR] : 1.725e-09       
                                          
                  Kappa : 0.6164          
                                          
 Mcnemar's Test P-Value : 0.3768          
                                          
            Sensitivity : 0.8818          
            Specificity : 0.7246          
         Pos Pred Value : 0.8362          
         Neg Pred Value : 0.7937          
             Prevalence : 0.6145          
         Detection Rate : 0.5419          
   Detection Prevalence : 0.6480          
      Balanced Accuracy : 0.8032          
                                          
       'Positive' Class : 0               
                                          

confusionMatrix(data = y_hat_rf, reference = test_set$Survived)$overall["Accuracy"]
cat("F1 Score:", F_meas(data = y_hat_rf, reference = test_set$Survived))

Accuracy: 0.82122905027933

F1 Score: 0.8584071

The variable importance shows which predictors have more importance in the random forest decisions.

varImp(train_rf)

rf variable importance

          Overall
Sexmale   100.000
Fare       62.069
Age        53.830
Pclass3    18.370
SibSp      13.299
Parch       8.192
Embarked2   4.369
Pclass2     3.492
Embarked1   0.000

ggplot(train_rf, highlight = TRUE)

In our approach the Random Forest model showed the best accuracy of all models. It has also increased specificity, compared to the others.
By checking its variable importance, we can see that the most important predictors are the sex, fare and age, which matches the initial analysis we presented previously over the data.