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 apakah data yang NA hanya terdapat pada 1 target variable saja
table(na$Survived)
#> 
#>   0   1 
#> 125  52
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 Model Fitting

4.3.1 Logistic Regression

model_titanic_logistic <- glm(formula = Survived ~ .,
                  data = titanic_train,
                  family = "binomial")  

summary(model_titanic_logistic)
#> 
#> Call:
#> glm(formula = Survived ~ ., family = "binomial", data = titanic_train)
#> 
#> Coefficients:
#>               Estimate Std. Error z value Pr(>|z|)    
#> (Intercept)  16.377366 611.653872   0.027  0.97864    
#> Pclass2      -1.122359   0.343993  -3.263  0.00110 ** 
#> Pclass3      -2.311315   0.348083  -6.640 3.13e-11 ***
#> Sexmale      -2.862859   0.232517 -12.312  < 2e-16 ***
#> Age          -0.038532   0.008999  -4.282 1.85e-05 ***
#> SibSp        -0.394663   0.125131  -3.154  0.00161 ** 
#> Parch        -0.149238   0.138641  -1.076  0.28173    
#> Fare          0.002225   0.003027   0.735  0.46224    
#> EmbarkedC   -12.048049 611.653722  -0.020  0.98428    
#> EmbarkedQ   -11.895595 611.653782  -0.019  0.98448    
#> EmbarkedS   -12.442659 611.653704  -0.020  0.98377    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 952.58  on 711  degrees of freedom
#> Residual deviance: 607.69  on 701  degrees of freedom
#> AIC: 629.69
#> 
#> Number of Fisher Scoring iterations: 13

Dari hasil diatas, didapatkan 4 variable prediktor yang memberikan signifikansi besar terhadap nilai log of odds. Karena itu akan dilakukan stepwise regression untuk mendapatkan prediktor yang memang memberikan signifikansi paling tinggi, dan juga menghasilkan informational loss AIC paling rendah

Kita akan menggunakan stepwise regression dengan direction backward

model_titanic_backward <- step(object = model_titanic_logistic, direction = "backward", trace = F)

summary(model_titanic_backward)
#> 
#> Call:
#> glm(formula = Survived ~ Pclass + Sex + Age + SibSp, family = "binomial", 
#>     data = titanic_train)
#> 
#> Coefficients:
#>              Estimate Std. Error z value Pr(>|z|)    
#> (Intercept)  4.248757   0.460017   9.236  < 2e-16 ***
#> Pclass2     -1.366577   0.298840  -4.573 4.81e-06 ***
#> Pclass3     -2.468226   0.278265  -8.870  < 2e-16 ***
#> Sexmale     -2.889007   0.224783 -12.852  < 2e-16 ***
#> Age         -0.038527   0.008882  -4.337 1.44e-05 ***
#> SibSp       -0.449240   0.118910  -3.778 0.000158 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 952.58  on 711  degrees of freedom
#> Residual deviance: 613.88  on 706  degrees of freedom
#> AIC: 625.88
#> 
#> Number of Fisher Scoring iterations: 5

4.3.1.1 Model Evaluation

Berdasarkan nilai AIC, didapatkan nilai AIC yang lebih rendah pada saat menggunakan stepwise regression yakni memiliki nilai AIC sebesar 625.88

model_titanic_backward$aic
#> [1] 625.8801
model_titanic_logistic$aic
#> [1] 629.6868

Sebelum melihat hasil prediksi, kita akan membuat model menggunakan K-Nearest Neighbor terlebih dahulu

4.3.2 K-NN

4.3.2.1 Splitting data

Splitting data prediktor & data target pada data train dan data test.

Karena KNN hanya bekerja dengan baik pada prediktor numerik, maka perlu kita pisahkan terlebih dahulu

# prediktor data train
titanic_train_x <- titanic_train %>% select_if(is.numeric)

# target data train
titanic_train_y <- titanic_train[,"Survived"]

# prediktor data test
titanic_test_x <- titanic_test %>% select_if(is.numeric)

# target data test
titanic_test_y <- titanic_test[,"Survived"]

4.3.2.2 Scaling

Karena prediktor kita memiliki range yang jauh berbeda, maka akan dilakukan scaling agar nilainya sebanding

summary(titanic_test_x)
#>       Age            SibSp            Parch             Fare        
#>  Min.   : 0.67   Min.   :0.0000   Min.   :0.0000   Min.   :  0.000  
#>  1st Qu.:23.00   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:  7.896  
#>  Median :28.00   Median :0.0000   Median :0.0000   Median : 14.454  
#>  Mean   :29.29   Mean   :0.3575   Mean   :0.3464   Mean   : 29.277  
#>  3rd Qu.:35.00   3rd Qu.:1.0000   3rd Qu.:0.0000   3rd Qu.: 29.413  
#>  Max.   :62.00   Max.   :4.0000   Max.   :6.0000   Max.   :512.329
# scaling data
# train
titanic_train_xs <- scale(x = titanic_train_x) # data prediktor untuk data train

