Predict Customer Purchase (Deployment/Application)

Mini Project for VinID’s Recruitment

Motivations

Phần 1 của dự án trình bày chi tiết về hai vấn đề quan trọng: (1) xử lí dữ liệu thô, và (2) thăm dò nhằm tìm kiếm mô hình tốt nhất nhằm dự báo hành vi tiêu dùng của khách hàng. Phần 2 của dự án đặt ra một mục tiêu cụ thể hơn cho việc xây dựng một mô hình mà cover được ít nhất 70% khách hàng sẽ mua hàng trong tháng tới bằng cách điều chỉnh ngưỡng phân loại (Cutoff/Threshold) cho mô hình GBM.

Chúng ta sử dụng dữ liệu khai thác được từ tháng 2 và 3 để tạo ra các Features (là RFM) và phải cần đến dữ liệu của tháng 4 kế tiếp để tạo ra biến Output để: (1) trước hết là huấn luyện, và (2) là đánh giá mô hình. R codes dưới đây hiện thực hóa ý tưởng trên:

#========================
#  Xử lí sơ bộ dữ liệu
#========================

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)) %>% 
  mutate(money = Quantity*UnitPrice) -> 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


#=======================================
#   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, ]


# Thiết lập môi trường tinh chỉnh tham số và cross - validation: 

set.seed(1)
train.control <- trainControl(method = "repeatedcv", 
                              number = 5,
                              repeats = 5, 
                              classProbs = TRUE,
                              allowParallel = TRUE, 
                              summaryFunction = twoClassSummary)



# Sử dụng tính toán song song nhằm tiết kiệm thời gian training: 
library(doParallel)
registerDoParallel(cores = detectCores() - 1)


# Huấn luyện GBM: 
set.seed(1)
my_gbm <- train(BuyNextMonth ~., 
                data = df_train, 
                method = "gbm", 
                metric = "ROC", 
                verbose = FALSE, 
                trControl = train.control)


# Đánh giá chất lượng phân loại của GBM trên dữ liệu test: 
actual <- df_test$BuyNextMonth
pred <- predict(my_gbm, df_test)
confusionMatrix(pred, actual, positive = "Yes")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   No  Yes
##        No  1089  492
##        Yes  252  818
##                                           
##                Accuracy : 0.7194          
##                  95% CI : (0.7018, 0.7364)
##     No Information Rate : 0.5058          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.4374          
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.6244          
##             Specificity : 0.8121          
##          Pos Pred Value : 0.7645          
##          Neg Pred Value : 0.6888          
##              Prevalence : 0.4942          
##          Detection Rate : 0.3086          
##    Detection Prevalence : 0.4036          
##       Balanced Accuracy : 0.7183          
##                                           
##        'Positive' Class : Yes             
## 

Mặc định thì R (cũng như Python) sẽ chọn Cutoff = 0.5 cho phân loại. Với ngưỡng mặc định này thì tỉ lệ cover khách hàng sẽ mua hàng trong tháng kế tiếp là 62.44% thể hiện qua tiêu chí Sensitivity. Như đã phân tích trong phần 2 thì chúng ta có thể đạt được mục tiêu phân loại đúng ít nhất 70% khách hàng sẽ mua hàng trong tháng tới bằng cách chọn ngưỡng 0.4:

# Viết hàm thực hiện dự báo khách hàng sẽ mua 
# trong tháng tới với ngưỡng cutoff cố định là 0.4: 
label_with_cutoff <- function(df_inputs) {
  prob_predict <- predict(my_gbm, df_inputs, type = "prob") %>% pull(Yes)
  label_predicted <- case_when(prob_predict >= 0.4 ~ "Yes", TRUE ~ "No") %>% as.factor()
  return(label_predicted)
  
}

# Sử dụng hàm: 
pred <- label_with_cutoff(df_inputs = df_test)

# Chất lượng phân loại của mô hình: 
confusionMatrix(pred, df_test$BuyNextMonth, positive = "Yes")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  946 386
##        Yes 395 924
##                                           
##                Accuracy : 0.7054          
##                  95% CI : (0.6876, 0.7227)
##     No Information Rate : 0.5058          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.4108          
##                                           
##  Mcnemar's Test P-Value : 0.7747          
##                                           
##             Sensitivity : 0.7053          
##             Specificity : 0.7054          
##          Pos Pred Value : 0.7005          
##          Neg Pred Value : 0.7102          
##              Prevalence : 0.4942          
##          Detection Rate : 0.3485          
##    Detection Prevalence : 0.4975          
##       Balanced Accuracy : 0.7054          
##                                           
##        'Positive' Class : Yes             
## 

