Dữ liệu HMDA từ package AER nói về các điều kiện để 1 người được cấp khoản vay để mua nhà (thế chấp nhà).
Tập dữ liệu gồm 2380 số quan sát với 14 biến. Tôi chỉ sử dụng hai biến định tính từ tập dữ liệu này là ‘deny’ và ‘phist’.
deny : Khoản vay để mua nhà có bị từ chối hay không? ‘Yes’ là bị từ chối, ‘No’ là được chấp nhận.
phist : Người này có khoản nợ xấu nào không? ‘Yes’ là có, ‘No’ là không có.
library(tidyverse)
library(DescTools)
library(dplyr)
library(DT)
library(AER)
data('HMDA')
hm <- HMDA
datatable(hm)
Đổi tên các biểu hiện ‘yes’, ‘no’ của 2 biến deny và phist
Đối với biến deny: ‘yes’ đổi thành ‘tuchoi’ và ‘yes’ đổi thành ‘chapnhan’
Đối với biến phist: ‘yes’ đổi thành ‘conoxau’ và ‘yes’ đổi thành ‘khongconoxau’
hm$deny <- factor(hm$deny, levels = c('yes','no'), labels = c('tuchoi','chapnhan'))
hm$phist <- factor(hm$phist, levels = c('yes','no'), labels = c('conoxau','khongconoxau'))
f <- table(hm$phist, hm$deny)
addmargins(f)
##
## tuchoi chapnhan Sum
## conoxau 76 99 175
## khongconoxau 209 1996 2205
## Sum 285 2095 2380
ff <- addmargins(prop.table(f))
ff
##
## tuchoi chapnhan Sum
## conoxau 0.03193277 0.04159664 0.07352941
## khongconoxau 0.08781513 0.83865546 0.92647059
## Sum 0.11974790 0.88025210 1.00000000
Dựa vào bảng thống kê ta thấy trong tổng số 2380 người được khảo sát thì số người bị cho vay mua nhà là 285 người (chiếm 11.97%). Trong đó, có 76 người là có khoản nợ xấu (chiếm 3.19% trong 285 người) và 209 người không có khoản nợ xấu nào (chiếm 8.78%).
Còn lại là 2095 người được chấp nhận cấp khoản vay mua nhà (88.025% trong tổng số người tham gia khảo sát). Trong đó, có 99 người có nợ xấu (4.16% trong 88.025%) và 1996 người không có nợ xấu (chiếm 83.86% còn lại).
ggplot(hm, aes(x = deny, y= after_stat(count)))+
geom_bar(fill = 'pink')+
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = -.5)+
labs(title= 'Số người bị từ chối thế chấp nhà')
ggplot(hm, aes(x = phist, y= after_stat(count)))+
geom_bar(fill = 'lightblue')+
geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = -.5)+
labs(title= 'Số người có nợ xấu')
ggplot(hm, aes(x=deny, fill = phist))+
geom_bar(position = 'dodge')+
labs(title = 'Số người')
Có thể thấy số người không có nợ xấu được cấp khoản vay để mua nhà là nhiều nhất và có cách biệt rõ rệt so với những người còn lại.
deny1 <- table(hm[hm$phist =='conoxau',]$deny)
deny1
##
## tuchoi chapnhan
## 76 99
prop.test(deny1['tuchoi'], sum(deny1), p=0.6)
##
## 1-sample proportions test with continuity correction
##
## data: deny1["tuchoi"] out of sum(deny1), null probability 0.6
## X-squared = 19.339, df = 1, p-value = 1.094e-05
## alternative hypothesis: true p is not equal to 0.6
## 95 percent confidence interval:
## 0.3602992 0.5112039
## sample estimates:
## p
## 0.4342857
Ta tiến hành lọc kết quả về khoản thế chấp nhà theo nhóm những người có nợ xấu. Kết quả thể hiện rằng cóp 76 người có nợ xấu bị từ chối cấp khoản vay và 99 người có nợ xấu được cấp khoản vay mua nhà.
Ước lượng tỷ lệ:
Đặt giả thuyết \(H_0\): Tỷ lệ người có nợ xấu bị từ chối thể chấp nhà là 60%.
Kết quả cho thấy giá trị p-value bằng 1.094e-05, nhỏ hơn giá trị \(\alpha = 0.05\). Nên bác bỏ giả thuyết tỷ lệ người có nợ xấu bị từ chối thế chấp nhà là 60%.
prop.test(deny1['chapnhan'], sum(deny1), p=0.3)
##
## 1-sample proportions test with continuity correction
##
## data: deny1["chapnhan"] out of sum(deny1), null probability 0.3
## X-squared = 57.578, df = 1, p-value = 3.248e-14
## alternative hypothesis: true p is not equal to 0.3
## 95 percent confidence interval:
## 0.4887961 0.6397008
## sample estimates:
## p
## 0.5657143
Giả thuyết \(H_0\): Tỷ lệ người có nợ xấu được chấp nhận thế chấp nhà là 30%.
Kết quả cho thấy p-value = 3.248e-14, rất nhỏ so với \(\alpha = 0.05\), nên bác bỏ giả thuyết \(H_0\).
deny2 <- table(hm[hm$phist =='khongconoxau',]$deny)
deny2
##
## tuchoi chapnhan
## 209 1996
prop.test(deny2['tuchoi'], sum(deny2), p=0.4)
##
## 1-sample proportions test with continuity correction
##
## data: deny2["tuchoi"] out of sum(deny2), null probability 0.4
## X-squared = 854.6, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.4
## 95 percent confidence interval:
## 0.08304019 0.10796449
## sample estimates:
## p
## 0.09478458
Tương tự như trên, ta tiến hành lọc kết quả về khoản thế chấp nhà theo nhóm những người không có nợ xấu. Kết quả thể hiện rằng có 209 người không có nợ xấu bị từ chối cấp khoản vay và 1996 người không có nợ xấu được cấp khoản vay mua nhà.
Ước lượng tỷ lệ:
Đặt giả thuyết \(H_0\): Tỷ lệ người không có nợ xấu bị từ chối thể chấp nhà là 40%.
Kết quả cho thấy giá trị p-value < 2.2e-16, rất nhỏ so với giá trị \(\alpha = 0.05\). Nên bác bỏ giả thuyết tỷ lệ người có không nợ xấu bị từ chối thế chấp nhà là 40%.
prop.test(deny2['chapnhan'], sum(deny2), p=0.8)
##
## 1-sample proportions test with continuity correction
##
## data: deny2["chapnhan"] out of sum(deny2), null probability 0.8
## X-squared = 151.91, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.8
## 95 percent confidence interval:
## 0.8920355 0.9169598
## sample estimates:
## p
## 0.9052154
Giả thuyết \(H_0\): Tỷ lệ người không có nợ xấu được chấp nhận thế chấp nhà là 80%.
Kết quả cho thấy p-value rất nhỏ so với \(\alpha = 0.05\), nên bác bỏ giả thuyết \(H_0\). Kết luận rằng tỷ lệ nhóm người không có nợ xấu được chấp nhận thế chấp nhà không phải là 80%.
hm_tuchoi <- hm[hm$deny == 'tuchoi',]
hm_chapnhan <- hm[hm$deny == 'chapnhan',]
tuchoi_conoxau <- hm_tuchoi[hm_tuchoi$phist == 'conoxau',]
chapnhan_conoxau <- hm_chapnhan[hm_chapnhan$phist == 'conoxau',]
a <- c(nrow(hm_tuchoi), nrow(hm_chapnhan))
a
## [1] 285 2095
b <- c(nrow(tuchoi_conoxau), nrow(chapnhan_conoxau))
b
## [1] 76 99
prop.test(b,a)
##
## 2-sample test for equality of proportions with continuity correction
##
## data: b out of a
## X-squared = 174.08, df = 1, p-value < 2.2e-16
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## 0.1652799 0.2735427
## sample estimates:
## prop 1 prop 2
## 0.26666667 0.04725537
Giả thuyết \(H_0\): Đối với nhóm người có nợ xấu, thì tỷ lệ bị từ chối và chấp nhận cấp khoản vay để mua nhà là như nhau.
Kết quả: p-value rất nhỏ so với \(\alpha= 0.05\), cho thấy không có cơ sở chấp nhận \(H_0\). Do đó, đối với nhóm người có nợ xấu, thì tỷ lệ bị từ chối và chấp nhận cấp khoản vay để mua nhà là khác nhau.
tuchoi_khongconoxau <- hm_tuchoi[hm_tuchoi$phist == 'khongconoxau',]
chapnhan_khongconoxau <- hm_chapnhan[hm_chapnhan$phist == 'khongconoxau',]
d <- c(nrow(tuchoi_khongconoxau), nrow(chapnhan_khongconoxau))
d
## [1] 209 1996
prop.test(d,a)
##
## 2-sample test for equality of proportions with continuity correction
##
## data: d out of a
## X-squared = 174.08, df = 1, p-value < 2.2e-16
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.2735427 -0.1652799
## sample estimates:
## prop 1 prop 2
## 0.7333333 0.9527446
Giả thuyết \(H_0\): Đối với nhóm người không có nợ xấu, thì tỷ lệ bị từ chối và chấp nhận cấp khoản vay để mua nhà là như nhau.
Kết quả: p-value rất nhỏ so với \(\alpha= 0.05\), cho thấy không có cơ sở chấp nhận \(H_0\). Do đó, đối với nhóm người không có nợ xấu, thì tỷ lệ bị từ chối và chấp nhận cấp khoản vay để mua nhà là khác nhau.
addmargins(f)
##
## tuchoi chapnhan Sum
## conoxau 76 99 175
## khongconoxau 209 1996 2205
## Sum 285 2095 2380
RelRisk(f)
## [1] 4.581818
RR > 1 trong trường hợp này cho thấy rằng người có nợ xấu có mức rủi ro cao hơn so với những người không có nợ xấu đối với việc từ chối thế chấp nhà.
RelRisk(f, conf.level=0.95)
## rel. risk lwr.ci upr.ci
## 4.581818 3.680715 5.629913
Ước lượng cho tỷ lệ rủi ro tương đối giữa nhóm có nợ xấu và không có nợ xấu là khoảng 4.58
Khoảng tin cậy 95% cho ước lượng này là từ khoảng 3.68 đến 5.63. Nghĩa là có 95% khả năng rằng giá trị thực sự của tỷ lệ rủi ro tương đối nằm trong khoảng từ 3.68 đến 5.63.
OddsRatio(f)
## [1] 7.331497
Tỷ lệ chênh lệch lớn > 1 trong trường hợp này thể hiện rằng những người có nợ xấu sẽ có khả năng bị từ chối cấp khoản vay mua nhà cao hơn so với nhũng người không có nợ xấu. Cụ thể, những người không có nợ xấu có khả năng được cấp khoản vay mua nhà gấp 7.33 lần so với những người có nợ xấu.
OddsRatio(f, conf.level = 0.95)
## odds ratio lwr.ci upr.ci
## 7.331497 5.264788 10.209498
Khoảng tin cậy 95% cho ước lượng này là từ khoảng 5.26 đến 10.21. Nghĩa là có 95% khả năng rằng giá trị thực sự của tỷ lệ chênh lệch nằm trong khoảng từ 5.26 đến 10.21
Thực hiện hồi quy biến phụ thuộc ‘deny’ theo biến độc lập ‘phist’ bằng lệnh glm
hoiquy <- glm(deny ~ phist, data = hm, family = binomial(link = "logit"))
hoiquy
##
## Call: glm(formula = deny ~ phist, family = binomial(link = "logit"),
## data = hm)
##
## Coefficients:
## (Intercept) phistkhongconoxau
## 0.2644 1.9922
##
## Degrees of Freedom: 2379 Total (i.e. Null); 2378 Residual
## Null Deviance: 1744
## Residual Deviance: 1622 AIC: 1626