BÀI LUẬN PHÂN TÍCH RỦI RO TÍN DỤNG
NGUYỄN ĐINH DANH, NGUYỄN MINH KHANG,34
28/10/2025
GIỚI THIỆU BỘ DỮ LIỆU
Khai báo thư viện
Kích thước bộ dữ liệu
dimensions <- dim(df)
cat(paste("Bộ dữ liệu có", dimensions[1], "hàng và", dimensions[2], "cột.\n"))Bộ dữ liệu có 255347 hàng và 18 cột.Tên các cột(Biến)
--- Tên các Cột ---Các cột trong dữ liệu bao gồm: [1] "LoanID" "Age" "Income" "LoanAmount"
[5] "CreditScore" "MonthsEmployed" "NumCreditLines" "InterestRate"
[9] "LoanTerm" "DTIRatio" "Education" "EmploymentType"
[13] "MaritalStatus" "HasMortgage" "HasDependents" "LoanPurpose"
[17] "HasCoSigner" "Default" Giải thích cột(các biến) trong bảng dữ liệu
variable_info <- data.frame(
Variable = c("LoanID", "Age", "Income", "LoanAmount", "CreditScore", "MonthsEmployed",
"NumCreditLines", "InterestRate", "LoanTerm", "DTIRatio", "Education",
"EmploymentType", "MaritalStatus", "HasMortgage", "HasDependents",
"LoanPurpose", "HasCoSigner", "Default"),
TiengViet = c("Mã khoản vay", "Tuổi", "Thu nhập", "Số tiền vay", "Điểm tín dụng", "Số tháng làm việc",
"Số khoản tín dụng", "Lãi suất", "Thời hạn vay", "Tỷ lệ nợ/thu nhập", "Trình độ học vấn",
"Loại hình công việc", "Tình trạng hôn nhân", "Có vay thế chấp", "Có người phụ thuộc",
"Mục đích vay", "Có người đồng vay", "Vỡ nợ"),
MoTa = c("Mã định danh duy nhất cho từng khoản vay",
"Tuổi của người vay",
"Tổng thu nhập hàng năm của người vay",
"Số tiền vay từ ngân hàng hoặc tổ chức tài chính",
"Điểm đánh giá khả năng tín dụng của người vay",
"Tổng số tháng làm việc tại công việc hiện tại",
"Tổng số khoản vay hoặc thẻ tín dụng đang có",
"Lãi suất phải trả cho khoản vay (%/năm)",
"Thời gian hoàn trả khoản vay (tháng/năm)",
"Tỷ lệ giữa tổng nợ và thu nhập hàng tháng",
"Cấp độ học vấn của người vay",
"Tình trạng công việc (toàn/bán thời gian, tự doanh...)",
"Tình trạng hôn nhân của người vay",
"Có đang vay thế chấp khác không (Yes/No)",
"Có người phụ thuộc hay không (con, cha mẹ...)",
"Mục đích của khoản vay (mua nhà, xe, học...)",
"Có người đồng ký vay hay không",
"Có bị vỡ nợ hay không (1=có, 0=không)")
)
kable(variable_info, caption = "Bảng giải thích các biến trong dữ liệu")| Variable | TiengViet | MoTa |
|---|---|---|
| LoanID | Mã khoản vay | Mã định danh duy nhất cho từng khoản vay |
| Age | Tuổi | Tuổi của người vay |
| Income | Thu nhập | Tổng thu nhập hàng năm của người vay |
| LoanAmount | Số tiền vay | Số tiền vay từ ngân hàng hoặc tổ chức tài chính |
| CreditScore | Điểm tín dụng | Điểm đánh giá khả năng tín dụng của người vay |
| MonthsEmployed | Số tháng làm việc | Tổng số tháng làm việc tại công việc hiện tại |
| NumCreditLines | Số khoản tín dụng | Tổng số khoản vay hoặc thẻ tín dụng đang có |
| InterestRate | Lãi suất | Lãi suất phải trả cho khoản vay (%/năm) |
| LoanTerm | Thời hạn vay | Thời gian hoàn trả khoản vay (tháng/năm) |
| DTIRatio | Tỷ lệ nợ/thu nhập | Tỷ lệ giữa tổng nợ và thu nhập hàng tháng |
| Education | Trình độ học vấn | Cấp độ học vấn của người vay |
| EmploymentType | Loại hình công việc | Tình trạng công việc (toàn/bán thời gian, tự doanh…) |
| MaritalStatus | Tình trạng hôn nhân | Tình trạng hôn nhân của người vay |
| HasMortgage | Có vay thế chấp | Có đang vay thế chấp khác không (Yes/No) |
| HasDependents | Có người phụ thuộc | Có người phụ thuộc hay không (con, cha mẹ…) |
| LoanPurpose | Mục đích vay | Mục đích của khoản vay (mua nhà, xe, học…) |
| HasCoSigner | Có người đồng vay | Có người đồng ký vay hay không |
| Default | Vỡ nợ | Có bị vỡ nợ hay không (1=có, 0=không) |
Kiểu Dữ liệu (Data Types) của các biến
--- Kiểu Dữ liệu (str) ---'data.frame': 255347 obs. of 18 variables:
$ LoanID : chr "I38PQUQS96" "HPSK72WA7R" "C1OZ6DPJ8Y" "V2KKSFM3UN" ...
$ Age : int 56 69 46 32 60 25 38 56 36 40 ...
$ Income : int 85994 50432 84208 31713 20437 90298 111188 126802 42053 132784 ...
$ LoanAmount : int 50587 124440 129188 44799 9139 90448 177025 155511 92357 228510 ...
$ CreditScore : int 520 458 451 743 633 720 429 531 827 480 ...
$ MonthsEmployed: int 80 15 26 0 8 18 80 67 83 114 ...
$ NumCreditLines: int 4 1 3 3 4 2 1 4 1 4 ...
$ InterestRate : num 15.23 4.81 21.17 7.07 6.51 ...
$ LoanTerm : int 36 60 24 24 48 24 12 60 48 48 ...
$ DTIRatio : num 0.44 0.68 0.31 0.23 0.73 0.1 0.16 0.43 0.2 0.33 ...
$ Education : chr "Bachelor's" "Master's" "Master's" "High School" ...
$ EmploymentType: chr "Full-time" "Full-time" "Unemployed" "Full-time" ...
$ MaritalStatus : chr "Divorced" "Married" "Divorced" "Married" ...
$ HasMortgage : chr "Yes" "No" "Yes" "No" ...
$ HasDependents : chr "Yes" "No" "Yes" "No" ...
$ LoanPurpose : chr "Other" "Other" "Auto" "Business" ...
$ HasCoSigner : chr "Yes" "Yes" "No" "No" ...
$ Default : int 0 0 1 0 0 1 0 0 1 0 ...Số lượng Giá trị bị thiếu (Missing Values)
--- Số lượng Giá trị bị thiếu (NA) cho mỗi Cột --- LoanID Age Income LoanAmount CreditScore
0 0 0 0 0
MonthsEmployed NumCreditLines InterestRate LoanTerm DTIRatio
0 0 0 0 0
Education EmploymentType MaritalStatus HasMortgage HasDependents
0 0 0 0 0
LoanPurpose HasCoSigner Default
0 0 0 Số lượng Hàng dữ liệu bị trùng lặp
---Số lượng Hàng trùng lặp ---num_duplicates <- sum(duplicated(df))
cat(paste("Tổng số hàng bị trùng lặp hoàn toàn:", num_duplicates, "\n"))Tổng số hàng bị trùng lặp hoàn toàn: 0 Thống kê Mô tả (Cho các cột dạng số)
--- Thống kê Mô tả (Cột số) ---# Chọn các cột số quan trọng
numeric_vars <- c("Age", "Income", "LoanAmount", "CreditScore", "MonthsEmployed", "InterestRate", "DTIRatio")
# Dùng hàm summary() trên các cột đã chọn
summary(df[numeric_vars]) Age Income LoanAmount CreditScore
Min. :18.0 Min. : 15000 Min. : 5000 Min. :300.0
1st Qu.:31.0 1st Qu.: 48826 1st Qu.: 66156 1st Qu.:437.0
Median :43.0 Median : 82466 Median :127556 Median :574.0
Mean :43.5 Mean : 82499 Mean :127579 Mean :574.3
3rd Qu.:56.0 3rd Qu.:116219 3rd Qu.:188985 3rd Qu.:712.0
Max. :69.0 Max. :149999 Max. :249999 Max. :849.0
MonthsEmployed InterestRate DTIRatio
Min. : 0.00 Min. : 2.00 Min. :0.1000
1st Qu.: 30.00 1st Qu.: 7.77 1st Qu.:0.3000
Median : 60.00 Median :13.46 Median :0.5000
Mean : 59.54 Mean :13.49 Mean :0.5002
3rd Qu.: 90.00 3rd Qu.:19.25 3rd Qu.:0.7000
Max. :119.00 Max. :25.00 Max. :0.9000 Phân tích các Cột Phân loại
--- Phân tích Cột Phân loại ---# Liệt kê các cột phân loại bạn muốn xem
categorical_cols <- c("Education", "EmploymentType", "MaritalStatus", "LoanPurpose", "HasMortgage", "HasDependents")
# Dùng vòng lặp 'for' để in ra bảng tần suất
for (col in categorical_cols) {
cat(paste("\n--- Phân tích cột:", col, "---\n"))
print(table(df[[col]]))
}
--- Phân tích cột: Education ---
Bachelor's High School Master's PhD
64366 63903 63541 63537
--- Phân tích cột: EmploymentType ---
Full-time Part-time Self-employed Unemployed
63656 64161 63706 63824
--- Phân tích cột: MaritalStatus ---
Divorced Married Single
85033 85302 85012
--- Phân tích cột: LoanPurpose ---
Auto Business Education Home Other
50844 51298 51005 51286 50914
--- Phân tích cột: HasMortgage ---
No Yes
127670 127677
--- Phân tích cột: HasDependents ---
No Yes
127605 127742 Phân phối của Biến Mục tiêu (Default)
--- Phân phối Biến Mục tiêu (Default) ---Số lượng (0 = Không vỡ nợ, 1 = Vỡ nợ):
0 1
225694 29653
Tỷ lệ Phần trăm:
0 1
88.38718 11.61282 Số lượng Giá trị Duy nhất
--- Số lượng Giá trị Duy nhất trong mỗi Cột ---# Dùng sapply để áp dụng hàm 'n_distinct' cho từng cột
# (n_distinct là hàm của gói dplyr, đã được tải cùng tidyverse)
unique_counts <- sapply(df, dplyr::n_distinct)
print(unique_counts) LoanID Age Income LoanAmount CreditScore
255347 52 114620 158729 550
MonthsEmployed NumCreditLines InterestRate LoanTerm DTIRatio
120 4 2301 5 81
Education EmploymentType MaritalStatus HasMortgage HasDependents
4 4 3 2 2
LoanPurpose HasCoSigner Default
5 2 2 THAO TÁC VỚI BỘ DỮ LIỆU
Mã hoá bộ dữ liệu
Tạo một bản sao của DataFrame để xử lý
Đã tạo bản sao 'df_processed' để bắt đầu xử lý.Xoá cột không cần thiết
--- 1. Xóa cột 'LoanID' ---Cột 'LoanID' đã được xóa. [1] "Age" "Income" "LoanAmount" "CreditScore"
[5] "MonthsEmployed" "NumCreditLines" "InterestRate" "LoanTerm"
[9] "DTIRatio" "Education" "EmploymentType" "MaritalStatus"
[13] "HasMortgage" "HasDependents" "LoanPurpose" "HasCoSigner"
[17] "Default" Chuyển những biến có giá trị “Yes/No” sang “1/0”
---Mã hóa 'Yes'/'No' sang 1/0 ---df_processed <- df_processed %>%
mutate(
# Biến HasMortgage
HasMortgage_Num = ifelse(HasMortgage == "Yes", 1, 0),
# Biến HasDepents
HasDependents_Num = ifelse(HasDependents == "Yes", 1, 0),
# Biến HasCosiner
HasCoSigner_Num = ifelse(HasCoSigner == "Yes", 1, 0)
)
cat("Đã tạo 3 cột số mới (Num) từ các cột Yes/No.\n")Đã tạo 3 cột số mới (Num) từ các cột Yes/No.# Xem 3 cột cũ và 3 cột mới
# knitr::kable(head(df_processed[, c("HasMortgage", "HasMortgage_Num", "HasDependents", "HasDependents_Num","HasCoSigner", "HasCoSigner_Num")]))Đã tạo 3 cột số mới (Num) từ các cột Yes/No.# Xem 3 cột cũ và 3 cột mới
knitr::kable(head(df_processed[, c("HasMortgage", "HasMortgage_Num", "HasDependents", "HasDependents_Num","HasCoSigner", "HasCoSigner_Num")]))| HasMortgage | HasMortgage_Num | HasDependents | HasDependents_Num | HasCoSigner | HasCoSigner_Num |
|---|---|---|---|---|---|
| Yes | 1 | Yes | 1 | Yes | 1 |
| No | 0 | No | 0 | Yes | 1 |
| Yes | 1 | Yes | 1 | No | 0 |
| No | 0 | No | 0 | No | 0 |
| No | 0 | Yes | 1 | No | 0 |
| Yes | 1 | No | 0 | Yes | 1 |
Thay đổi thứ bậc trong cột biến “Education”
--- Mã hóa Thứ bậc cho 'Education' ---# Định nghĩa thứ bậc: High School (thấp nhất) -> PhD (cao nhất)
education_levels <- c(
"High School" = 0,
"Bachelor's" = 1,
"Master's" = 2,
"PhD" = 3
)
df_processed <- df_processed %>%
mutate(Education_Ordinal = recode(Education, !!!education_levels))
cat("Đã tạo cột 'Education_Ordinal' (0-3).\n")Đã tạo cột 'Education_Ordinal' (0-3).Phân chia cột LoanDefaul
---Chia nhóm (Binning) cho 'LoanAmount' (Số tiền vay) ---# Lấy ra các mốc Tứ phân vị (Quantiles)
breaks_loanamount <- quantile(df_processed$LoanAmount,
probs = c(0, 0.25, 0.5, 0.75, 1),
na.rm = TRUE)
# In các mốc số tiền vay này ra
cat("--- Các mốc LoanAmount (Số tiền vay) cụ thể ---\n")--- Các mốc LoanAmount (Số tiền vay) cụ thể --- 0% 25% 50% 75% 100%
5000 66156 127556 188985 249999 # Áp dụng các mốc này để tạo cột nhóm mới
df_processed <- df_processed %>%
mutate(
LoanAmountGroup = cut(LoanAmount,
breaks = breaks_loanamount,
labels = c("Rất nhỏ", "Nhỏ", "Vừa", "Lớn"),
include.lowest = TRUE) # Bao gồm cả giá trị thấp nhất
)
cat("\nĐã tạo cột 'LoanAmountGroup'.\n")
Đã tạo cột 'LoanAmountGroup'.Số lượng người trong mỗi nhóm (gần như bằng nhau):
Rất nhỏ Nhỏ Vừa Lớn
63838 63836 63836 63837 Tạo lập cột “Tỷ lệ nợ/Thu nhập”(Quy mô của khoả vay so với thu nhập)
---Tạo đặc trưng mới 'LoanToIncomeRatio' ---df_processed <- df_processed %>%
mutate(LoanToIncomeRatio = LoanAmount / (Income + 1))
cat("Đã tạo cột 'LoanToIncomeRatio'.\n")Đã tạo cột 'LoanToIncomeRatio'.Phân hoá cột biến Age thể hiện sự rủi ro
--- Chia nhóm (Binning) cho cột 'Age' ---df_processed <- df_processed %>%
mutate(
AgeGroup = cut(Age,
breaks = c(17, 25, 40, 60, Inf),
labels = c("18-25", "26-40", "41-60", "60+"),
right = TRUE)
)
cat("Đã tạo cột 'AgeGroup' (phân loại).\n")Đã tạo cột 'AgeGroup' (phân loại).Phân Hoá cột Thu nhập(Income)
--- Chia nhóm (Binning) cho cột 'Income' ---# Lấy ra các mốc Tứ phân vị (Quantiles)
# (0%, 25%, 50%, 75%, 100%)
# Dùng df (gốc) để tính toán các mốc
income_breaks <- quantile(df$Income,
probs = c(0, 0.25, 0.5, 0.75, 1),
na.rm = TRUE)
# ---------------------------------------------
# Thu nhập từng mốc:
cat("--- Các mốc thu nhập cụ thể ---\n")--- Các mốc thu nhập cụ thể --- 0% 25% 50% 75% 100%
15000.0 48825.5 82466.0 116219.0 149999.0 # ---------------------------------------------
# Áp dụng các mốc này vào df_processed
df_processed <- df_processed %>%
mutate(
IncomeGroup = cut(Income,
breaks = income_breaks,
labels = c("Thấp", "Trung bình", "Cao", "Rất cao"),
include.lowest = TRUE) # Bao gồm cả giá trị thấp nhất
)
cat("Đã tạo cột 'IncomeGroup' (Thấp, Trung bình, Cao, Rất cao).\n")Đã tạo cột 'IncomeGroup' (Thấp, Trung bình, Cao, Rất cao).
Thấp Trung bình Cao Rất cao
63837 63837 63839 63834 Phân hoá cột CreditScore
---Chia nhóm (Binning) cho 'CreditScore' (Điểm Tín Dụng) ---# Lấy ra các mốc Tứ phân vị (Quantiles)
# (0%, 25%, 50%, 75%, 100%)
breaks_credit_score <- quantile(df_processed$CreditScore,
probs = c(0, 0.25, 0.5, 0.75, 1),
na.rm = TRUE) # na.rm = TRUE phòng trường hợp có NA
# In các mốc điểm này ra để bạn biết (Tiền đề phân tích)
cat("--- Các mốc CreditScore (Điểm Tín Dụng) cụ thể ---\n")--- Các mốc CreditScore (Điểm Tín Dụng) cụ thể --- 0% 25% 50% 75% 100%
300 437 574 712 849 # Áp dụng các mốc này để tạo cột nhóm mới
df_processed <- df_processed %>%
mutate(
CreditScoreGroup = cut(CreditScore,
breaks = breaks_credit_score,
labels = c("Thấp", "Trung bình", "Cao", "Rất cao"),
include.lowest = TRUE) # Bao gồm cả giá trị thấp nhất (300)
)
cat("\nĐã tạo cột 'CreditScoreGroup' (Thấp, Trung bình, Cao, Rất cao).\n")
Đã tạo cột 'CreditScoreGroup' (Thấp, Trung bình, Cao, Rất cao).Số lượng người trong mỗi nhóm:
Thấp Trung bình Cao Rất cao
64140 63803 63896 63508 Phân chia cột MonthsEmployed
--- Chia nhóm (Binning) theo 'Ngưỡng Nghiệp vụ' cho 'MonthsEmployed' ---# Định nghĩa các mốc chia (breaks) theo logic:
# (-Inf, 0] -> Nhóm 0 tháng
# (0, 12] -> Nhóm 1-12 tháng
# (12, 60] -> Nhóm 13-60 tháng (1-5 năm)
# (60, Inf] -> Nhóm trên 60 tháng (Trên 5 năm) (Inf là Vô cực)
business_breaks <- c(-Inf, 0, 12, 60, Inf)
# Định nghĩa tên (nhãn) cho các nhóm này
business_labels <- c("0 tháng", "1-12 tháng", "1-5 năm", "Trên 5 năm")
# Áp dụng các mốc này để tạo cột nhóm mới
df_processed <- df_processed %>%
mutate(
# Chúng ta vẫn gọi là MonthsEmployedGroup để thống nhất
MonthsEmployedGroup = cut(MonthsEmployed,
breaks = business_breaks,
labels = business_labels,
right = TRUE) # right=TRUE nghĩa là (a, b]
)
cat("\nĐã tạo cột 'MonthsEmployedGroup' (Chia theo Nghiệp vụ).\n")
Đã tạo cột 'MonthsEmployedGroup' (Chia theo Nghiệp vụ).Lưu ý: Số lượng người trong mỗi nhóm sẽ KHÔNG bằng nhau:
0 tháng 1-12 tháng 1-5 năm Trên 5 năm
2122 25546 102097 125582 Phân chia cột ‘InterestRate’
--- Chia nhóm (Binning) theo 'Ngưỡng Nghiệp vụ' cho 'InterestRate' ---# Định nghĩa các mốc chia (breaks) theo logic rủi ro:
# (-Inf, 8] -> Nhóm Lãi suất Thấp (< 8%)
# (8, 15] -> Nhóm Trung bình (8% - 15%)
# (15, 20] -> Nhóm Cao (15% - 20%)
# (20, Inf] -> Nhóm Rất cao (> 20%) (Inf là Vô cực)
interest_breaks <- c(-Inf, 8, 15, 20, Inf)
# Định nghĩa tên (nhãn) cho các nhóm này
interest_labels <- c("Thấp (<8%)", "Trung bình (8-15%)", "Cao (15-20%)", "Rất cao (>20%)")
# Áp dụng các mốc này để tạo cột nhóm mới
df_processed <- df_processed %>%
mutate(
InterestRateGroup = cut(InterestRate,
breaks = interest_breaks,
labels = interest_labels,
right = TRUE)
)
cat("\nĐã tạo cột 'InterestRateGroup' (Chia theo Nghiệp vụ).\n")
Đã tạo cột 'InterestRateGroup' (Chia theo Nghiệp vụ).Số lượng người trong mỗi nhóm (sẽ không bằng nhau):
Thấp (<8%) Trung bình (8-15%) Cao (15-20%) Rất cao (>20%)
66489 78396 54978 55484 Phân chia cột DTIRation
---Chia nhóm (Binning) theo 'Ngưỡng Tứ phân vị' cho 'DTIRatio' ---# Lấy ra các mốc Tứ phân vị (Quantiles)
# Dữ liệu này có min=0.1, 25%=0.3, 50%=0.5, 75%=0.7, max=0.9
breaks_dti <- quantile(df_processed$DTIRatio,
probs = c(0, 0.25, 0.5, 0.75, 1),
na.rm = TRUE)
# In các mốc DTI này ra
cat("--- Các mốc DTIRatio (Tỷ lệ Nợ/Thu nhập) cụ thể ---\n")--- Các mốc DTIRatio (Tỷ lệ Nợ/Thu nhập) cụ thể --- 0% 25% 50% 75% 100%
0.1 0.3 0.5 0.7 0.9 # Định nghĩa tên (nhãn) cho các nhóm này
dti_labels <- c("Thấp (<30%)", "Trung bình (30-50%)", "Cao (50-70%)", "Rất cao (>70%)")
# Áp dụng các mốc này để tạo cột nhóm mới
df_processed <- df_processed %>%
mutate(
DTIRatioGroup = cut(DTIRatio,
breaks = breaks_dti,
labels = dti_labels,
include.lowest = TRUE) # Bao gồm cả giá trị thấp nhất
)
cat("\nĐã tạo cột 'DTIRatioGroup'.\n")
Đã tạo cột 'DTIRatioGroup'.Số lượng người trong mỗi nhóm (gần như bằng nhau):
Thấp (<30%) Trung bình (30-50%) Cao (50-70%) Rất cao (>70%)
65248 63970 63781 62348 Mã hoa tập hợp các biến “MaritalStatus”, “EmploymentType”, “LoanPurpose”, “AgeGroup”
library(fastDummies)
cols_to_one_hot <- c("MaritalStatus", "EmploymentType", "LoanPurpose", "AgeGroup")
df_processed <- dummy_cols(
df_processed,
select_columns = cols_to_one_hot,
remove_first_dummy = TRUE, # Tránh đa cộng tuyến
remove_selected_columns = TRUE # Xóa các cột gốc
)
cat("Đã thực hiện One-Hot Encoding.\n")Đã thực hiện One-Hot Encoding. [1] "Age" "Income"
[3] "LoanAmount" "CreditScore"
[5] "MonthsEmployed" "NumCreditLines"
[7] "InterestRate" "LoanTerm"
[9] "DTIRatio" "Education"
[11] "HasMortgage" "HasDependents"
[13] "HasCoSigner" "Default"
[15] "HasMortgage_Num" "HasDependents_Num"
[17] "HasCoSigner_Num" "Education_Ordinal"
[19] "LoanAmountGroup" "LoanToIncomeRatio"
[21] "IncomeGroup" "CreditScoreGroup"
[23] "MonthsEmployedGroup" "InterestRateGroup"
[25] "DTIRatioGroup" "MaritalStatus_Married"
[27] "MaritalStatus_Single" "EmploymentType_Part-time"
[29] "EmploymentType_Self-employed" "EmploymentType_Unemployed"
[31] "LoanPurpose_Business" "LoanPurpose_Education"
[33] "LoanPurpose_Home" "LoanPurpose_Other"
[35] "AgeGroup_26-40" "AgeGroup_41-60"
[37] "AgeGroup_60+" Làm Gọn lại bộ dữ liệu
--- Mã hóa One-Hot (Tổng hợp) cho TẤT CẢ các cột phân loại ---# Tạo một danh sách 'master' chứa TẤT CẢ các cột cần mã hóa
# 10 cột tất cả
cols_to_one_hot_master <- c(
# 3 cột chữ gốc
"MaritalStatus", "EmploymentType", "LoanPurpose",
# 2 cột số (nhưng là phân loại)
"LoanTerm", "NumCreditLines",
# 5 cột 'Group' MỚI chúng ta đã tạo (thay vì 6, vì T12 thay T12_biz)
"AgeGroup",
"IncomeGroup",
"CreditScoreGroup",
"MonthsEmployedGroup",
"InterestRateGroup",
"DTIRatioGroup",
"LoanAmountGroup"
)
# Chạy hàm dummy_cols
df_processed <- dummy_cols(
df_processed,
select_columns = cols_to_one_hot_master,
remove_first_dummy = TRUE, # Tránh đa cộng tuyến
remove_selected_columns = TRUE # Tự động xóa 10 cột gốc này
)
cat("Đã thực hiện One-Hot Encoding cho 10 cột phân loại.\n")Đã thực hiện One-Hot Encoding cho 10 cột phân loại.--- Dọn dẹp (Làm gọn) Bộ dữ liệu ---# Lệnh 'select' này sẽ xóa TẤT CẢ các cột gốc còn lại
# mà chúng ta đã thay thế
df_processed <- df_processed %>%
select(
-c(
# Xóa 3 cột 'Yes'/'No' (vì đã có ..._Num)
HasMortgage, HasDependents, HasCoSigner,
# Xóa cột 'Education' (vì đã có Education_Ordinal)
Education,
# Xóa 6 cột số gốc (vì đã có ...Group, và ...Group đã bị One-Hot)
Age, Income, CreditScore, MonthsEmployed, InterestRate, DTIRatio,LoanAmount
)
)
cat("--- HOÀN TẤT: BỘ DỮ LIỆU ĐÃ SẴN SÀNG CHO MÔ HÌNH ---\n")--- HOÀN TẤT: BỘ DỮ LIỆU ĐÃ SẴN SÀNG CHO MÔ HÌNH ---Cấu trúc dữ liệu cuối cùng (Tất cả đều là số):'data.frame': 255347 obs. of 43 variables:
$ Default : int 0 0 1 0 0 1 0 0 1 0 ...
$ HasMortgage_Num : num 1 0 1 0 0 1 1 0 1 1 ...
$ HasDependents_Num : num 1 0 1 0 1 0 0 0 0 0 ...
$ HasCoSigner_Num : num 1 1 0 0 0 1 1 1 0 1 ...
$ Education_Ordinal : num 1 2 2 0 1 0 1 3 1 0 ...
$ LoanToIncomeRatio : num 0.588 2.467 1.534 1.413 0.447 ...
$ MaritalStatus_Married : int 0 1 0 1 0 0 0 1 0 1 ...
$ MaritalStatus_Single : int 0 0 0 0 0 1 1 0 0 0 ...
$ EmploymentType_Part-time : int 0 0 0 0 0 0 0 0 0 0 ...
$ EmploymentType_Self-employed : int 0 0 0 0 0 0 0 0 1 1 ...
$ EmploymentType_Unemployed : int 0 0 1 0 1 1 1 0 0 0 ...
$ LoanPurpose_Business : int 0 0 0 1 0 1 0 0 0 0 ...
$ LoanPurpose_Education : int 0 0 0 0 0 0 0 0 1 0 ...
$ LoanPurpose_Home : int 0 0 0 0 0 0 1 1 0 0 ...
$ LoanPurpose_Other : int 1 1 0 0 0 0 0 0 0 1 ...
$ AgeGroup_26-40 : int 0 0 0 1 0 0 1 0 1 1 ...
$ AgeGroup_41-60 : int 1 0 1 0 1 0 0 1 0 0 ...
$ AgeGroup_60+ : int 0 1 0 0 0 0 0 0 0 0 ...
$ LoanTerm_24 : int 0 0 1 1 0 1 0 0 0 0 ...
$ LoanTerm_36 : int 1 0 0 0 0 0 0 0 0 0 ...
$ LoanTerm_48 : int 0 0 0 0 1 0 0 0 1 1 ...
$ LoanTerm_60 : int 0 1 0 0 0 0 0 1 0 0 ...
$ NumCreditLines_2 : int 0 0 0 0 0 1 0 0 0 0 ...
$ NumCreditLines_3 : int 0 0 1 1 0 0 0 0 0 0 ...
$ NumCreditLines_4 : int 1 0 0 0 1 0 0 1 0 1 ...
$ IncomeGroup_Trung bình : int 0 1 0 0 0 0 0 0 0 0 ...
$ IncomeGroup_Cao : int 1 0 1 0 0 1 1 0 0 0 ...
$ IncomeGroup_Rất cao : int 0 0 0 0 0 0 0 1 0 1 ...
$ CreditScoreGroup_Trung bình : int 1 1 1 0 0 0 0 1 0 1 ...
$ CreditScoreGroup_Cao : int 0 0 0 0 1 0 0 0 0 0 ...
$ CreditScoreGroup_Rất cao : int 0 0 0 1 0 1 0 0 1 0 ...
$ MonthsEmployedGroup_1-12 tháng : int 0 0 0 0 1 0 0 0 0 0 ...
$ MonthsEmployedGroup_1-5 năm : int 0 1 1 0 0 1 0 0 0 0 ...
$ MonthsEmployedGroup_Trên 5 năm : int 1 0 0 0 0 0 1 1 1 1 ...
$ InterestRateGroup_Trung bình (8-15%): int 0 0 0 0 0 0 0 1 0 1 ...
$ InterestRateGroup_Cao (15-20%) : int 1 0 0 0 0 0 1 0 0 0 ...
$ InterestRateGroup_Rất cao (>20%) : int 0 0 1 0 0 1 0 0 1 0 ...
$ DTIRatioGroup_Trung bình (30-50%) : int 1 0 1 0 0 0 0 1 0 1 ...
$ DTIRatioGroup_Cao (50-70%) : int 0 1 0 0 0 0 0 0 0 0 ...
$ DTIRatioGroup_Rất cao (>70%) : int 0 0 0 0 1 0 0 0 0 0 ...
$ LoanAmountGroup_Nhỏ : int 0 1 0 0 0 1 0 0 1 0 ...
$ LoanAmountGroup_Vừa : int 0 0 1 0 0 0 1 1 0 0 ...
$ LoanAmountGroup_Lớn : int 0 0 0 0 0 0 0 0 0 1 ...Thống kê,Phân tích bộ dữ liệu
Tải lại file dữ liệu GỐC vào biến ‘df’+khai báo một số thư viện
# === CÁC BIẾN LOGIC ===
breaks_credit_score <- quantile(df$CreditScore, probs = c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE)
labels_credit_score <- c("Thấp (Q1)", "Trung bình (Q2)", "Cao (Q3)", "Rất cao (Q4)")
labels_credit_score_short <- c("Thấp", "TB", "Cao", "Rất cao")
interest_breaks <- c(-Inf, 8, 15, 20, Inf)
interest_labels <- c("Thấp (<8%)", "Trung bình (8-15%)", "Cao (15-20%)", "Rất cao (>20%)")
business_breaks <- c(-Inf, 0, 12, 60, Inf)
business_labels <- c("0 tháng", "1-12 tháng", "1-5 năm", "Trên 5 năm")
breaks_dti <- quantile(df$DTIRatio, probs = c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE)
dti_labels <- c("Thấp (<30%)", "Trung bình (30-50%)", "Cao (50-70%)", "Rất cao (>70%)")
breaks_loanamount <- quantile(df$LoanAmount, probs = c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE)
loanamount_labels <- c("Rất nhỏ (Q1)", "Nhỏ (Q2)", "Vừa (Q3)", "Lớn (Q4)")
breaks_age <- c(17, 25, 40, 60, Inf)
labels_age <- c("18-25", "26-40", "41-60", "60+")
df <- df %>% mutate(DefaultStatus = as.factor(ifelse(Default == 1, "Vỡ nợ", "Không Vỡ nợ")))
format_large_number <- function(x) { format(x, big.mark = ",", scientific = FALSE) }# tạo hàm phân cách số hàng nghìn và bỏ các số lớnTỷ lệ vỡ nợ
--- Tỷ lệ Vỡ nợ Tổng thể ---# Dùng dplyr (%>%) để tính toán tóm tắt
default_summary <- df %>%
summarise(
TotalCount = n(), # Đếm tổng số dòng (tổng số khoản vay)
DefaultCount = sum(Default), # Đếm tổng số khoản vay bị vỡ nợ (Default=1)
# Dùng chính 2 biến vừa tạo ở trên để tính tỷ lệ:
DefaultRate = DefaultCount / TotalCount
)
# In kết quả ra dạng bảng đẹp
knitr::kable(default_summary, digits = 4)| TotalCount | DefaultCount | DefaultRate |
|---|---|---|
| 255347 | 29653 | 0.1161 |
# In ra một câu kết luận dùng hàm percent()
cat(paste0("\nTỷ lệ vỡ nợ tổng thể là: ", percent(default_summary$DefaultRate, accuracy = 0.01)))
Tỷ lệ vỡ nợ tổng thể là: 11.61%TRực quan hoá Tỷ lệ vỡ nợ(Biểu đồ Tròn)
--- Trực quan hóa Tỷ lệ Vỡ nợ (Vẽ từ Thao tác 1) ---# ===================================================================
#Chuẩn bị dữ liệu 'df_plot' TỪ 'default_summary'
# ===================================================================
df_plot_from_t1 <- default_summary %>%
# Tính toán tỷ lệ "Không Vỡ nợ"
mutate(NonDefaultRate = 1 - DefaultRate) %>%
# Chỉ chọn 2 cột tỷ lệ
select(DefaultRate, NonDefaultRate) %>%
# Chuyển đổi từ 1 hàng (ngang) thành 2 hàng (dọc)
pivot_longer(
cols = everything(), # Lấy tất cả các cột
names_to = "StatusName", # Tên cột mới là "StatusName"
values_to = "Percentage" # Giá trị cột mới là "Percentage"
) %>%
# Đặt lại tên cho đẹp
mutate(
DefaultStatus = ifelse(StatusName == "DefaultRate", "Vỡ nợ (1)", "Không Vỡ nợ (0)"),
) %>%
# Sắp xếp lại để "Không Vỡ nợ" (phần lớn hơn) ở trên cùng
arrange(desc(DefaultStatus)) %>%
# Tính vị trí đặt nhãn % (ypos)
mutate(ypos = cumsum(Percentage) - 0.5 * Percentage)
# ===================================================================
# Vẽ biểu đồ Donut
# ===================================================================
ggplot(df_plot_from_t1, aes(x = 2, y = Percentage, fill = DefaultStatus)) +
# Cột (với viền trắng mỏng)
geom_col(width = 1, color="white", linewidth = 0.25) +
# Nhãn %
geom_text(aes(y = ypos, label = percent(Percentage, accuracy = 0.1)),
color = "white", size = 5, fontface = "bold") +
# Biến thành hình tròn
coord_polar(theta = "y", start = 0) +
# Màu sắc
scale_fill_manual(values = c("Không Vỡ nợ (0)" = "#0077b6", "Vỡ nợ (1)" = "#e76f51")) +
# Tiêu đề và nhãn
labs(title = "Tỷ lệ Phân phối Vỡ nợ",
fill = "Tình trạng:",
caption = "Biểu đồ dựa trên kết quả tóm tắt tỷ lệ vỡ nợ") +
# Xóa nền (Theme)
theme_void(base_size = 14) +
# Tạo lỗ hổng (Donut)
xlim(0.5, 2.5) +
# Cải thiện Chú thích (Legend)
theme(legend.position = "right",
plot.title = element_text(hjust = 0.5, face = "bold")) # Căn giữa tiêu đề
Thống kê Ảnh hưởng của CreditScore lên Vỡ nợ
---Định lượng Ảnh hưởng của CreditScore lên Vỡ nợ ---# Tính DefaultRate cho từng nhóm
risk_by_credit_calc <- df %>%
mutate(
CreditScoreGroup = cut(CreditScore,
breaks = breaks_credit_score,
labels = labels_credit_score, # Giữ nguyên Thấp -> Rất cao
include.lowest = TRUE,
ordered_result = TRUE) # Quan trọng: Giữ thứ tự Factor
) %>%
filter(!is.na(CreditScoreGroup)) %>%
group_by(CreditScoreGroup) %>%
summarise(TotalCount = n(), DefaultRate = mean(Default), .groups = 'drop') # Bỏ group sau khi tính
# Sắp xếp THEO THỨ TỰ NHÓM (Thấp -> Rất cao) rồi mới tính % thay đổi
risk_by_credit_final <- risk_by_credit_calc %>%
# Sắp xếp theo đúng thứ tự logic của nhóm điểm
arrange(CreditScoreGroup) %>%
# Bây giờ mới tính lag và PctChange
mutate(
PrevRate = lag(DefaultRate),
PctChange = (DefaultRate - PrevRate) / PrevRate
)
cat("Bảng Tỷ lệ Vỡ nợ và Mức giảm Rủi ro tương đối:\n")Bảng Tỷ lệ Vỡ nợ và Mức giảm Rủi ro tương đối:# Bỏ cột PrevRate khi hiển thị
knitr::kable(risk_by_credit_final %>% select(-PrevRate), digits = 4,
col.names = c("Nhóm Điểm", "Số lượng", "Tỷ lệ Vỡ nợ", "% Thay đổi Rủi ro"))| Nhóm Điểm | Số lượng | Tỷ lệ Vỡ nợ | % Thay đổi Rủi ro |
|---|---|---|---|
| Thấp (Q1) | 64140 | 0.1306 | NA |
| Trung bình (Q2) | 63803 | 0.1189 | -0.0890 |
| Cao (Q3) | 63896 | 0.1129 | -0.0508 |
| Rất cao (Q4) | 63508 | 0.1020 | -0.0968 |
# : Diễn giải kết quả - Tham chiếu đúng index
# PctChange[4] là % thay đổi của nhóm "Rất cao" (dòng 4) so với nhóm "Cao" (dòng 3)
cat(paste0("\nKết luận Thống kê: Rủi ro giảm khi điểm tín dụng tăng. Chuyển từ 'Cao' sang 'Rất cao' giảm rủi ro tới ",
# Sử dụng index [4] vì đã sắp xếp tăng dần
percent(abs(risk_by_credit_final$PctChange[4]), accuracy=0.1), "."))
Kết luận Thống kê: Rủi ro giảm khi điểm tín dụng tăng. Chuyển từ 'Cao' sang 'Rất cao' giảm rủi ro tới 9.7%.Trực quan hoá
--- Trực quan hóa Xu hướng Giảm Rủi ro theo CreditScore ) ---#Dữ liệu 'risk_by_credit_final' đã được tính toán ở trên
# Vẽ biểu đồ ggplot
ggplot(risk_by_credit_final,
# Sử dụng biến đã sửa: risk_by_credit_final
aes(x = CreditScoreGroup, y = DefaultRate, fill = CreditScoreGroup)) +
# Khởi tạo ggplot và vẽ các cột (geom_col)
geom_col(alpha = 0.8, show.legend = FALSE) +
# Định dạng trục Y thành tỷ lệ phần trăm
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
# Thêm Tiêu đề và Nhãn trục X, Y
labs(
title = "Rủi ro Vỡ nợ Giảm Rõ Rệt khi Điểm Tín dụng Tăng",
x = "Nhóm Điểm Tín dụng (Tứ phân vị)",
y = "Tỷ lệ Vỡ nợ (Default Rate)"
) +
# Thêm thang màu và Theme
# Thang màu RdYlGn (Đỏ-Vàng-Xanh) với direction = -1 để Xanh là an toàn (Điểm cao)
scale_fill_brewer(palette = "RdYlGn", direction = -1) +
theme_minimal(base_size = 14)
#### TRực quan hoá(2)
--- Phân tích Phân phối CreditScore theo Tình trạng Vỡ nợ ---# Dữ liệu 'df' đã có cột 'DefaultStatus')
# Vẽ biểu đồ ggplot với tố
ggplot(df,
# aes(): ánh xạ CreditScore vào trục X, màu tô (fill) vào DefaultStatus
aes(x = CreditScore, fill = DefaultStatus)) +
# Khởi tạo ggplot + Vẽ 2 đường cong mật độ chồng lớp
# alpha = 0.5: Độ trong suốt 50% để nhìn thấy phần giao nhau
geom_density(alpha = 0.5) +
# Định nghĩa màu tô cho từng nhóm DefaultStatus
scale_fill_manual(values = c("Không Vỡ nợ" = "#0077b6", "Vỡ nợ" = "#e76f51")) +
# Thêm Tiêu đề, Phụ đề, và Nhãn trục/chú thích
labs(
title = "Phân phối Điểm Tín dụng Khác biệt Rõ rệt giữa hai Nhóm",
subtitle = "Nhóm Vỡ nợ tập trung ở vùng điểm thấp hơn đáng kể",
x = "Điểm Tín dụng (CreditScore)",
y = "Mật độ (Density)",
fill = "Tình trạng Vỡ nợ:" # Đặt tên cho chú thích màu (legend)
) +
# Sử dụng Theme sạch sẽ và đặt chú thích ở dưới
theme_minimal(base_size = 14) +
theme(legend.position = "bottom")
Phân tích tác động của InterestRate đến Default
--- 5. Thống kê Mô tả cho InterestRate ---# Bắt đầu chuỗi lệnh dplyr trên data frame 'df' (dữ liệu gốc)
interest_summary <- df %>%
# Sử dụng hàm summarise để tính toán các chỉ số thống kê tóm tắt
summarise(
# Tính giá trị nhỏ nhất của cột InterestRate và đặt tên là "Giá trị Nhỏ nhất (Min)"
"Giá trị Nhỏ nhất (Min)" = min(InterestRate),
# Tính giá trị trung vị (50th percentile) và đặt tên là "Trung vị (Median - Q2)"
"Trung vị (Median - Q2)" = median(InterestRate),
# Tính giá trị trung bình cộng và đặt tên là "Trung bình (Mean)"
"Trung bình (Mean)" = mean(InterestRate),
# Tính giá trị lớn nhất và đặt tên là "Giá trị Lớn nhất (Max)"
"Giá trị Lớn nhất (Max)" = max(InterestRate),
# Tính độ lệch chuẩn (standard deviation) và đặt tên là "Độ lệch Chuẩn (SD)"
"Độ lệch Chuẩn (SD)" = sd(InterestRate)
)
# In kết quả tóm tắt ra dạng bảng đẹp bằng hàm kable từ thư viện knitr
# digits = 2: Làm tròn các giá trị số trong bảng đến 2 chữ số thập phân
cat("Bảng Thống kê Mô tả Lãi suất:\n")Bảng Thống kê Mô tả Lãi suất:| Giá trị Nhỏ nhất (Min) | Trung vị (Median - Q2) | Trung bình (Mean) | Giá trị Lớn nhất (Max) | Độ lệch Chuẩn (SD) |
|---|---|---|---|---|
| 2 | 13.46 | 13.49 | 25 | 6.64 |
# In ra câu kết luận, diễn giải các kết quả thống kê chính
cat("\nKết luận Thống kê: Lãi suất dao động từ 2% đến 25%. Giá trị trung bình và trung vị cũng rất gần nhau (khoảng 13.5%), cho thấy phân phối khá đối xứng, tương tự như CreditScore.")
Kết luận Thống kê: Lãi suất dao động từ 2% đến 25%. Giá trị trung bình và trung vị cũng rất gần nhau (khoảng 13.5%), cho thấy phân phối khá đối xứng, tương tự như CreditScore.
---Phân tích Ảnh hưởng của InterestRate lên Vỡ nợ ---# Tính toán tỷ lệ vỡ nợ theo nhóm lãi suất
risk_by_interest <- df %>%
# Tạo cột InterestRateGroup dựa trên các mốc nghiệp vụ đã định nghĩa
mutate(
InterestRateGroup = cut(InterestRate,
breaks = interest_breaks, # Biến định nghĩa ở chunk setup
labels = interest_labels, # Biến định nghĩa ở chunk setup
include.lowest = TRUE, # Bao gồm cả giá trị thấp nhất
right = TRUE) # Khoảng (a, b]
) %>%
# Lọc bỏ NA nếu có
filter(!is.na(InterestRateGroup)) %>%
# Nhóm theo 4 nhóm lãi suất vừa tạo
group_by(InterestRateGroup) %>%
# Tính TotalCount và DefaultRate cho từng nhóm
summarise(TotalCount = n(), DefaultRate = mean(Default)) %>%
# Sắp xếp theo thứ tự lãi suất tăng dần (logic)
arrange(factor(InterestRateGroup, levels = interest_labels))
cat("Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Nhóm Lãi suất:\n")Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Nhóm Lãi suất:| InterestRateGroup | TotalCount | DefaultRate |
|---|---|---|
| Thấp (<8%) | 66489 | 0.0661 |
| Trung bình (8-15%) | 78396 | 0.0993 |
| Cao (15-20%) | 54978 | 0.1379 |
| Rất cao (>20%) | 55484 | 0.1782 |
# Diễn giải KẾT QUẢ thống kê
diff_interest = risk_by_interest$DefaultRate[4] - risk_by_interest$DefaultRate[1]
cat(paste0("\nKết luận Thống kê: Có mối quan hệ đồng biến mạnh mẽ. Rủi ro vỡ nợ của nhóm 'Rất cao' (>20%) (",
percent(risk_by_interest$DefaultRate[4], accuracy=0.1),
") cao hơn rất nhiều so với nhóm 'Thấp' (<8%) (",
percent(risk_by_interest$DefaultRate[1], accuracy=0.1),
"), chênh lệch tới ", percent(diff_interest, accuracy=0.1), ". Lãi suất là một chỉ báo rủi ro quan trọng."))
Kết luận Thống kê: Có mối quan hệ đồng biến mạnh mẽ. Rủi ro vỡ nợ của nhóm 'Rất cao' (>20%) (17.8%) cao hơn rất nhiều so với nhóm 'Thấp' (<8%) (6.6%), chênh lệch tới 11.2%. Lãi suất là một chỉ báo rủi ro quan trọng.Trực quan hoá
# In tiêu đề cho thao tác
cat("--- Phân tích Phân phối InterestRate theo Tình trạng Vỡ nợ (Box Plot) ---\n")--- Phân tích Phân phối InterestRate theo Tình trạng Vỡ nợ (Box Plot) ---# Dữ liệu 'df' đã có cột 'DefaultStatus' (tạo ở chunk setup)
# Vẽ biểu đồ ggplot với tối đa 5 layers
ggplot(df,
# aes(): ánh xạ DefaultStatus vào trục X, InterestRate vào trục Y, màu tô (fill) vào DefaultStatus
aes(x = DefaultStatus, y = InterestRate, fill = DefaultStatus)) +
# Khởi tạo ggplot + Vẽ Box Plot
# alpha = 0.7: Độ trong suốt
# show.legend = FALSE: Ẩn chú thích màu vì đã rõ trên trục X
geom_boxplot(alpha = 0.7, show.legend = FALSE) +
# Định nghĩa màu tô cho từng nhóm DefaultStatus
scale_fill_manual(values = c("Không Vỡ nợ" = "#0077b6", "Vỡ nợ" = "#e76f51")) +
# Thêm Tiêu đề và Nhãn trục X, Y
labs(
title = "Phân phối Lãi suất Khác biệt giữa hai Nhóm Vỡ nợ",
subtitle = "Nhóm Vỡ nợ có xu hướng lãi suất cao hơn đáng kể (thể hiện qua trung vị và IQR)",
x = "Tình trạng Vỡ nợ",
y = "Lãi suất (%)"
) +
# Sử dụng Theme sạch sẽ
theme_minimal(base_size = 14)
Biểu đồ Rủi ro (InterestRate):ggplot(risk_by_interest, aes(x = InterestRateGroup, y = DefaultRate, fill = InterestRateGroup)) +
# Khởi tạo ggplot và vẽ các cột
geom_col(alpha = 0.8, show.legend = FALSE) +
# Định dạng trục Y thành %
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
# Thêm Tiêu đề và Nhãn trục
labs(title = "Rủi ro Vỡ nợ Tăng Rõ Rệt khi Lãi suất Tăng",
x = "Nhóm Lãi suất (Ngưỡng Nghiệp vụ)",
y = "Tỷ lệ Vỡ nợ") +
# Sử dụng Theme sạch sẽ
theme_minimal(base_size = 14)
### Thống kê Ảnh hưởng của MonthsEmployed
# In tiêu đề cho thao tác
cat("--- Phân tích Ảnh hưởng của Thâm niên (Tập trung nhóm 0 tháng) ---\n")--- Phân tích Ảnh hưởng của Thâm niên (Tập trung nhóm 0 tháng) ---# Bắt đầu chuỗi lệnh dplyr trên data frame 'df'
risk_by_months <- df %>%
# Tạo cột 'MonthsEmployedGroup' dựa trên logic
mutate(
# Sử dụng hàm cut() để chia nhóm
MonthsEmployedGroup = cut(MonthsEmployed,
# Dùng các mốc đã định nghĩa: -Inf, 0, 12, 60, Inf
breaks = business_breaks,
# Gán các nhãn đã định nghĩa: "0 tháng", "1-12 tháng", ...
labels = business_labels,
# Bao gồm giá trị 0 vào nhóm đầu tiên [-Inf, 0]
include.lowest = TRUE,
# Đảm bảo kết quả là factor có thứ tự
ordered_result = TRUE)
) %>%
# Lọc bỏ các hàng có thể có giá trị NA (dù không nên xảy ra)
filter(!is.na(MonthsEmployedGroup)) %>%
# Nhóm dữ liệu theo cột MonthsEmployedGroup vừa tạo
group_by(MonthsEmployedGroup) %>%
# Tính toán tóm tắt cho mỗi nhóm
summarise(
# Đếm số lượng quan sát trong mỗi nhóm
TotalCount = n(),
# Tính tỷ lệ vỡ nợ (trung bình của cột Default 0/1) cho mỗi nhóm
DefaultRate = mean(Default),
# .groups='drop' để bỏ nhóm sau khi summarise, tránh cảnh báo
.groups = 'drop'
)
# In kết quả bảng thống kê
cat("Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Nhóm Thâm niên:\n")Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Nhóm Thâm niên:| MonthsEmployedGroup | TotalCount | DefaultRate |
|---|---|---|
| 0 tháng | 2122 | 0.1814 |
| 1-12 tháng | 25546 | 0.1680 |
| 1-5 năm | 102097 | 0.1350 |
| Trên 5 năm | 125582 | 0.0892 |
# Lấy tỷ lệ vỡ nợ trung bình đã tính
avg_rate = default_summary$DefaultRate
# Lấy tỷ lệ vỡ nợ của nhóm "0 tháng" (là dòng đầu tiên trong bảng risk_by_months)
rate_0_month = risk_by_months$DefaultRate[1]
# In ra câu kết luận, diễn giải và so sánh kết quả
cat(paste0("\nKết luận Thống kê: Nhóm '0 tháng' có tỷ lệ vỡ nợ ",
# Format tỷ lệ của nhóm 0 tháng thành %
percent(rate_0_month, accuracy=0.1),
# So sánh với tỷ lệ trung bình
", cao hơn đáng kể so với mức trung bình chung (", percent(avg_rate, accuracy=0.1), ") và các nhóm có thâm niên khác. Điều này cho thấy rủi ro rất cao khi cho vay những người mới bắt đầu công việc hoặc chưa có việc làm."))
Kết luận Thống kê: Nhóm '0 tháng' có tỷ lệ vỡ nợ 18.1%, cao hơn đáng kể so với mức trung bình chung (11.6%) và các nhóm có thâm niên khác. Điều này cho thấy rủi ro rất cao khi cho vay những người mới bắt đầu công việc hoặc chưa có việc làm.Trực quan hoá
--- Trực quan hóa Ảnh hưởng của Thâm niên ) ---# Dữ liệu 'risk_by_months' đã được tính toán ở trên
# Vẽ biểu đồ ggplot với tối đa 5 layers
ggplot(risk_by_months, aes(x = MonthsEmployedGroup, y = DefaultRate, fill = MonthsEmployedGroup)) +
# Khởi tạo ggplot và vẽ các cột
# alpha = 0.8: Độ trong suốt
# show.legend = FALSE: Ẩn chú thích màu
geom_col(alpha = 0.8, show.legend = FALSE) +
# Định dạng trục Y thành tỷ lệ phần trăm
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
# Thêm Tiêu đề và Nhãn trục X, Y
labs(
title = "Rủi ro Vỡ nợ Cao ở Nhóm '0 tháng'",
x = "Nhóm Thâm niên (Ngưỡng Nghiệp vụ)",
y = "Tỷ lệ Vỡ nợ"
) +
# Sử dụng Theme (giao diện) sạch sẽ
theme_minimal(base_size = 14)
Thống kê Ảnh hưởng của DTIRatio lên Vỡ nợ
--- Thống kê Ảnh hưởng của DTIRatio lên Vỡ nợ ---# Tính toán tỷ lệ vỡ nợ theo nhóm DTIRatio)
risk_by_dti <- df %>%
# Tạo cột DTIRatioGroup dựa trên các mốc tứ phân vị
mutate(
DTIRatioGroup = cut(DTIRatio,
# Dùng các mốc đã định nghĩa: quantile(0, 0.25, 0.5, 0.75, 1)
breaks = breaks_dti,
# Gán các nhãn đã định nghĩa: "Thấp (<30%)", ...
labels = dti_labels,
# Bao gồm giá trị nhỏ nhất
include.lowest = TRUE,
# Đảm bảo kết quả là factor có thứ tự
ordered_result = TRUE)
) %>%
# Lọc bỏ NA nếu có
filter(!is.na(DTIRatioGroup)) %>%
# Nhóm theo 4 nhóm DTI vừa tạo
group_by(DTIRatioGroup) %>%
# Tính TotalCount và DefaultRate cho từng nhóm
summarise(TotalCount = n(), DefaultRate = mean(Default), .groups = 'drop') %>%
# Sắp xếp theo thứ tự DTI tăng dần
arrange(DTIRatioGroup)
# In kết quả bảng thống kê
cat("Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Nhóm DTIRatio:\n")Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Nhóm DTIRatio:| DTIRatioGroup | TotalCount | DefaultRate |
|---|---|---|
| Thấp (<30%) | 65248 | 0.1066 |
| Trung bình (30-50%) | 63970 | 0.1154 |
| Cao (50-70%) | 63781 | 0.1199 |
| Rất cao (>70%) | 62348 | 0.1231 |
# Lấy tỷ lệ của nhóm thấp nhất và cao nhất để diễn giải
rate_dti_low = risk_by_dti$DefaultRate[1]
rate_dti_high = risk_by_dti$DefaultRate[4]
diff_dti = rate_dti_high - rate_dti_low
# In ra câu kết luận, diễn giải và so sánh kết quả
cat(paste0("\nKết luận Thống kê: Có mối quan hệ đồng biến rõ ràng giữa DTIRatio và rủi ro vỡ nợ. Nhóm có DTIRatio 'Rất cao' (>70%) có tỷ lệ vỡ nợ là ",
percent(rate_dti_high, accuracy=0.1),
", cao hơn so với nhóm 'Thấp' (<30%) (",
percent(rate_dti_low, accuracy=0.1),
"), chênh lệch ", percent(diff_dti, accuracy=0.1), ". Điều này cho thấy gánh nặng nợ hàng tháng càng cao thì khả năng vỡ nợ càng tăng."))
Kết luận Thống kê: Có mối quan hệ đồng biến rõ ràng giữa DTIRatio và rủi ro vỡ nợ. Nhóm có DTIRatio 'Rất cao' (>70%) có tỷ lệ vỡ nợ là 12.3%, cao hơn so với nhóm 'Thấp' (<30%) (10.7%), chênh lệch 1.6%. Điều này cho thấy gánh nặng nợ hàng tháng càng cao thì khả năng vỡ nợ càng tăng.Trực quan hoá
Biểu đồ Xu hướng Rủi ro (DTIRatio):ggplot(risk_by_dti,
# aes(): Map nhóm vào trục X, tỷ lệ vào trục Y. group=1 để nối các điểm
aes(x = DTIRatioGroup, y = DefaultRate, group = 1)) +
# Khởi tạo ggplot + Vẽ đường nối các điểm
# linewidth = 1.5: Làm đường dày hơn
# color = "#e76f51": Màu cam/đỏ cho đường
geom_line(linewidth = 1.5, color = "#e76f51") +
# Vẽ thêm các điểm trên đường cho rõ
# size = 4: Làm điểm to hơn
geom_point(size = 4, color = "#e76f51") +
# Định dạng trục Y thành %
scale_y_continuous(labels = scales::percent_format(accuracy = 1), limits = c(0, max(risk_by_dti$DefaultRate)*1.1)) +
#Thêm Tiêu đề và Nhãn trục + Theme
labs(
title = "Xu hướng Rủi ro Vỡ nợ Tăng theo DTIRatio",
x = "Nhóm Tỷ lệ Nợ/Thu nhập (Tứ phân vị)",
y = "Tỷ lệ Vỡ nợ"
) +
theme_minimal(base_size = 14)
Thống kê Ảnh hưởng của Số tiền vay (LoanAmount) lên Vỡ nợ
# In tiêu đề cho thao tác
cat("--- Thống kê Ảnh hưởng của Số tiền vay (LoanAmount) lên Vỡ nợ ---\n")--- Thống kê Ảnh hưởng của Số tiền vay (LoanAmount) lên Vỡ nợ ---# Tính toán tỷ lệ vỡ nợ theo nhóm LoanAmount
risk_by_loanamount <- df %>%
# Tạo cột LoanAmountGroup dựa trên các mốc tứ phân vị
mutate(
LoanAmountGroup = cut(LoanAmount,
# Dùng các mốc đã định nghĩa: quantile(0, 0.25, 0.5, 0.75, 1)
breaks = breaks_loanamount,
# Gán các nhãn đã định nghĩa: "Rất nhỏ (Q1)", ...
labels = loanamount_labels,
# Bao gồm giá trị nhỏ nhất
include.lowest = TRUE,
# Đảm bảo kết quả là factor có thứ tự
ordered_result = TRUE)
) %>%
# Lọc bỏ NA nếu có
filter(!is.na(LoanAmountGroup)) %>%
# Nhóm theo 4 nhóm LoanAmount vừa tạo
group_by(LoanAmountGroup) %>%
# Tính TotalCount và DefaultRate cho từng nhóm
summarise(TotalCount = n(), DefaultRate = mean(Default), .groups = 'drop') %>%
# Sắp xếp theo thứ tự LoanAmount tăng dần
arrange(LoanAmountGroup)
# In kết quả bảng thống kê
cat("Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Nhóm Số tiền vay:\n")Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Nhóm Số tiền vay:| LoanAmountGroup | TotalCount | DefaultRate |
|---|---|---|
| Rất nhỏ (Q1) | 63838 | 0.0825 |
| Nhỏ (Q2) | 63836 | 0.1025 |
| Vừa (Q3) | 63836 | 0.1235 |
| Lớn (Q4) | 63837 | 0.1560 |
# Lấy tỷ lệ nhỏ nhất và lớn nhất để diễn giải
min_rate_la = min(risk_by_loanamount$DefaultRate)
max_rate_la = max(risk_by_loanamount$DefaultRate)
# Tính độ chênh lệch
diff_la = max_rate_la - min_rate_la
cat(paste0("\nKết luận Thống kê: Ảnh hưởng của Số tiền vay lên rủi ro vỡ nợ thể hiện một **xu hướng tăng rõ rệt**. Tỷ lệ vỡ nợ tăng nhất quán qua các nhóm, dao động mạnh từ ",
percent(min_rate_la, accuracy=0.1), " (ở nhóm 'Rất nhỏ') đến ", percent(max_rate_la, accuracy=0.1), " (ở nhóm 'Lớn'). Chênh lệch đáng kể ", percent(diff_la, accuracy=0.1), " cho thấy **quy mô khoản vay là một yếu tố rủi ro quan trọng**."))
Kết luận Thống kê: Ảnh hưởng của Số tiền vay lên rủi ro vỡ nợ thể hiện một **xu hướng tăng rõ rệt**. Tỷ lệ vỡ nợ tăng nhất quán qua các nhóm, dao động mạnh từ 8.2% (ở nhóm 'Rất nhỏ') đến 15.6% (ở nhóm 'Lớn'). Chênh lệch đáng kể 7.4% cho thấy **quy mô khoản vay là một yếu tố rủi ro quan trọng**.Biểu đồ mình hoạ
# In tiêu đề cho thao tác
cat("\n--- Trực quan hóa Ảnh hưởng của Số tiền vay (Line Chart - Minh họa T15) ---\n")
--- Trực quan hóa Ảnh hưởng của Số tiền vay (Line Chart - Minh họa T15) ---# Dữ liệu 'risk_by_loanamount' đã được tính toán
# Vẽ biểu đồ đường ggplot vớis
ggplot(risk_by_loanamount,
# aes(): Map nhóm vào trục X, tỷ lệ vào trục Y. group=1 để nối các điểm
aes(x = LoanAmountGroup, y = DefaultRate, group = 1)) +
# Khởi tạo ggplot + Vẽ đường nối các điểm
# linewidth = 1.5: Làm đường dày hơn
# color = "#2a9d8f": Màu xanh lá cây
geom_line(linewidth = 1.5, color = "#2a9d8f") +
# Vẽ thêm các điểm trên đường cho rõ
# size = 4: Làm điểm to hơn
geom_point(size = 4, color = "#2a9d8f") +
# Định dạng trục Y thành % và đặt giới hạn trục Y hợp lý
scale_y_continuous(labels = scales::percent_format(accuracy = 0.1),
# Đặt giới hạn trục Y chặt hơn một chút để thấy rõ biến động nhỏ
limits = c(min(risk_by_loanamount$DefaultRate)*0.98, max(risk_by_loanamount$DefaultRate)*1.02)
) +
# Thêm Tiêu đề và Nhãn trục + Theme
labs(
title = "Xu hướng Rủi ro Vỡ nợ theo Nhóm Số tiền vay",
subtitle = "Tỷ lệ vỡ nợ khá ổn định giữa các nhóm quy mô khoản vay",
x = "Nhóm Số tiền vay (Tứ phân vị)",
y = "Tỷ lệ Vỡ nợ"
) +
theme_minimal(base_size = 14)
Thống kê Ảnh hưởng của Tỷ lệ Vay/Thu nhập lên Vỡ nợ( LoanToIncomeRatio)
--- Thống kê Ảnh hưởng của Tỷ lệ Vay/Thu nhập lên Vỡ nợ ---# Tái tạo biến LoanToIncomeRatio trên df gốc
# Tạo data frame tạm df_ratio để không thay đổi df gốc quá sớm
df_ratio <- df %>%
mutate(LoanToIncomeRatio = LoanAmount / (Income + 1)) # Thêm +1 để tránh chia cho 0
# Tính các mốc Tứ phân vị cho biến mới này
breaks_ratio <- quantile(df_ratio$LoanToIncomeRatio,
probs = c(0, 0.25, 0.5, 0.75, 1),
na.rm = TRUE)
# Định nghĩa nhãn
labels_ratio <- c("Thấp (Q1)", "TB (Q2)", "Cao (Q3)", "Rất cao (Q4)")
# Tính toán tỷ lệ vỡ nợ theo nhóm RatioGroup
# Sử dụng df_ratio đã có cột LoanToIncomeRatio
risk_by_ratio <- df_ratio %>%
# Tạo cột RatioGroup dựa trên các mốc tứ phân vị
mutate(
RatioGroup = cut(LoanToIncomeRatio,
breaks = breaks_ratio,
labels = labels_ratio,
include.lowest = TRUE,
ordered_result = TRUE)
) %>%
# Lọc bỏ NA nếu có
filter(!is.na(RatioGroup)) %>%
# Nhóm theo 4 nhóm Ratio vừa tạo
group_by(RatioGroup) %>%
# Tính TotalCount và DefaultRate cho từng nhóm
summarise(TotalCount = n(), DefaultRate = mean(Default), .groups = 'drop') %>%
# Sắp xếp theo thứ tự Ratio tăng dần
arrange(RatioGroup)
# In kết quả bảng thống kê
cat("Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Nhóm Tỷ lệ Vay/Thu nhập:\n")Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Nhóm Tỷ lệ Vay/Thu nhập:| RatioGroup | TotalCount | DefaultRate |
|---|---|---|
| Thấp (Q1) | 63837 | 0.0796 |
| TB (Q2) | 63837 | 0.0917 |
| Cao (Q3) | 63836 | 0.1063 |
| Rất cao (Q4) | 63837 | 0.1869 |
# Lấy tỷ lệ của nhóm thấp nhất và cao nhất để diễn giải
rate_ratio_low = risk_by_ratio$DefaultRate[1]
rate_ratio_high = risk_by_ratio$DefaultRate[4]
diff_ratio = rate_ratio_high - rate_ratio_low
# In ra câu kết luận, diễn giải và so sánh kết quả
cat(paste0("\nKết luận Thống kê: Có mối quan hệ đồng biến giữa Tỷ lệ Vay/Thu nhập và rủi ro vỡ nợ. Nhóm có tỷ lệ 'Rất cao' (Q4) có tỷ lệ vỡ nợ là ",
percent(rate_ratio_high, accuracy=0.1),
", cao hơn so với nhóm 'Thấp' (Q1) (",
percent(rate_ratio_low, accuracy=0.1),
"), chênh lệch ", percent(diff_ratio, accuracy=0.1), ". Gánh nặng tổng thể của khoản vay càng lớn so với thu nhập, khả năng vỡ nợ càng tăng."))
Kết luận Thống kê: Có mối quan hệ đồng biến giữa Tỷ lệ Vay/Thu nhập và rủi ro vỡ nợ. Nhóm có tỷ lệ 'Rất cao' (Q4) có tỷ lệ vỡ nợ là 18.7%, cao hơn so với nhóm 'Thấp' (Q1) (8.0%), chênh lệch 10.7%. Gánh nặng tổng thể của khoản vay càng lớn so với thu nhập, khả năng vỡ nợ càng tăng.Trực quan hoá
---Trực quan hóa Ảnh hưởng của Tỷ lệ Vay/Thu nhập) ---# Dữ liệu 'risk_by_ratio' đã được tính toán ở trên
# Vẽ biểu đồ ggplot
ggplot(risk_by_ratio,
# aes(): ánh xạ RatioGroup vào trục X, DefaultRate vào trục Y, màu tô (fill) vào RatioGroup
aes(x = RatioGroup, y = DefaultRate, fill = RatioGroup)) +
# Khởi tạo ggplot + Vẽ các cột
# alpha = 0.8: Độ trong suốt
# show.legend = FALSE: Ẩn chú thích màu
geom_col(alpha = 0.8, show.legend = FALSE) +
# Định dạng trục Y thành tỷ lệ phần trăm
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
# Thêm Tiêu đề và Nhãn trục X, Y
labs(
title = "Rủi ro Vỡ nợ Tăng khi Tỷ lệ Vay/Thu nhập Tăng",
x = "Nhóm Tỷ lệ Vay/Thu nhập (Tứ phân vị)",
y = "Tỷ lệ Vỡ nợ"
) +
# Sử dụng Theme (giao diện) sạch sẽ
theme_minimal(base_size = 14)
So sánh giữa DTIRatio và LoanToIncomeRatio
--- Phân tích Mối liên hệ giữa DTIRatio và LoanToIncomeRatio ---# Tạo lại biến LoanToIncomeRatio trên df gốc
# Tạo data frame tạm df_analysis để không thay đổi df gốc
df_analysis <- df %>%
mutate(LoanToIncomeRatio = LoanAmount / (Income + 1))
# : Chọn 2 cột cần phân tích
vars_to_correlate <- df_analysis %>%
select(DTIRatio, LoanToIncomeRatio)
# Tính toán Hệ số Tương quan Pearson
# na.rm=TRUE để xử lý nếu có giá trị NA (dù bộ dữ liệu này không có)
correlation_value <- cor(vars_to_correlate$DTIRatio, vars_to_correlate$LoanToIncomeRatio, use = "complete.obs")
# In kết quả tương quan
cat(paste0("\nHệ số tương quan Pearson giữa DTIRatio và LoanToIncomeRatio là: ",
round(correlation_value, 3), "\n"))
Hệ số tương quan Pearson giữa DTIRatio và LoanToIncomeRatio là: 0.001# Diễn giải ý nghĩa hệ số tương quan
if (abs(correlation_value) < 0.1) {
cat("=> Kết luận Thống kê: Mối tương quan tuyến tính giữa hai biến này rất yếu (gần như bằng 0).\n")
} else if (correlation_value > 0 & correlation_value < 0.3) {
cat("=> Kết luận Thống kê: Có mối tương quan tuyến tính dương yếu giữa hai biến.\n")
} else if (correlation_value < 0 & correlation_value > -0.3) {
cat("=> Kết luận Thống kê: Có mối tương quan tuyến tính âm yếu giữa hai biến.\n")
} else {
cat("=> Kết luận Thống kê: Có mối tương quan tuyến tính trung bình/mạnh giữa hai biến.\n")
}=> Kết luận Thống kê: Mối tương quan tuyến tính giữa hai biến này rất yếu (gần như bằng 0).Trực quan hoá
Biểu đồ Tán xạ (Scatter Plot) minh họa:# Lấy mẫu ngẫu nhiên 10000 dòng từ df_analysis
set.seed(123) # Đặt seed để lấy mẫu ngẫu nhiên có thể lặp lại
df_sample <- df_analysis %>% sample_n(10000)
# Vẽ biểu đồ
ggplot(df_sample, aes(x = DTIRatio, y = LoanToIncomeRatio)) +
# ggplot + Vẽ các điểm (trong suốt nhẹ)
geom_point(alpha = 0.2, color = "darkblue", size=1.5) +
# Thêm đường xu hướng tuyến tính (lm = linear model)
geom_smooth(method = "lm", color = "red", se = FALSE, linewidth=1) + # se=FALSE bỏ dải tin cậy
# Thêm Tiêu đề và Nhãn trục
labs(
title = "Mối liên hệ giữa DTIRatio và LoanToIncomeRatio",
subtitle = paste("Hệ số tương quan Pearson:", round(correlation_value, 3)),
x = "DTIRatio (Gánh nặng Nợ Hàng tháng)",
y = "LoanToIncomeRatio (Quy mô Vay Mới / Thu nhập)"
) +
# Theme
theme_minimal(base_size = 14)
Thống kê Ảnh hưởng của Kỳ hạn Vay (LoanTerm) lên Vỡ nợ
--- Thống kê Ảnh hưởng của Kỳ hạn Vay (LoanTerm) lên Vỡ nợ ---#Tính toán tỷ lệ vỡ nợ theo từng LoanTerm
risk_by_term <- df %>%
# Nhóm dữ liệu theo cột LoanTerm
group_by(LoanTerm) %>%
# Tính TotalCount và DefaultRate cho từng kỳ hạn
summarise(TotalCount = n(), DefaultRate = mean(Default), .groups = 'drop') %>%
# Sắp xếp bảng kết quả theo LoanTerm tăng dần
arrange(LoanTerm)
# In kết quả bảng thống kê
cat("Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Kỳ hạn Vay:\n")Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Kỳ hạn Vay:| LoanTerm | TotalCount | DefaultRate |
|---|---|---|
| 12 | 50957 | 0.1162 |
| 24 | 51009 | 0.1161 |
| 36 | 51061 | 0.1157 |
| 48 | 51166 | 0.1157 |
| 60 | 51154 | 0.1170 |
# Lấy tỷ lệ của kỳ hạn ngắn nhất và dài nhất để diễn giải
rate_term_short = risk_by_term$DefaultRate[1] # Tỷ lệ của 12 tháng
rate_term_long = risk_by_term$DefaultRate[nrow(risk_by_term)] # Tỷ lệ của 60 tháng
diff_term = rate_term_long - rate_term_short
# In ra câu kết luận, diễn giải xu hướng
cat(paste0("\nKết luận Thống kê: Có xu hướng rủi ro **tăng theo kỳ hạn vay**. Kỳ hạn dài nhất (60 tháng) có tỷ lệ vỡ nợ là ",
percent(rate_term_long, accuracy=0.1),
", cao hơn đáng kể so với kỳ hạn ngắn nhất (12 tháng) (",
percent(rate_term_short, accuracy=0.1),
"), chênh lệch ", percent(diff_term, accuracy=0.1), ". Điều này phù hợp với logic nghiệp vụ."))
Kết luận Thống kê: Có xu hướng rủi ro **tăng theo kỳ hạn vay**. Kỳ hạn dài nhất (60 tháng) có tỷ lệ vỡ nợ là 11.7%, cao hơn đáng kể so với kỳ hạn ngắn nhất (12 tháng) (11.6%), chênh lệch 0.1%. Điều này phù hợp với logic nghiệp vụ.Trực quan hoá
--- Trực quan hóa Ảnh hưởng của Kỳ hạn Vay ---# Dữ liệu 'risk_by_term' đã được tính toán
# Vẽ biểu đồ ggplot
ggplot(risk_by_term,
# aes(): Map LoanTerm (chuyển thành factor) vào trục X, DefaultRate vào trục Y, màu tô vào LoanTerm
aes(x = as.factor(LoanTerm), y = DefaultRate, fill = as.factor(LoanTerm))) +
# : Khởi tạo ggplot + Vẽ các cột
# alpha = 0.8: Độ trong suốt
# show.legend = FALSE: Ẩn chú thích màu
geom_col(alpha = 0.8, show.legend = FALSE) +
# Định dạng trục Y thành tỷ lệ phần trăm
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
# Thêm Tiêu đề và Nhãn trục X, Y
labs(
title = "Rủi ro Vỡ nợ Tăng theo Kỳ hạn Vay",
x = "Kỳ hạn Vay (Tháng)",
y = "Tỷ lệ Vỡ nợ"
) +
# Sử dụng Theme (giao diện) sạch sẽ
theme_minimal(base_size = 14)
Thống kê Ảnh hưởng của LoanPurpose lên Vỡ nợ
--- Thống kê Ảnh hưởng của Mục đích Vay (LoanPurpose) lên Vỡ nợ ---# Tính toán tỷ lệ vỡ nợ theo từng LoanPurpose
risk_by_purpose <- df %>%
# Nhóm dữ liệu theo cột LoanPurpose
group_by(LoanPurpose) %>%
# Tính TotalCount và DefaultRate cho từng mục đích
summarise(TotalCount = n(), DefaultRate = mean(Default), .groups = 'drop') %>%
# Sắp xếp kết quả theo DefaultRate giảm dần
arrange(desc(DefaultRate))
# In kết quả bảng thống kê
cat("Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Mục đích Vay (Sắp xếp theo rủi ro giảm dần):\n")Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Mục đích Vay (Sắp xếp theo rủi ro giảm dần):| LoanPurpose | TotalCount | DefaultRate |
|---|---|---|
| Business | 51298 | 0.1233 |
| Auto | 50844 | 0.1188 |
| Education | 51005 | 0.1184 |
| Other | 50914 | 0.1179 |
| Home | 51286 | 0.1023 |
# Lấy thông tin mục đích rủi ro nhất/thấp nhất
rate_purpose_high = risk_by_purpose$DefaultRate[1]
purpose_high = risk_by_purpose$LoanPurpose[1]
rate_purpose_low = risk_by_purpose$DefaultRate[nrow(risk_by_purpose)]
purpose_low = risk_by_purpose$LoanPurpose[nrow(risk_by_purpose)]
diff_purpose = rate_purpose_high - rate_purpose_low
# In kết luận
cat(paste0("\nKết luận Thống kê: Mục đích vay có ảnh hưởng đến rủi ro. Mục đích '",
purpose_high, "' có tỷ lệ vỡ nợ cao nhất (",
percent(rate_purpose_high, accuracy=0.1), "), trong khi '",
purpose_low, "' có tỷ lệ thấp nhất (",
percent(rate_purpose_low, accuracy=0.1), "). Chênh lệch ",
percent(diff_purpose, accuracy=0.1), " cho thấy sự khác biệt giữa các mục đích vay."))
Kết luận Thống kê: Mục đích vay có ảnh hưởng đến rủi ro. Mục đích 'Business' có tỷ lệ vỡ nợ cao nhất (12.3%), trong khi 'Home' có tỷ lệ thấp nhất (10.2%). Chênh lệch 2.1% cho thấy sự khác biệt giữa các mục đích vay.Trực quan hóa
--- Trực quan hóa Ảnh hưởng của Mục đích Vay ) ---# Dữ liệu 'risk_by_purpose' đã được tính toán và sắp xếp ở Thao tác 18
# Vẽ biểu đồ ggplot với tối đa 5 layers
ggplot(risk_by_purpose,
# aes(): Map LoanPurpose (đã sắp xếp bằng reorder) vào trục X,
# DefaultRate vào trục Y, màu tô (fill) vào LoanPurpose
# reorder(LoanPurpose, -DefaultRate): Sắp xếp các mục đích trên trục X
# theo thứ tự DefaultRate giảm dần (dấu trừ)
aes(x = reorder(LoanPurpose, -DefaultRate), y = DefaultRate, fill = LoanPurpose)) +
# Khởi tạo ggplot + Vẽ các cột
# alpha = 0.8: Độ trong suốt
# show.legend = FALSE: Ẩn chú thích màu
geom_col(alpha = 0.8, show.legend = FALSE) +
# Định dạng trục Y thành tỷ lệ phần trăm
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
# Thêm Tiêu đề và Nhãn trục X, Y
labs(
title = "Tỷ lệ Vỡ nợ (Rủi ro) theo Mục đích Vay",
x = "Mục đích Vay (Sắp xếp theo rủi ro giảm dần)",
y = "Tỷ lệ Vỡ nợ"
) +
# Sử dụng Theme (giao diện) sạch sẽ
theme_minimal(base_size = 14) +
# Tùy chỉnh nhỏ: Xoay nhãn trục X nếu cần
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Thống kê Ảnh hưởng của Tình trạng Việc làm (EmploymentType) lên Vỡ nợ
--- Thống kê Ảnh hưởng của Tình trạng Việc làm (EmploymentType) lên Vỡ nợ ---# Tính toán tỷ lệ vỡ nợ theo từng EmploymentType
risk_by_emp <- df %>%
# Nhóm dữ liệu theo cột EmploymentType
group_by(EmploymentType) %>%
# Tính TotalCount và DefaultRate cho từng nhóm
summarise(TotalCount = n(), DefaultRate = mean(Default), .groups = 'drop') %>%
# Sắp xếp kết quả theo DefaultRate giảm dần
arrange(desc(DefaultRate))
# In kết quả bảng thống kê
cat("Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Tình trạng Việc làm:\n")Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Tình trạng Việc làm:| EmploymentType | TotalCount | DefaultRate |
|---|---|---|
| Unemployed | 63824 | 0.1355 |
| Part-time | 64161 | 0.1197 |
| Self-employed | 63706 | 0.1146 |
| Full-time | 63656 | 0.0946 |
# Lấy thông tin nhóm rủi ro nhất
rate_emp_high = risk_by_emp$DefaultRate[1]
emp_high = risk_by_emp$EmploymentType[1]
# In kết luận
cat(paste0("\nKết luận Thống kê: Tình trạng việc làm ảnh hưởng rõ rệt đến rủi ro vỡ nợ. Nhóm '",
emp_high, "' có tỷ lệ vỡ nợ cao nhất (",
percent(rate_emp_high, accuracy=0.1), ")."))
Kết luận Thống kê: Tình trạng việc làm ảnh hưởng rõ rệt đến rủi ro vỡ nợ. Nhóm 'Unemployed' có tỷ lệ vỡ nợ cao nhất (13.6%).TRực quan hoá
#In tiêu đề cho thao tác
cat("\n--- Trực quan hóa Ảnh hưởng của Tình trạng Việc làm (Minh họa T20) ---\n")
--- Trực quan hóa Ảnh hưởng của Tình trạng Việc làm (Minh họa T20) ---# Dữ liệu 'risk_by_emp' đã được tính toán và sắp xếp ở Thao tác 20
# Vẽ biểu đồ ggplots
ggplot(risk_by_emp,
# aes(): Map EmploymentType (đã sắp xếp) vào trục X,
# DefaultRate vào trục Y, màu tô (fill) vào EmploymentType
# reorder(EmploymentType, -DefaultRate): Sắp xếp các cột theo DefaultRate giảm dần
aes(x = reorder(EmploymentType, -DefaultRate), y = DefaultRate, fill = EmploymentType)) +
# Khởi tạo ggplot + Vẽ các cột
# alpha = 0.8: Độ trong suốt
# show.legend = FALSE: Ẩn chú thích màu
geom_col(alpha = 0.8, show.legend = FALSE) +
# Định dạng trục Y thành tỷ lệ phần trăm
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
# Thêm Tiêu đề và Nhãn trục X, Y
labs(
title = "Tỷ lệ Vỡ nợ (Rủi ro) theo Tình trạng Việc làm",
x = "Tình trạng Việc làm (Sắp xếp theo rủi ro giảm dần)",
y = "Tỷ lệ Vỡ nợ"
) +
# Sử dụng Theme (giao diện) sạch sẽ và xoay nhãn X
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
### Thống kê Ảnh hưởng của Education, Age & Income lên Vỡ nợ
--- Thống kê Ảnh hưởng của Education, Age & Income lên Vỡ nợ ---
--- Phân tích Ảnh hưởng của Education ---# Tính tỷ lệ vỡ nợ theo Education
risk_by_edu <- df %>%
group_by(Education) %>%
summarise(TotalCount = n(), DefaultRate = mean(Default), .groups = 'drop') %>%
arrange(desc(DefaultRate)) # Sắp xếp
# In bảng kết quả Education
cat("Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Học vấn:\n")Bảng Tỷ lệ Vỡ nợ (Rủi ro) theo Học vấn:| Education | TotalCount | DefaultRate |
|---|---|---|
| High School | 63903 | 0.1288 |
| Bachelor’s | 64366 | 0.1210 |
| Master’s | 63541 | 0.1087 |
| PhD | 63537 | 0.1059 |
# Diễn giải kết quả Education
min_rate_edu = min(risk_by_edu$DefaultRate)
max_rate_edu = max(risk_by_edu$DefaultRate)
diff_edu = max_rate_edu - min_rate_edu
cat(paste0("\nKết luận (Education): Ảnh hưởng của Học vấn lên rủi ro vỡ nợ trong bộ dữ liệu này là **không đáng kể**. Tỷ lệ vỡ nợ giữa các nhóm rất gần nhau, chỉ chênh lệch ",
percent(diff_edu, accuracy=0.1), " (từ ",
percent(min_rate_edu, accuracy=0.1), " đến ", percent(max_rate_edu, accuracy=0.1), ")."))
Kết luận (Education): Ảnh hưởng của Học vấn lên rủi ro vỡ nợ trong bộ dữ liệu này là **không đáng kể**. Tỷ lệ vỡ nợ giữa các nhóm rất gần nhau, chỉ chênh lệch 2.3% (từ 10.6% đến 12.9%).# --- Xác nhận lại Age & Income ---
cat("\n\n--- Xác nhận lại Ảnh hưởng (không đáng kể) của Age & Income ---\n")
--- Xác nhận lại Ảnh hưởng (không đáng kể) của Age & Income ---# Tính lại tỷ lệ vỡ nợ theo AgeGroup
risk_by_age <- df %>%
mutate(AgeGroup = cut(Age, breaks = breaks_age, labels = labels_age, include.lowest=TRUE, ordered_result = TRUE)) %>%
filter(!is.na(AgeGroup)) %>% group_by(AgeGroup) %>% summarise(DefaultRate = mean(Default))
# Tính lại tỷ lệ vỡ nợ theo IncomeGroup
risk_by_income <- df %>%
mutate(IncomeGroup = cut(Income, breaks = quantile(df$Income, probs=c(0,0.25,0.5,0.75,1), na.rm=TRUE), labels = c("Thấp","TB","Cao","Rất cao"), include.lowest = TRUE, ordered_result = TRUE)) %>%
filter(!is.na(IncomeGroup)) %>% group_by(IncomeGroup) %>% summarise(DefaultRate = mean(Default))
# In bảng kết quả Age
cat("\nBảng Tỷ lệ Vỡ nợ theo Nhóm Tuổi (Xác nhận):\n")
Bảng Tỷ lệ Vỡ nợ theo Nhóm Tuổi (Xác nhận):| AgeGroup | DefaultRate |
|---|---|
| 18-25 | 0.2076 |
| 26-40 | 0.1491 |
| 41-60 | 0.0843 |
| 60+ | 0.0505 |
Bảng Tỷ lệ Vỡ nợ theo Nhóm Thu nhập (Xác nhận):| IncomeGroup | DefaultRate |
|---|---|
| Thấp | 0.1738 |
| TB | 0.1054 |
| Cao | 0.0951 |
| Rất cao | 0.0902 |
# Diễn giải kết quả Age & Income
cat("\nKết luận (Age & Income): Age (Tuổi) có ảnh hưởng đáng kể và nghịch biến đến DefaultRate (Tỷ lệ Vỡ nợ). Nhóm tuổi càng trẻ thì rủi ro vỡ nợ càng cao,tuổi càng trẻ+học vấn đang thấp.Từ đó thấy được cột học vấn thấp thì tỷ lệ vỡ nợ càng cao")
Kết luận (Age & Income): Age (Tuổi) có ảnh hưởng đáng kể và nghịch biến đến DefaultRate (Tỷ lệ Vỡ nợ). Nhóm tuổi càng trẻ thì rủi ro vỡ nợ càng cao,tuổi càng trẻ+học vấn đang thấp.Từ đó thấy được cột học vấn thấp thì tỷ lệ vỡ nợ càng caoMa trận Tương quan (Toàn bộ Biến số)
--- Ma trận Tương quan (Toàn bộ Biến số) ---# Chọn các cột số quan trọng từ df gốc
numeric_cols_full <- df %>%
select(Age, Income, LoanAmount, CreditScore, MonthsEmployed,
InterestRate, DTIRatio, NumCreditLines, LoanTerm, Default)
# Tính toán ma trận tương quan, làm tròn 2 chữ số
# use = "complete.obs" xử lý các hàng có giá trị NA (nếu có)
corr_matrix_full <- round(cor(numeric_cols_full, use = "complete.obs"), 2)
# In bảng ma trận tương quan (để tham khảo số liệu chính xác)
cat("Bảng Ma trận Tương quan:\n")Bảng Ma trận Tương quan:| Age | Income | LoanAmount | CreditScore | MonthsEmployed | InterestRate | DTIRatio | NumCreditLines | LoanTerm | Default | |
|---|---|---|---|---|---|---|---|---|---|---|
| Age | 1.00 | 0.0 | 0.00 | 0.00 | 0.0 | 0.00 | 0.00 | 0.00 | 0 | -0.17 |
| Income | 0.00 | 1.0 | 0.00 | 0.00 | 0.0 | 0.00 | 0.00 | 0.00 | 0 | -0.10 |
| LoanAmount | 0.00 | 0.0 | 1.00 | 0.00 | 0.0 | 0.00 | 0.00 | 0.00 | 0 | 0.09 |
| CreditScore | 0.00 | 0.0 | 0.00 | 1.00 | 0.0 | 0.00 | 0.00 | 0.00 | 0 | -0.03 |
| MonthsEmployed | 0.00 | 0.0 | 0.00 | 0.00 | 1.0 | 0.00 | 0.00 | 0.00 | 0 | -0.10 |
| InterestRate | 0.00 | 0.0 | 0.00 | 0.00 | 0.0 | 1.00 | 0.00 | 0.00 | 0 | 0.13 |
| DTIRatio | 0.00 | 0.0 | 0.00 | 0.00 | 0.0 | 0.00 | 1.00 | 0.00 | 0 | 0.02 |
| NumCreditLines | 0.00 | 0.0 | 0.00 | 0.00 | 0.0 | 0.00 | 0.00 | 1.00 | 0 | 0.03 |
| LoanTerm | 0.00 | 0.0 | 0.00 | 0.00 | 0.0 | 0.00 | 0.00 | 0.00 | 1 | 0.00 |
| Default | -0.17 | -0.1 | 0.09 | -0.03 | -0.1 | 0.13 | 0.02 | 0.03 | 0 | 1.00 |
Trực quan hoá
Biểu đồ Heatmap Tương quan:# Cần library(ggcorrplot) đã load ở chunk setup
ggcorrplot(corr_matrix_full,
# Layer 1&2: ggcorrplot + Chỉ hiển thị nửa dưới ma trận (vì đối xứng)
type = "lower",
# Layer 3: Hiển thị giá trị hệ số tương quan (r) trên ô
lab = TRUE,
lab_size = 3, # Cỡ chữ của giá trị r
# Layer 4: Đặt màu (Đỏ cam cho âm - Trắng cho 0 - Xanh dương cho dương)
colors = c("#E46726", "white", "#6D9EC1")
) +
# Thêm tiêu đề (sử dụng labs của ggplot) và căn giữa
labs(title = "Ma trận Tương quan Giữa các Biến số") +
theme(plot.title = element_text(hjust = 0.5, size=16))
Phân tích Tương tác: Rủi ro theo CreditScore VÀ LoanPurpose
# Tính DefaultRate cho từng tổ hợp (dùng lại các mốc từ T3)
risk_heatmap <- df %>%
# Tạo cột nhóm CreditScore
mutate(CreditScoreGroup = cut(CreditScore,
breaks = breaks_credit_score,
labels = labels_credit_score_short,
include.lowest = TRUE)) %>%
# Lọc NA và nhóm theo cả hai biến
filter(!is.na(CreditScoreGroup)) %>%
group_by(CreditScoreGroup, LoanPurpose) %>%
# Tính DefaultRate cho từng ô
summarise(DefaultRate = mean(Default), .groups = 'drop')
# In bảng kết quả (có thể pivot_wider để dễ đọc hơn nếu cần)
cat("Bảng Tỷ lệ Vỡ nợ theo Tổ hợp (Ví dụ):\n")Bảng Tỷ lệ Vỡ nợ theo Tổ hợp (Ví dụ):| CreditScoreGroup | LoanPurpose | DefaultRate |
|---|---|---|
| Thấp | Auto | 0.1321 |
| Thấp | Business | 0.1416 |
| Thấp | Education | 0.1296 |
| Thấp | Home | 0.1194 |
| Thấp | Other | 0.1298 |
| TB | Auto | 0.1230 |
TRực quan hoá
Biểu đồ Heatmap Rủi ro:ggplot(risk_heatmap, aes(x = CreditScoreGroup, y = LoanPurpose, fill = DefaultRate)) +
# Vẽ các ô màu và đường viền
geom_tile(color = "white") +
geom_text(aes(label = percent(DefaultRate, accuracy = 0.1)), color = "black", size = 3) + # Thêm nhãn %
# : Định nghĩa thang màu (Xanh lá -> Đỏ cam)
scale_fill_gradient(low = "#2a9d8f", high = "#e76f51", labels = scales::percent) +
# Thêm Tiêu đề và Nhãn trục
labs(title = "Heatmap Rủi ro: Điểm Tín dụng vs Mục đích Vay",
x = "Nhóm Điểm Tín dụng", y = "Mục đích Vay", fill = "% Vỡ nợ") +
# Theme
theme_minimal(base_size = 14)
### Phân tích Tương tác: Rủi ro theo Lãi suất VÀ Thâm niên
--- Phân tích Tương tác: Rủi ro theo Lãi suất VÀ Thâm niên ---# Tính DefaultRate cho từng tổ hợp (dùng lại các mốc từ T13 và T12)
risk_heatmap_2 <- df %>%
# Tạo cột InterestRateGroup
mutate(InterestRateGroup = cut(InterestRate, breaks = interest_breaks, labels = interest_labels),
# Tạo cột MonthsEmployedGroup
MonthsEmployedGroup = cut(MonthsEmployed, breaks = business_breaks, labels = business_labels)) %>%
# Lọc NA và nhóm theo cả hai biến
filter(!is.na(InterestRateGroup) & !is.na(MonthsEmployedGroup)) %>%
group_by(InterestRateGroup, MonthsEmployedGroup) %>%
# Tính DefaultRate cho từng ô
summarise(DefaultRate = mean(Default), .groups = 'drop')
# In bảng kết quả thống kê
cat("Bảng Tỷ lệ Vỡ nợ theo Tổ hợp Lãi suất và Thâm niên:\n")Bảng Tỷ lệ Vỡ nợ theo Tổ hợp Lãi suất và Thâm niên:| InterestRateGroup | MonthsEmployedGroup | DefaultRate |
|---|---|---|
| Thấp (<8%) | 0 tháng | 0.1044 |
| Thấp (<8%) | 1-12 tháng | 0.0995 |
| Thấp (<8%) | 1-5 năm | 0.0777 |
| Thấp (<8%) | Trên 5 năm | 0.0493 |
| Trung bình (8-15%) | 0 tháng | 0.1538 |
| Trung bình (8-15%) | 1-12 tháng | 0.1460 |
| Trung bình (8-15%) | 1-5 năm | 0.1174 |
| Trung bình (8-15%) | Trên 5 năm | 0.0741 |
| Cao (15-20%) | 0 tháng | 0.1946 |
| Cao (15-20%) | 1-12 tháng | 0.2003 |
| Cao (15-20%) | 1-5 năm | 0.1612 |
| Cao (15-20%) | Trên 5 năm | 0.1055 |
| Rất cao (>20%) | 0 tháng | 0.3013 |
| Rất cao (>20%) | 1-12 tháng | 0.2485 |
| Rất cao (>20%) | 1-5 năm | 0.2025 |
| Rất cao (>20%) | Trên 5 năm | 0.1420 |
# Lấy các giá trị để diễn giải
max_rate_combo = max(risk_heatmap_2$DefaultRate)
min_rate_combo = min(risk_heatmap_2$DefaultRate)
diff_combo = max_rate_combo - min_rate_combo
cat(paste0("\nKết luận Thống kê: Sự cộng hưởng rủi ro là rõ ràng. Tỷ lệ vỡ nợ cao nhất là ",
percent(max_rate_combo, accuracy=0.1),
" (Tổ hợp rủi ro nhất) và thấp nhất là ",
percent(min_rate_combo, accuracy=0.1),
", chênh lệch tới ", percent(diff_combo, accuracy=0.1),
". Rủi ro tập trung ở tổ hợp Lãi suất cao + Thâm niên thấp."))
Kết luận Thống kê: Sự cộng hưởng rủi ro là rõ ràng. Tỷ lệ vỡ nợ cao nhất là 30.1% (Tổ hợp rủi ro nhất) và thấp nhất là 4.9%, chênh lệch tới 25.2%. Rủi ro tập trung ở tổ hợp Lãi suất cao + Thâm niên thấp.Trực quan hoá
Biểu đồ Heatmap Rủi ro:ggplot(risk_heatmap_2, aes(x = InterestRateGroup, y = MonthsEmployedGroup, fill = DefaultRate)) +
# Vẽ các ô màu và nhãn %
geom_tile(color = "white") +
geom_text(aes(label = percent(DefaultRate, accuracy = 0.1)), color = "black", size = 3) +
# Định nghĩa thang màu (Xanh lá - An toàn, Đỏ cam - Rủi ro)
scale_fill_gradient(low = "#2a9d8f", high = "#e76f51", labels = scales::percent) +
# Thêm Tiêu đề và Nhãn trục
labs(title = "Heatmap Rủi ro: Lãi suất vs Thâm niên",
x = "Nhóm Lãi suất", y = "Nhóm Thâm niên", fill = "% Vỡ nợ") +
# Theme
theme_minimal(base_size = 14)
Phân tích Tương tác: CreditScoreGroup và LoanToIncomeRatio
--- Phân tích Tương tác: Rủi ro theo CreditScore VÀ Tỷ lệ Vay/Thu nhập ---# Tạo biến LoanToIncomeRatio (Tái tạo logic T13)
df_ratio <- df %>% mutate(LoanToIncomeRatio = LoanAmount / (Income + 1))
#Tính các mốc Tứ phân vị (breaks) cho LoanToIncomeRatio
breaks_ratio <- quantile(df_ratio$LoanToIncomeRatio, probs = c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE)
labels_ratio <- c("Thấp (Q1)", "TB (Q2)", "Cao (Q3)", "Rất cao (Q4)")
labels_credit_short <- c("Thấp", "TB", "Cao", "Rất cao")
# Tính DefaultRate cho từng tổ hợp
risk_heatmap_3 <- df_ratio %>%
mutate(
# Tạo CreditScoreGroup (Dùng mốc từ T3)
CreditScoreGroup = cut(CreditScore, breaks = breaks_credit_score, labels = labels_credit_score_short, include.lowest = TRUE),
# Tạo RatioGroup
RatioGroup = cut(LoanToIncomeRatio, breaks = breaks_ratio, labels = labels_ratio, include.lowest = TRUE)
) %>%
filter(!is.na(CreditScoreGroup) & !is.na(RatioGroup)) %>%
group_by(CreditScoreGroup, RatioGroup) %>%
summarise(DefaultRate = mean(Default), .groups = 'drop')
# In bảng kết quả thống kê
cat("Bảng Tỷ lệ Vỡ nợ theo Tổ hợp Điểm Tín dụng và Gánh nặng Vay:\n")Bảng Tỷ lệ Vỡ nợ theo Tổ hợp Điểm Tín dụng và Gánh nặng Vay:| CreditScoreGroup | RatioGroup | DefaultRate |
|---|---|---|
| Thấp | Thấp (Q1) | 0.0881 |
| Thấp | TB (Q2) | 0.1046 |
| Thấp | Cao (Q3) | 0.1192 |
| Thấp | Rất cao (Q4) | 0.2102 |
| TB | Thấp (Q1) | 0.0849 |
| TB | TB (Q2) | 0.0959 |
| TB | Cao (Q3) | 0.1092 |
| TB | Rất cao (Q4) | 0.1867 |
| Cao | Thấp (Q1) | 0.0765 |
| Cao | TB (Q2) | 0.0878 |
| Cao | Cao (Q3) | 0.1024 |
| Cao | Rất cao (Q4) | 0.1833 |
| Rất cao | Thấp (Q1) | 0.0686 |
| Rất cao | TB (Q2) | 0.0786 |
| Rất cao | Cao (Q3) | 0.0942 |
| Rất cao | Rất cao (Q4) | 0.1671 |
# Lấy các giá trị để diễn giải
max_rate_combo_3 = max(risk_heatmap_3$DefaultRate)
min_rate_combo_3 = min(risk_heatmap_3$DefaultRate)
cat(paste0("\nKết luận Thống kê: Điểm Tín dụng có vai trò giảm thiểu rủi ro ngay cả khi gánh nặng vay lớn. Tỷ lệ vỡ nợ cao nhất là ",
percent(max_rate_combo_3, accuracy=0.1),
" và thấp nhất là ",
percent(min_rate_combo_3, accuracy=0.1),
". Mức giảm rủi ro theo chiều ngang (từ điểm thấp sang điểm cao) rất đáng kể."))
Kết luận Thống kê: Điểm Tín dụng có vai trò giảm thiểu rủi ro ngay cả khi gánh nặng vay lớn. Tỷ lệ vỡ nợ cao nhất là 21.0% và thấp nhất là 6.9%. Mức giảm rủi ro theo chiều ngang (từ điểm thấp sang điểm cao) rất đáng kể.Trực quan hoá
Biểu đồ Heatmap Rủi ro:ggplot(risk_heatmap_3, aes(x = CreditScoreGroup, y = RatioGroup, fill = DefaultRate)) +
# Vẽ các ô màu và nhãn %
geom_tile(color = "white") +
geom_text(aes(label = percent(DefaultRate, accuracy = 0.1)), color = "black", size = 3) +
# Định nghĩa thang màu (Xanh lá - An toàn, Đỏ cam - Rủi ro)
scale_fill_gradient(low = "#2a9d8f", high = "#e76f51", labels = scales::percent) +
# Thêm Tiêu đề và Nhãn trục
labs(title = "Heatmap Rủi ro: Điểm Tín dụng vs Tỷ lệ Vay/Thu nhập",
x = "Nhóm Điểm Tín dụng", y = "Nhóm Tỷ lệ Vay/Thu nhập", fill = "% Vỡ nợ") +
#Theme
theme_minimal(base_size = 14)
Phân tích Tương tác: LoanTerm và LoanPurpose
--- 28. Phân tích Tương tác: Rủi ro Kỳ hạn trong từng Mục đích Vay ---# Tính DefaultRate cho từng tổ hợp (LoanTerm x LoanPurpose)
risk_dodged <- df %>%
# Chuyển LoanTerm thành Factor (phân loại) để vẽ
mutate(LoanTerm = as.factor(LoanTerm)) %>%
# Nhóm theo LoanPurpose và LoanTerm
group_by(LoanPurpose, LoanTerm) %>%
# Tính DefaultRate cho từng ô tổ hợp
summarise(DefaultRate = mean(Default), .groups = 'drop')
# In bảng kết quả thống kê
cat("Bảng Tỷ lệ Vỡ nợ theo Tổ hợp Mục đích và Kỳ hạn (Ví dụ):\n")Bảng Tỷ lệ Vỡ nợ theo Tổ hợp Mục đích và Kỳ hạn (Ví dụ):| LoanPurpose | LoanTerm | DefaultRate |
|---|---|---|
| Auto | 12 | 0.1148 |
| Auto | 24 | 0.1218 |
| Auto | 36 | 0.1167 |
| Auto | 48 | 0.1201 |
| Auto | 60 | 0.1207 |
| Business | 12 | 0.1298 |
Trực quan hoá
Biểu đồ Cột Nhóm Rủi ro:ggplot(risk_dodged, aes(x = LoanPurpose, y = DefaultRate, fill = LoanTerm)) +
# Vẽ các cột (position="dodge" đặt các cột cạnh nhau)
geom_col(position = "dodge", alpha=0.8) +
# Định dạng trục Y thành %
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
# Thêm Tiêu đề và Nhãn trục
labs(title = "Phân tích Rủi ro: Kỳ hạn Vay thay đổi trong từng Mục đích Vay",
x = "Mục đích Vay", y = "Tỷ lệ Vỡ nợ", fill = "Kỳ hạn (Tháng)") +
# Theme và tùy chỉnh nhãn X
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Phân tích Tương tác: InterestRateGroup trong từng CreditScoreGroup
--- Phân tích Tương tác: Rủi ro Lãi suất TRONG từng Nhóm Điểm Tín dụng ---# Tính DefaultRate cho tổ hợp CreditScoreGroup x InterestRateGroup
risk_facet <- df %>%
mutate(
# Tạo CreditScoreGroup (Dùng mốc từ T3)
CreditScoreGroup = cut(CreditScore, breaks = breaks_credit_score, labels = labels_credit_score_short, include.lowest = TRUE),
# Tạo InterestRateGroup
InterestRateGroup = cut(InterestRate, breaks = interest_breaks, labels = interest_labels)
) %>%
filter(!is.na(CreditScoreGroup) & !is.na(InterestRateGroup)) %>%
group_by(CreditScoreGroup, InterestRateGroup) %>%
summarise(DefaultRate = mean(Default), .groups = 'drop')
# In bảng kết quả thống kê
cat("Bảng Tỷ lệ Vỡ nợ theo Tổ hợp:\n")Bảng Tỷ lệ Vỡ nợ theo Tổ hợp:| CreditScoreGroup | InterestRateGroup | DefaultRate |
|---|---|---|
| Thấp | Thấp (<8%) | 0.0774 |
| Thấp | Trung bình (8-15%) | 0.1122 |
| Thấp | Cao (15-20%) | 0.1533 |
| Thấp | Rất cao (>20%) | 0.1974 |
| TB | Thấp (<8%) | 0.0683 |
| TB | Trung bình (8-15%) | 0.1028 |
| TB | Cao (15-20%) | 0.1376 |
| TB | Rất cao (>20%) | 0.1846 |
| Cao | Thấp (<8%) | 0.0614 |
| Cao | Trung bình (8-15%) | 0.0959 |
| Cao | Cao (15-20%) | 0.1396 |
| Cao | Rất cao (>20%) | 0.1715 |
| Rất cao | Thấp (<8%) | 0.0571 |
| Rất cao | Trung bình (8-15%) | 0.0864 |
| Rất cao | Cao (15-20%) | 0.1210 |
| Rất cao | Rất cao (>20%) | 0.1591 |
TRực quan hoá
Biểu đồ Facet Rủi ro:ggplot(risk_facet, aes(x = InterestRateGroup, y = DefaultRate, fill = InterestRateGroup)) +
# Vẽ các cột
geom_col(alpha=0.8, show.legend = FALSE) +
#Lệnh tạo 4 biểu đồ con (Facet Wrap)
facet_wrap(~ CreditScoreGroup, ncol = 4) +
# Định dạng trục Y thành %
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
# Thêm Tiêu đề và Nhãn trục
labs(title = "Ảnh hưởng Lãi suất lên Rủi ro (theo Nhóm Điểm Tín dụng)",
x = "Nhóm Lãi suất", y = "Tỷ lệ Vỡ nợ") +
# Theme (Cần phải chỉnh sửa một chút để fit vào màn hình)
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust=0.5), # Xoay nhãn X
strip.text = element_text(face="bold"))
Phân tích Tương tác: MonthsEmployedGroup trong từng EmploymentType
--- Phân tích Tương tác: Rủi ro Thâm niên TRONG từng Tình trạng Việc làm ---# Tính DefaultRate cho tổ hợp MonthsEmployedGroup x EmploymentType
risk_facet_2 <- df %>%
mutate(
# Tạo MonthsEmployedGroup
MonthsEmployedGroup = cut(MonthsEmployed, breaks = business_breaks, labels = business_labels, include.lowest = TRUE, ordered_result = TRUE)
) %>%
filter(!is.na(MonthsEmployedGroup)) %>%
group_by(EmploymentType, MonthsEmployedGroup) %>%
summarise(DefaultRate = mean(Default), .groups = 'drop')
# In bảng kết quả thống kê
cat("Bảng Tỷ lệ Vỡ nợ theo Tổ hợp :\n")Bảng Tỷ lệ Vỡ nợ theo Tổ hợp :| EmploymentType | MonthsEmployedGroup | DefaultRate |
|---|---|---|
| Full-time | 0 tháng | 0.1609 |
| Full-time | 1-12 tháng | 0.1402 |
| Full-time | 1-5 năm | 0.1089 |
| Full-time | Trên 5 năm | 0.0726 |
| Part-time | 0 tháng | 0.1780 |
| Part-time | 1-12 tháng | 0.1839 |
| Part-time | 1-5 năm | 0.1387 |
| Part-time | Trên 5 năm | 0.0904 |
| Self-employed | 0 tháng | 0.1884 |
| Self-employed | 1-12 tháng | 0.1616 |
| Self-employed | 1-5 năm | 0.1350 |
| Self-employed | Trên 5 năm | 0.0872 |
| Unemployed | 0 tháng | 0.1974 |
| Unemployed | 1-12 tháng | 0.1862 |
| Unemployed | 1-5 năm | 0.1571 |
| Unemployed | Trên 5 năm | 0.1064 |
Trục quan hoá
Biểu đồ Facet Rủi ro:ggplot(risk_facet_2, aes(x = MonthsEmployedGroup, y = DefaultRate, fill = MonthsEmployedGroup)) +
# Vẽ các cột
geom_col(alpha=0.8, show.legend = FALSE) +
# Lệnh tạo 4 biểu đồ con (Facet Wrap)
facet_wrap(~ EmploymentType, ncol = 4) +
# Định dạng trục Y và Thêm Tiêu đề
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(title = "Rủi ro Thâm niên thay đổi theo Tình trạng Việc làm",
x = "Nhóm Thâm niên", y = "Tỷ lệ Vỡ nợ") +
# Theme và tùy chỉnh nhãn
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust=0.5),
legend.position = "none",
strip.text = element_text(face="bold"))