Pada latihan kali ini kita akan memprediksi survival dari penumpang kapal titanic berdasarkan kelas tiket, gender, sex, jumlah pasangan, jumlah saudara dan orang tua yang dibawa. Pemodelan dan prediksi ini akan menggunakan model naive bayes dan decision tree. Latihan ini menggunakan R studio dan library yang digunakan adalah sebagai berikut:
library(dplyr)
library(e1071)
library(caret)
library(rsample)
library(partykit)
library(randomForest)
library(readxl)
library(tidyr)
library(forcats)
library(ROCR)
Tahap pertama kita akan membaca data .csv dengan variabel bernama
Titanic
Titanic <- read.csv("titanic/train.csv", stringsAsFactors = TRUE)
Titanic
Survived: Survival of a Passenger; 0 = No, 1 = Yes
Pclass : Ticket class; 1 = 1st, 2 = 2nd, 3 = 3rd
Sex : Gender Age : Age in years
SibSp : of siblings / spouses aboard the Titanic
Parch : of parents / children aboard the Titanic
Ticket : Ticket number
Fare : Passenger fare
Cabin : Cabin number
Embarked : Port of Embarkation C = Cherbourg, Q =
Queenstown, S = Southampton
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 : 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 ...
Titanic %>% is.na() %>% colSums()
#> PassengerId Survived Pclass Name Sex Age
#> 0 0 0 0 0 177
#> SibSp Parch Ticket Fare Cabin Embarked
#> 0 0 0 0 0 0
Terdapat missing value pada data Titanic, yaitu pada data
Age. Maka dari itu kita akan melihat range data
Age, begitupun dengan outliers pada datanya menggunakan
boxplot.
summary(Titanic)
#> PassengerId Survived Pclass
#> Min. : 1.0 Min. :0.0000 Min. :1.000
#> 1st Qu.:223.5 1st Qu.:0.0000 1st Qu.:2.000
#> Median :446.0 Median :0.0000 Median :3.000
#> Mean :446.0 Mean :0.3838 Mean :2.309
#> 3rd Qu.:668.5 3rd Qu.:1.0000 3rd Qu.:3.000
#> Max. :891.0 Max. :1.0000 Max. :3.000
#>
#> Name Sex Age
#> Abbing, Mr. Anthony : 1 female:314 Min. : 0.42
#> Abbott, Mr. Rossmore Edward : 1 male :577 1st Qu.:20.12
#> Abbott, Mrs. Stanton (Rosa Hunt) : 1 Median :28.00
#> Abelson, Mr. Samuel : 1 Mean :29.70
#> Abelson, Mrs. Samuel (Hannah Wizosky): 1 3rd Qu.:38.00
#> Adahl, Mr. Mauritz Nils Martin : 1 Max. :80.00
#> (Other) :885 NA's :177
#> SibSp Parch Ticket Fare
#> Min. :0.000 Min. :0.0000 1601 : 7 Min. : 0.00
#> 1st Qu.:0.000 1st Qu.:0.0000 347082 : 7 1st Qu.: 7.91
#> Median :0.000 Median :0.0000 CA. 2343: 7 Median : 14.45
#> Mean :0.523 Mean :0.3816 3101295 : 6 Mean : 32.20
#> 3rd Qu.:1.000 3rd Qu.:0.0000 347088 : 6 3rd Qu.: 31.00
#> Max. :8.000 Max. :6.0000 CA 2144 : 6 Max. :512.33
#> (Other) :852
#> Cabin Embarked
#> :687 : 2
#> B96 B98 : 4 C:168
#> C23 C25 C27: 4 Q: 77
#> G6 : 4 S:644
#> C22 C26 : 3
#> D : 3
#> (Other) :186
boxplot(Titanic$Age, horizontal = TRUE)
Berdasarkan observasi dari data di atas, terdapat beberapa outliers yang dikhawatirkan akan membuat data mean menjadi tidak terlalu akurat untuk mengganti nilai missing value. Maka dari itu kita akan menggunakan data median yaitu 28
Titanic <- Titanic %>%
mutate_at(('Age'), ~replace_na(.,28))
anyNA(Titanic)
#> [1] FALSE
Setelah mengganti nilai missing value, maka sudah tidak terdapat missing value
Kita akan merubah tipe data Survived dan
Pclass menjadi tipe data factor, kemudian kita akan
menghilangkan kolom PassengerId, Cabin,
Ticket,dan Name karena tidak akan bisa
digunakan untuk melakukan modeling decision tree.
Titanic <- Titanic %>%
select(-c(PassengerId, Cabin, Ticket, Name)) %>%
mutate_at(vars(Survived, Pclass), as.factor)
Mengecek proporsi data
prop.table(table(Titanic$Survived))
#>
#> 0 1
#> 0.6161616 0.3838384
Proporsi data Survived masih balance (imbalance ketika
lebih besar dari 70:30)
Membagi data menjadi data train dan data test menjadi 75:25
RNGkind(sample.kind = "Rounding")
set.seed(100)
# train-test splitting
index <- sample(nrow(Titanic), nrow(Titanic)*0.75)
titanic_train <- Titanic[index, ]
titanic_test <- Titanic[-index, ]
Setelah membagi Titanic menjadi data train dan data
test, selanjutnya kita akan kembali mengecek proporsi data train.
prop.table(table(titanic_train$Survived))
#>
#> 0 1
#> 0.6092814 0.3907186
Proporsi data train Survived masih balance (imbalance
ketika lebih besar dari 70:30)
Selanjutnya kita akan melakukan modeling pada model naive bayes dengan manambahkan laplace = 1 karena terdapat nilai pada data survived = 0, yang mana tidak akan bisa untuk dilakukan prediksi naive bayes.
# train
model_nb_titanic <- naiveBayes(Survived~., titanic_train, laplace = 1)
Prediksi class dari data test dengan function
predict():
# predict class
pred_nb_titanic <- predict(object = model_nb_titanic,
newdata=titanic_test,
type="class")
Untuk mengevaluasi model naive bayes akan menggunakan confusion matrix sebagai berikut.
# confusion matrix
confusionMatrix(data = pred_nb_titanic, reference = titanic_test$Survived, positive = "1")
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction 0 1
#> 0 128 25
#> 1 14 56
#>
#> Accuracy : 0.8251
#> 95% CI : (0.7688, 0.8726)
#> No Information Rate : 0.6368
#> P-Value [Acc > NIR] : 0.0000000005202
#>
#> Kappa : 0.6106
#>
#> Mcnemar's Test P-Value : 0.1093
#>
#> Sensitivity : 0.6914
#> Specificity : 0.9014
#> Pos Pred Value : 0.8000
#> Neg Pred Value : 0.8366
#> Prevalence : 0.3632
#> Detection Rate : 0.2511
#> Detection Prevalence : 0.3139
#> Balanced Accuracy : 0.7964
#>
#> 'Positive' Class : 1
#>
Evaluasi berikutnya untuk membandingkan nilai True Positive Rate dan False Positive Rate dalam bentuk kurva. Diharapkan kurva memiliki nilai True Positive rate yang tinggi dan False positive rate yang rendah.
# ambil hasil prediksi data test dalam bentuk probability
titanic_test$pred <- predict(model_nb_titanic, titanic_test, type="raw")
Selanjutnya menyiapkan data frame untuk ROC dengan mengasumsikan kelas positifnya adalah Survived atau sama dengan nilai 1.
# menyiapkan actual dalam bentuk 1 & 0
titanic_test$actual <- ifelse(titanic_test$Survived == "1", yes = 1, no = 0)
Berikutnya adalah menggambarkan plot ROC dengan memasukkan nilai probability dari hasil prediksi, dan nilai aktual dari data tes.
# objek prediction
roc_pred <- prediction(predictions = titanic_test$pred[,2], # prediksi titanic 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 kurva telah menunjukkan bahwa kurva memiliki nilai True Positive rate yang tinggi dan False positive rate yang rendah. Untuk memastikan nilai ROC tersebut adalah yang terbaik, maka akan dihitung luas di bawah kurva terebut atau nilai AUC.
Luas AUC yang paling ideal adalah nilai yang mendekati 1, karena semakin baik performa model dalam memisahkan kelas positif dan negatif.
# nilai AUC
auc_pred <- performance(prediction.obj = roc_pred, "auc")
auc_pred@y.values # tanda @ untuk mengakases nilai dari object auc_pred
#> [[1]]
#> [1] 0.8764128
Berdasarkan hasil AUC, didapat nilainya adalah 0.876 yang menunjukkan nilainya cukup baik karena mendekati 1.
Selanjutnya kita akan membandingakan hasil model naive bayes dengan model decision tree.
dtree_model <- ctree(formula = Survived ~ .,
data = titanic_train)
plot(dtree_model, type = "simple")
## a. Evaluasi Data Train
Untuk memastikan model decision tree kita cukup baik, maka kita akan mengevaluasi masing-masing untuk data train dan data test
Berikut adalah prediksi pada kelas data train:
# prediksi kelas di data train
pred_titanic_train <- predict(dtree_model, titanic_train, type="response")
# confusion matrix data train
confusionMatrix(pred_titanic_train, titanic_train$Survived, positive = "1")
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction 0 1
#> 0 382 96
#> 1 25 165
#>
#> Accuracy : 0.8189
#> 95% CI : (0.7875, 0.8474)
#> No Information Rate : 0.6093
#> P-Value [Acc > NIR] : < 0.00000000000000022
#>
#> Kappa : 0.6
#>
#> Mcnemar's Test P-Value : 0.000000000197
#>
#> Sensitivity : 0.6322
#> Specificity : 0.9386
#> Pos Pred Value : 0.8684
#> Neg Pred Value : 0.7992
#> Prevalence : 0.3907
#> Detection Rate : 0.2470
#> Detection Prevalence : 0.2844
#> Balanced Accuracy : 0.7854
#>
#> 'Positive' Class : 1
#>
Berikut adalah prediksi pada kelas data test:
# prediksi kelas di data test
pred_titanic <- predict(dtree_model, titanic_test, type="response")
# confusion matrix data test
confusionMatrix(pred_titanic, titanic_test$Survived, positive = "1")
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction 0 1
#> 0 133 32
#> 1 9 49
#>
#> Accuracy : 0.8161
#> 95% CI : (0.759, 0.8647)
#> No Information Rate : 0.6368
#> P-Value [Acc > NIR] : 0.000000003602
#>
#> Kappa : 0.5767
#>
#> Mcnemar's Test P-Value : 0.0005908
#>
#> Sensitivity : 0.6049
#> Specificity : 0.9366
#> Pos Pred Value : 0.8448
#> Neg Pred Value : 0.8061
#> Prevalence : 0.3632
#> Detection Rate : 0.2197
#> Detection Prevalence : 0.2601
#> Balanced Accuracy : 0.7708
#>
#> 'Positive' Class : 1
#>
Berdasarkan hasil confusion matrix di atas, maka interpretasi modelnya dapat dijabarkan sebagai berikut:
FN : diprediksi not survive, padahal survived - Resiko: perkiraan terdapat penumpang yang tidak dapat diselamatkan pada saat itu
FP : diprediksi survived, padahal not survive - Resiko: perkiraan terdapat penumpang yang tidak selamat namun dianggap selamat.
Risiko yang concerning adalah jika terjadi kejadian FP, dikarenakan ini adalah data masa lampau, yang sensitif terdapat kesalahan data apabila jumlah yang tidak selamat lebih sedikit dibanding yang sebenarnya, maka dari itu kita akan mengambil matriks evaluasi Specificity
Perbandingan antara data train dan data test adalah sebagai berikut Naive Bayes: - Accuracy : 0.8251 - Specificity: 0.9014 Data Train: - Accuracy : 0.8186 - Specificity: 0.9386 Data Test: - Accuracy : 0.8161 - Specificity: 0.9366
Berdasarkan perbandingan hasil confusion matrix di atas menunjukkan bahwa model naive bayes adalah yang terbaik dalam memprediksi survival penumpang titanic.
Selanjutnya kita akan mencoba melakukan tuning terhadap model
dtree_model untuk mendapatkan nilai akurasi yang lebih
tinggi dibandingakan dua model yang telah diuji di atas.
tree_titanic_tuning <- ctree(formula = Survived ~ .,
data = titanic_train,
control = ctree_control(mincriterion = 0.90, # 1-alpha
minsplit = 15,
minbucket = 5))
Berikut adalah prediksi pada kelas data train setelah tuning:
# prediksi kelas di data train
tuned_titanic_train <- predict(tree_titanic_tuning, titanic_train, type="response")
# confusion matrix data train
confusionMatrix(tuned_titanic_train, titanic_train$Survived, positive = "1")
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction 0 1
#> 0 384 89
#> 1 23 172
#>
#> Accuracy : 0.8323
#> 95% CI : (0.8018, 0.8599)
#> No Information Rate : 0.6093
#> P-Value [Acc > NIR] : < 0.00000000000000022
#>
#> Kappa : 0.6311
#>
#> Mcnemar's Test P-Value : 0.0000000008153
#>
#> Sensitivity : 0.6590
#> Specificity : 0.9435
#> Pos Pred Value : 0.8821
#> Neg Pred Value : 0.8118
#> Prevalence : 0.3907
#> Detection Rate : 0.2575
#> Detection Prevalence : 0.2919
#> Balanced Accuracy : 0.8012
#>
#> 'Positive' Class : 1
#>
Berikut adalah prediksi pada kelas data test setelah tuning:
# prediksi kelas di data test
tuned_pred_titanic <- predict(tree_titanic_tuning, titanic_test, type="response")
# confusion matrix data test
confusionMatrix(tuned_pred_titanic, titanic_test$Survived, positive = "1")
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction 0 1
#> 0 135 30
#> 1 7 51
#>
#> Accuracy : 0.8341
#> 95% CI : (0.7786, 0.8804)
#> No Information Rate : 0.6368
#> P-Value [Acc > NIR] : 0.00000000006655
#>
#> Kappa : 0.618
#>
#> Mcnemar's Test P-Value : 0.0002983
#>
#> Sensitivity : 0.6296
#> Specificity : 0.9507
#> Pos Pred Value : 0.8793
#> Neg Pred Value : 0.8182
#> Prevalence : 0.3632
#> Detection Rate : 0.2287
#> Detection Prevalence : 0.2601
#> Balanced Accuracy : 0.7902
#>
#> 'Positive' Class : 1
#>
Setelah tuning didapatkan hasil sebagai berikut Data Train after Tuning: - Accuracy : 0.8323 - Specificity: 0.9435 Data Test after Tuning: - Accuracy : 0.8341 - Specificity: 0.9507
Kesimpulan dari modeling decision tree ini adalah bahwa semakin rendah parameter mincriterion, minsplit, dan minbucket sebagai custom characteristics untuk membangun model. Semakin rendah nilainya, maka akan semakin kompleks modelnya yang mana dapat meningkatkan akurasi untuk modelnya membuat prediksi.
Model Naive Bayes adalah model yang terikat pada nilai peluang, sedangkan model decision tree adalah model yang terikat pada tipe data faktor. Dikarenakan tuning pada naive bayes tidak cukup iteratif seperti model decision tree, maka model decision tree adalah model yang lebih fleksibel untuk mendapatkan akurasi lebih baik namun memiliki kecenderungan untuk untuk overfitting atau underfitting dibandingkan model naive bayes.