Nhiệm Vụ 6

1 Giới thiệu

Bộ dữ liệu được rút gọn từ một chiến dịch marketing qua điện thoại của một ngân hàng tại Bồ Đào Nha. Dữ liệu ban đầu nhằm phục vụ cho việc dự đoán khả năng khách hàng đăng ký gửi tiền có kỳ hạn. Tuy nhiên, trong nghiên cứu này, tác giả tập trung vào hai biến định tính quan trọng có liên quan đến hành vi tài chính của khách hàng, đó là:

• loan: Khách hàng có vay tiêu dùng hay không (yes/no)

Hai biến này được chọn làm biến phụ thuộc, với mục tiêu phân tích xem các yếu tố nhân khẩu học và đặc điểm khách hàng như:

• Nghề nghiệp (job)
• Tình trạng hôn nhân (marital)
• Trình độ học vấn (education)
• Tình trạng nợ quá hạn (default)
• Hình thức liên hệ (contact)
• Tình trạng vay mua nhà của khách hàng (housing)

… có ảnh hưởng như thế nào đến quyết định vay tiêu dùng của khách hàng.

Thông qua việc sử dụng các công cụ phân tích dữ liệu định tính như: bảng tần số, biểu đồ minh họa, kiểm định Chi bình phương, phân tích tỷ số chênh lệch (Odds Ratio) và rủi ro tương đối (Relative Risk), bài nghiên cứu sẽ làm rõ các yếu tố quan trọng ảnh hưởng đến hành vi tài chính của khách hàng.

1.1 Đọc và khám phá dữ liệu

data <- read.xlsx("D:/PTDLDT/data.xlsx", sheetIndex = 1, header = TRUE)

data <- data %>%
  mutate(
    loan = as.factor(loan),
    housing = as.factor(housing),
    job = as.factor(job),
    marital = as.factor(marital),
    education = as.factor(education),
    default = as.factor(default),
    contact = as.factor(contact)
  )
str(data)

## 'data.frame':    4521 obs. of  8 variables:
##  $ age      : num  30 33 35 30 59 35 36 39 41 43 ...
##  $ job      : Factor w/ 12 levels "admin.","blue-collar",..: 11 8 5 5 2 5 7 10 3 8 ...
##  $ marital  : Factor w/ 3 levels "divorced","married",..: 2 2 3 2 2 3 2 2 2 2 ...
##  $ education: Factor w/ 4 levels "primary","secondary",..: 1 2 3 3 2 3 3 2 3 1 ...
##  $ default  : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 1 1 ...
##  $ housing  : Factor w/ 2 levels "no","yes": 1 2 2 2 2 1 2 2 2 2 ...
##  $ loan     : Factor w/ 2 levels "no","yes": 1 2 1 2 1 1 1 1 1 2 ...
##  $ contact  : Factor w/ 3 levels "cellular","telephone",..: 1 1 1 3 3 1 1 1 3 1 ...

summary(data)

##       age                 job          marital         education    default   
##  Min.   :19.00   management :969   divorced: 528   primary  : 678   no :4445  
##  1st Qu.:33.00   blue-collar:946   married :2797   secondary:2306   yes:  76  
##  Median :39.00   technician :768   single  :1196   tertiary :1350             
##  Mean   :41.17   admin.     :478                   unknown  : 187             
##  3rd Qu.:49.00   services   :417                                              
##  Max.   :87.00   retired    :230                                              
##                  (Other)    :713                                              
##  housing     loan           contact    
##  no :1962   no :3830   cellular :2896  
##  yes:2559   yes: 691   telephone: 301  
##                        unknown  :1324  
##                                        
##                                        
##                                        
## 

1.2 Mô tả các biến

Tên biến	Kiểu dữ liệu	Số lượng giá trị duy nhất	Mô tả nội dung
age	Numeric	67	Tuổi của khách hàng (từ 19 đến 87 tuổi).
job	Character	12	Nghề nghiệp của khách hàng như: management, blue-collar, services, student, retired, unemployed,…
marital	Character	3	Tình trạng hôn nhân: single, married, divorced.
education	Character	4	Trình độ học vấn: primary, secondary, tertiary, unknown.
default	Character	2	Khách hàng có nợ tín dụng quá hạn không? (yes, no)
housing	Character	2	Khách hàng có vay mua nhà không? (yes, no)
loan	Character	2	Khách hàng có vay tiêu dùng không? (yes, no)
contact	Character	3	Hình thức liên hệ: cellular, telephone, unknown

Nhận xét

Bộ dữ liệu gồm 8 biến và 4251 quan sát, được chia thành hai nhóm chính: biến định lượng và biến định tính.

• Biến định lượng: Chỉ có một biến duy nhất là biến định lượng, đó là biến age. Đây là biến đo lường tuổi của khách hàng, có kiểu số (numeric), có thể sử dụng để tính toán trung bình, độ lệch chuẩn, phân phối, v.v. Biến này mang thông tin liên tục và có thể dùng cho các phương pháp phân tích định lượng như hồi quy tuyến tính hoặc phân tích phương sai.

• Các biến định tính: Có bảy biến còn lại thuộc loại biến định tính. Các biến này mang thông tin dạng danh mục (categorical), không dùng để tính toán trực tiếp mà thường được phân tích bằng cách đếm tần số, tỷ lệ, hoặc dùng các phương pháp thống kê cho dữ liệu định tính như kiểm định Chi bình phương, tính Odds Ratio, Relative Risk,…

Tạo bộ dữ liệu chỉ có biến định tính

library(dplyr)

# Tạo bộ dữ liệu chỉ chứa các biến định tính
data1 <- data %>%
  dplyr::select(job, marital, education, default, housing, loan, contact)

# Xem trước dữ liệu mới
str(data1)

## 'data.frame':    4521 obs. of  7 variables:
##  $ job      : Factor w/ 12 levels "admin.","blue-collar",..: 11 8 5 5 2 5 7 10 3 8 ...
##  $ marital  : Factor w/ 3 levels "divorced","married",..: 2 2 3 2 2 3 2 2 2 2 ...
##  $ education: Factor w/ 4 levels "primary","secondary",..: 1 2 3 3 2 3 3 2 3 1 ...
##  $ default  : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 1 1 ...
##  $ housing  : Factor w/ 2 levels "no","yes": 1 2 2 2 2 1 2 2 2 2 ...
##  $ loan     : Factor w/ 2 levels "no","yes": 1 2 1 2 1 1 1 1 1 2 ...
##  $ contact  : Factor w/ 3 levels "cellular","telephone",..: 1 1 1 3 3 1 1 1 3 1 ...

head(data1)

---

2 Thống kê mô tả biến nghiên cứu

2.1 Thống mô tả biến phụ thuộc

2.1.1 Biến Loan

Lập bảng tần số và tần suất

table(data1$loan)

## 
##   no  yes 
## 3830  691

prop.table(table(data1$loan))

## 
##        no       yes 
## 0.8471577 0.1528423

Vẽ biểu đồ cột

freq_loan <- as.data.frame(table(data1$loan))
colnames(freq_loan) <- c("Loan", "Count")

ggplot(freq_loan, aes(x = Loan, y = Count)) +
  geom_col(fill = "#9370DB", color = "black") +
  geom_text(aes(label = Count), vjust = -0.5) +
  labs(title = "Tần số vay tiêu dùng", x = "Vay tiêu dùng", y = "Số lượng") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

