1 Setup

library(dplyr)
library(rsample)
library(recipes)
library(caret)

2 Business Question

• Tujuan: Membuat model klasifikasi untuk memprediksi apakah seorang karyawan akan resign atau tidak.
• Fungsi PCA: Data pre-processing sebelum model klasifikasi

Kita akan menggunakan library recipes untuk menerapkan PCA pada data train, lalu data test akan ditransformasi menggunakan eigen vector yang telah dipelajari dari data train.

3 Read Data

attrition <- read.csv("attrition.csv", stringsAsFactors = TRUE)
glimpse(attrition)

## Rows: 1,470
## Columns: 35
## $ attrition                  <fct> yes, no, yes, no, no, no, no, no, no, no, n~
## $ age                        <int> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35,~
## $ business_travel            <fct> travel_rarely, travel_frequently, travel_ra~
## $ daily_rate                 <int> 1102, 279, 1373, 1392, 591, 1005, 1324, 135~
## $ department                 <fct> sales, research_development, research_devel~
## $ distance_from_home         <int> 1, 8, 2, 3, 2, 2, 3, 24, 23, 27, 16, 15, 26~
## $ education                  <int> 2, 1, 2, 4, 1, 2, 3, 1, 3, 3, 3, 2, 1, 2, 3~
## $ education_field            <fct> life_sciences, life_sciences, other, life_s~
## $ employee_count             <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1~
## $ employee_number            <int> 1, 2, 4, 5, 7, 8, 10, 11, 12, 13, 14, 15, 1~
## $ environment_satisfaction   <int> 2, 3, 4, 4, 1, 4, 3, 4, 4, 3, 1, 4, 1, 2, 3~
## $ gender                     <fct> female, male, male, female, male, male, fem~
## $ hourly_rate                <int> 94, 61, 92, 56, 40, 79, 81, 67, 44, 94, 84,~
## $ job_involvement            <int> 3, 2, 2, 3, 3, 3, 4, 3, 2, 3, 4, 2, 3, 3, 2~
## $ job_level                  <int> 2, 2, 1, 1, 1, 1, 1, 1, 3, 2, 1, 2, 1, 1, 1~
## $ job_role                   <fct> sales_executive, research_scientist, labora~
## $ job_satisfaction           <int> 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3, 4, 3~
## $ marital_status             <fct> single, married, single, married, married, ~
## $ monthly_income             <int> 5993, 5130, 2090, 2909, 3468, 3068, 2670, 2~
## $ monthly_rate               <int> 19479, 24907, 2396, 23159, 16632, 11864, 99~
## $ num_companies_worked       <int> 8, 1, 6, 1, 9, 0, 4, 1, 0, 6, 0, 0, 1, 0, 5~
## $ over_18                    <fct> y, y, y, y, y, y, y, y, y, y, y, y, y, y, y~
## $ over_time                  <fct> yes, no, yes, yes, no, no, yes, no, no, no,~
## $ percent_salary_hike        <int> 11, 23, 15, 11, 12, 13, 20, 22, 21, 13, 13,~
## $ performance_rating         <int> 3, 4, 3, 3, 3, 3, 4, 4, 4, 3, 3, 3, 3, 3, 3~
## $ relationship_satisfaction  <int> 1, 4, 2, 3, 4, 3, 1, 2, 2, 2, 3, 4, 4, 3, 2~
## $ standard_hours             <int> 80, 80, 80, 80, 80, 80, 80, 80, 80, 80, 80,~
## $ stock_option_level         <int> 0, 1, 0, 0, 1, 0, 3, 1, 0, 2, 1, 0, 1, 1, 0~
## $ total_working_years        <int> 8, 10, 7, 8, 6, 8, 12, 1, 10, 17, 6, 10, 5,~
## $ training_times_last_year   <int> 0, 3, 3, 3, 3, 2, 3, 2, 2, 3, 5, 3, 1, 2, 4~
## $ work_life_balance          <int> 1, 3, 3, 3, 3, 2, 2, 3, 3, 2, 3, 3, 2, 3, 3~
## $ years_at_company           <int> 6, 10, 0, 8, 2, 7, 1, 1, 9, 7, 5, 9, 5, 2, ~
## $ years_in_current_role      <int> 4, 7, 0, 7, 2, 7, 0, 0, 7, 7, 4, 5, 2, 2, 2~
## $ years_since_last_promotion <int> 0, 1, 0, 3, 2, 3, 0, 0, 1, 7, 0, 0, 4, 1, 0~
## $ years_with_curr_manager    <int> 5, 7, 0, 0, 2, 6, 0, 0, 8, 7, 3, 8, 3, 2, 3~

