Human Stress Detection

by Reza Syahputra

2/28/2022

Table of Contents

Background

Mengingat gaya hidup saat ini dimana setiap orang melakukan berbagai aktivitas ringan hingga berat, banyak energi yang terkuras selama seharian. Untuk beristirahat, manusia membutuhkan tidur untuk sekedar mengembalikan energi & mengembalikan otak yang mungkin tertekan dan stress selama aktivitas yg dilakukan seharian. Namun, ada manfaat lain selain tidur yang jarang diketahui banyak orang. Salah satunya adalah dengan tidur dapat diketahui tingkat stress seseorang. Pada report ini akan dilakukan klasifikasi Human Stress berdasarkan kualitas tidur seseorang menggunakan algoritma Naive Bayes, Decision Tree, dan Random Forest. Dataset yang digunakan didapatkan dari situs kaggle Human Stress Detection.

Import Library

library(dplyr)
library(e1071)
library(caret)
library(ROCR)
library(partykit)
library(randomForest)

Data Preparation

stress_main <- read.csv("SaYoPillow Dataset/SaYoPillow.csv")

Data Wrangling

Cek tipe kolom

str(stress_main)
## 'data.frame':    630 obs. of  9 variables:
##  $ sr  : num  93.8 91.6 60 85.8 48.1 ...
##  $ rr  : num  25.7 25.1 20 23.5 17.2 ...
##  $ t   : num  91.8 91.6 96 90.8 97.9 ...
##  $ lm  : num  16.6 15.9 10 13.9 6.5 ...
##  $ bo  : num  89.8 89.6 95 88.8 96.2 ...
##  $ rem : num  99.6 98.9 85 96.9 72.5 ...
##  $ sr.1: num  1.84 1.552 7 0.768 8.248 ...
##  $ hr  : num  74.2 72.8 60 68.8 53.1 ...
##  $ sl  : int  3 3 1 3 0 1 0 0 0 1 ...

Humas Stress Dataset berisikan 630 observasi dengan 9 varibael. Pada dataset tersebut dilakukan klasifikasi berdasarkan variabel sl. Penjelasan terkait variabel dijelaskan sebagai berikut:

  • sr : Snoring rate
  • rr : Respiration rate
  • t : Body temperature
  • lm : Limb movement
  • bo : Blood oxygen
  • rem : Eye movement
  • sr.1 : Sleeping hours
  • hr : Heart rate
  • sl : Stress level (0: Low (Normal), 1: Medium Low, 2: Medium, 3: Medium High, 4: High)

Merubah Tipe Kolom

stress_main <- stress_main %>% 
  mutate(sl = as.factor(sl))

Cek Missing Value

anyNA(stress_main)
## [1] FALSE

Menampilkan data Stress Dataset yang digunakan

rmarkdown::paged_table((stress_main))

Cross Validation

Train Test Split

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

index <- sample(nrow(stress_main), nrow(stress_main)*0.80)

data_train <- stress_main[index,]
data_test <- stress_main[-index,]

Dilakukan splitting data_train dan data_test untuk kebutuhan pelatihan dan melakukan pengecekkan apakah model dapat mengklasifikasikan unseen data dengan baik atau tidak. Data dipisah sebanyak 80% untuk data_train

Cek Proporsi

prop.table(table(data_train$sl))
## 
##         0         1         2         3         4 
## 0.2103175 0.2043651 0.1904762 0.2083333 0.1865079

Dilakukan untuk mengetahui proporsi dari setiap label, dari hasil yang ditunjukkan bahwa data_train memiliki proporsi yang seimbang. Sehingga tidak diperlukan balancing data.

Modelling: Naive Bayes

Build Model

naive_model <- naiveBayes(x = data_train %>% select(-sl), 
                          y = data_train$sl, 
                          laplace = 1)

Interpretasi Model

