Predict Customer Purchase (GBM and Adjust Cutoff for Classification)

Mini Project for VinID’s Recruitment

Motivations

Mục Discussion Problem thuộc phần 1 của dự án đề xuất đặt ra một mục tiêu cụ thể hơn khi xây dựng mô hình dự báo hành vi của khách hàng đó là mô hình phải cover được ít nhất 70% khách hàng sẽ mua hàng trong tháng tới. Do vậy phần 2 của dự án được thực hiện nhằm xây dựng một mô hình thỏa mãn mục tiêu này.

Approach to Modelling

Với sự kiện Khách hàng sẽ mua hàng trong tháng tới thì mô hình GBM sẽ đưa ra một xác suất dự báo xẩy ra sự kiện này cho một khách hàng. Ví dụ, khách hàng tên có mã ID là A37 có xác suất mua hàng trong tháng tới là 0.46 thì việc gán nhãn cho khách hàng này là Yes (tướng ứng với việc anh ta sẽ mua hàng) hay là No (tương ứng với việc không mua hàng) sẽ hoàn toàn phụ thuộc vào ngưỡng (Cutoff/Threshold) được lựa chọn. Nếu chọn ngưỡng là 0.4 thì khách hàng này sẽ được dán nhãn Yes (vì 0.46 > 0.4) nhưng nếu ngưỡng được nâng lên là 0.5 thì khách hàng này sẽ được dán nhãn là No. Mặc định thì cả R lẫn Python sẽ chọn ngưỡng 0.5 cho phân loại.

Cách tiếp cận đề xuất nhằm xây dựng một mô hình thỏa mãn mục tiêu trên được tiến hành theo các bước sau:

• Bước 1: Huấn luyện GBM trên bộ dữ liệu đã được sử dụng để huấn luyện 15 mô hình ML như ở phần 1. Sử dụng GBM có được để đưa ra xác suất dự báo cho sự kiện “sẽ mua hàng trong tháng tới”.
• Bước 2: Khảo sát sự biến đổi của Sensitivity - tức là khả năng cover những khách hàng thực sự sẽ mua hàng trong tháng tới theo những ngưỡng khác nhau của Cutoff. Ngoài Sensitivity thì Accuracy cũng được khảo sát (dù rằng đây là tiêu chí phụ).

Điểm khác biệt ở đây (so với phần 1) là sử dụng h2o - một tools có lõi được viết bằng Java và có thể chạy trên cả R lẫn Python với cú pháp như nhau.

Trước hết là chuẩn bị dữ liệu cho huấn luyện mô hình. R codes dưới đây cho chuẩn bị dữ liệu đã xuất hiện ở phần 1 và được sử dụng lại:

library(knitr)
library(tidyverse)
load("C:\\Users\\Admin\\Documents\\data_df.RData") # Load dữ liệu đã lưu. 
all_obj <- ls()
rm(list = all_obj[!str_detect(all_obj, "data_df")]) # Xóa các objects thừa. 


# Loại các Missing: 
data_df %>% filter(!is.na(Quantity)) -> my_df

# Tạo thêm một số biến số mà có thể sử dụng sau này: 

library(lubridate)

my_df %>% 
  rename(time_ymd = InvoiceDate) %>% 
  mutate(w_day = wday(time_ymd, label = TRUE, abbr = TRUE), 
         time_mon = month(time_ymd, label = TRUE, abbr = TRUE)) -> my_df

my_df %>% 
  mutate(money = Quantity*UnitPrice) -> my_df


#=======================================
#   Extract các Features (RFM Inputs) 
#=======================================

# Hàm thực hiện extract ra các inputs RFM: 