Như vậy bằng cách điều chỉnh cutoff = 0.4 thì GBM xác định đúng 924 khách hàng sẽ mua thàng trong tháng 4 trong tổng số 924 + 386 = 1310, Như vậy GBM cover đúng 70.53% khách hàng sẽ mua hàng trong tháng tới.

Câu hỏi ở đây là nếu ngưỡng phân loại 0.4 được sử dụng để dự báo khách hàng nào sẽ mua hàng trong tháng 5 dựa trên FRM khai thác được từ tháng 3 và 4 thì GBM sẽ được sử dụng như thế nào và chúng ta có thể đánh giá chất lượng dự báo ra sao?.

Deployment/Application

Nhắc lại rằng chúng ta xây dựng và đánh giá mô hình trên dữ liệu có được ở tháng 2, 3 và 4. Câu hỏi trên tương đương với việc trả lời câu hỏi sau nếu sử dụng dữ liệu tháng 3 và 4 thì những khách hàng nào sẽ mua hàng trong tháng 5 tới dựa trên kết quả dự báo từ GBM với ngưỡng phân loại được chọn là 0.4?.

Để trả lời câu hỏi này trước hết viết hàm extract RFM từ hai tháng chọn trước đồng thời scaling 0-1 luôn cho các Inputs này:

extractRFM_twoMonths <- function(towMonths_selected) {
  
  train_df <- my_df %>% 
    filter(time_mon %in% towMonths_selected)
  
  train_df %>% 
    group_by(CustomerID) %>% 
    summarise(money = sum(money)) %>% 
    ungroup() -> df_train_m

  train_df %>% 
    group_by(CustomerID) %>% 
    count() %>% 
    ungroup() %>% 
    rename(freq = n) -> df_train_f

 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

 df_predicting <- df_train_f %>% 
   full_join(df_train_m, by = "CustomerID") %>% 
   full_join(df_train_r, by = "CustomerID") %>% 
   mutate_if(is.numeric, function(x) {(x - min(x)) / (max(x) - min(x))})
 
 return(df_predicting)
}

Sử dụng hàm đã viết ở trên để extract ra inputs sẽ được sử dụng để dự báo những khách hàng sẽ mua hàng trong tháng 5 như sau:

df_inputs <- extractRFM_twoMonths(towMonths_selected = c("Mar", "Apr"))

# Những khách hàng sẽ mua hàng trong tháng 5 tới: 
Buy_in_May_predicted <- label_with_cutoff(df_inputs = df_inputs)

Dựa trên dữ liệu của tháng 3 và 4 thì GBM sẽ dự báo rằng có 6873 khách hàng sẽ mua hàng trong tháng 5 tới với ngưỡng phân loại được chọn là 0.4:

Buy_in_May_predicted %>% table()

## .
##   No  Yes 
## 5852 6647

Dựa trên kết quả này công ti sẽ gửi email cho 6873 khách hàng có trong danh sách (trích một phần) dưới đây:

# Danh sách những khách hàng sẽ nhận được email 
# dựa trên kết quả dự báo của GBM: 
df_inputs %>% 
  mutate(Buy_in_May_predicted = Buy_in_May_predicted) %>% 
  filter(Buy_in_May_predicted == "Yes") %>% 
  select(CustomerID, Buy_in_May_predicted) -> CusID_buy_in_May

# Một số khách hàng trong danh sách: 
CusID_buy_in_May %>% 
  head() %>% 
  kable()

CustomerID	Buy_in_May_predicted
aGdgbmdq	Yes
aGdgcGNs	Yes
aGdgcGRp	Yes
aGdiamFo	Yes
aGdibWg=	Yes
aGdicGJk	Yes

Đến thời điểm này chúng ta vẫn chưa thể trả lời được câu hỏi những khách hàng nhận được email mà công ti gửi có cover ít nhất 70% những khách hàng thực sự sẽ mua hàng trong tháng 5 tới hay không?. Để trả lời câu hỏi này chúng ta phải chờ dữ liệu của tháng 5 xuất hiện. Sau khi dữ liệu của tháng 5 đã có chúng ta có thể trả lời câu hỏi trên như sau:

# Những khách hàng mua hàng trong tháng 3 + 4: 
IDCus_Buy_in_Mar_Apr <- df_inputs$CustomerID %>% unique()

