1 PENDAHULUAN

Tenggelamnya kapal Titanic adalah salah satu berita yang paling terkenal diseluruh dunia. Pada tanggal 15 April 1912, saat pelayaran perdananya, kapal Titanic secara luas dianggap tidak dapat tenggelam, tenggelam setelah bertabrakan dengan gunung es, yang mengakibatkan 1502 kematian dari 2224 penumpang dan awak kapal.

Meskipun ada beberapa elemen keberuntungan yang terlibat dalam bertahan hidup, tampaknya beberapa kelompok orang lebih mungkin untuk bertahan hidup daripada yang lain.

Untuk itu, kita akan membuat tiga model (Naive_Bayes, Decision Tree, dan Random Forest) untuk memprediksi orang seperti apa lebih mungkin untuk bertahan hidup? dengan menggunakan kolom Survived sebagai target variabelnya, dan model manakah yang paling akurat dalam memprediksi. Adapun data yang digunakan adalah dataset yang didapat dari https://www.kaggle.com/c/titanic.

2 EKSPLORASI DATA

2.1 Deskripsi

Data yang akan digunakan untuk membuat model adalah data yang didownload dari https://www.kaggle.com/c/titanic. Untuk mempermudah dalam pembuatan model maka kita menggabungkan data yang telah di download tersebut (train.csv, test.csv dan gender_submission.csv) menjadi satu data yang bernama titanic.xlsx.

2.2 Library

Library yang digunakan untuk membuat model kita adalah sebagai berikut :

library(tidyverse)
library(partykit)
library(randomForest)
library(caret)
library(e1071)
library(readxl)

2.3 Load Dataset

# load data set
titanic <- read_xlsx("titanic/titanic.xlsx")
glimpse(titanic)

## Rows: 1,309
## Columns: 12
## $ PassengerId <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, ...
## $ Survived    <dbl> 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 0, 1, 0...
## $ Pclass      <dbl> 3, 1, 3, 1, 3, 3, 1, 3, 3, 2, 3, 1, 3, 3, 3, 2, 3, 2, 3...
## $ Name        <chr> "Braund, Mr. Owen Harris", "Cumings, Mrs. John Bradley ...
## $ Sex         <chr> "male", "female", "female", "female", "male", "male", "...
## $ Age         <chr> "22", "38", "26", "35", "35", NA, "54", "2", "27", "14"...
## $ SibSp       <dbl> 1, 1, 0, 1, 0, 0, 0, 3, 0, 1, 1, 0, 0, 1, 0, 0, 4, 0, 1...
## $ Parch       <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, 1, 0, 0, 5, 0, 0, 1, 0, 0...
## $ Ticket      <chr> "A/5 21171", "PC 17599", "STON/O2. 3101282", "113803", ...
## $ Fare        <chr> "7.25", "712833", "7925", "53.1", "8.05", "84583", "518...
## $ Cabin       <chr> NA, "C85", NA, "C123", NA, NA, "E46", NA, NA, NA, "G6",...
## $ Embarked    <chr> "S", "C", "S", "S", "S", "Q", "S", "S", "S", "C", "S", ...

Data titanic terdapat 1309 baris dan 12 kolom variabel

Deskripsi data dari masing-masing kolom :

PassengerId : Id penumpang kapal titanic
Pclass : Proksi kelas status sosial ekonomi (SES) {1st=upper, 2nd=middle, 3rd=lower}
Name : Nama penumpang
Sex : Jenis Kelamin
Age : Usia Penumpang
SibSp : Hubungan keluarga (saudara = saudara laki-laki, saudara perempuan, saudara tiri)
Parch : Hubungan keluarga (orang tua = ibu/ayah, anak = anak perempuan, anak laki-laki, perempuan tiri)
Ticket : Nomor tiket kapal milik penumpang
Fare : Tarif penumpang
Cabin : No cabin
Embarked : Keberangkatan awal

2.4 Cek Korelasi

# cek korelasi tiap prediktor pada data set
GGally::ggcorr(titanic, hjust = 1, layout.exp = 2, label = T, label_size = 2.9)

## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2

## Warning in GGally::ggcorr(titanic, hjust = 1, layout.exp = 2, label = T, : data
## in column(s) 'Name', 'Sex', 'Age', 'Ticket', 'Fare', 'Cabin', 'Embarked' are not
## numeric and were ignored

# ubah tipe data kolom survived didataset dan buang prediktor yang tidak mempunyai korelasi