procesing_RFMdata <- function(month_training, month_lookback) {
  
  # Data sử dụng để huấn luyện mô hình: 
  train_df <- my_df %>% 
    filter(time_mon %in% month_training)
  
  # Data dùng để kiểm tra khách hàng sẽ mua ở tháng kế tiếp hay không: 
  lookback_df <- my_df %>% 
    filter(time_mon == month_lookback)
  
  # Các khách hàng trong 2 tháng liên tiếp: 
  customer_2months <- train_df$CustomerID %>% unique()
  
  # Các khách hàng có mặt ở tháng kế tiếp: 
  customer_next_month <- lookback_df$CustomerID %>% unique()
  
  # Tính M: 
  train_df %>% 
    group_by(CustomerID) %>% 
    summarise(money = sum(money)) %>% 
    ungroup() -> df_train_m
  
  # Tính F: 
  train_df %>% 
    group_by(CustomerID) %>% 
    count() %>% 
    ungroup() %>% 
    rename(freq = n) -> df_train_f
  
  # Tính R: 
  
  now_time <- max(train_df$time_ymd)
  y <- as.numeric(now_time - train_df$time_ymd)
  
  train_df %>% 
    mutate(recency = y) %>% 
    group_by(CustomerID) %>% 
    summarise(recency = min(recency)) %>% 
    ungroup() -> df_train_r
  
  # Join RFM: 
  df_modelling <- df_train_f %>% 
    full_join(df_train_m, by = "CustomerID") %>% 
    full_join(df_train_r, by = "CustomerID") %>% 
    mutate(BuyNextMonth = case_when(CustomerID %in% customer_next_month ~ "Yes", TRUE ~ "No")) %>% 
    mutate(BuyNextMonth = as.factor(BuyNextMonth))
  
  return(df_modelling )
  
}



# Sử dụng hàm để extract ra RFM: 
month_training23 <- c("Feb", "Mar")
procesing_RFMdata(month_training = month_training23, month_lookback = c("Apr")) -> df_modelling


# Scaling 0-1 cho dữ liệu: 
df_forML <- df_modelling %>% 
  select(- CustomerID) %>% 
  mutate_if(is.numeric, function(x) {(x - min(x)) / (max(x) - min(x))})

# Chia dữ liệu theo tỉ lệ 80 - 20:

library(caret)
set.seed(1)
id <- createDataPartition(df_forML$BuyNextMonth, p = 0.8, list = FALSE)
df_train <- df_forML[id, ]
df_test <- df_forML[-id, ]

Train GBM Model

Dưới đây là R Codes huấn luyện GBM với thư viện h2o và đánh giá khả năng phân biệt của mô hình trên 10 validation data sets:

# Khởi động h2o cho huấn luyện GBM: 
library(h2o)
h2o.init()

##  Connection successful!
## 
## R is connected to the H2O cluster: 
##     H2O cluster uptime:         1 hours 56 minutes 
##     H2O cluster timezone:       Asia/Bangkok 
##     H2O data parsing timezone:  UTC 
##     H2O cluster version:        3.26.0.2 
##     H2O cluster version age:    3 months and 1 day  
##     H2O cluster name:           H2O_started_from_R_Admin_fkf769 
##     H2O cluster total nodes:    1 
##     H2O cluster total memory:   1.46 GB 
##     H2O cluster total cores:    4 
##     H2O cluster allowed cores:  4 
##     H2O cluster healthy:        TRUE 
##     H2O Connection ip:          localhost 
##     H2O Connection port:        54321 
##     H2O Connection proxy:       NA 
##     H2O Internal Security:      FALSE 
##     H2O API Extensions:         Amazon S3, Algos, AutoML, Core V3, Core V4 
##     R Version:                  R version 3.6.1 (2019-07-05)

h2o.no_progress()

# Chỉ định Inputs và Output: 
test <- as.h2o(df_test)
train <- as.h2o(df_train)
y <- "BuyNextMonth"
x <- setdiff(names(train), y)

# Train default GBM: 
default_gbm <- h2o.gbm(x = x, y = y, 
                       training_frame = train, 
                       stopping_rounds = 5, 
                       stopping_tolerance = 0.001, 
                       stopping_metric = "AUC", 
                       seed = 29, 
                       balance_classes = FALSE, 
                       nfolds = 10)

