Machine Learning Model: Titanic Survival Prediction

1 Introduction

Kecelakaan tenggelamnya kapal Titanic adalah salah satu peristiwa kapal karam paling terkenal dalam sejarah. Dalam kejadian kapal tenggelam, terdapat beberapa kelompok orang yang memiliki peluang lebih besar untuk selamat dibandingkan lainnya. Artikel ini akan membahas pembuatan model prediktif yang bertujuan untuk memprediksi kriteria orang yang lebih mungkin selamat, dengan menggunakan data titanic. Algoritma yang digunakan termasuk dalam kategori Supervised Learning, yaitu Logistic Regression dan KNN.

2 Data Preparation

2.1 Importing Libraries

library(dplyr)
library(gtools)
library(gmodels)
library(ggplot2)
library(class)
library(tidyr)
library(tidyverse)
library(caret)
library(plotly)
library(data.table)
library(GGally)
library(car)
library(scales)
library(tidymodels)
library(gridExtra)
library(ggstatsplot)
library(dplyr)
library(grid)
library(performance)

2.2 Importing Datasets

titanic <- read.csv("titanic.csv", sep = ',', header = TRUE)
str(titanic)
#> '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       : chr  "Braund, Mr. Owen Harris" "Cumings, Mrs. John Bradley (Florence Briggs Thayer)" "Heikkinen, Miss. Laina" "Futrelle, Mrs. Jacques Heath (Lily May Peel)" ...
#>  $ Sex        : chr  "male" "female" "female" "female" ...
#>  $ 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     : chr  "A/5 21171" "PC 17599" "STON/O2. 3101282" "113803" ...
#>  $ Fare       : num  7.25 71.28 7.92 53.1 8.05 ...
#>  $ Cabin      : chr  "" "C85" "" "C123" ...
#>  $ Embarked   : chr  "S" "C" "S" "S" ...

