Motivations

R/Python có nhiều package có thể được sử dụng để thực hiện thuật toán Random Forests. Trong số các package của R thì ranger được viết bằng C++ và do vậy tốc độ tính toán và hiệu quả sử dụng RAM là tốt nhất theo dựa trên các kết quả thực nghiệm cho một số bộ dữ liệu và được trình bày ở bảng dưới đây (nguồn: Wirtschaftsuniversität Wien):

Chi tiết hơn có thể tham khảo tại đây.

Mặt khác việc tìm kiếm tham số tối ưu cho các thuật toán ML cũng là việc tốn thời gian nhất là nếu sử dụng Full Grid Search. Random Search có thể hiệu quả về mặt thời gian nhưng rất có thể bỏ qua tham số tốt nhất. Do vậy Bayesian Optimization được sử dụng để tìm kiếm tham số tối ưu cho Random Forests.

Empirical Results

Sử dụng bộ số liệu từ cuộc thi Give Me Some Credit trên Kaggle chúng ta có thể đạt được kết quả AUC/ROC = 0.86566 ngay trong lần submit đầu tiên. Đây là một kết quá không tồi nếu so với đội dẫn đầu với AUC/ROC = 0.86955:

R codes cho kết quả ở trên:

#=================
#  Prepare data 
#=================

# Clear R environment: 
rm(list = ls())

# Load data: 

library(tidyverse)

library(pROC)

read_csv("F:\\GiveMeSomeCredit\\cs-training.csv") -> df_train

read_csv("F:\\GiveMeSomeCredit\\cs-test.csv") -> df_test

# Combine the two data sets: 

bind_rows(df_train, df_test) -> df_total

# Rename for some columns: 

df_total %>% select(-1) -> df_total

df_total %>% names() %>% str_replace_all("-", "_") -> new_names

names(df_total) <- new_names

df_total %>% select(-SeriousDlqin2yrs) -> df_inputs

# Impute missing data: 

library(missRanger)

missRanger(df_inputs, seed = 29) -> inputs_imputed

# Rescale features: 

inputs_imputed %>% 
  mutate_all(function(x) {(x - min(x)) / (max(x) - min(x))}) -> inputs_imputed

# Convert to categorical: 

inputs_imputed %>% 
  mutate(SeriousDlqin2yrs = df_total$SeriousDlqin2yrs) %>% 
  filter(!is.na(SeriousDlqin2yrs)) %>% 
  mutate(SeriousDlqin2yrs = case_when(SeriousDlqin2yrs == 1 ~ "Bad", TRUE ~ "Good")) %>% 
  mutate_if(is.character, as.factor) -> df_train 

inputs_imputed %>% 
  mutate(SeriousDlqin2yrs = df_total$SeriousDlqin2yrs) %>% 
  filter(is.na(SeriousDlqin2yrs)) %>% 
  select(-SeriousDlqin2yrs) -> df_test

#===============================================================================
#  Option 1: Random Forest with optimal parameters using Bayesian Optimization
#===============================================================================

# Prepare Train and Validation set: 

set.seed(1)

id <- sample(1:nrow(df_train), size = 100000, replace = FALSE)

df_train %>% slice(id) -> dataTrain

df_train %>% slice(-id) -> dataValid

dataValid %>% select(-SeriousDlqin2yrs) -> inputValid

actuals <- dataValid$SeriousDlqin2yrs # Actual labels. 


# Objective function: 

library(ranger)

my_fun <- function(num.trees, mtry, max.depth) {
  
  rf <- ranger(formula = SeriousDlqin2yrs ~ ., 
               data = dataTrain,
               num.trees = num.trees,
               mtry = mtry,
               min.node.size = 1,
               max.depth = max.depth, 
               probability = TRUE)
  
  predict(rf, inputValid, type = "response") -> pred_fromRF
  
  pred_fromRF$predictions %>% as.data.frame() %>% pull(Bad) -> PD_predicted
  
  roc(actuals, PD_predicted)$auc %>% as.numeric() -> my_auc
  
  print(my_auc)
  
  list(Score = my_auc, Pred = NULL)
  }


# Define domain space: 

my_hypers <- list(num.trees = c(500L, 2500L),
                  mtry = c(1L, 10L),
                  max.depth = c(3L, 10L))


# Search optimal hyperparameter by Bayesian Optimization: 

library(rBayesianOptimization)

system.time(OPT_Res <- BayesianOptimization(my_fun, 
                                            bounds = my_hypers, 
                                            init_points = 15, 
                                            n_iter = 10,
                                            acq = "ucb", 
                                            kappa = 2.576, 
                                            eps = 0.0,
                                            verbose = FALSE))



# Best parameters: 
OPT_Res$Best_Par

# Retrain RF with optimal parameters: 

rf <- ranger(formula = SeriousDlqin2yrs ~ ., 
             data = df_train,
             num.trees = OPT_Res$Best_Par[1],
             mtry = OPT_Res$Best_Par[2],
             min.node.size = 1,
             max.depth = OPT_Res$Best_Par[3], 
             probability = TRUE)

# Use RF for predicting PD: 

predict(rf, df_test, type = "response") -> pred_fromRF

pred_fromRF$predictions %>% as.data.frame() %>% pull(Bad) -> PD_predicted

# Save results for submission: 

data.frame(Id = 1:nrow(df_test), Probability = PD_predicted) -> df_submission

write_csv(df_submission, "E://submission_updated.csv")

Final Notes

Chúng ta có thể cải thiện kết quả tốt hơn bằng:

  1. Một số kĩ thuật feature engineering như lựa chọn feature dựa trên IV hoặc monotonic binning.

  2. Để đạt kết quả trên chúng ta mới chỉ tinh chỉnh và tìm kiếm ba tham số của Random Forest là num.trees, mtry và max.depth. Ngoài các tham số này chúng ta có thể tinh chỉnh các tham số khác để cải thiện kết quả.