khả năng phân loại của GBM qua một số tiêu chí thu được từ 10 validation data sets là tương đối cao như chúng ta có thể thấy:

# Hàm extract cross-validation results: 

results_cross_validation <- function(h2o_model) {
  h2o_model@model$cross_validation_metrics_summary %>% 
    as.data.frame() %>% 
    select(-mean, -sd) %>% 
    t() %>% 
    as.data.frame() %>% 
    mutate_all(as.character) %>% 
    mutate_all(as.numeric) %>% 
    select(Accuracy = accuracy, 
           AUC = auc, 
           Precision = precision, 
           Specificity = specificity, 
           Recall = recall, 
           Logloss = logloss) %>% 
    return()
}

# Sử dụng hàm: 
results_cross_validation(default_gbm) -> ket_qua_default

# Chất lượng phân loại của GBM qua một số tiêu chí: 

theme_set(theme_minimal())

plot_results <- function(df_results) {
  df_results %>% 
    gather(Metrics, Values) %>% 
    ggplot(aes(Metrics, Values, fill = Metrics, color = Metrics)) +
    geom_boxplot(alpha = 0.3, show.legend = FALSE) + 
    theme(plot.margin = unit(c(1, 1, 1, 1), "cm")) +    
    scale_y_continuous(labels = scales::percent) + 
    facet_wrap(~ Metrics, scales = "free") + 
    labs(title = "Model Performance by Some Criteria Selected", y = NULL)
}

plot_results(ket_qua_default) +
  labs(subtitle = "Model: Default GBM (h2o package)")

GBM sử dụng thư viện h2o có khả năng cover 75.34% khách hàng sẽ mua hàng trong tháng tới, tức là 987 khách hàng trong tổng số 987 + 323 = 1310 khách hàng sẽ thực sự mua hàng trong tháng kế tiếp. Kết quả này (và một số tiêu chí thể hiện chất lượng phân loại của mô hình) có thể thấy qua ma trận nhầm lẫn với dữ liệu test:

# Model performance trên test data: 
pred_class <- h2o.predict(default_gbm, test) %>% as.data.frame() %>% pull(predict)
confusionMatrix(pred_class, df_test$BuyNextMonth, positive = "Yes")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  863 323
##        Yes 478 987
##                                         
##                Accuracy : 0.6978        
##                  95% CI : (0.68, 0.7153)
##     No Information Rate : 0.5058        
##     P-Value [Acc > NIR] : < 2.2e-16     
##                                         
##                   Kappa : 0.3964        
##                                         
##  Mcnemar's Test P-Value : 5.289e-08     
##                                         
##             Sensitivity : 0.7534        
##             Specificity : 0.6435        
##          Pos Pred Value : 0.6737        
##          Neg Pred Value : 0.7277        
##              Prevalence : 0.4942        
##          Detection Rate : 0.3723        
##    Detection Prevalence : 0.5526        
##       Balanced Accuracy : 0.6985        
##                                         
##        'Positive' Class : Yes           
## 

Chúng ta cũng có thể xem đường cong ROC và diện tích dưới đường cong AUC:

# Hàm tính toán AUC: 
library(pROC)
auc_for_test <- function(model_selected) {
  actual <- df_test$BuyNextMonth
  pred_prob <- h2o.predict(model_selected, test) %>% as.data.frame() %>% pull(Yes)
  return(roc(actual, pred_prob))
}

# Sử dụng hàm: 
my_auc <- auc_for_test(default_gbm)

# Vẽ ROC/AUC cho GBM: 

sen_spec_df <- data_frame(TPR = my_auc$sensitivities, FPR = 1 - my_auc$specificities)

sen_spec_df %>% 
  ggplot(aes(x = FPR, ymin = 0, ymax = TPR))+
  geom_polygon(aes(y = TPR), fill = "red", alpha = 0.3)+
  geom_path(aes(y = TPR), col = "firebrick", size = 1.2) +
  geom_abline(intercept = 0, slope = 1, color = "gray37", size = 1, linetype = "dashed") + 
  theme_bw() +
  coord_equal() +
  labs(x = "FPR (1 - Specificity)", 
       y = "TPR (Sensitivity)", 
       title = "Model Performance for GBM based on Test Data", 
       subtitle = paste0("AUC Value: ", my_auc$auc %>% round(2)))