Data Dictionary : - PassengerId` : ID Penumpang - Survived : Survived/Not Survived - Pclass : Ticket class - Name : Nama Penumpang - Sex : Jenis Kelamin - Age : Usia - SibSp : Total Saudara di Titanic
- Parch : Total Orang Tua di Titanic - Ticket : No Tiket - Fare : Harga Tiket - Cabin : No Cabin - Embarked : Pelabuhan Keberangkatan

Target variabel = Survived

Beberapa tipe data variable perlu disesuaikan

2.3 Data Types

titanic$Sex <- as.factor(titanic$Sex)
titanic$Embarked <- as.factor(titanic$Embarked)
titanic <- titanic %>% 
  mutate_if(is.integer, as.factor) %>% 
  mutate(Survived = factor(Survived, levels = c(0,1), labels = c("Unsurvived","Survived")),
         Pclass = factor(Pclass, levels = c(1,2,3), labels = c("1st","2nd","3rd")))
glimpse(titanic)
#> Rows: 891
#> Columns: 12
#> $ PassengerId <fct> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,…
#> $ Survived    <fct> Unsurvived, Survived, Survived, Survived, Unsurvived, Unsu…
#> $ Pclass      <fct> 3rd, 1st, 3rd, 1st, 3rd, 3rd, 1st, 3rd, 3rd, 2nd, 3rd, 1st…
#> $ Name        <chr> "Braund, Mr. Owen Harris", "Cumings, Mrs. John Bradley (Fl…
#> $ Sex         <fct> male, female, female, female, male, male, male, male, fema…
#> $ Age         <dbl> 22, 38, 26, 35, 35, NA, 54, 2, 27, 14, 4, 58, 20, 39, 14, …
#> $ SibSp       <fct> 1, 1, 0, 1, 0, 0, 0, 3, 0, 1, 1, 0, 0, 1, 0, 0, 4, 0, 1, 0…
#> $ Parch       <fct> 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, 1, 0, 0, 5, 0, 0, 1, 0, 0, 0…
#> $ Ticket      <chr> "A/5 21171", "PC 17599", "STON/O2. 3101282", "113803", "37…
#> $ Fare        <dbl> 7.2500, 71.2833, 7.9250, 53.1000, 8.0500, 8.4583, 51.8625,…
#> $ Cabin       <chr> "", "C85", "", "C123", "", "", "E46", "", "", "", "G6", "C…
#> $ Embarked    <fct> S, C, S, S, S, Q, S, S, S, C, S, S, S, S, S, S, Q, S, S, C…

3 Exploratory Data Analysis

3.1 Duplicates

Cek data duplikat.

dup <- sum(duplicated(titanic))
dup
#> [1] 0

data titanic tidak memiliki data duplikat.

3.2 Missing Values

Cek Missing Values

mv <- colSums(is.na(x=titanic))
mv
#> PassengerId    Survived      Pclass        Name         Sex         Age 
#>           0           0           0           0           0         177 
#>       SibSp       Parch      Ticket        Fare       Cabin    Embarked 
#>           0           0           0           0           0           0

Variabel Age memiliki missing values, sehingga diperlukan penanganan dengan mengganti missing values dengan 0. Kemudian cek ulang missing values

titanic$Age <- replace_na(titanic$Age, 0)
mv <- colSums(is.na(x=titanic))
mv
#> PassengerId    Survived      Pclass        Name         Sex         Age 
#>           0           0           0           0           0           0 
#>       SibSp       Parch      Ticket        Fare       Cabin    Embarked 
#>           0           0           0           0           0           0

3.3 Proporsi Data

Cek proporsi target variabel Survived

prop.table(table(titanic$Survived))
#> 
#> Unsurvived   Survived 
#>  0.6161616  0.3838384

Proporsi kedua kelas dianggap seimbang.

3.4 Splitting Train-Test

Split data train dan test data data train = modeling data test = pengujian model.

set.seed(240899)
intrain <- sample(nrow(titanic), nrow(titanic)*0.7)
titanic_train <- titanic[intrain,]
titanic_test <- titanic[-intrain,]
titanic$Survived %>% levels()
#> [1] "Unsurvived" "Survived"

4 Modelling

4.1 Regresi Logistik

Target = Survived Feature = (Pclass,Sex,Age,SibSp,Parch,Fare).

Model

model_reglog <- glm(formula = Survived ~ Pclass + Sex + Age + SibSp + Parch + Fare, family = "binomial",                       data = titanic_train)
summary(model_reglog)
#> 
#> Call:
#> glm(formula = Survived ~ Pclass + Sex + Age + SibSp + Parch + 
#>     Fare, family = "binomial", data = titanic_train)
#> 
#> Coefficients:
#>                Estimate  Std. Error z value             Pr(>|z|)    
#> (Intercept)    2.789737    0.426583   6.540      0.0000000000616 ***
#> Pclass2nd     -0.979791    0.339809  -2.883              0.00393 ** 
#> Pclass3rd     -2.078434    0.339411  -6.124      0.0000000009146 ***
#> Sexmale       -2.707333    0.243196 -11.132 < 0.0000000000000002 ***
#> Age           -0.016869    0.006602  -2.555              0.01061 *  
#> SibSp1         0.153371    0.262814   0.584              0.55951    
#> SibSp2        -0.858049    0.783718  -1.095              0.27358    
#> SibSp3        -2.241771    0.845861  -2.650              0.00804 ** 
#> SibSp4        -2.341555    1.181785  -1.981              0.04755 *  
#> SibSp5       -15.760423  948.195900  -0.017              0.98674    
#> SibSp8       -17.126501 1056.732286  -0.016              0.98707    
#> Parch1         0.734393    0.349506   2.101              0.03562 *  
#> Parch2         0.297595    0.434749   0.685              0.49365    
#> Parch3         0.617524    1.204792   0.513              0.60826    
#> Parch4       -16.356561 1654.307691  -0.010              0.99211    
#> Parch5        -0.359054    1.383369  -0.260              0.79521    
#> Parch6       -16.753315 2399.544744  -0.007              0.99443    
#> Fare           0.001023    0.002924   0.350              0.72657    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 822.63  on 622  degrees of freedom
#> Residual deviance: 541.47  on 605  degrees of freedom
#> AIC: 577.47
#> 
#> Number of Fisher Scoring iterations: 15

Model Fitting

Model fitting menggunakan metode backward pada stepwise.

library(MASS)
model_reglog2 <- stepAIC(model_reglog, direction = "backward")
#> Start:  AIC=577.47
#> Survived ~ Pclass + Sex + Age + SibSp + Parch + Fare
#> 
#>          Df Deviance    AIC
#> - Parch   6   550.79 574.79
#> - Fare    1   541.60 575.60
#> <none>        541.47 577.47
#> - Age     1   548.16 582.16
#> - SibSp   6   562.62 586.62
#> - Pclass  2   582.12 614.12
#> - Sex     1   696.27 730.27
#> 
#> Step:  AIC=574.79
#> Survived ~ Pclass + Sex + Age + SibSp + Fare
#> 
#>          Df Deviance    AIC
#> - Fare    1   550.87 572.87
#> <none>        550.79 574.79
#> - Age     1   559.86 581.86
#> - SibSp   6   572.12 584.12
#> - Pclass  2   597.78 617.78
#> - Sex     1   715.53 737.53
#> 
#> Step:  AIC=572.87
#> Survived ~ Pclass + Sex + Age + SibSp
#> 
#>          Df Deviance    AIC
#> <none>        550.87 572.87
#> - Age     1   560.03 580.03
#> - SibSp   6   572.46 582.46
#> - Pclass  2   620.11 638.11
#> - Sex     1   716.61 736.61
summary(model_reglog2)
#> 
#> Call:
#> glm(formula = Survived ~ Pclass + Sex + Age + SibSp, family = "binomial", 
#>     data = titanic_train)
#> 
#> Coefficients:
#>                Estimate  Std. Error z value             Pr(>|z|)    
#> (Intercept)    2.992931    0.365827   8.181 0.000000000000000281 ***
#> Pclass2nd     -0.979911    0.299434  -3.273              0.00107 ** 
#> Pclass3rd     -2.191961    0.283721  -7.726 0.000000000000011118 ***
#> Sexmale       -2.711808    0.236272 -11.477 < 0.0000000000000002 ***
#> Age           -0.019222    0.006452  -2.979              0.00289 ** 
#> SibSp1         0.265525    0.244871   1.084              0.27821    
#> SibSp2        -0.636717    0.736430  -0.865              0.38726    
#> SibSp3        -1.790595    0.792588  -2.259              0.02387 *  
#> SibSp4        -2.062606    1.130946  -1.824              0.06818 .  
#> SibSp5       -15.470634  948.466255  -0.016              0.98699    
#> SibSp8       -16.843135 1054.506286  -0.016              0.98726    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 822.63  on 622  degrees of freedom
#> Residual deviance: 550.87  on 612  degrees of freedom
#> AIC: 572.87
#> 
#> Number of Fisher Scoring iterations: 15

Prediksi

Prediksi target menggunakan hasil dari stepwise. Cek sebaran peluang dari hasil prediksi data

titanic_test$prob_titanic <- predict(model_reglog2, type = "response", newdata = titanic_test)
ggplot(titanic_test, aes(x=prob_titanic)) + geom_density(lwd=0.5) + 
  labs(title = "Distribution of Probability Predict Data") + theme_minimal()

Pada grafik di atas, dapat dilihat bahwa hasil prediksi yang dilakukan lebih condong ke arah 0 yang artinya Unsurvived

titanic_test$pred_titanic <- factor(ifelse(titanic_test$prob_titanic > 0.5, "Survived","Unsurvived"))
titanic_test[1:10, c("pred_titanic","Survived")]
#>    pred_titanic   Survived
#> 5    Unsurvived Unsurvived
#> 7    Unsurvived Unsurvived
#> 9      Survived   Survived
#> 16     Survived   Survived
#> 37   Unsurvived   Survived
#> 38   Unsurvived Unsurvived
#> 39   Unsurvived Unsurvived
#> 44     Survived   Survived
#> 45     Survived   Survived
#> 48     Survived   Survived

hasil probabilitas data test lebih dari 0,5 artinya penumpang Survived.

Model Evaluation

Pada model regresi logistik akan digunakan confusion matrix sebagai metriks evaluasi.

📌 Keterangan • Re-call/Sensitivity = dari semua data aktual yang positif, seberapa mampu proporsi model saya menebak benar. • Specificity = dari semua data aktual yang negatif, seberapa mampu proporsi model saya menebak yang benar. • Accuracy = seberapa mampu model saya menebak dengan benar target Y. • Precision = dari semua hasil prediksi, seberapa mampu model saya dapat menebak benar kelas positif.

library(caret)
log_conf <- confusionMatrix(titanic_test$pred_titanic, titanic_test$Survived, positive = "Survived")
log_conf
#> Confusion Matrix and Statistics
#> 
#>             Reference
#> Prediction   Unsurvived Survived
#>   Unsurvived        133       27
#>   Survived           25       83
#>                                              
#>                Accuracy : 0.806              
#>                  95% CI : (0.7535, 0.8516)   
#>     No Information Rate : 0.5896             
#>     P-Value [Acc > NIR] : 0.00000000000003612
#>                                              
#>                   Kappa : 0.598              
#>                                              
#>  Mcnemar's Test P-Value : 0.8897             
#>                                              
#>             Sensitivity : 0.7545             
#>             Specificity : 0.8418             
#>          Pos Pred Value : 0.7685             
#>          Neg Pred Value : 0.8313             
#>              Prevalence : 0.4104             
#>          Detection Rate : 0.3097             
#>    Detection Prevalence : 0.4030             
#>       Balanced Accuracy : 0.7982             
#>                                              
#>        'Positive' Class : Survived           
#>

💡 Interpretasi

Berikut hasil confusion matrix Akurasi model : 80,6%
Kemampuan model mem-proyeksi penumpang Survived : 75,5% Kemampuan model mem-proyeksi penumpang `Unsurvived : 84,2%.