naive_model
## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = data_train %>% select(-sl), y = data_train$sl, 
##     laplace = 1)
## 
## A-priori probabilities:
## data_train$sl
##         0         1         2         3         4 
## 0.2103175 0.2043651 0.1904762 0.2083333 0.1865079 
## 
## Conditional probabilities:
##              sr
## data_train$sl     [,1]     [,2]
##             0 47.51358 1.479553
##             1 55.06641 2.892747
##             2 69.90500 5.567742
##             3 87.65714 4.274863
##             4 98.00545 1.149727
## 
##              rr
## data_train$sl     [,1]      [,2]
##             0 17.00543 0.5918214
##             1 19.01328 0.5785494
##             2 20.99050 0.5567742
##             3 24.04190 1.1399636
##             4 28.00545 1.1497267
## 
##              t
## data_train$sl     [,1]      [,2]
##             0 97.50815 0.8877321
##             1 95.01328 0.5785494
##             2 92.99050 0.5567742
##             3 91.02095 0.5699818
##             4 87.50681 1.4371583
## 
##              lm
## data_train$sl      [,1]      [,2]
##             0  6.010868 1.1836428
##             1  9.013282 0.5785494
##             2 10.990500 0.5567742
##             3 14.552381 1.4249545
##             4 18.002723 0.5748633
## 
##              bo
## data_train$sl     [,1]      [,2]
##             0 96.00543 0.5918214
##             1 93.51992 0.8678241
##             2 90.99050 0.5567742
##             3 89.02095 0.5699818
##             4 85.00817 1.7245900
## 
##              rem
## data_train$sl      [,1]     [,2]
##             0  70.05434 5.918214
##             1  82.53320 1.446374
##             2  89.95250 2.783871
##             3  97.55238 1.424954
##             4 102.50681 1.437158
## 
##              sr.1
## data_train$sl     [,1]      [,2]
##             0 8.005434 0.5918214
##             1 6.013282 0.5785494
##             2 3.485750 0.8351614
##             3 1.020952 0.5699818
##             4 0.000000 0.0000000
## 
##              hr
## data_train$sl     [,1]     [,2]
##             0 52.51358 1.479553
##             1 57.53320 1.446374
##             2 62.47625 1.391936
##             3 70.10476 2.849909
##             4 80.01362 2.874317

Prediksi: Data Test

naive_predict <- predict(naive_model, 
                         newdata = data_test, 
                         type = "class")
head(naive_predict)
## [1] 3 1 3 0 2 1
## Levels: 0 1 2 3 4

Model Evaluation: Data Test

Confussion Matrix

cm_naive <- confusionMatrix(data = naive_predict, 
                reference = data_test$sl)

cm_naive
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1  2  3  4
##          0 20  0  0  0  0
##          1  0 23  0  0  0
##          2  0  0 30  0  0
##          3  0  0  0 21  0
##          4  0  0  0  0 32
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9711, 1)
##     No Information Rate : 0.254      
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: 0 Class: 1 Class: 2 Class: 3 Class: 4
## Sensitivity            1.0000   1.0000   1.0000   1.0000    1.000
## Specificity            1.0000   1.0000   1.0000   1.0000    1.000
## Pos Pred Value         1.0000   1.0000   1.0000   1.0000    1.000
## Neg Pred Value         1.0000   1.0000   1.0000   1.0000    1.000
## Prevalence             0.1587   0.1825   0.2381   0.1667    0.254
## Detection Rate         0.1587   0.1825   0.2381   0.1667    0.254
## Detection Prevalence   0.1587   0.1825   0.2381   0.1667    0.254
## Balanced Accuracy      1.0000   1.0000   1.0000   1.0000    1.000

Dari evaluasi confussion matrix dari Naive Bayesmodel ditunjukkan bahwa model dapat melakukan klasifikasi dengan sangat baik, hal tersebut ditunjukkan dengan nilai akurasi 1 atau 100%. Namun hal ini patut di curigai bisa jadi model terjadi Overfitting atau terlalu percaya diri dalam melakukan klasifikasi sehingga di perlukan evaluasi lain yakni dengan menghitung nilai ROC dan AUC sebagai ukuran kebaikan data.

ROC

naive_predProb <- predict(naive_model, 
                          newdata = data_test, 
                          type = "raw")

stress_naive_roc <- prediction(predictions = naive_predProb[, 1],
                               labels = (data_test$sl == 0))

perf <- performance(prediction.obj = stress_naive_roc,
                    measure = "tpr", 
                    x.measure = "fpr")
                    

plot(perf)
abline(0,1, lty = 2)

AUC

auc_naive <- performance(prediction.obj = stress_naive_roc, 
                   measure = "auc")
auc_naive@y.values[[1]]
## [1] 1

Dari visualisasi ROC menunjukkan bahwa terbentuk garis dengan pola L terbalik dengan sudut berada di pojok kiri atas, serta nilai AUC bernilai 1 menunjukkan bahwa Naive Bayes model memang sangat baik dalam mengklasifikasikan data setiap label dari stress level. Untuk menguji nya kembali dilakukan predict terhadap data train.

Prediksi: Data Train

naive_predict <- predict(naive_model, 
                         newdata = data_train, 
                         type = "class")

Model Evaluation: Data Train

Confussion Matrix: Data Train

confusionMatrix(data = naive_predict, 
                reference = data_train$sl)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1   2   3   4