titanic <- titanic %>% 
  mutate(Survived = factor(Survived, levels = c(0,1),
                          labels = c("No","Yes"))) %>% 
  select(-c(Name, Sex, Age, Ticket, Fare, Cabin, Embarked))
head(titanic)

3 DATA CLEANING

Kita cek data train kita untuk memastikan ada tidaknya missing value

titanic %>% 
  is.na() %>% 
  colSums() %>% 
  enframe() %>% 
  arrange(desc(value))

Dari data diatas tidak terdapat missing value, maka kita lanjutkan ke tahap berikutnya.

4 CROSS VALIDATION

Langkah berkutnya yaitu melakukan cross validation dengan cara membagi data menjadi 2 : data train dan data set dengan proporsi 80:20

RNGkind(sample.kind = "Rounding")

## Warning in RNGkind(sample.kind = "Rounding"): non-uniform 'Rounding' sampler
## used

set.seed(100)

intrain_titanic <- sample(nrow(titanic), size = nrow(titanic) * 0.8)
train_titanic <- titanic[intrain_titanic,]
test_titanic <- titanic[-intrain_titanic,]

5 SUBSAMPLING DATA

Setelah kita membagi data menjadi 2, maka selanjutnya kita lihat proporsi tabel dari dataset apakah sudah seimbang atau belum. Jika belum maka kita lakukan Subsampling Data.

prop.table(table(titanic$Survived))

## 
##        No       Yes 
## 0.6226127 0.3773873

Kita dapatkan bahwa proporsi tidak seimbang, maka kita gunakan subsampling data pada data train kita dengan metode upsampling.

set.seed(47)
train_titanic <- upSample(x = select(train_titanic, -Survived),
                  y = train_titanic$Survived, 
                  yname = "Survived")

prop.table(table(train_titanic$Survived))

## 
##  No Yes 
## 0.5 0.5

Kita telah melakukan subsampling data dengan metode upsampling dan hasil yang didapat sudah seimbang dengan proporsi 50:50, maka langkah selanjutnya adalah membuat model.

6 MODELING

6.1 Decision Tree

# hint: function ctree(formula, data)
# mincreterion = 0.95

model_dtree <- ctree(formula = Survived ~., data = train_titanic)

plot(model_dtree, type = "simple")

## Random Forest

# mengatur k-fold cross validation

ctrl <- trainControl(method = "repeatedcv",
                     number = 5, # k-fold
                     repeats = 3) # repetisi

# hint: train_titanic(formula, data, method = "rf", trControl = ctrl)

model_rf <- train(Survived ~ ., 
                          data = train_titanic, 
                          method = "rf", 
                          trControl = ctrl)
saveRDS(model_rf, "model_rf_titanic.RDS") # simpan model

6.2 Naive Bayes

model_nb <- naiveBayes(x = train_titanic %>% 
                         select(-Survived),
                       y = train_titanic$Survived, 
                       laplace = 1)

7 PREDICT to DATA TEST

prediction_dtree <- predict(model_dtree, newdata = test_titanic)
  
prediction_rf <- predict(model_rf, newdata = test_titanic)
  
prediction_nb <- predict(model_nb, newdata = test_titanic)

8 EVALUASI PADA TIAP MODEL

Hint: positive class = “Yes”

Setelah kita membuat model dan memprediksinya, maka langkah selanjutnya adalah evaluasi model dengan confusion matrix untuk setiap model yang telah kita buat. (Note : positive class = “Yes”)

# confusion matrix hasil model prediksi decision tree

confusionMatrix(prediction_dtree, 
                reference = test_titanic$Survived, 
                positive = "Yes")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  105  32
##        Yes  69  56
##                                           
##                Accuracy : 0.6145          
##                  95% CI : (0.5526, 0.6738)
##     No Information Rate : 0.6641          
##     P-Value [Acc > NIR] : 0.9601506       
##                                           
##                   Kappa : 0.2172          
##                                           
##  Mcnemar's Test P-Value : 0.0003408       
##                                           
##             Sensitivity : 0.6364          
##             Specificity : 0.6034          
##          Pos Pred Value : 0.4480          
##          Neg Pred Value : 0.7664          
##              Prevalence : 0.3359          
##          Detection Rate : 0.2137          
##    Detection Prevalence : 0.4771          
##       Balanced Accuracy : 0.6199          
##                                           
##        'Positive' Class : Yes             
##