4.1 KNN

Algoritma k-Nearest Neighbor (KNN) adalah salah satu algoritma dalam supervised learning yang mengklasifikasikan objek baru berdasarkan mayoritas dari kategori k terdekat. Algoritma ini bekerja dengan mencari kategori terdekat dari data yang baru diberikan berdasarkan jarak euclidean atau jarak manhattan.

Pre-Processing Data

membuat variable dummy dari variabel kategori

dmy <- dummyVars (" ~Survived+Pclass+Sex+SibSp+Parch", data = titanic)
dmy <- data.frame(predict(dmy, newdata = titanic))
str(dmy)
#> 'data.frame':    891 obs. of  21 variables:
#>  $ Survived.Unsurvived: num  1 0 0 0 1 1 1 1 0 0 ...
#>  $ Survived.Survived  : num  0 1 1 1 0 0 0 0 1 1 ...
#>  $ Pclass.1st         : num  0 1 0 1 0 0 1 0 0 0 ...
#>  $ Pclass.2nd         : num  0 0 0 0 0 0 0 0 0 1 ...
#>  $ Pclass.3rd         : num  1 0 1 0 1 1 0 1 1 0 ...
#>  $ Sex.female         : num  0 1 1 1 0 0 0 0 1 1 ...
#>  $ Sex.male           : num  1 0 0 0 1 1 1 1 0 0 ...
#>  $ SibSp.0            : num  0 0 1 0 1 1 1 0 1 0 ...
#>  $ SibSp.1            : num  1 1 0 1 0 0 0 0 0 1 ...
#>  $ SibSp.2            : num  0 0 0 0 0 0 0 0 0 0 ...
#>  $ SibSp.3            : num  0 0 0 0 0 0 0 1 0 0 ...
#>  $ SibSp.4            : num  0 0 0 0 0 0 0 0 0 0 ...
#>  $ SibSp.5            : num  0 0 0 0 0 0 0 0 0 0 ...
#>  $ SibSp.8            : num  0 0 0 0 0 0 0 0 0 0 ...
#>  $ Parch.0            : num  1 1 1 1 1 1 1 0 0 1 ...
#>  $ Parch.1            : num  0 0 0 0 0 0 0 1 0 0 ...
#>  $ Parch.2            : num  0 0 0 0 0 0 0 0 1 0 ...
#>  $ Parch.3            : num  0 0 0 0 0 0 0 0 0 0 ...
#>  $ Parch.4            : num  0 0 0 0 0 0 0 0 0 0 ...
#>  $ Parch.5            : num  0 0 0 0 0 0 0 0 0 0 ...
#>  $ Parch.6            : num  0 0 0 0 0 0 0 0 0 0 ...

