1 Objective

Pada kesempatan kali ini kita akan memprediksi klasifikasi kategori keselamatan para penumpang kapal Titanic yang tenggelam pada 15 April 1912.Data yang akan digunakan adalah dataset yang telah disediakan oleh platform Kaggle pada link dibawah berikut:

Kaggle Dataset:Titanic

2 Preparation

2.1 Import Library

library(dplyr)
library(caret)
library(e1071)
library(ROCR)
library(tidyr)
library(stringr)
library(partykit)
library(class)

2.2 Read Data

Input data & cek tipe data

titanic <- read.csv("data input/train.csv")
head(titanic)

Deskripsi Data

  • PassengerId : ID penumpang
  • Survived (target) : Kategori survival dimana 1 adalah yes atau selamat, 0 adalah no tidak selamat
  • Pclass: tipe kelas dari penumpang first class (1), second class (2), third class (3)
  • Sex : jenis kelamin
  • Age : usia penumpang
  • SibSp : Jumlah dari pasangan/saudara penumpang (siblings/spouse)
  • Parch : jumlah orangtua/anak penumpang
  • ticket : nomor tiket
  • fare :biaya kepergian penumpang
  • cabin : nomor kabin
  • Embarked : Pelabuhan kepergian C = Cherbourg, Q = Queenstown, S = Southampton

3 Data Wrangling

3.1 Cek Struktur Data

Cek & ubah tipe data yang belum sesuai

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" ...
#Ubah tipe data yang belum tepat
titanic <- titanic %>% 
  mutate_at(vars(Survived,Pclass, Sex, Embarked ), factor)
str(titanic)
#> 'data.frame':    891 obs. of  12 variables:
#>  $ PassengerId: int  1 2 3 4 5 6 7 8 9 10 ...
#>  $ Survived   : Factor w/ 2 levels "0","1": 1 2 2 2 1 1 1 1 2 2 ...
#>  $ Pclass     : Factor w/ 3 levels "1","2","3": 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        : 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     : 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   : Factor w/ 4 levels "","C","Q","S": 4 2 4 4 4 3 4 4 4 2 ...

3.2 Cek Data yang kosong

Terdapat missing values pada kolom Age untuk penumpang yang selamat dan tidak.

#Cek Data NA
colSums(is.na(titanic))
#> PassengerId    Survived      Pclass        Name         Sex         Age 
#>           0           0           0           0           0         177 
#>       SibSp       Parch      Ticket        Fare       Cabin    Embarked 
#>           0           0           0           0           0           0
na <- titanic[is.na(titanic$Age),]

#Cek sebaran data variable Age
hist(titanic$Age)

Untuk menjaga data tetap terdistribusi normal, maka akan diisikan nilai median.

#Impute missing values with Median
titanic <- titanic %>% mutate(across(Age, ~replace_na(., median(., na.rm=TRUE))))

Cek kembali setelah melakukan impute

colSums(is.na(titanic))
#> PassengerId    Survived      Pclass        Name         Sex         Age 
#>           0           0           0           0           0           0 
#>       SibSp       Parch      Ticket        Fare       Cabin    Embarked 
#>           0           0           0           0           0           0

4 Cross-Validation

4.1 Exclude variable

Sebelum dilakukan splitting data, akan diexclude variable yang seluruhnya unique

#Dilakukan exclude variable yang tidak bersifat numerik atau unique seluruhnya
titanic_split <- titanic %>% 
  select(-PassengerId, -Name, -Ticket, -Cabin)
str(titanic_split)
#> 'data.frame':    891 obs. of  8 variables:
#>  $ Survived: Factor w/ 2 levels "0","1": 1 2 2 2 1 1 1 1 2 2 ...
#>  $ Pclass  : Factor w/ 3 levels "1","2","3": 3 1 3 1 3 3 1 3 3 2 ...
#>  $ Sex     : Factor w/ 2 levels "female","male": 2 1 1 1 2 2 2 2 1 1 ...
#>  $ Age     : num  22 38 26 35 35 28 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 ...
#>  $ Fare    : num  7.25 71.28 7.92 53.1 8.05 ...
#>  $ Embarked: Factor w/ 4 levels "","C","Q","S": 4 2 4 4 4 3 4 4 4 2 ...

4.2 Split data

Dilakukan split data dimana data train akan diambil 80% dari data eksisting

#Set ke-randoman data
RNGkind(sample.kind = "Rounding")
set.seed(222)

#spli data train & test
index <- sample(nrow(titanic_split), nrow(titanic_split)*0.8)
titanic_train <- titanic_split[index,]
titanic_test <- titanic_split[-index,]
prop.table(table(titanic_train$Survived))
#> 
#>         0         1 
#> 0.6095506 0.3904494