##          0 106   0   0   0   0
##          1   0 103   0   0   0
##          2   0   0  96   0   0
##          3   0   0   0 105   0
##          4   0   0   0   0  94
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9927, 1)
##     No Information Rate : 0.2103     
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: 0 Class: 1 Class: 2 Class: 3 Class: 4
## Sensitivity            1.0000   1.0000   1.0000   1.0000   1.0000
## Specificity            1.0000   1.0000   1.0000   1.0000   1.0000
## Pos Pred Value         1.0000   1.0000   1.0000   1.0000   1.0000
## Neg Pred Value         1.0000   1.0000   1.0000   1.0000   1.0000
## Prevalence             0.2103   0.2044   0.1905   0.2083   0.1865
## Detection Rate         0.2103   0.2044   0.1905   0.2083   0.1865
## Detection Prevalence   0.2103   0.2044   0.1905   0.2083   0.1865
## Balanced Accuracy      1.0000   1.0000   1.0000   1.0000   1.0000

Modeling: Decision Tree

Build Model

tree_model <- ctree(formula = sl ~ ., 
                       data = data_train)

plot(tree_model, type = "simple")

tree_model
## 
## Model formula:
## sl ~ sr + rr + t + lm + bo + rem + sr.1 + hr
## 
## Fitted party:
## [1] root
## |   [2] sr <= 95
## |   |   [3] sr.1 <= 6.984
## |   |   |   [4] rem <= 84.96: 1 (n = 103, err = 0.0%)
## |   |   |   [5] rem > 84.96
## |   |   |   |   [6] sr <= 79.84: 2 (n = 96, err = 0.0%)
## |   |   |   |   [7] sr > 79.84: 3 (n = 105, err = 0.0%)
## |   |   [8] sr.1 > 6.984: 0 (n = 106, err = 0.0%)
## |   [9] sr > 95: 4 (n = 94, err = 0.0%)
## 
## Number of inner nodes:    4
## Number of terminal nodes: 5

Interpretasi Model

Dari prediktor yang digunakan terbentuk Decision Tree seperti pada gambar diatas dengan prediktor sr atau snoring rate sebagai root node nya. Dari decision yang terbentuk terlihat hanya terdapat 3 prediktor yang memiliki tingkat signifikansi dibawah 0.001 saja yang dapat membuat cabang yakni sr, sr.1, dan rem.

Cara membaca Decision Tree diatas:

  • Jika terdapat seseorang dengan nilai sr 90 dan sr.1 7 maka orang tersebut diklasifikasikan kedalam level 0
  • Jika terdapat seseorang dengan nilai sr 89, sr.1 6.5 dan rem 83 maka orang tersebut diklasifikasikan kedalam level 1

Prediksi: Data Test

tree_pred <- predict(tree_model, 
                          newdata = data_test, 
                          type = "response")

Model Evaluation: Data Test

cm_tree <- confusionMatrix(tree_pred, 
                data_test$sl)
cm_tree
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1  2  3  4
##          0 20  1  0  0  0
##          1  0 22  0  0  0
##          2  0  0 29  0  0
##          3  0  0  1 21  0
##          4  0  0  0  0 32
## 
## Overall Statistics
##                                           
##                Accuracy : 0.9841          
##                  95% CI : (0.9438, 0.9981)
##     No Information Rate : 0.254           
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.98            
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: 0 Class: 1 Class: 2 Class: 3 Class: 4
## Sensitivity            1.0000   0.9565   0.9667   1.0000    1.000
## Specificity            0.9906   1.0000   1.0000   0.9905    1.000
## Pos Pred Value         0.9524   1.0000   1.0000   0.9545    1.000
## Neg Pred Value         1.0000   0.9904   0.9897   1.0000    1.000
## Prevalence             0.1587   0.1825   0.2381   0.1667    0.254
## Detection Rate         0.1587   0.1746   0.2302   0.1667    0.254
## Detection Prevalence   0.1667   0.1746   0.2302   0.1746    0.254
## Balanced Accuracy      0.9953   0.9783   0.9833   0.9952    1.000

Dari model evaluation menggunakan confussion matrix menunjukkan bahwa model Decission Tree hampir dikatakan Sangat baik dalam mengklasifikasikan data stress level. Ditunjukkan dengan nilai akurasi sebesar 98.41% dan hampir semua data benar terprediksi hanya terdapat 2 data yang mengalami salah prediksi dengan nilai seharusnya 1 namun di prediksi sebagai 0 dan seharusnya 2 namun di prediksi sebagai 3.

ROC

tree_predProb <- predict(tree_model, 
                          newdata = data_test, 
                          type = "prob")