Vẽ biểu đồ tròn

# Tạo bảng tần suất
loan_freq <- table(data1$loan)
loan_prop <- prop.table(loan_freq)

# Chuyển thành data frame để dùng ggplot2
loan_df <- as.data.frame(loan_prop)
colnames(loan_df) <- c("Loan", "Proportion")

# Tính phần trăm để hiển thị nhãn
loan_df$Percent <- paste0(round(loan_df$Proportion * 100, 1), "%")

# Vẽ biểu đồ tròn bằng ggplot2
ggplot(loan_df, aes(x = "", y = Proportion, fill = Loan)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y") +
  geom_text(aes(label = Percent), position = position_stack(vjust = 0.5)) +
  labs(title = "Tỷ lệ vay tiêu dùng", x = NULL, y = NULL) +
  theme_void()+
  theme(plot.title = element_text(hjust = 0.5))

Dựa vào bảng tần số, tần suất và biểu đồ của biến loan, ta có các nhận định sau:

• Nhóm không vay tiêu dùng (no) chiếm số lượng lớn vượt trội với 3.830 người, tương ứng khoảng 84.7% tổng số mẫu. Đây là nhóm chiếm ưu thế rõ rệt.

• Nhóm có vay tiêu dùng (yes) chỉ có 691 người, chiếm khoảng 15.3%.

Kết luận:

Phân bố vay tiêu dùng cho thấy đa số khách hàng không sử dụng hình thức vay tiêu dùng, phản ánh sự thận trọng trong chi tiêu hoặc tiếp cận hạn chế với loại hình tín dụng này. Yếu tố này có thể đóng vai trò trong việc xác định mức độ tiêu dùng cá nhân và khả năng tiếp cận tín dụng tiêu dùng trong nghiên cứu hành vi tài chính.

2.2 Thống kê mô tả biến độc lập

2.2.1 Biến Housing

Lập bảng tần số và tần suất

table(data1$housing)

## 
##   no  yes 
## 1962 2559

prop.table(table(data1$housing))

## 
##        no       yes 
## 0.4339748 0.5660252

Vẽ biểu đồ cột

freq_housing <- as.data.frame(table(data1$housing))
colnames(freq_housing) <- c("Housing", "Count")

ggplot(freq_housing, aes(x = Housing, y = Count)) +
  geom_col(fill = "#66CDAA", color = "black") +
  geom_text(aes(label = Count), vjust = -0.5) +
  labs(title = "Tần số vay mua nhà", x = "Vay nhà", y = "Số lượng") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

# Tạo bảng tần suất
housing_freq <- table(data1$housing)
housing_prop <- prop.table(housing_freq)

# Chuyển sang data frame để vẽ với ggplot2
housing_df <- as.data.frame(housing_prop)
colnames(housing_df) <- c("Housing", "Proportion")

# Thêm cột phần trăm để làm nhãn
housing_df$Percent <- paste0(round(housing_df$Proportion * 100, 1), "%")

# Vẽ biểu đồ tròn
ggplot(housing_df, aes(x = "", y = Proportion, fill = Housing)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y") +
  geom_text(aes(label = Percent), position = position_stack(vjust = 0.5)) +
  labs(title = "tỷ lệ vay mua nhà", x = NULL, y = NULL) +
  theme_void()

theme(plot.title = element_text(hjust = 0.5))

## List of 1
##  $ plot.title:List of 11
##   ..$ family       : NULL
##   ..$ face         : NULL
##   ..$ colour       : NULL
##   ..$ size         : NULL
##   ..$ hjust        : num 0.5
##   ..$ vjust        : NULL
##   ..$ angle        : NULL
##   ..$ lineheight   : NULL
##   ..$ margin       : NULL
##   ..$ debug        : NULL
##   ..$ inherit.blank: logi FALSE
##   ..- attr(*, "class")= chr [1:2] "element_text" "element"
##  - attr(*, "class")= chr [1:2] "theme" "gg"
##  - attr(*, "complete")= logi FALSE
##  - attr(*, "validate")= logi TRUE

Dựa vào bảng tần số, tần suất và biểu đồ của biến housing, ta có các nhận định sau:

• Nhóm có vay mua nhà (yes) chiếm tỷ lệ cao hơn với 2,559 người, tương ứng khoảng 56.6% tổng số mẫu. Đây là nhóm chiếm tỷ trọng lớn trong tập dữ liệu.

• Nhóm không vay mua nhà (no) có 1,962 người, chiếm khoảng 43.4%.

Kết luận:

Phân bố dữ liệu cho thấy phần lớn khách hàng trong tập dữ liệu có khoản vay mua nhà. Điều này có thể phản ánh nhu cầu về nhà ở cũng như mức độ tiếp cận tín dụng mua bất động sản của khách hàng trong tập mẫu.

2.2.2 Biến Job

Lập bảng tần số và tần suất

#Bảng tần số
table(data1$job)

## 
##        admin.   blue-collar  entrepreneur     housemaid    management 
##           478           946           168           112           969 
##       retired self-employed      services       student    technician 
##           230           183           417            84           768 
##    unemployed       unknown 
##           128            38

#Bảng tần suất
table(data1$job)/sum(table(data1$job))

## 
##        admin.   blue-collar  entrepreneur     housemaid    management 
##    0.10572882    0.20924574    0.03715992    0.02477328    0.21433311 
##       retired self-employed      services       student    technician 
##    0.05087370    0.04047777    0.09223623    0.01857996    0.16987392 
##    unemployed       unknown 
##    0.02831232    0.00840522

Vẽ biểu đồ cột

library(ggplot2)

library(ggplot2)

# Tạo bảng tần số cho biến job
freq1 <- table(data1$job)

# Chuyển thành data frame
job_freq <- as.data.frame(freq1)
colnames(job_freq) <- c("Job", "Count")

# Vẽ biểu đồ cột
ggplot(job_freq, aes(x = Job, y = Count)) +
  geom_col(fill = "#6495ED", color = "black") +
  geom_text(aes(label = Count), vjust = -0.5, color = "black") +
  labs(title = "Tần số theo nghề nghiệp", x = "Nghề nghiệp", y = "Số lượng") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))+
  theme(plot.title = element_text(hjust = 0.5)) 

Dựa vào bảng tần số và biểu đồ trên, ta có các nhận định sau:

• Nghề nghiệp phổ biến nhất là management với 969 người, chiếm khoảng 21.4% tổng số mẫu.

• Theo sau là blue-collar (946 người, ~20.9%) và technician (768 người, ~17.0%).

• Các nhóm nghề ít phổ biến hơn gồm: student (84 người, ~1.9%) và unknown (38 người, ~0.8%).

• Tổng cộng, ba nhóm nghề chiếm tỷ lệ cao nhất (management, blue-collar, technician) đã chiếm hơn 59% toàn bộ dữ liệu.

Kết luận:

Phân bố nghề nghiệp không đều, cho thấy các khách hàng trong dữ liệu chủ yếu đến từ các ngành quản lý, lao động phổ thông và kỹ thuật viên.

2.2.3 Biến Marital

Lập bảng tần số và tần suất

# Bảng tần số
table(data1$marital)