variabel dummy pada data seblumnya dihapus.

dmy$Survived.Not.Survived <- NULL
dmy$Sex.Female <- NULL
names(dmy)
#>  [1] "Survived.Unsurvived" "Survived.Survived"   "Pclass.1st"         
#>  [4] "Pclass.2nd"          "Pclass.3rd"          "Sex.female"         
#>  [7] "Sex.male"            "SibSp.0"             "SibSp.1"            
#> [10] "SibSp.2"             "SibSp.3"             "SibSp.4"            
#> [13] "SibSp.5"             "SibSp.8"             "Parch.0"            
#> [16] "Parch.1"             "Parch.2"             "Parch.3"            
#> [19] "Parch.4"             "Parch.5"             "Parch.6"

Membagi data train dan test baru dari data dmy yang telah terbentuk

set.seed(240899)
intrain <- sample(nrow(titanic), nrow(titanic)*0.7)
dmy_train <- dmy[intrain,]
dmy_test <- dmy[-intrain,]
dmy_train_label <- dmy[intrain,1]
dmy_test_label <- dmy[-intrain,1]

Prediksi

Selanjutnya dilakukan prediksi dengan KNN

pred_knn <- class::knn(train = dmy_train, test = dmy_test, cl = dmy_train_label, k = 10)

