1 Overview

Pada kesempatan ini, saya akan mencoba melakukan prediksi kebahagiaan dari seseorang berdasarkan data survey kebahagiaan dari berbagai kota dan mengetahui faktor-faktor apa saja yang mempengaruhi kebahagiaan seseorang

2 Read Data

happy <- read.csv("happydata.csv")
head(happy)

informasi dari setiap kolom adalah sebagai berikut :

infoavail : ketersediaan informasi terkait dengan fasilitas yang terdapat di kota tempat tinggal housecost : harga tempat tinggal schoolquality : kualitas sekolah didaerah sekitar tempat tinggal policetrust : tingkat kepercayaan kepada polisi streetquality : kualitas jalan didaerah sekitar tempat tinggal events : banyaknya event yang terdapat di sekitar tempat tinggal

semua kolom berisi scala 1 sampai 5 dengan nilai 5 merupakan nilai terbaik

3 Data Wrangling and Analysis

Target: happy (happy = 1, not happy = 0)

3.1 Cek Type Data

Cek type data yang masih belum sesuai

glimpse(happy)
#> Rows: 143
#> Columns: 7
#> $ infoavail     <int> 3, 3, 5, 5, 5, 5, 3, 5, 4, 4, 3, 4, 5, 4, 4, 3, 5, 5, 5,…
#> $ housecost     <int> 3, 2, 3, 4, 4, 5, 1, 4, 1, 4, 2, 4, 2, 2, 1, 2, 3, 1, 1,…
#> $ schoolquality <int> 3, 3, 3, 3, 3, 3, 2, 4, 4, 4, 3, 3, 4, 4, 3, 4, 4, 4, 2,…
#> $ policetrust   <int> 4, 5, 3, 3, 3, 5, 2, 4, 4, 2, 3, 4, 5, 5, 3, 3, 5, 3, 4,…
#> $ streetquality <int> 2, 4, 3, 3, 3, 5, 1, 4, 4, 5, 2, 4, 5, 4, 4, 4, 4, 4, 4,…
#> $ ëvents        <int> 4, 3, 5, 5, 5, 5, 3, 5, 4, 5, 3, 4, 5, 3, 3, 4, 5, 5, 5,…
#> $ happy         <int> 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0,…
happy <- happy %>% mutate(happy = as.factor(happy))
glimpse(happy)
#> Rows: 143
#> Columns: 7
#> $ infoavail     <int> 3, 3, 5, 5, 5, 5, 3, 5, 4, 4, 3, 4, 5, 4, 4, 3, 5, 5, 5,…
#> $ housecost     <int> 3, 2, 3, 4, 4, 5, 1, 4, 1, 4, 2, 4, 2, 2, 1, 2, 3, 1, 1,…
#> $ schoolquality <int> 3, 3, 3, 3, 3, 3, 2, 4, 4, 4, 3, 3, 4, 4, 3, 4, 4, 4, 2,…
#> $ policetrust   <int> 4, 5, 3, 3, 3, 5, 2, 4, 4, 2, 3, 4, 5, 5, 3, 3, 5, 3, 4,…
#> $ streetquality <int> 2, 4, 3, 3, 3, 5, 1, 4, 4, 5, 2, 4, 5, 4, 4, 4, 4, 4, 4,…
#> $ ëvents        <int> 4, 3, 5, 5, 5, 5, 3, 5, 4, 5, 3, 4, 5, 3, 3, 4, 5, 5, 5,…
#> $ happy         <fct> 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0,…

3.2 Cek Missing Value

colSums(is.na(happy))
#>     infoavail     housecost schoolquality   policetrust streetquality 
#>             0             0             0             0             0 
#>        ëvents         happy 
#>             0             0

Tidak terdapa missing value pada setiap kolom

3.3 Cek Class Imbalance

table(happy$happy) %>% prop.table()
#> 
#>         0         1 
#> 0.4615385 0.5384615

Kelas target dari data dapat dikatakan seimbang antara happy dan not happy

4 Cross Validation

Dilakukan pemisahan data train dengan test untuk mengevaluasi model dan melihat kemampuannya memprediksi data baru

RNGkind(sample.kind = "Rounding")
set.seed(100)

# index sampling 
# ---- mengambil 80 persen index dari jumlah data -----
index <- sample(x = nrow(happy),size = 0.8*nrow(happy)) 


# splitting data 
train <- happy[index,] #ambil data 80%
test  <- happy[-index,]  #ambil data 20%
# re-check class imbalance
table(train$happy) %>% prop.table() %>% round(digits = 2)
#> 
#>    0    1 
#> 0.45 0.55

5 Model Logistik Regression

5.1 Model dengan semua prediktor

model_log <- glm(formula = happy ~ . ,
                   data = train,
                   family = "binomial")

summary(model_log)
#> 
#> Call:
#> glm(formula = happy ~ ., family = "binomial", data = train)
#> 
#> Coefficients:
#>                Estimate Std. Error z value Pr(>|z|)   
#> (Intercept)   -4.990903   1.643770  -3.036   0.0024 **
#> infoavail      0.716586   0.299023   2.396   0.0166 * 
#> housecost      0.081375   0.190966   0.426   0.6700   
#> schoolquality -0.009295   0.234819  -0.040   0.9684   
#> policetrust    0.018055   0.251384   0.072   0.9427   
#> streetquality  0.171700   0.202636   0.847   0.3968   
#> ëvents         0.291724   0.265758   1.098   0.2723   
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 156.77  on 113  degrees of freedom
#> Residual deviance: 141.34  on 107  degrees of freedom
#> AIC: 155.34
#> 
#> Number of Fisher Scoring iterations: 4
exp(model_log$coefficients)
#>   (Intercept)     infoavail     housecost schoolquality   policetrust 
#>   0.006799518   2.047431152   1.084778078   0.990748276   1.018218844 
#> streetquality        ëvents 
#>   1.187321544   1.338733416