# confusion matrix hasil model prediksi random forest

confusionMatrix(data = prediction_rf, 
                reference = test_titanic$Survived, 
                positive =  "Yes")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  118  51
##        Yes  56  37
##                                           
##                Accuracy : 0.5916          
##                  95% CI : (0.5294, 0.6517)
##     No Information Rate : 0.6641          
##     P-Value [Acc > NIR] : 0.9941          
##                                           
##                   Kappa : 0.0972          
##                                           
##  Mcnemar's Test P-Value : 0.6990          
##                                           
##             Sensitivity : 0.4205          
##             Specificity : 0.6782          
##          Pos Pred Value : 0.3978          
##          Neg Pred Value : 0.6982          
##              Prevalence : 0.3359          
##          Detection Rate : 0.1412          
##    Detection Prevalence : 0.3550          
##       Balanced Accuracy : 0.5493          
##                                           
##        'Positive' Class : Yes             
##

# confusion matrix hasil model prediksi Naive Bayes

confusionMatrix(data = prediction_nb, 
                reference = test_titanic$Survived, 
                positive = "Yes")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  101  30
##        Yes  73  58
##                                           
##                Accuracy : 0.6069          
##                  95% CI : (0.5449, 0.6664)
##     No Information Rate : 0.6641          
##     P-Value [Acc > NIR] : 0.9777          
##                                           
##                   Kappa : 0.2137          
##                                           
##  Mcnemar's Test P-Value : 3.498e-05       
##                                           
##             Sensitivity : 0.6591          
##             Specificity : 0.5805          
##          Pos Pred Value : 0.4427          
##          Neg Pred Value : 0.7710          
##              Prevalence : 0.3359          
##          Detection Rate : 0.2214          
##    Detection Prevalence : 0.5000          
##       Balanced Accuracy : 0.6198          
##                                           
##        'Positive' Class : Yes             
##

Dari data di atas dapat dirangkum sebagai berikut :

performance_tiap_model <- data.frame(
  Model = c("Decision Tree", "Random Forest", "Naive Bayes"),
  Accuracy = c("0.6145", "0.5916", "0.6069"), 
  Recall = c("0.6364", "0.4205", "0.6591")
)
performance_tiap_model

9 KESIMPULAN

Karena kita ingin mengetahui orang yang survived = “Yes” atau dengan kata lain ingin meminimalisir False Negative, maka metrik yang cocok untuk prediksi kali ini adalah Recall(Sensitivity).
Karena metrik yang digunakan adalah Recall(Sensitivity), maka model yang paling baik untuk digunakan adalah Naive Bayes.

10 ROC & AUC

10.1 Receiver-Operating Curve (ROC)

# ambil hasil prediksi dalam bentuk probability
survived_prob <- predict(object = model_nb, 
                         newdata = test_titanic, 
                         type = "raw")

head(survived_prob)

##             No        Yes
## [1,] 0.5857452 0.41425482
## [2,] 0.9473810 0.05261902
## [3,] 0.2239017 0.77609829
## [4,] 0.5856328 0.41436715
## [5,] 0.9473336 0.05266641
## [6,] 0.2244625 0.77553748

Siapkan data frame untuk ROC (sebenarnya opsional, namun akan mempermudah). Kita asumsikan bahwa kelas positifnya adalah “Yes”.

# menyiapkan prediksi vs actual
data_roc <- data.frame(prediksi_prob = survived_prob[,"Yes"],
                       actual = ifelse(test_titanic$Survived == "Yes", 1, 0))


head(data_roc)

library(ROCR)

#object prediction

survived_roc <- prediction(predictions = data_roc$prediksi_prob, 
                           labels = data_roc$actual)

# ROC curve

plot(performance(survived_roc, "tpr", "fpr"))

## Area Under Curve (AUC)

survived_auc <- performance(survived_roc, measure = "auc")
survived_auc@y.values[[1]]

## [1] 0.6716954

plot(performance(survived_roc, "tpr", "fpr"))
abline(0, 1, lty = 2)
text(0.4, 0.6, paste("AUC = ", round(survived_auc@y.values[[1]], 2)))

Dari data di atas didapatkan nilai AUC = 0.67, yang dapat disimpulkan bahwa model menggunakan naive bayes sudah cukup baik dalam memisahkan kelas survived Yes dan No.

Prediksi Penumpang Kapal Titanic Yang Selamat

Maryanto

1/24/2021