stress_tree_roc <- prediction(predictions = tree_predProb[, 1],
                               labels = (data_test$sl == 0))

perf <- performance(prediction.obj = stress_tree_roc,
                    measure = "tpr", 
                    x.measure = "fpr")
                    

plot(perf)
abline(0,1, lty = 2)

AUC

auc_tree <- performance(prediction.obj = stress_tree_roc, 
                   measure = "auc")
auc_tree@y.values[[1]] 
## [1] 0.995283

Dari plot ROC dan perhitungan nilai AUC model menggunakan Decision Tree sangat baik dalam memisahkan data sesuai dengan kelas nya masing masing.

Prediksi: Data Train

tree_pred <- predict(tree_model, 
                          newdata = data_train, 
                          type = "response")

Model Evaluation: Data Train

confusionMatrix(tree_pred, 
                data_train$sl)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1   2   3   4
##          0 106   0   0   0   0
##          1   0 103   0   0   0
##          2   0   0  96   0   0
##          3   0   0   0 105   0
##          4   0   0   0   0  94
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9927, 1)
##     No Information Rate : 0.2103     
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: 0 Class: 1 Class: 2 Class: 3 Class: 4
## Sensitivity            1.0000   1.0000   1.0000   1.0000   1.0000
## Specificity            1.0000   1.0000   1.0000   1.0000   1.0000
## Pos Pred Value         1.0000   1.0000   1.0000   1.0000   1.0000
## Neg Pred Value         1.0000   1.0000   1.0000   1.0000   1.0000
## Prevalence             0.2103   0.2044   0.1905   0.2083   0.1865
## Detection Rate         0.2103   0.2044   0.1905   0.2083   0.1865
## Detection Prevalence   0.2103   0.2044   0.1905   0.2083   0.1865
## Balanced Accuracy      1.0000   1.0000   1.0000   1.0000   1.0000

Namun jika model Decision Tree dilakukan klasifikasi pada data_train memiliki performa yang sangat baik dengan tingkat akurasi adalah 100%

Modelling: Random Forest

Build Model

set.seed(100)

ctrl <- trainControl(method="repeatedcv",
                     number = 5, 
                     repeats = 3) 

stress_forest <- train(sl ~ ., 
                   data = data_train, 
                   method = "rf", 
                   trControl = ctrl) 
## Warning in (function (kind = NULL, normal.kind = NULL, sample.kind = NULL) :
## non-uniform 'Rounding' sampler used

Interpretasi Model

stress_forest
## Random Forest 
## 
## 504 samples
##   8 predictor
##   5 classes: '0', '1', '2', '3', '4' 
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 3 times) 
## Summary of sample sizes: 404, 403, 404, 403, 402, 403, ... 
## Resampling results across tuning parameters:
## 
##   mtry  Accuracy   Kappa    
##   2     0.9933990  0.9917429
##   5     0.9940525  0.9925598
##   8     0.9933859  0.9917258
## 
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 5.

Dari 8 prediktor yang ada, dengan menggunakan permodelan Random Forest hanya dipilih 5 prediktor yang memiliki tingkat akurasi terbaik yakni 99.40%

stress_forest$finalModel
## 
## Call:
##  randomForest(x = x, y = y, mtry = min(param$mtry, ncol(x))) 
##                Type of random forest: classification
##                      Number of trees: 500
## No. of variables tried at each split: 5
## 
##         OOB estimate of  error rate: 0.4%
## Confusion matrix:
##     0   1  2   3  4 class.error
## 0 106   0  0   0  0 0.000000000
## 1   1 102  0   0  0 0.009708738
## 2   0   0 96   0  0 0.000000000
## 3   0   0  0 104  1 0.009523810
## 4   0   0  0   0 94 0.000000000

Jika model tersebut di tampilkan memilki confussion matrix seperti diatas, dapat dilihat bahwa performa finalModel baik dalam mengklasifikasikan tingkat stress namun terdapat 2 data yang salah diklasifikasikan.

Prediksi: Data Test

stress_pred <- predict(stress_forest, 
                       data_test, 
                       type = "raw")

Model Evaluation: Data Test

cm_forest <- confusionMatrix(data = stress_pred,
                reference = data_test$sl)