## 
## divorced  married   single 
##      528     2797     1196

# Bảng tần suất
prop.table(table(data1$marital))

## 
##  divorced   married    single 
## 0.1167883 0.6186684 0.2645432

Vẽ biểu đồ cột

# Biểu đồ cột
library(ggplot2)
freq_marital <- as.data.frame(table(data1$marital))
colnames(freq_marital) <- c("Marital", "Count")

ggplot(freq_marital, aes(x = Marital, y = Count)) +
  geom_col(fill = "#6495ED", color = "black") +
  geom_text(aes(label = Count), vjust = -0.5) +
  labs(title = "Tần số theo tình trạng hôn nhân", x = "Tình trạng hôn nhân", y = "Số lượng") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        plot.title = element_text(hjust = 0.5))

Dựa vào bảng tần số và tần suất của biến marital, ta có các nhận định sau:

• Nhóm kết hôn (married) chiếm tỷ lệ cao nhất, với 2,797 người, tương ứng khoảng 61.9% tổng số mẫu. Đây là nhóm chiếm ưu thế vượt trội.

• Nhóm độc thân (single) chiếm 1,196 người (~26.5%), đứng thứ hai về tần suất.

• Nhóm ly hôn (divorced) chỉ chiếm 528 người (~11.7%), là nhóm có số lượng thấp nhất.

Kết luận:

Phân bố tình trạng hôn nhân trong tập dữ liệu này khá chênh lệch, với phần lớn khách hàng là người đã kết hôn. Điều này có thể phản ánh xu hướng hoặc cấu trúc dân số của khách hàng trong tập dữ liệu.

2.2.4 Biến Education

Lập bảng tần số và tần suất

table(data1$education)

## 
##   primary secondary  tertiary   unknown 
##       678      2306      1350       187

prop.table(table(data1$education))

## 
##    primary  secondary   tertiary    unknown 
## 0.14996682 0.51006415 0.29860650 0.04136253

Vẽ biểu đồ cột

freq_edu <- as.data.frame(table(data1$education))
colnames(freq_edu) <- c("Education", "Count")

ggplot(freq_edu, aes(x = Education, y = Count)) +
  geom_col(fill = "#FF9966", color = "black") +
  geom_text(aes(label = Count), vjust = -0.5) +
  labs(title = "Tần số theo trình độ học vấn", x = "Trình độ", y = "Số lượng") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        plot.title = element_text(hjust = 0.5))

Dựa vào bảng tần số và tần suất của biến education, ta có các nhận định sau:

• Nhóm có trình độ học vấn secondary chiếm tỷ lệ cao nhất, với 2,306 người, tương ứng khoảng 51.0% tổng số mẫu. Đây là nhóm chiếm ưu thế vượt trội.

• Nhóm có trình độ tertiary (đại học, sau đại học) có 1,350 người, chiếm khoảng 29.8%, đứng thứ hai về tần suất.

• Nhóm primary có 678 người, tương ứng khoảng 15.0% tổng số mẫu.

• Nhóm unknown (không rõ trình độ học vấn) chỉ chiếm 187 người, tương ứng 4.1%, là nhóm có số lượng thấp nhất.

Kết luận:

Phân bố trình độ học vấn trong tập dữ liệu cho thấy phần lớn khách hàng có trình độ học vấn trung học. Điều này có thể phản ánh cấu trúc trình độ học vấn phổ biến trong nhóm khách hàng được khảo sát, đồng thời là yếu tố cần xem xét trong các phân tích liên quan đến hành vi tiêu dùng hoặc khả năng tiếp cận dịch vụ.

2.2.5 Biến Default

Lập bảng tần số và tần suất

table(data1$default)

## 
##   no  yes 
## 4445   76

prop.table(table(data1$default))

## 
##         no        yes 
## 0.98318956 0.01681044

Vẽ biểu đồ cột

freq_default <- as.data.frame(table(data1$default))
colnames(freq_default) <- c("Default", "Count")

ggplot(freq_default, aes(x = Default, y = Count)) +
  geom_col(fill = "#F08080", color = "black") +
  geom_text(aes(label = Count), vjust = -0.5) +
  labs(title = "Tần số nợ tín dụng xấu", x = "Default", y = "Số lượng") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

Dựa vào bảng tần số và tần suất của biến default, ta có các nhận định sau:

• Nhóm không có nợ tín dụng xấu (no) chiếm số lượng lớn nhất với 4,445 người, tương ứng khoảng 98.4% tổng số mẫu. Đây là nhóm chiếm ưu thế gần như tuyệt đối.

• Nhóm có nợ tín dụng xấu (yes) chỉ có 76 người, chiếm tỷ lệ rất nhỏ, khoảng 1.7%.

Kết luận:

Phân bố nợ tín dụng xấu trong tập dữ liệu cho thấy phần lớn khách hàng không có lịch sử nợ xấu. Điều này phản ánh chất lượng tín dụng tương đối tốt của nhóm khách hàng được khảo sát.

3 Kiểm định chi bình phương

Kiểm định Chi bình phương (Chi-squared test) được sử dụng để kiểm tra xem có mối liên hệ thống kê giữa hai biến phân loại (categorical variables) hay không. Trong bối cảnh này, ta kiểm tra xem các yếu tố như housing, marital, education, default, v.v. có ảnh hưởng đến quyết định vay tiêu dùng (loan) hay không.

3.1 Kiểm định giữa loan và housing

Giả thuyết kiểm định

• H0: Không có mối liên hệ giữa loan và housing
• H1: Có mối liên hệ giữa loan và housing

# Thực hiện kiểm định Chi bình phương
table_loan_housing <- table(data1$loan, data1$housing)
chisq_housing <- chisq.test(table_loan_housing)
chisq_housing

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table_loan_housing
## X-squared = 1.4374, df = 1, p-value = 0.2306

3.2 Kiểm định giữa loan và job

Giả thuyết kiểm định

• H0: Không có mối liên hệ giữa nghề nghiệp và khả năng vay tiêu dùng.
• H1: Có mối liên hệ giữa nghề nghiệp và khả năng vay tiêu dùng.

# Thực hiện kiểm định Chi bình phương
table_loan_job <- table(data1$loan, data1$job)
chisq_job <- chisq.test(table_loan_job)
chisq_job

## 
##  Pearson's Chi-squared test
## 
## data:  table_loan_job
## X-squared = 47.191, df = 11, p-value = 1.989e-06

3.3 Kiểm định giữa loan và education

Giả thuyết kiểm định

• H0: Không có mối liên hệ giữa trình độ học vấn và quyết định vay tiêu dùng.
• H1: Có mối liên hệ giữa trình độ học vấn và quyết định vay tiêu dùng.

table_loan_edu <- table(data1$loan, data1$education)
chisq_edu <- chisq.test(table_loan_edu)
chisq_edu

## 
##  Pearson's Chi-squared test
## 
## data:  table_loan_edu
## X-squared = 39.798, df = 3, p-value = 1.176e-08

3.4 Kiểm định giữa loan và default

Giả thuyết kiểm định

• H0: Không có mối liên hệ giữa tình trạng nợ quá hạn và việc vay tiêu dùng.
• H1: Có mối liên hệ giữa tình trạng nợ quá hạn và việc vay tiêu dùng.