Pada model ini kenaikan 1 nilai infoavail maka akan meningkatkan kemungkinan happy sebesar 2.04 kali. dengan catatan variabel prediktor lainnya bernilai sama.

5.2 Model Stepwise

model_log2 <- step(model_log,direction = "backward",trace = 0)
summary(model_log2)
#> 
#> Call:
#> glm(formula = happy ~ infoavail, family = "binomial", data = train)
#> 
#> Coefficients:
#>             Estimate Std. Error z value Pr(>|z|)    
#> (Intercept)  -3.7535     1.2057  -3.113 0.001851 ** 
#> infoavail     0.9150     0.2732   3.349 0.000811 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 156.77  on 113  degrees of freedom
#> Residual deviance: 143.78  on 112  degrees of freedom
#> AIC: 147.78
#> 
#> Number of Fisher Scoring iterations: 4

Berdasarkan stepwise backward model terbaik hanya dari 1 prediktor saja yaitu infoavail

5.3 Predict

#Prediksi model All Prediktor
pred_log <- predict(model_log,
                    newdata = test,
                    type = "response")

#Prediksi model stepwise backward
pred_log2 <- predict(model_log2,
                    newdata = test,
                    type = "response")
# Prediksi label model all prediktor
pred_label_log <- ifelse(test = pred_log >= 0.55, 
                         yes = 1,
                         no = 0)

# Prediksi label model stepwise backward
pred_label_log2 <- ifelse(test = pred_log2 >= 0.55, 
                         yes = 1,
                         no = 0)

Formula diatas adalah ketika probabilitas data test lebih dari 0.5, artinya dia happy.

5.4 Model Evaluation

5.4.1 Evaluasi Model all prediktor

confusionMatrix(data = as.factor(pred_label_log),
                reference = test$happy,
                positive = "1")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  0  1
#>          0 11  5
#>          1  4  9
#>                                           
#>                Accuracy : 0.6897          
#>                  95% CI : (0.4917, 0.8472)
#>     No Information Rate : 0.5172          
#>     P-Value [Acc > NIR] : 0.04598         
#>                                           
#>                   Kappa : 0.3771          
#>                                           
#>  Mcnemar's Test P-Value : 1.00000         
#>                                           
#>             Sensitivity : 0.6429          
#>             Specificity : 0.7333          
#>          Pos Pred Value : 0.6923          
#>          Neg Pred Value : 0.6875          
#>              Prevalence : 0.4828          
#>          Detection Rate : 0.3103          
#>    Detection Prevalence : 0.4483          
#>       Balanced Accuracy : 0.6881          
#>                                           
#>        'Positive' Class : 1               
#>

5.4.2 Evaluasi Model Backward

confusionMatrix(data = as.factor(pred_label_log2),
                reference = test$happy,
                positive = "1")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  0  1
#>          0 11  5
#>          1  4  9
#>                                           
#>                Accuracy : 0.6897          
#>                  95% CI : (0.4917, 0.8472)
#>     No Information Rate : 0.5172          
#>     P-Value [Acc > NIR] : 0.04598         
#>                                           
#>                   Kappa : 0.3771          
#>                                           
#>  Mcnemar's Test P-Value : 1.00000         
#>                                           
#>             Sensitivity : 0.6429          
#>             Specificity : 0.7333          
#>          Pos Pred Value : 0.6923          
#>          Neg Pred Value : 0.6875          
#>              Prevalence : 0.4828          
#>          Detection Rate : 0.3103          
#>    Detection Prevalence : 0.4483          
#>       Balanced Accuracy : 0.6881          
#>                                           
#>        'Positive' Class : 1               
#>

6 Model K-Nearest Neighbor

6.1 K optimum

sqrt(nrow(train))
#> [1] 10.67708

6.2 Predict

pred_knn <- knn(train = train,
                 test = test,
                 cl = train$happy,
                 k = 11)
confusionMatrix(data = as.factor(pred_knn),
                reference = test$happy,
                positive = "1")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  0  1
#>          0  9  1
#>          1  6 13
#>                                          
#>                Accuracy : 0.7586         
#>                  95% CI : (0.5646, 0.897)
#>     No Information Rate : 0.5172         
#>     P-Value [Acc > NIR] : 0.006883       
#>                                          
#>                   Kappa : 0.5224         
#>                                          
#>  Mcnemar's Test P-Value : 0.130570       
#>                                          
#>             Sensitivity : 0.9286         
#>             Specificity : 0.6000         
#>          Pos Pred Value : 0.6842         
#>          Neg Pred Value : 0.9000         
#>              Prevalence : 0.4828         
#>          Detection Rate : 0.4483         
#>    Detection Prevalence : 0.6552         
#>       Balanced Accuracy : 0.7643         
#>                                          
#>        'Positive' Class : 1              
#>

7 Conclusion

Hasil dari dua metode pembuatan model classifikasi yaitu Logistik regression dan K-Nearest Neighbor (K-NN) pada data Happiness prediksi lebih baik didapatkan pada model K-NN dengan Precision (Pos Pred Value) 72% dan akurasi 79% dibandingkan dengan model logistik regression Precision (Pos Pred Value) 69% dan akurasi 69%.

note : Precision lebih dititikberatkan karena pada data ini ingin mengurangi prediksi false positif dalam hal ini diprediksi bahagia padahal sebenarnya tidak