cm_forest
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1  2  3  4
##          0 20  1  0  0  0
##          1  0 22  1  0  0
##          2  0  0 28  0  0
##          3  0  0  1 21  0
##          4  0  0  0  0 32
## 
## Overall Statistics
##                                          
##                Accuracy : 0.9762         
##                  95% CI : (0.932, 0.9951)
##     No Information Rate : 0.254          
##     P-Value [Acc > NIR] : < 2.2e-16      
##                                          
##                   Kappa : 0.97           
##                                          
##  Mcnemar's Test P-Value : NA             
## 
## Statistics by Class:
## 
##                      Class: 0 Class: 1 Class: 2 Class: 3 Class: 4
## Sensitivity            1.0000   0.9565   0.9333   1.0000    1.000
## Specificity            0.9906   0.9903   1.0000   0.9905    1.000
## Pos Pred Value         0.9524   0.9565   1.0000   0.9545    1.000
## Neg Pred Value         1.0000   0.9903   0.9796   1.0000    1.000
## Prevalence             0.1587   0.1825   0.2381   0.1667    0.254
## Detection Rate         0.1587   0.1746   0.2222   0.1667    0.254
## Detection Prevalence   0.1667   0.1825   0.2222   0.1746    0.254
## Balanced Accuracy      0.9953   0.9734   0.9667   0.9952    1.000

Dari hasil prediksi didapatkan tingkat akurasi model yakni 97.62% dapat dikatakan bahwa Random Forest model memilki performa yang baik. dengan terdapat 3 observasi yang salah klasifikasi.

Interpretation

varImp(stress_forest)
## rf variable importance
## 
##      Overall
## bo   100.000
## t     86.880
## sr.1  48.589
## sr    32.259
## hr    20.431
## rem   11.792
## lm     8.405
## rr     0.000

Dengan menampilkan varImp setiap prediktor yang ada, didapatkan informasi bahwa prediktor bo atau tingkat oksigen dalam darah memiliki keterkaitan dengna klasifikasi stress level seseorang dengan nilai gini importance sebesar 100

ROC

forest_predProb <- predict(stress_forest, 
                          newdata = data_test, 
                          type = "prob")

stress_forest_roc <- prediction(predictions = forest_predProb[, 1],
                               labels = (data_test$sl == 0))

perf <- performance(prediction.obj = stress_forest_roc,
                    measure = "tpr", 
                    x.measure = "fpr")
                    

plot(perf)
abline(0,1, lty = 2)

AUC

auc_forest <- performance(prediction.obj = stress_forest_roc, 
                   measure = "auc")
auc_forest@y.values[[1]]
## [1] 1

Plot ROC dan nilai AUC sebagai metriks kebaikan model menunjukkan bahwa Random Forest juga telah sangat baik memisahkan data kedalam setiap kelas nya.

Conclusion

model_overall <- data_frame(
  Model = c("Naive Bayes", "Decision Tree", "Random Forest"),
  Accuracy = c(cm_naive$overall[1], cm_tree$overall[1], cm_forest$overall[1]),
  Recall = c(cm_naive$byClass[1], cm_tree$byClass[1], cm_forest$byClass[1]),
  Specificity = c(cm_naive$byClass[2], cm_tree$byClass[2], cm_forest$byClass[2]),
  Precision = c(cm_naive$byClass[3], cm_tree$byClass[3], cm_forest$byClass[3]),
  AUC = c(auc_naive@y.values[[1]], auc_tree@y.values[[1]], auc_forest@y.values[[1]])
)
## Warning: `data_frame()` was deprecated in tibble 1.1.0.
## Please use `tibble()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
rmarkdown::paged_table((model_overall))

Dari percobaan yang dilakukan menunjukkan performa model disajikan dalam tabel diatas. yang dapat disimpulkan bahwa ketiga model Naive Bayes, Decision Tree, dan Random Forest sangat mampu dalam melakukan klasifikasi Human Stress Level seseorang berdasarkan data yang record saat tidur. Tingkat akurasi yang didapatkan paling tinggi adalah Naive Bayes yang sangat sempurna dalam klasifikasi stress level seseorang. Hal ini perlu dilakukan eksplorasi tambahan untuk menguji kebenaran dan kebaikan model dengan memasukkan data baru tambahan atau dengan menambah dataset yang digunakan.

Reference

[1] L. Rachakonda, A. K. Bapatla, S. P. Mohanty, and E. Kougianos, “SaYoPillow: Blockchain-Integrated Privacy-Assured IoMT Framework for Stress Management Considering Sleeping Habits”, IEEE Transactions on Consumer Electronics (TCE), Vol. 67, No. 1, Feb 2021, pp. 20-29. [2] L. Rachakonda, S. P. Mohanty, E. Kougianos, K. Karunakaran, and M. Ganapathiraju, “Smart-Pillow: An IoT based Device for Stress Detection Considering Sleeping Habits”, in Proceedings of the 4th IEEE International Symposium on Smart Electronic Systems (iSES), 2018, pp. 161--166.