table_loan_default <- table(data1$loan, data1$default)
chisq_edu <- chisq.test(table_loan_default)
chisq_edu

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table_loan_default
## X-squared = 17.157, df = 1, p-value = 3.441e-05

3.5 Kiểm định giữa loan và marital

Giả thuyết kiểm định

• H0: Không có mối liên hệ giữa tình trạng hôn nhân và việc vay tiêu dùng.
• H1: Có mối liên hệ giữa tình trạng hôn nhân và việc vay tiêu dùng.

table_loan_marital <- table(data1$loan, data1$marital)
chisq_edu <- chisq.test(table_loan_marital)
chisq_edu

## 
##  Pearson's Chi-squared test
## 
## data:  table_loan_marital
## X-squared = 10.88, df = 2, p-value = 0.004339

Thông qua kết quả kiểm định chỉ có 1 biến housing là không có mối liên hệ với biến loan, 4 biến độc lập còn lại đều có mối liên hệ với biến phụ thuộc là loan. Tiếp theo đó ta sẽ phân tích sâu về tình trạng vay tiêu dùng với 4 biến độc lập là: job, education, marital và default thông qua relative risk và oddratio.

4 Phân tích sâu hành vi vay tiêu dùng với Relative Risk và Odds Ratio

Sau khi kiểm định Chi bình phương, 4 biến định tính gồm: education, default, marital, và job được xác định là có mối liên hệ thống kê với biến phụ thuộc loan. Chúng ta tiếp tục đặt ra các câu hỏi nghiên cứu cụ thể và phân tích sâu hơn bằng Relative Risk và Odds Ratio.

4.1 Education – Trình độ học vấn

Liệu khách hàng có trình độ học vấn cao (tertiary) có xu hướng vay tiêu dùng cao hơn so với những người không có học vấn cao hoặc không rõ học vấn không?

4.1.1 Gộp dữ liệu và tạo bảng tần số

data1$edu_grouped <- ifelse(data1$education == "tertiary", "high", 
                            ifelse(data1$education %in% c("primary", "secondary"), "low", NA))
table_edu_grouped <- table(data1$loan, data1$edu_grouped)
table_edu_grouped

##      
##       high  low
##   no  1176 2474
##   yes  174  510

data1 <- na.omit(data1)

4.1.2 Vẽ đồ thị phân tích

df_edu_grouped <- as.data.frame(table_edu_grouped)
colnames(df_edu_grouped) <- c("Loan", "Edu_Grouped", "Count")