# test
titanic_test_xs <- scale(x = titanic_test_x,
                      center = attr(titanic_train_xs, "scaled:center"), #nilai rata2 data
                      scale = attr(titanic_train_xs,"scaled:scale"))

4.3.2.3 Find Optimum K Value

Nilai K dapat dicari dengan mencari akar kuadrat dari jumlah data yang kita miliki

sqrt(nrow(titanic_train))
#> [1] 26.68333

karena ada 4 predictor maka dipilih k ganjil = 27

5 Test Model

Untuk mengevaluasi prediksi, kita akan melakukan evaluasi menggunakan confusion matrix. Selanjutnya kita akan mengevaluasi berdasarkan nilai False Positive dimana nilai positive yang digunakan adalah nilai Survived = 1 atau penumapng dinyatakan hidup

Berdasarkan penjelasan diatas, akan diambil evaluasi Precisition atau Positive Prediction Value

5.1 K-NN Method

Setelah mendapatkan parameter yang diperlukan untuk memprediksi menggunakan K-NN, selanjutnya akan kita uji untuk memprediksi menggunakan data test/unseen data

5.1.1 Predicting Survival

pred_knn <- knn(train = titanic_train_xs, # prediktor data train
                test = titanic_test_xs, # prediktor data test
                cl = titanic_train_y, # label dari data train
                k = 27)

5.1.2 Interpretation

Menggunakan metode K-NN, kita mendapatkan nilai akurasi sebesar 69.8%

conf_knn <- confusionMatrix(pred_knn, titanic_test_y, positive = "1")
conf_knn$overall
#>       Accuracy          Kappa  AccuracyLower  AccuracyUpper   AccuracyNull 
#>     0.69832402     0.30480437     0.62539282     0.76455206     0.64245810 
#> AccuracyPValue  McnemarPValue 
#>     0.06789604     0.04122683

Juga nilai precision sebesar 60.4%

conf_knn$byClass
#>          Sensitivity          Specificity       Pos Pred Value 
#>            0.4531250            0.8347826            0.6041667 
#>       Neg Pred Value            Precision               Recall 
#>            0.7328244            0.6041667            0.4531250 
#>                   F1           Prevalence       Detection Rate 
#>            0.5178571            0.3575419            0.1620112 
#> Detection Prevalence    Balanced Accuracy 
#>            0.2681564            0.6439538

5.2 Logistic Regression

Sama seperti K-NN, kita akan menguji prediksi menggunakan data test/unseen data

5.2.1 Predicting Survival

Selanjutnya kita akan melakukan prediksi menggunakan model_titanic_backward menggunakan data test

Dipilih parameter response untuk menghasilkan nilai probability dan bukan log of odds

pred_titanic_logistic <-  predict(model_titanic_backward, newdata = titanic_test, type = "response")

Hasil probability akan dilakukan pemisahan dimana nilai probability yang lebih tinggi dari 0.5 akan dianggap masuk ke kategori Survived = 1 dan sebaliknya

# ubah peluang menjadi label prediksi
# ifelse(kondisi, benar, salah)
label_titanic_logistic <- ifelse(pred_titanic_logistic > 0.5, 1, 0)

Setelah mengklasifikasikan kategori prediksi survived, selanjutnya akan dilakukan evaluasi menggunakan confusion matrix

conf_logis <- confusionMatrix(as.factor(label_titanic_logistic), titanic_test$Survived, positive = "1")

5.2.2 Interpretation

Berdasarkan nilai confusion matrix, didapatkan nilai akurasi dari prediksi logistic regression sebesar 76.5%

conf_logis$overall
#>       Accuracy          Kappa  AccuracyLower  AccuracyUpper   AccuracyNull 
#>   0.7653631285   0.4996672434   0.6963625083   0.8253581886   0.6424581006 
#> AccuracyPValue  McnemarPValue 
#>   0.0002764728   0.4404006981

Selain itu nilai precision yang didapatkan dari prediksi logistic regression yakni sebesar 65.7%

conf_logis$byClass
#>          Sensitivity          Specificity       Pos Pred Value 
#>            0.7187500            0.7913043            0.6571429 
#>       Neg Pred Value            Precision               Recall 
#>            0.8348624            0.6571429            0.7187500 
#>                   F1           Prevalence       Detection Rate 
#>            0.6865672            0.3575419            0.2569832 
#> Detection Prevalence    Balanced Accuracy 
#>            0.3910615            0.7550272

6 Conclusion

Berdasarkan percobaan prediksi dengan menggunakan 2 metode di atas, dapat disimpulkan kedua metode menghasilkan nilai yang tidak jauh berbeda baik dari nilai akurasi maupun nilai precision/Positive Prediction Values. Namun untuk data titanic dengan random seed di atas, hasil prediksi dengan metode logistic regression menghasilkan prediksi lebih baik, baik dari nilai akurasi maupun precision.