Perbandingan variable target memiliki perbandingan 60:40. Masih dapat dikatakan balanced

4.3 Cek ketergantungan antar variable predictor

Salah satu syarat modeling naivebayes adalah antara prediktornya tidak boleh saling berhubungan kuat

#Cek korelasi antar prediktor
library(GGally)
ggcorr(titanic, label = T)

masing - masing prediktor tidak ada yang memiliki korelasi kuat positif maupun negatif(|x|>0.6) sehingga bisa dilakukan

5 Model Fitting

5.1 Naive Bayes

Dilakukan modelling naivebayes dengan data train titanic_train menggunakan seluruh prediktor

model_naive_titanic <- naiveBayes(Survived~., data = titanic_train, laplace = 1)

5.1.1 Predict Naive Bayes

pred_titanic <- predict(object = model_naive_titanic, newdata = titanic_test, type = "class")

5.1.2 Evaluasi Confussion Matrix

confu_nb <- confusionMatrix(pred_titanic, reference = titanic_test$Survived, positive = "1")
confu_nb
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  0  1
#>          0 96 25
#>          1 19 39
#>                                           
#>                Accuracy : 0.7542          
#>                  95% CI : (0.6844, 0.8154)
#>     No Information Rate : 0.6425          
#>     P-Value [Acc > NIR] : 0.0009041       
#>                                           
#>                   Kappa : 0.4536          
#>                                           
#>  Mcnemar's Test P-Value : 0.4509823       
#>                                           
#>             Sensitivity : 0.6094          
#>             Specificity : 0.8348          
#>          Pos Pred Value : 0.6724          
#>          Neg Pred Value : 0.7934          
#>              Prevalence : 0.3575          
#>          Detection Rate : 0.2179          
#>    Detection Prevalence : 0.3240          
#>       Balanced Accuracy : 0.7221          
#>                                           
#>        'Positive' Class : 1               
#>

5.1.3 Interpretasi evaluasi model Naive Bayes

Berdasarkan hasil evaluasi menggunakan confusion matrix, model naive bayes yang dibentuk mempunyai akurasi sebesar 75%. Namun perlu dievaluasi juga berdasarkan kasus False Positive & False Negative, dalam hal ini akan diambil kasus False Positive yakni “penumpang diprediksi hidup, namun ternyata tidak selamat” hal ini bertujuan untuk melihat keakuratan model terhadap karakteristik penumpang yang seharusnya selamat

Maka kita menggunakan evaluasi precision untuk melihat seberapa baik model kita memprediksi nilai positive dari yang terprediksi positive yakni sebesar 67%

confu_nb$byClass
#>          Sensitivity          Specificity       Pos Pred Value 
#>            0.6093750            0.8347826            0.6724138 
#>       Neg Pred Value            Precision               Recall 
#>            0.7933884            0.6724138            0.6093750 
#>                   F1           Prevalence       Detection Rate 
#>            0.6393443            0.3575419            0.2178771 
#> Detection Prevalence    Balanced Accuracy 
#>            0.3240223            0.7220788

Meskipun begitu, kita perlu memastikan apakah model kita dapat memisahkan kelas positive & negative dengan baik atau tidak, karena itu perlu kita lakukan evaluasi dengan ROC & AUC

5.1.4 ROC & AUC

Kita akan membuat hasil prediksi dalam bentuk probability

titanic_test$prob <- predict(model_naive_titanic, titanic_test, type="raw")
titanic_test$actual <- ifelse(titanic_test$Survived == 1, yes = 1, no = 0)
head(titanic_test$prob)
#>               0         1
#> [1,] 0.02384606 0.9761539
#> [2,] 0.10801554 0.8919845
#> [3,] 0.12775479 0.8722452
#> [4,] 0.44121905 0.5587809
#> [5,] 0.13411171 0.8658883
#> [6,] 0.49052950 0.5094705

5.1.4.1 ROC (Receiver-Operating Curve)

Selanjutnya akan kita ambil data probability untuk kolom Survived = 1 untuk selanjutnya dilakukan plotting ROC & AUC

# objek prediction
roc_pred <- prediction(predictions = titanic_test$prob[,2], # prediksi dalam peluang
                       labels = titanic_test$actual) # label asli dalam bentuk 1 & 0

# ROC curve
plot(performance(prediction.obj = roc_pred, "tpr", "fpr"))
abline(0,1, lty=2)

Berdasarkan grafik diatas, dapat dikatakan bahwa model memiliki True Positive Rate yang tinggi untuk nilai False positive rate yang rendah. Namun grafik ini masih sulit diinterpretasi, karena itu perlu dicek nilai AUC nya

5.1.4.2 AUC (Area Under Curve)

Berdasarkan nilai AUC yang diperoleh yakni sebesar 0.789 dapat disimpulkan bahwa model yang dibuat sudah baik dalam memisahkan target variable