4 Data Inspection

attrition %>% 
  summarise_all(n_distinct) %>% 
  t() %>% 
  as.data.frame() %>% 
  rename(n_distinct = V1) %>% 
  cbind(data_type = sapply(attrition, class)) %>% 
  arrange(-n_distinct) 

prop.table(table(attrition$attrition))

## 
##        no       yes 
## 0.8387755 0.1612245

5 Cross Validation

Sebelum melakukan PCA terlebih dahulu dilakukan cross validation, yaitu membagi data menjadi training set untuk proses pemodelan dan testing set untuk melakukan evaluasi. Namun, data train dan data test tidak langsung dimasukkan ke dalam sebuah objek melainkan dilakukan PCA terlebih dahulu.

Cross validation akan dilakukan dengan menggunakan fungsi initial_split() dari library rsample. Fungsi tersebut akan melakukan proses sampling untuk cross validation dengan metode stratified random sampling, sehingga proporsi target variabel pada data awal, akan dipertahankan baik pada training set maupun testing set.

set.seed(123)
splitted <- initial_split(data = attrition,
                          prop = 0.75, # persentase data train
                          strata = "attrition") # mempertahankan proporsi target
splitted

## <Analysis/Assess/Total>
## <1103/367/1470>

6 Data Preparation

Melakukan tahapan data preparation yang didalamnya termasuk melakukan PCA. Data preparation yang akan dilakukan adalah menghapus variabel yang dianggap tidak berpengaruh, membuang variabel yang variansinya mendekati 0 (tidak informatif), melakukan scaling, dan melakukan PCA. Proses yang dilakukan pada tahapan data preparation akan dilakukan dengan menggunakan fungsi dari library recipes, yaitu:

• step_rm() untuk menghapus variabel
• step_nzv() untuk membuang variabel yang variansinya mendekati 0
• step_center() dan step_scale() untuk melakukan scaling
• step_pca() untuk melakukan PCA, threshold = 0.9 maksudnya ingin mempertahankan minimal 90% informasi data awal
• step_upsample() untuk melakukan upsampling pada kolom target, yaitu attrition. Parameter over_ratio mengatur rasio setelah sampling antara kelas mayoritas dibandingkan minoritas.

rec <- recipe(formula = attrition ~ ., data = training(splitted)) %>% 
  step_rm(employee_number) %>% # dihapus karena semua unique
  step_nzv(all_predictors()) %>% # dihapus karena hanya mengandung 1 nilai
  step_center(all_numeric()) %>% 
  step_scale(all_numeric()) %>% 
  step_pca(all_numeric(), threshold = 0.9) %>% 
  step_upsample(attrition) %>% 
  prep()

rec

## Data Recipe
## 
## Inputs:
## 
##       role #variables
##    outcome          1
##  predictor         34
## 
## Training data contained 1103 data points and no missing data.
## 
## Operations:
## 
## Variables removed employee_number [trained]
## Sparse, unbalanced variable filter removed employee_count, over_18, standard_hours [trained]
## Centering for age, daily_rate, distance_from_home, ... [trained]
## Scaling for age, daily_rate, distance_from_home, ... [trained]
## PCA extraction with age, daily_rate, distance_from_home, ... [trained]
## Up-sampling based on attrition [trained]

Setelah mendefinisikan proses data preparation pada objek rec, selanjutnya proses tersebut diterapkan ke data train menggunakan fungsi juice() dan ke data test menggunakan fungsi bake() dari library recipes.

# data train
attrition_train <- juice(rec)
head(attrition_train, 5)

# data test
attrition_test <- bake(rec, new_data = testing(splitted))
head(attrition_test, 5)

Dari output di atas diketahui bahwa variabel numerik sudah berbentuk sebuah PC, yang merangkum minimal 90% variansi data awal. Selanjutnya, data train dan test sudah siap untuk dilanjutkan ke tahap modeling.