# Những khách hàng thực sự mua hàng trong tháng 5: 
IDCus_Buy_in_May <- my_df %>% 
  filter(time_mon %in% c("May")) %>% 
  pull(CustomerID) %>% 
  unique()

# Những khách hàng mà tháng 3 + 4 mua hàng mà tháng 5 cũng mua hàng: 
case_when(IDCus_Buy_in_Mar_Apr %in% IDCus_Buy_in_May ~ "Yes", 
          TRUE ~ "No") %>% as.factor() -> actuals_next

# Đánh giá chất lượng dự báo của GBM: 

confusionMatrix(Buy_in_May_predicted, actuals_next, positive = "Yes")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   No  Yes
##        No  4128 1724
##        Yes 1967 4680
##                                           
##                Accuracy : 0.7047          
##                  95% CI : (0.6966, 0.7127)
##     No Information Rate : 0.5124          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.4085          
##                                           
##  Mcnemar's Test P-Value : 6.796e-05       
##                                           
##             Sensitivity : 0.7308          
##             Specificity : 0.6773          
##          Pos Pred Value : 0.7041          
##          Neg Pred Value : 0.7054          
##              Prevalence : 0.5124          
##          Detection Rate : 0.3744          
##    Detection Prevalence : 0.5318          
##       Balanced Accuracy : 0.7040          
##                                           
##        'Positive' Class : Yes             
## 

Như vậy GBM dự báo đúng 73.08% khách hàng sẽ mua hàng trong tháng 5 (Sensitivity = 0.7308). Kết quả này thỏa mãn mục tiêu đặt ra ban đầu khi thiết kế và xây dựng mô hình dự báo.

Go Further

Sử dụng dữ liệu của tháng 4 + 5 chúng ta có thể đánh giá việc sử dụng GBM cho việc dự báo những khách hàng nào sẽ mua hàng trong tháng 6 như sau:

# Dự báo những khách hàng sẽ mua hàng trong tháng 6 kết tiếp: 
df_inputs <- extractRFM_twoMonths(towMonths_selected = c("Apr", "May"))
Buy_in_Jun_predicted <- label_with_cutoff(df_inputs = df_inputs)

# Đánh giá chất lượng dự báo của GBM: 
IDCus_Buy_in_Apr_May <- df_inputs$CustomerID %>% unique()

IDCus_Buy_in_Jun <- my_df %>% 
  filter(time_mon %in% c("Jun")) %>% 
  pull(CustomerID) %>% 
  unique()

case_when(IDCus_Buy_in_Apr_May %in% IDCus_Buy_in_Jun ~ "Yes", 
          TRUE ~ "No") %>% as.factor() -> actuals_next

# Đánh giá chất lượng dự báo của GBM: 

confusionMatrix(Buy_in_Jun_predicted, actuals_next, positive = "Yes")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   No  Yes
##        No  4443 1799
##        Yes 1865 4579
##                                           
##                Accuracy : 0.7112          
##                  95% CI : (0.7032, 0.7191)
##     No Information Rate : 0.5028          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.4223          
##                                           
##  Mcnemar's Test P-Value : 0.2829          
##                                           
##             Sensitivity : 0.7179          
##             Specificity : 0.7043          
##          Pos Pred Value : 0.7106          
##          Neg Pred Value : 0.7118          
##              Prevalence : 0.5028          
##          Detection Rate : 0.3609          
##    Detection Prevalence : 0.5080          
##       Balanced Accuracy : 0.7111          
##                                           
##        'Positive' Class : Yes             
## 

GBM dự báo đúng 71.79% khách hàng sẽ mua hàng trong tháng 6 dựa trên dữ liệu tháng 4 + 5.

Conclusion

Series gồm ba bài viết (trước đó là phần 1 và phần 2) trình bày việc xây dựng, lựa chọn và áp dụng GBM cho công việc dự báo khách hàng nào sẽ mua hàng trong tháng tới dựa trên dữ liệu lịch sử về giao dịch của hai tháng trước đó với mục tiêu là cover được ít nhất 70% khách hàng sẽ mua hàng để Rainbow Store thực hiện và chuẩn bị trước các chiến lược tiếp thị, quảng cáo và kích cầu mua sắm. Còn nhiều khía cạnh khác của việc xây dựng, lựa chọn, và triển khái ứng dụng của mô hình chưa được đề cập.