Search Optimal Threshold

Chúng ta khảo sát khả năng phân loại của GBM với trọng tâm là Sensitivity theo một số ngưỡng. Trước hết viết hàm tính toán ma trận nhầm lẫn CM:

# Hàm tính toán ma trận nhầm lẫn CM: 

my_cm_com_gbm <- function(thre) {
  du_bao_prob <- h2o.predict(default_gbm, test) %>% as.data.frame() %>% pull(Yes)
  du_bao <- case_when(du_bao_prob >= thre ~ "Yes", 
                      du_bao_prob < thre ~ "No") %>% as.factor()
  cm <- confusionMatrix(du_bao, df_test$BuyNextMonth, positive = "Yes")
  return(cm)
  
}

Khả năng phân loại của GBM khi ngưỡng phân loại (Threshold) thay đổi:

# Chọn một số ngưỡng cho Threshold: 
my_threshold <- c(0.30, 0.40, 0.45, 0.55)
results_list_gbm <- lapply(my_threshold, my_cm_com_gbm)
 
# Hàm tính toán một số tiêu chí đo lường khả năng 
# phân loại của mô hình và hình ảnh hóa chúng: 

vis_detection_rate_gbm <- function(x) {
  
  results_list_gbm[[x]]$table %>% as.data.frame() -> m
  rate <- round(100*m$Freq[4] / sum(m$Freq[c(4, 3)]), 2)
  acc <- round(100*sum(m$Freq[c(1, 4)]) / sum(m$Freq), 2)
  acc <- paste0(acc, "%")
  
  m %>% 
    ggplot(aes(Reference, Freq, fill = Prediction)) +
    geom_col(position = "fill") + 
    scale_fill_manual(values = c("#e41a1c", "#377eb8"), name = "") + 
    theme(panel.grid.minor.y = element_blank()) + 
    theme(panel.grid.minor.x = element_blank()) + 
    scale_y_continuous(labels = scales::percent) + 
    labs(x = NULL, y = NULL, 
         title = paste0("Detecting BuyNextMonth when Threshold = ", my_threshold[x]), 
         subtitle = paste0("Cover Rate for BuyNextMonth: ", rate, "%", ", ", "Accuracy: ", acc))
}

# Sử dụng hàm: 
gridExtra::grid.arrange(vis_detection_rate_gbm(1), 
                        vis_detection_rate_gbm(2), 
                        vis_detection_rate_gbm(3), 
                        vis_detection_rate_gbm(4))

Kết quả trên chỉ ra rằng khi Threshold = 0.3 thì Sensitivity là 89.39% còn Accuracy là 59.52%. Khi ngưỡng này tăng dần thì Sensitivity giảm còn Accuracy lại tăng. Sự đánh đổi giữa các tiêu chí đo lường chất lượng phân loại của mô hình là điều chúng ta đã biết.

Như vậy, nếu muốn đạt được mục tiêu mô hình cover được ít nhất 70% khách hàng sẽ mua hàng trong tháng tới thì ngưỡng mà chúng ta nên chọn là 0.45. Với ngưỡng này thì chất lượng phân loại của GBM trên test data như sau:

results_list_gbm[[3]]

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  971 392
##        Yes 370 918
##                                           
##                Accuracy : 0.7126          
##                  95% CI : (0.6949, 0.7297)
##     No Information Rate : 0.5058          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.4249          
##                                           
##  Mcnemar's Test P-Value : 0.4468          
##                                           
##             Sensitivity : 0.7008          
##             Specificity : 0.7241          
##          Pos Pred Value : 0.7127          
##          Neg Pred Value : 0.7124          
##              Prevalence : 0.4942          
##          Detection Rate : 0.3463          
##    Detection Prevalence : 0.4859          
##       Balanced Accuracy : 0.7124          
##                                           
##        'Positive' Class : Yes             
## 