ggplot(df_edu_grouped, aes(x = Edu_Grouped, y = Count, fill = Loan)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(
    title = "Phân bố vay tiêu dùng theo trình độ học vấn",
    x = "Trình độ học vấn",
    y = "Số lượng",
    fill = "Vay tiêu dùng"
  ) +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

4.1.3 Tính Relative Risk và Odd Ratio

mat_edu_grouped <- matrix(c(
  sum(data1$loan == "no" & data1$edu_grouped == "low"),
  sum(data1$loan == "no" & data1$edu_grouped == "high"),
  sum(data1$loan == "yes" & data1$edu_grouped == "low"),
  sum(data1$loan == "yes" & data1$edu_grouped == "high")
),
byrow = TRUE, nrow = 2,
dimnames = list(Loan = c("no", "yes"), Education = c("low", "high")))  

mat_edu_grouped

##      Education
## Loan   low high
##   no  2474 1176
##   yes  510  174

rr_edu_grouped <- riskratio(mat_edu_grouped)
rr_edu_grouped$measure

##      risk ratio with 95% C.I.
## Loan   estimate     lower     upper
##   no  1.0000000        NA        NA
##   yes 0.7895483 0.6886984 0.9051661

or_edu_grouped <- oddsratio(mat_edu_grouped)
or_edu_grouped$measure

##      odds ratio with 95% C.I.
## Loan   estimate     lower     upper
##   no  1.0000000        NA        NA
##   yes 0.7181725 0.5952221 0.8629916

Trong phân tích mối quan hệ giữa trình độ học vấn và hành vi vay tiêu dùng, tác giả phân chia khách hàng thành hai nhóm:

• Nhóm có học vấn cao: khách hàng có trình độ tertiary

• Nhóm học vấn thấp: bao gồm trình độ primary và secondary

Sau khi tính toán Relative Risk (RR) và Odds Ratio (OR) để so sánh xác suất và khả năng vay tiêu dùng giữa hai nhóm, kết quả cho thấy cả RR và OR đều nhỏ hơn 1 điều đó có nghĩa là khách hàng có học vấn cao có xu hướng vay tiêu dùng ít hơn nhóm học vấn thấp.

Cụ thể:

• Nguy cơ tương đối (RR) là 0.7895483, tức là xác suất vay tiêu dùng của nhóm học vấn cao chỉ bằng 78.95% so với nhóm học vấn thấp.
• Tỷ số chênh (OR) là 0.7181725, nghĩa là odds vay tiêu dùng của nhóm học vấn cao chỉ bằng 71.82% so với nhóm học vấn thấp.

4.2 Default – Nợ tín dụng quá hạn

4.2.1 Gộp dữ liệu và tạo bảng tần số

table_default <- table(data1$loan, data1$default)
table_default

##      
##         no  yes
##   no  3601   49
##   yes  660   24

4.2.2 Vẽ đồ thị phân tích

df_default <- as.data.frame(table_default)
colnames(df_default) <- c("Loan", "Default", "Count")

ggplot(df_default, aes(x = Default, y = Count, fill = Loan)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(
    title = "Phân bố vay tiêu dùng theo trạng thái nợ tín dụng",
    x = "Nợ tín dụng",
    y = "Số lượng",
    fill = "Vay tiêu dùng"
  ) +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

4.2.3 Tính Relative Risk và Odd Ratio

# Tạo ma trận với nhóm 'yes' (vay tiêu dùng) làm dòng thứ nhất = nhóm tham chiếu
mat_default <- matrix(c(
  sum(data1$loan == "yes" & data1$default == "yes"),  # a
  sum(data1$loan == "yes" & data1$default == "no"),   # b
  sum(data1$loan == "no" & data1$default == "yes"),   # c
  sum(data1$loan == "no" & data1$default == "no")     # d
),
byrow = TRUE, nrow = 2,
dimnames = list(Loan = c("yes", "no"), Default = c("yes", "no")))

mat_default

##      Default
## Loan  yes   no
##   yes  24  660
##   no   49 3601

# Tính RR và OR với nhóm 'yes' làm tham chiếu
rr_default <- riskratio(mat_default)
rr_default$measure

##      risk ratio with 95% C.I.
## Loan  estimate    lower    upper
##   yes 1.000000       NA       NA
##   no  1.022451 1.007447 1.037678

or_default <- oddsratio(mat_default)
or_default$measure

##      odds ratio with 95% C.I.
## Loan  estimate    lower    upper
##   yes 1.000000       NA       NA
##   no  2.680628 1.604802 4.358874

Trong phân tích này, tác giả xem xét mối liên hệ giữa hành vi vay tiêu dùng (loan) và tình trạng nợ tín dụng quá hạn (default). Nhóm có vay tiêu dùng được chọn làm nhóm tham chiếu, nhằm so sánh nguy cơ và khả năng nợ tín dụng ở nhóm không vay.

Kết quả như sau:

• Nguy cơ tương đối (Relative Risk – RR) của nhóm không vay so với nhóm có vay là 1.022451 → Điều này có nghĩa là xác suất nợ tín dụng quá hạn ở nhóm không vay cao hơn 2.25% so với nhóm có vay.

• Tỷ số chênh (Odds Ratio – OR) giữa hai nhóm là 2.680628 → Diễn giải rằng khả năng nợ tín dụng quá hạn (odds) ở nhóm không vay cao gấp 2.68 lần so với nhóm có vay.

Tóm lại, cả RR và OR đều lớn hơn 1 và có ý nghĩa thống kê, cho thấy nhóm khách hàng không vay tiêu dùng có nguy cơ và khả năng nợ tín dụng quá hạn cao hơn đáng kể so với nhóm có vay tiêu dùng.

4.3 Marital – Tình trạng hôn nhân

Khách hàng đã kết hôn có xu hướng vay tiêu dùng khác với người chưa kết hôn không?

4.3.1 Gộp dữ liệu và tạo bảng tần số

data1$marital_grouped <- ifelse(data1$marital == "married", "married", "others")
table_marital <- table(data1$loan, data1$marital_grouped)
table_marital

##      
##       married others
##   no     2232   1418
##   yes     448    236

4.3.2 Vẽ đồ thị phân tích

df_marital <- as.data.frame(table_marital)
colnames(df_marital) <- c("Loan", "Marital", "Count")

ggplot(df_marital, aes(x = Marital, y = Count, fill = Loan)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(
    title = "Phân bố vay tiêu dùng theo tình trạng hôn nhân",
    x = "Tình trạng hôn nhân",
    y = "Số lượng",
    fill = "Vay tiêu dùng"
  ) +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

4.3.3 Tính Relative Risk và Odd Ratio

mat_marital <- matrix(c(
  sum(data1$loan == "yes" & data1$marital_grouped == "married"),
  sum(data1$loan == "yes" & data1$marital_grouped == "others"),
  sum(data1$loan == "no" & data1$marital_grouped == "married"),
  sum(data1$loan == "no" & data1$marital_grouped == "others")
),
byrow = TRUE, nrow = 2,
dimnames = list(Loan = c("yes", "no"), Marital = c("married", "others")))

mat_marital

##      Marital
## Loan  married others
##   yes     448    236
##   no     2232   1418

rr_marital <- riskratio(mat_marital)
rr_marital$measure

##      risk ratio with 95% C.I.
## Loan  estimate   lower    upper
##   yes 1.000000      NA       NA
##   no  1.125972 1.00769 1.258137

or_marital <- oddsratio(mat_marital)
or_marital$measure

##      odds ratio with 95% C.I.
## Loan  estimate    lower    upper
##   yes 1.000000       NA       NA
##   no  1.205617 1.016948 1.432372

Trong phân tích này, khách hàng được chia thành hai nhóm: đã kết hôn (married) và khác (others – bao gồm độc thân, ly hôn…). Nhóm khách hàng có vay tiêu dùng (Loan = yes) được chọn làm nhóm tham chiếu.

Kết quả cho thấy

• Nguy cơ tương đối (RR) của nhóm không vay tiêu dùng so với nhóm vay tiêu dùng là 1.126, nghĩa là xác suất không vay tiêu dùng của nhóm chưa kết hôn cao hơn 12.6% so với nhóm đã kết hôn. Khoảng tin cậy 95% là [1.008 ; 1.258], cho thấy sự khác biệt có ý nghĩa thống kê.

• Tương tự, tỷ số chênh (OR) là 1.2056, tức là odds không vay tiêu dùng của nhóm chưa kết hôn cao hơn khoảng 20.56% so với nhóm đã kết hôn. Khoảng tin cậy 95% là [1.017 ; 1.432], tiếp tục khẳng định kết quả có ý nghĩa thống kê.

Như vậy, khách hàng đã kết hôn có xu hướng vay tiêu dùng nhiều hơn so với nhóm chưa kết hôn.

4.4 Job – Nghề nghiệp

Liệu nhóm người thất nghiệp có xu hướng vay tiêu dùng khác biệt so với các nhóm nghề còn lại không?

4.4.1 Gộp dữ liệu và tạo bảng tần số

data1$job_grouped <- ifelse(data1$job == "unemployed", "unemployed", "others")
table_job <- table(data1$loan, data1$job_grouped)
table_job

##      
##       others unemployed
##   no    3537        113
##   yes    671         13

4.4.2 Vẽ đồ thị phân tích

df_job <- as.data.frame(table_job)
colnames(df_job) <- c("Loan", "Job_Group", "Count")

ggplot(df_job, aes(x = Job_Group, y = Count, fill = Loan)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(
    title = "Phân bố vay tiêu dùng theo nghề nghiệp (thất nghiệp vs còn lại)",
    x = "Nhóm nghề nghiệp",
    y = "Số lượng",
    fill = "Vay tiêu dùng"
  ) +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

4.4.3 Tính Relative Risk và Odd Ratio

mat_job <- matrix(c(
  sum(data1$loan == "yes" & data1$job_grouped == "unemployed"),
  sum(data1$loan == "no" & data1$job_grouped == "unemployed"),
  sum(data1$loan == "yes" & data1$job_grouped == "others"),
  sum(data1$loan == "no" & data1$job_grouped == "others")
),
byrow = TRUE, nrow = 2,
dimnames = list(Loan = c("yes", "no"), Job = c("unemployed", "others")))

mat_job

##      Job
## Loan  unemployed others
##   yes         13    113
##   no         671   3537

rr_job <- riskratio(mat_job)
rr_job$measure

##      risk ratio with 95% C.I.
## Loan   estimate     lower     upper
##   yes 1.0000000        NA        NA
##   no  0.9372413 0.8820711 0.9958623

or_job <- oddsratio(mat_job)
or_job$measure

##      odds ratio with 95% C.I.
## Loan   estimate     lower    upper
##   yes 1.0000000        NA       NA
##   no  0.6131379 0.3264265 1.055025

Trong phân tích này, khách hàng được chia thành hai nhóm nghề nghiệp: thất nghiệp (unemployed) và các nhóm nghề còn lại (others). Nhóm khách hàng có vay tiêu dùng (Loan = yes) được chọn làm nhóm tham chiếu.

Kết quả cho thấy

• Nguy cơ tương đối (RR) là 0.9372, nghĩa là xác suất không vay tiêu dùng của nhóm còn lại chỉ bằng 93.72% so với nhóm thất nghiệp. Khoảng tin cậy 95% là [0.8821 ; 0.9959], cho thấy sự khác biệt có ý nghĩa thống kê.

• Trong khi đó, tỷ số chênh (OR) là 0.6131, tức là odds không vay tiêu dùng của nhóm nghề nghiệp còn lại thấp hơn khoảng 38.7% so với nhóm thất nghiệp. Tuy nhiên, khoảng tin cậy 95% là [0.3264 ; 1.0550], có chứa 1, nên kết quả này chưa đủ bằng chứng để kết luận có sự khác biệt thống kê ở mức ý nghĩa 5%.

Như vậy, có thể kết luận rằng nhóm khách hàng thất nghiệp có xu hướng không vay tiêu dùng cao hơn so với các nhóm nghề còn lại, và sự khác biệt này có ý nghĩa thống kê khi xét theo RR, nhưng chưa rõ ràng theo OR.

---

5 Hồi quy Logistic

Sau khi thực hiện phân tích nguy cơ tương đối (Relative Risk) và tỷ số chênh (Odds Ratio) để khám phá mối liên hệ giữa hành vi vay tiêu dùng với từng biến độc lập, bước tiếp theo là xây dựng mô hình hồi quy logistic nhằm đánh giá đồng thời tác động của các yếu tố này đến khả năng vay tiêu dùng của khách hàng.

# Hồi quy logistic
model_logit <- glm(loan ~ job + education + marital + default,
                   data = data1,
                   family = binomial)

# Tóm tắt kết quả
summary(model_logit)

## 
## Call:
## glm(formula = loan ~ job + education + marital + default, family = binomial, 
##     data = data1)
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)        -1.58836    0.20458  -7.764 8.22e-15 ***
## jobblue-collar     -0.08718    0.15435  -0.565 0.572185    
## jobentrepreneur     0.44778    0.22476   1.992 0.046340 *  
## jobhousemaid       -0.60363    0.34688  -1.740 0.081833 .  
## jobmanagement      -0.33188    0.17955  -1.848 0.064543 .  
## jobretired         -0.28758    0.23024  -1.249 0.211644    
## jobself-employed   -0.09880    0.23845  -0.414 0.678629    
## jobservices        -0.11508    0.17553  -0.656 0.512067    
## jobstudent         -2.58693    1.01624  -2.546 0.010909 *  
## jobtechnician      -0.21448    0.15634  -1.372 0.170112    
## jobunemployed      -0.68802    0.31788  -2.164 0.030430 *  
## jobunknown         -1.51908    1.03125  -1.473 0.140740    
## educationsecondary  0.33074    0.13543   2.442 0.014601 *  
## educationtertiary   0.05984    0.17065   0.351 0.725858    
## maritalmarried     -0.07152    0.12961  -0.552 0.581097    
## maritalsingle      -0.33498    0.14894  -2.249 0.024508 *  
## defaultyes          0.93740    0.25773   3.637 0.000276 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3779.6  on 4333  degrees of freedom
## Residual deviance: 3698.3  on 4317  degrees of freedom
## AIC: 3732.3
## 
## Number of Fisher Scoring iterations: 6

Trong mô hình hồi quy logistic, mỗi hệ số (coefficient) phản ánh log odds của khả năng xảy ra sự kiện quan tâm (ở đây là vay tiêu dùng) khi biến độc lập thay đổi, so với nhóm tham chiếu và giữ các biến khác không đổi. Các hệ số dương cho thấy xác suất vay tăng, trong khi hệ số âm cho thấy xác suất vay giảm.

Biến education – Trình độ học vấn

• educationsecondary (hệ số = 0.331, p = 0.015): → So với khách hàng học tiểu học, nhóm có trình độ trung học có log odds vay tiêu dùng cao hơn 0.331 đơn vị. → Nếu chuyển đổi sang odds ratio: exp(0.331) ≈ 1.39, nghĩa là nhóm học vấn trung học có odds vay cao hơn 39% so với nhóm học vấn tiểu học. → Kết luận: Trình độ học vấn trung học có ảnh hưởng tích cực và có ý nghĩa thống kê đến hành vi vay tiêu dùng.

• educationtertiary (hệ số = 0.060, p = 0.726): → Khác biệt không có ý nghĩa thống kê. Odds của nhóm có trình độ đại học không khác đáng kể so với nhóm tiểu học.

Biến job – Nghề nghiệp

Biến này gồm nhiều nhóm so sánh với nhóm tham chiếu là “admin.”:

• jobentrepreneur (hệ số = 0.448, p = 0.046): → Log odds vay tăng 0.448 so với nhóm admin → odds tăng khoảng 56.5% (exp(0.448) ≈ 1.565). → Kết luận: Người tự doanh có xu hướng vay cao hơn nhân viên hành chính và sự khác biệt có ý nghĩa thống kê.

• jobstudent (hệ số = -2.587, p = 0.011): → Hệ số âm lớn và có ý nghĩa thống kê: odds vay giảm khoảng 92% (exp(-2.587) ≈ 0.075). → Kết luận: Sinh viên có xác suất vay tiêu dùng thấp hơn rất nhiều, đây là kết quả có ý nghĩa thực tiễn mạnh.

• jobunemployed (hệ số = -0.688, p = 0.030): → Giảm odds vay tiêu dùng khoảng 50% (exp(-0.688) ≈ 0.503). → Kết luận: Người thất nghiệp cũng có xu hướng vay thấp hơn, với mức giảm có ý nghĩa thống kê.

Các nhóm khác như blue-collar, retired, housemaid, technician, unknown… đều không có hệ số ý nghĩa thống kê (p > 0.05), tức là không có bằng chứng mạnh mẽ cho thấy họ khác biệt về hành vi vay so với nhóm admin.

Biến marital – Tình trạng hôn nhân

Nhóm tham chiếu là đã ly hôn (divorced):

• maritalsingle (hệ số = -0.335, p = 0.025): → Odds giảm khoảng 28% (exp(-0.335) ≈ 0.715). → Người độc thân có xu hướng vay tiêu dùng thấp hơn so với người đã ly hôn, và sự khác biệt này có ý nghĩa thống kê.

• married (hệ số = -0.072, p = 0.581): → Không có ý nghĩa thống kê → không thể kết luận có sự khác biệt với người ly hôn.

Biến default – Nợ tín dụng quá hạn

defaultyes (hệ số = 0.937, p < 0.001): → Là một trong những biến quan trọng nhất của mô hình. → Odds tăng gấp 2.55 lần so với người không nợ (exp(0.937) ≈ 2.552). → Kết luận: Khách hàng có lịch sử nợ xấu có khả năng vay cao hơn nhiều — điều này có thể phản ánh sự lặp lại hành vi tài chính rủi ro, hoặc chiến lược nhắm mục tiêu khách hàng nhiều rủi ro của ngân hàng.

6 Tổng kết kết quả hồi quy logistic và giả thuyết thống kê

Mô hình hồi quy logistic được xây dựng để phân tích các yếu tố ảnh hưởng đến khả năng vay tiêu dùng (loan). Trong đó, các biến độc lập gồm: job, education, marital, và default.

Đối với mỗi biến giải thích (biến độc lập), giả thuyết thống kê được đặt ra như sau:

• Giả thuyết không (H₀): Hệ số hồi quy bằng 0 (biến độc lập không ảnh hưởng đến xác suất vay tiêu dùng).
• Giả thuyết đối (H₁): Hệ số hồi quy khác 0 (biến độc lập có ảnh hưởng đến xác suất vay tiêu dùng).

Kết quả mô hình chỉ ra một số biến có ý nghĩa thống kê, tức là có bằng chứng để bác bỏ H₀ ở mức ý nghĩa 5%:

6.1 Các biến có ảnh hưởng đáng kể đến hành vi vay tiêu dùng:

• defaultyes (p = 0.0003):
  → Bác bỏ H₀. Khách hàng có nợ tín dụng quá hạn có xác suất vay tiêu dùng cao hơn đáng kể.
  → OR > 1 cho thấy tăng khả năng vay.

• jobstudent (p = 0.0109):
  → Bác bỏ H₀. Nhóm sinh viên có xác suất vay tiêu dùng thấp hơn nhiều so với nhóm nghề nghiệp tham chiếu (admin).
  → OR < 1 cho thấy giảm khả năng vay.

• jobunemployed (p = 0.0304):
  → Bác bỏ H₀. Người thất nghiệp ít có khả năng vay tiêu dùng hơn.
  → OR < 1, phản ánh sự hạn chế tiếp cận tín dụng.

• jobentrepreneur (p = 0.0463):
  → Bác bỏ H₀. Nhóm doanh nhân có khả năng vay tiêu dùng cao hơn.

• educationsecondary (p = 0.0146):
  → Bác bỏ H₀. Trình độ học vấn trung học làm tăng xác suất vay tiêu dùng so với tiểu học.

• maritalsingle (p = 0.0245):
  → Bác bỏ H₀. Nhóm độc thân có xu hướng vay ít hơn so với nhóm ly hôn (tham chiếu).

6.2 Các biến không có ý nghĩa thống kê (p > 0.05)

• Các biến như jobblue-collar, jobretired, educationtertiary, maritalmarried không đủ bằng chứng để bác bỏ H₀. Điều này có nghĩa là chưa có cơ sở thống kê để khẳng định những biến này ảnh hưởng đến xác suất vay tiêu dùng trong mô hình.

---

7 Hồi quy Probit

Sau khi thực hiện mô hình hồi quy logistic, tác giả tiếp tục triển khai mô hình hồi quy Probit nhằm kiểm tra độ nhất quán và tính nhạy của các kết quả. Mô hình Probit sử dụng hàm liên kết phân phối chuẩn tích lũy để mô phỏng xác suất khách hàng vay tiêu dùng (loan = yes) dựa trên các biến độc lập như nghề nghiệp, trình độ học vấn, tình trạng hôn nhân và lịch sử nợ xấu (default).

Giả thuyết thống kê

Đối với từng biến độc lập trong mô hình, ta kiểm định:

• H₀: Biến không có ảnh hưởng đến xác suất vay tiêu dùng
• H₁: Biến có ảnh hưởng đến xác suất vay tiêu dùng

Mức ý nghĩa sử dụng là 5% (α = 0.05). Nếu p-value < 0.05, ta bác bỏ H₀.

7.0.1 Kết quả mô hình Probit

# Chạy mô hình probit
model_probit <- glm(loan ~ job + education + marital + default,
                    data = data1,
                    family = binomial(link = "probit"))

# Hiển thị kết quả
summary(model_probit)

## 
## Call:
## glm(formula = loan ~ job + education + marital + default, family = binomial(link = "probit"), 
##     data = data1)
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)        -0.95148    0.11423  -8.330  < 2e-16 ***
## jobblue-collar     -0.04945    0.08733  -0.566 0.571234    
## jobentrepreneur     0.25600    0.13113   1.952 0.050907 .  
## jobhousemaid       -0.32254    0.18134  -1.779 0.075288 .  
## jobmanagement      -0.18647    0.09917  -1.880 0.060054 .  
## jobretired         -0.16692    0.12751  -1.309 0.190520    
## jobself-employed   -0.06293    0.13357  -0.471 0.637561    
## jobservices        -0.06470    0.09927  -0.652 0.514542    
## jobstudent         -1.19238    0.39451  -3.022 0.002507 ** 
## jobtechnician      -0.12132    0.08785  -1.381 0.167308    
## jobunemployed      -0.37298    0.16658  -2.239 0.025157 *  
## jobunknown         -0.76093    0.46589  -1.633 0.102407    
## educationsecondary  0.18140    0.07419   2.445 0.014476 *  
## educationtertiary   0.03537    0.09280   0.381 0.703059    
## maritalmarried     -0.03876    0.07259  -0.534 0.593391    
## maritalsingle      -0.18677    0.08238  -2.267 0.023374 *  
## defaultyes          0.54800    0.15588   3.516 0.000439 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3779.6  on 4333  degrees of freedom
## Residual deviance: 3698.3  on 4317  degrees of freedom
## AIC: 3732.3
## 
## Number of Fisher Scoring iterations: 6

8 Thống kê mô tả

loan_tab <- table(data$loan)
barplot(loan_tab, col = c("skyblue", "orange"), main = "Phân bố vay tiêu dùng", ylab = "Số lượng")

prop.table(loan_tab)

## 
##        no       yes 
## 0.8471577 0.1528423

9 Phân tích Chi bình phương, RR, OR

# Kiểm định Chi bình phương
chisq.test(table(data$loan, data$education))

## 
##  Pearson's Chi-squared test
## 
## data:  table(data$loan, data$education)
## X-squared = 39.798, df = 3, p-value = 1.176e-08

chisq.test(table(data$loan, data$housing))

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table(data$loan, data$housing)
## X-squared = 1.4374, df = 1, p-value = 0.2306

chisq.test(table(data$loan, data$marital))

## 
##  Pearson's Chi-squared test
## 
## data:  table(data$loan, data$marital)
## X-squared = 10.88, df = 2, p-value = 0.004339

# Relative Risk và Odds Ratio
rr1 <- riskratio(table(data$loan, data$housing))
rr2 <- riskratio(table(data$loan, data$default))

# Gộp education lại làm nhóm high/low
data$edu_bin <- ifelse(data$education == "tertiary", "high", "low")
rr3 <- riskratio(table(data$loan, data$edu_bin))

rr1

## $data
##        
##           no  yes Total
##   no    1677 2153  3830
##   yes    285  406   691
##   Total 1962 2559  4521
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate     lower    upper
##   no  1.000000        NA       NA
##   yes 1.045208 0.9760694 1.119244
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   no          NA           NA         NA
##   yes   0.214876    0.2266007  0.2147536
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

rr2

## $data
##        
##           no yes Total
##   no    3779  51  3830
##   yes    666  25   691
##   Total 4445  76  4521
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate    lower    upper
##   no  1.000000       NA       NA
##   yes 2.717006 1.695398 4.354211
## 
## $p.value
##      two-sided
##         midp.exact fisher.exact   chi.square
##   no            NA           NA           NA
##   yes 0.0001173576 0.0001325964 1.686155e-05
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

rr3

## $data
##        
##         high  low Total
##   no    1176 2654  3830
##   yes    174  517   691
##   Total 1350 3171  4521
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate    lower    upper
##   no  1.000000       NA       NA
##   yes 1.079718 1.028993 1.132943
## 
## $p.value
##      two-sided
##        midp.exact fisher.exact  chi.square
##   no           NA           NA          NA
##   yes 0.003151701  0.003325888 0.003495297
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

10 Hồi quy Logistic

model_logit <- glm(loan ~ age + job + marital + education + default + housing + contact,
                   data = data, family = binomial(link = "logit"))
summary(model_logit)

## 
## Call:
## glm(formula = loan ~ age + job + marital + education + default + 
##     housing + contact, family = binomial(link = "logit"), data = data)
## 
## Coefficients:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)        -1.178525   0.329099  -3.581 0.000342 ***
## age                -0.007839   0.005196  -1.509 0.131399    
## jobblue-collar     -0.103687   0.154434  -0.671 0.501966    
## jobentrepreneur     0.426384   0.223481   1.908 0.056401 .  
## jobhousemaid       -0.411495   0.327034  -1.258 0.208296    
## jobmanagement      -0.307045   0.178470  -1.720 0.085355 .  
## jobretired         -0.185252   0.249837  -0.741 0.458396    
## jobself-employed   -0.088828   0.238548  -0.372 0.709618    
## jobservices        -0.112180   0.174801  -0.642 0.521030    
## jobstudent         -2.734139   1.016134  -2.691 0.007130 ** 
## jobtechnician      -0.214554   0.155763  -1.377 0.168378    
## jobunemployed      -0.697566   0.317785  -2.195 0.028157 *  
## jobunknown         -1.670462   1.028412  -1.624 0.104309    
## maritalmarried     -0.067450   0.129712  -0.520 0.603064    
## maritalsingle      -0.388726   0.156069  -2.491 0.012748 *  
## educationsecondary  0.296682   0.137480   2.158 0.030927 *  
## educationtertiary  -0.002919   0.173300  -0.017 0.986561    
## educationunknown   -1.297147   0.406230  -3.193 0.001407 ** 
## defaultyes          0.978165   0.253887   3.853 0.000117 ***
## housingyes         -0.037839   0.090870  -0.416 0.677115    
## contacttelephone    0.013655   0.176674   0.077 0.938392    
## contactunknown     -0.100777   0.096938  -1.040 0.298524    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3866.4  on 4520  degrees of freedom
## Residual deviance: 3753.7  on 4499  degrees of freedom
## AIC: 3797.7
## 
## Number of Fisher Scoring iterations: 6

11 Hồi quy Probit

model_probit <- glm(loan ~ age + job + marital + education + default + housing + contact,
                    data = data, family = binomial(link = "probit"))
summary(model_probit)

## 
## Call:
## glm(formula = loan ~ age + job + marital + education + default + 
##     housing + contact, family = binomial(link = "probit"), data = data)
## 
## Coefficients:
##                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)        -0.7271617  0.1821922  -3.991 6.57e-05 ***
## age                -0.0043173  0.0028555  -1.512 0.130554    
## jobblue-collar     -0.0619725  0.0870289  -0.712 0.476408    
## jobentrepreneur     0.2379582  0.1295090   1.837 0.066153 .  
## jobhousemaid       -0.2108010  0.1734828  -1.215 0.224323    
## jobmanagement      -0.1695078  0.0982353  -1.726 0.084432 .  
## jobretired         -0.1119851  0.1375354  -0.814 0.415515    
## jobself-employed   -0.0542759  0.1331695  -0.408 0.683589    
## jobservices        -0.0619023  0.0986216  -0.628 0.530217    
## jobstudent         -1.2599311  0.3931070  -3.205 0.001350 ** 
## jobtechnician      -0.1199374  0.0872809  -1.374 0.169394    
## jobunemployed      -0.3772845  0.1663065  -2.269 0.023292 *  
## jobunknown         -0.8183526  0.4494684  -1.821 0.068651 .  
## maritalmarried     -0.0348699  0.0722885  -0.482 0.629542    
## maritalsingle      -0.2126583  0.0860073  -2.473 0.013415 *  
## educationsecondary  0.1610728  0.0752378   2.141 0.032286 *  
## educationtertiary  -0.0021571  0.0940543  -0.023 0.981702    
## educationunknown   -0.6380585  0.1868779  -3.414 0.000639 ***
## defaultyes          0.5735549  0.1531773   3.744 0.000181 ***
## housingyes         -0.0188070  0.0500329  -0.376 0.706996    
## contacttelephone   -0.0003741  0.0972035  -0.004 0.996929    
## contactunknown     -0.0546517  0.0533416  -1.025 0.305570    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 3866.4  on 4520  degrees of freedom
## Residual deviance: 3754.0  on 4499  degrees of freedom
## AIC: 3798
## 
## Number of Fisher Scoring iterations: 6

12 Đánh giá mô hình

p_logit <- predict(model_logit, type = "response")
roc_logit <- roc(data$loan, p_logit)
plot(roc_logit, col = "blue", main = "ROC Curve: Logistic vs Probit")
auc(roc_logit)

## Area under the curve: 0.6139

p_probit <- predict(model_probit, type = "response")
roc_probit <- roc(data$loan, p_probit)
lines(roc_probit, col = "red")
legend("bottomright", legend = c("Logistic", "Probit"), col = c("blue", "red"), lty = 1)

13 Bảng so sánh Logistic và Probit

stargazer(model_logit, model_probit, type = "text", title = "So sánh hồi quy logistic & probit")

## 
## So sánh hồi quy logistic & probit
## ===============================================
##                        Dependent variable:     
##                    ----------------------------
##                                loan            
##                       logistic       probit    
##                         (1)            (2)     
## -----------------------------------------------
## age                    -0.008        -0.004    
##                       (0.005)        (0.003)   
##                                                
## jobblue-collar         -0.104        -0.062    
##                       (0.154)        (0.087)   
##                                                
## jobentrepreneur        0.426*        0.238*    
##                       (0.223)        (0.130)   
##                                                
## jobhousemaid           -0.411        -0.211    
##                       (0.327)        (0.173)   
##                                                
## jobmanagement         -0.307*        -0.170*   
##                       (0.178)        (0.098)   
##                                                
## jobretired             -0.185        -0.112    
##                       (0.250)        (0.138)   
##                                                
## jobself-employed       -0.089        -0.054    
##                       (0.239)        (0.133)   
##                                                
## jobservices            -0.112        -0.062    
##                       (0.175)        (0.099)   
##                                                
## jobstudent           -2.734***      -1.260***  
##                       (1.016)        (0.393)   
##                                                
## jobtechnician          -0.215        -0.120    
##                       (0.156)        (0.087)   
##                                                
## jobunemployed         -0.698**      -0.377**   
##                       (0.318)        (0.166)   
##                                                
## jobunknown             -1.670        -0.818*   
##                       (1.028)        (0.449)   
##                                                
## maritalmarried         -0.067        -0.035    
##                       (0.130)        (0.072)   
##                                                
## maritalsingle         -0.389**      -0.213**   
##                       (0.156)        (0.086)   
##                                                
## educationsecondary    0.297**        0.161**   
##                       (0.137)        (0.075)   
##                                                
## educationtertiary      -0.003        -0.002    
##                       (0.173)        (0.094)   
##                                                
## educationunknown     -1.297***      -0.638***  
##                       (0.406)        (0.187)   
##                                                
## defaultyes            0.978***      0.574***   
##                       (0.254)        (0.153)   
##                                                
## housingyes             -0.038        -0.019    
##                       (0.091)        (0.050)   
##                                                
## contacttelephone       0.014         -0.0004   
##                       (0.177)        (0.097)   
##                                                
## contactunknown         -0.101        -0.055    
##                       (0.097)        (0.053)   
##                                                
## Constant             -1.179***      -0.727***  
##                       (0.329)        (0.182)   
##                                                
## -----------------------------------------------
## Observations           4,521          4,521    
## Log Likelihood       -1,876.863    -1,876.992  
## Akaike Inf. Crit.    3,797.725      3,797.984  
## ===============================================
## Note:               *p<0.1; **p<0.05; ***p<0.01