Model Evaluation

Selanjutnya akan dibuat confusion matrix dari hasil prediksi KNN

pred_knn_conf <- confusionMatrix(as.factor(pred_knn), as.factor(dmy_test_label), "1")
pred_knn_conf
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction   0   1
#>          0 110   0
#>          1   0 158
#>                                                
#>                Accuracy : 1                    
#>                  95% CI : (0.9863, 1)          
#>     No Information Rate : 0.5896               
#>     P-Value [Acc > NIR] : < 0.00000000000000022
#>                                                
#>                   Kappa : 1                    
#>                                                
#>  Mcnemar's Test P-Value : NA                   
#>                                                
#>             Sensitivity : 1.0000               
#>             Specificity : 1.0000               
#>          Pos Pred Value : 1.0000               
#>          Neg Pred Value : 1.0000               
#>              Prevalence : 0.5896               
#>          Detection Rate : 0.5896               
#>    Detection Prevalence : 0.5896               
#>       Balanced Accuracy : 1.0000               
#>                                                
#>        'Positive' Class : 1                    
#>

💡 Interpretasi

Berikut hasil confusion matrix Akurasi model KNN : 92,16%
Kemampuan model mem-prediksi penumpang Survived : 84,5% Kemampuan model mem-prediksi penumpang Unsurvived : 97,5%

5 Model Evaluation : Logistic Regression vs KNN

Perbandingan efektifitas model dari Regresi Logistik dan KNN

#*Model Evaluation Logit*
eval_logit <- data_frame(Accuracy = log_conf$overall[1],
                         Recall = log_conf$byClass[1],
                         Specificity = log_conf$byClass[2],
                         Precision = log_conf$byClass[3])
print("Model Evaluation Logit")
#> [1] "Model Evaluation Logit"
eval_logit
#> # A tibble: 1 × 4
#>   Accuracy Recall Specificity Precision
#>      <dbl>  <dbl>       <dbl>     <dbl>
#> 1    0.806  0.755       0.842     0.769
#*Model Evaluation KNN*
eval_knn <- data_frame(Accuracy = pred_knn_conf$overall[1],
                       Recall = pred_knn_conf$byClass[1],
                       Specificity = log_conf$byClass[2],
                       Precision = pred_knn_conf$byClass[3])
print("Model Evaluation KNN")
#> [1] "Model Evaluation KNN"
eval_knn
#> # A tibble: 1 × 4
#>   Accuracy Recall Specificity Precision
#>      <dbl>  <dbl>       <dbl>     <dbl>
#> 1        1      1       0.842         1

Berdasarkan hasil perbandingan evaluasi kedua model, model KNN lebih baik berdasarkan Accuracy, Recall, dan Precision. Sedangkan berdasarkan Specificity kedua model memiliki nilai yang sama. Dapat disimpulkan model KNN lebih unggul dalam memprediksi Survived maupun Unsurvived penumpang kapal Titanic.

6 Conclusion

Dalam kasus prediksi penumpang Kapal Titanic yang Survived atau Unsurvived, kedua model yang digunakan, yaitu KNN dan Regresi Logistik, menunjukkan akurasi yang tinggi. Namun, berdasarkan Confusion Matrix, KNN lebih unggul dalam memberikan prediksi yang lebih akurat dibandingkan dengan Regresi Logistik.

Jika tujuan analisis adalah memaksimalkan jumlah prediksi benar untuk kategori positif maupun negatif, maka metrik yang sesuai untuk digunakan adalah accuracy. Namun, jika fokus utama adalah pada klasifikasi kategori positif, maka metrik yang menjadi prioritas adalah precision. Selain itu, dalam situasi di mana kesalahan dalam mengidentifikasi kategori tertentu memiliki dampak yang signifikan, pemilihan metrik seperti F1-score juga dapat dipertimbangkan agar hasil prediksi lebih relevan dengan kebutuhan analisis.