Nếu muốn chúng ta cũng có thể xem ma trận nhầm lẫn CM trên test data cho tất cả các ngưỡng đã chọn:

results_list_gbm

## [[1]]
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   No  Yes
##        No   407  139
##        Yes  934 1171
##                                          
##                Accuracy : 0.5952         
##                  95% CI : (0.5763, 0.614)
##     No Information Rate : 0.5058         
##     P-Value [Acc > NIR] : < 2.2e-16      
##                                          
##                   Kappa : 0.196          
##                                          
##  Mcnemar's Test P-Value : < 2.2e-16      
##                                          
##             Sensitivity : 0.8939         
##             Specificity : 0.3035         
##          Pos Pred Value : 0.5563         
##          Neg Pred Value : 0.7454         
##              Prevalence : 0.4942         
##          Detection Rate : 0.4417         
##    Detection Prevalence : 0.7940         
##       Balanced Accuracy : 0.5987         
##                                          
##        'Positive' Class : Yes            
##                                          
## 
## [[2]]
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  857 317
##        Yes 484 993
##                                         
##                Accuracy : 0.6978        
##                  95% CI : (0.68, 0.7153)
##     No Information Rate : 0.5058        
##     P-Value [Acc > NIR] : < 2.2e-16     
##                                         
##                   Kappa : 0.3965        
##                                         
##  Mcnemar's Test P-Value : 4.483e-09     
##                                         
##             Sensitivity : 0.7580        
##             Specificity : 0.6391        
##          Pos Pred Value : 0.6723        
##          Neg Pred Value : 0.7300        
##              Prevalence : 0.4942        
##          Detection Rate : 0.3746        
##    Detection Prevalence : 0.5571        
##       Balanced Accuracy : 0.6985        
##                                         
##        'Positive' Class : Yes           
##                                         
## 
## [[3]]
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  971 392
##        Yes 370 918
##                                           
##                Accuracy : 0.7126          
##                  95% CI : (0.6949, 0.7297)
##     No Information Rate : 0.5058          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.4249          
##                                           
##  Mcnemar's Test P-Value : 0.4468          
##                                           
##             Sensitivity : 0.7008          
##             Specificity : 0.7241          
##          Pos Pred Value : 0.7127          
##          Neg Pred Value : 0.7124          
##              Prevalence : 0.4942          
##          Detection Rate : 0.3463          
##    Detection Prevalence : 0.4859          
##       Balanced Accuracy : 0.7124          
##                                           
##        'Positive' Class : Yes             
##                                           
## 
## [[4]]
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   No  Yes
##        No  1166  577
##        Yes  175  733
##                                           
##                Accuracy : 0.7163          
##                  95% CI : (0.6988, 0.7334)
##     No Information Rate : 0.5058          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.4306          
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.5595          
##             Specificity : 0.8695          
##          Pos Pred Value : 0.8073          
##          Neg Pred Value : 0.6690          
##              Prevalence : 0.4942          
##          Detection Rate : 0.2765          
##    Detection Prevalence : 0.3425          
##       Balanced Accuracy : 0.7145          
##                                           
##        'Positive' Class : Yes             
## 

Discussion Problem

Phần 2 của dự án là tiếp nối của phần 1 theo đó đề xuất cách tiếp cận điều chỉnh ngưỡng phân loại cho GBM nhằm đạt được mục tiêu là mô hình cover được ít nhất 70% khách hàng sẽ mua hàng trong tháng tới dựa trên khảo sát khả năng phân loại của mô hình khi ngưỡng thay đổi. Tuy nhiên việc tinh chỉnh tham số tối ưu cho GBM trong giới hạn 8h và cấu hình rất hạn chế của may tính người làm dự án này là điều không khả thi. Hi vọng sẽ có dịp xử lí vấn đề tinh chỉnh tham số tối ưu cho GBM trong một bài viết khác.