Recap:

• Dimensi data awal attrition: 26 numerik dan 9 kategorik (total: 35)
• Dimensi data sebelum PCA (menghapus 4 kolom): 23 numerik dan 8 kategorik (total: 31)
• Dimensi data setelah PCA: 16 numerik dan 8 kategorik (total: 24)
• PCA mereduksi 23 kolom numerik menjadi 16 kolom dengan merangkum minimal 90% variansi data awal

7 Modeling

Kita coba menggunakan model Random Forest karena ingin mendapatkan hasil prediksi yang setepat mungkin, saat ini belum membutuhkan interpretasi model.

set.seed(123)
attrition_rf <- train(attrition ~ .,
                      data = attrition_train,
                      method = "rf")
saveRDS(attrition_rf, "attrition_rf.RDS")

attrition_rf <- readRDS("attrition_rf.RDS")
attrition_rf

## Random Forest 
## 
## 1850 samples
##   23 predictor
##    2 classes: 'no', 'yes' 
## 
## No pre-processing
## Resampling: Bootstrapped (25 reps) 
## Summary of sample sizes: 1850, 1850, 1850, 1850, 1850, 1850, ... 
## Resampling results across tuning parameters:
## 
##   mtry  Accuracy   Kappa    
##    2    0.9764871  0.9529251
##   19    0.9535222  0.9070345
##   37    0.9405830  0.8812178
## 
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.

8 Model Evaluation

• Kelas Positive: attrition = "yes"
• Kasus False Positive: Karyawan yang sebenarnya tidak resign, diprediksi akan resign
• Kasus False Negative: Karyawan yang sebenarnya resign, diprediksi akan tidak resign

Misalnya untuk semua karyawan yang diprediksi resign akan dievaluasi kembali kinerjanya dan ada kemungkinan untuk meningkatkan benefit karyawan tersebut. Sedangkan untuk yang diprediksi tidak resign maka tidak akan dilakukan treatment apapun. Dalam kasus ini, kita ingin meminimalisir kasus False Negative. Maka dari itu, kita ingin recall setinggi mungkin.

Evaluasi model di data training

confusionMatrix(data = predict(attrition_rf, attrition_train),
                reference = attrition_train$attrition,
                positive = "yes",
                mode = "prec_recall")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  no yes
##        no  925   0
##        yes   0 925
##                                                
##                Accuracy : 1                    
##                  95% CI : (0.998, 1)           
##     No Information Rate : 0.5                  
##     P-Value [Acc > NIR] : < 0.00000000000000022
##                                                
##                   Kappa : 1                    
##                                                
##  Mcnemar's Test P-Value : NA                   
##                                                
##               Precision : 1.0                  
##                  Recall : 1.0                  
##                      F1 : 1.0                  
##              Prevalence : 0.5                  
##          Detection Rate : 0.5                  
##    Detection Prevalence : 0.5                  
##       Balanced Accuracy : 1.0                  
##                                                
##        'Positive' Class : yes                  
## 

Evaluasi model di data testing

confusionMatrix(data = predict(attrition_rf, attrition_test),
                reference = attrition_test$attrition,
                positive = "yes",
                mode = "prec_recall")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  no yes
##        no  305  46
##        yes   3  13
##                                           
##                Accuracy : 0.8665          
##                  95% CI : (0.8274, 0.8996)
##     No Information Rate : 0.8392          
##     P-Value [Acc > NIR] : 0.08614         
##                                           
##                   Kappa : 0.2986          
##                                           
##  Mcnemar's Test P-Value : 0.000000001973  
##                                           
##               Precision : 0.81250         
##                  Recall : 0.22034         
##                      F1 : 0.34667         
##              Prevalence : 0.16076         
##          Detection Rate : 0.03542         
##    Detection Prevalence : 0.04360         
##       Balanced Accuracy : 0.60530         
##                                           
##        'Positive' Class : yes             
## 

9 Conclusion

Model Random Forest yang dihasilkan masih overfit, karena performa di data train perfect namun di data test masih belum memuaskan. Fokus pada artikel ini adalah untuk memberikan contoh bagaimana PCA dapat diimplementasi sebelum dilakukan model supervised learning, dalam kasus ini adalah klasifikasi.