auc_pred <- performance(prediction.obj = roc_pred, "auc")

auc_pred@y.values # tanda @ untuk mengakases nilai dari object auc_pred
#> [[1]]
#> [1] 0.7898098

Selanjutnya evaluasi ini akan kita bandingnkan dengan model lainnya yakni menggunakan decision-tree

5.2 Decision-Tree

model_tree_titanic <- ctree(Survived~., data = titanic_train)
plot(model_tree_titanic, type = "simple")

5.2.1 Predict Model Decision Tree

pred_tree_titanic <- predict(object = model_tree_titanic, newdata = titanic_test, type = "response")
confusionMatrix(data = pred_tree_titanic, reference = titanic_test$Survived, positive = "1")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  0  1
#>          0 99 20
#>          1 16 44
#>                                          
#>                Accuracy : 0.7989         
#>                  95% CI : (0.7326, 0.855)
#>     No Information Rate : 0.6425         
#>     P-Value [Acc > NIR] : 3.827e-06      
#>                                          
#>                   Kappa : 0.5561         
#>                                          
#>  Mcnemar's Test P-Value : 0.6171         
#>                                          
#>             Sensitivity : 0.6875         
#>             Specificity : 0.8609         
#>          Pos Pred Value : 0.7333         
#>          Neg Pred Value : 0.8319         
#>              Prevalence : 0.3575         
#>          Detection Rate : 0.2458         
#>    Detection Prevalence : 0.3352         
#>       Balanced Accuracy : 0.7742         
#>                                          
#>        'Positive' Class : 1              
#>

5.2.2 Interpretasi evaluasi model Decision-Tree

Berdasarkan hasil evaluasi menggunakan confusion matrix, model decision-tree yang dibentuk mempunyai akurasi sebesar 79%, dan juga nilai evaluasi precision sebesar 73%.

5.2.3 Tuning Model - Pruning

Berdasarkan hasil yang diperoleh dari model Decision-Tree jika dibandingkan dengan model naive bayes memiliki nilai lebih baik, namun dapat kita tuning untuk mendapatkan hasil lebih baik

Poin - poin yang akan dilakukan perubahan yakni

Nilai mincriterion (1-\(\alpha\)) akan dikurangi untuk mempermudah percabangan Nilai minsplit akan dikurangi menjadi 10 untuk mempermudah percabangan mempertimbangakan adanya jumlah data yang mencapai 10 setelah percabangan variable Age Nilai minbucket dikurangi menjadi 3 untuk mempermudah percabangan

model_tree_titanic_tuning <- ctree(Survived~., data = titanic_train, control = ctree_control(mincriterion = 0.8,minsplit = 10, minbucket = 3))
plot(model_tree_titanic_tuning, type = "simple")

pred_tree_titanic_tuning <- predict(object = model_tree_titanic_tuning, newdata = titanic_test, type = "response")
confusionMatrix(data = pred_tree_titanic_tuning, reference = titanic_test$Survived, positive = "1")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction   0   1
#>          0 108  28
#>          1   7  36
#>                                           
#>                Accuracy : 0.8045          
#>                  95% CI : (0.7387, 0.8599)
#>     No Information Rate : 0.6425          
#>     P-Value [Acc > NIR] : 1.675e-06       
#>                                           
#>                   Kappa : 0.541           
#>                                           
#>  Mcnemar's Test P-Value : 0.0007232       
#>                                           
#>             Sensitivity : 0.5625          
#>             Specificity : 0.9391          
#>          Pos Pred Value : 0.8372          
#>          Neg Pred Value : 0.7941          
#>              Prevalence : 0.3575          
#>          Detection Rate : 0.2011          
#>    Detection Prevalence : 0.2402          
#>       Balanced Accuracy : 0.7508          
#>                                           
#>        'Positive' Class : 1               
#>

5.2.3.1 Interpretasi evaluasi model tuning Decision-Tree

Berdasarkan hasil evaluasi menggunakan confusion matrix, model decision-tree yang dibentuk dengan tuning mempunyai akurasi yang meningkat yakni sebesar 80%. Selain itu model ini juga memiliki nilai precision sebesar 83.7% dimana nilai ini juga meningkat setelah dilakukan tuning. Namun mengalami penurunan nilai pada sensitiviy/recall.

6 Conclusion

Berdasarkan perbandingan nilai evaluasi akurasi & juga precision, untuk data titanic, model decision-tree menghasilkan prediksi yang lebih baik ketimbang model naive-bayes. Pada model decision-tree pun setelah dituning dapat menghasilkan nilai evaluasi yang lebih baik lagi. Namun perlu diingat proses tuning ini akan membuat model menjadi overfit, dan mengakibatkan penurunan pada nilai sensitivity/recall.