1. Giới thiệu dữ liệu

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’.

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.2     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.1     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(DescTools)
## Warning: package 'DescTools' was built under R version 4.3.3
library(dplyr)
library(DT)
## Warning: package 'DT' was built under R version 4.3.1
library(AER)
## Loading required package: car
## Loading required package: carData
## 
## Attaching package: 'car'
## 
## The following object is masked from 'package:DescTools':
## 
##     Recode
## 
## The following object is masked from 'package:dplyr':
## 
##     recode
## 
## The following object is masked from 'package:purrr':
## 
##     some
## 
## Loading required package: lmtest
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## Loading required package: sandwich
## Loading required package: survival
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

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'))

2. Bảng tần số

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).

3. Vẽ đồ thị

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.

4. Ước lượng tỷ lệ

Đối với nhóm người có nợ xấu

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\).

Đối với nhóm người không có nợ xấu

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%.

5. Ước lượng chênh lệch tỷ lệ

Đối với nhóm người có nợ xấu

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.

Đối với nhóm người không có nợ xấu

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.

6. Relative Risk

Ước lượng Relative Risk

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à.

Khoảng ước lượng Relative Risk

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.

7. Odd ratio

Ước lượng Odd ratio

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.

Khoảng ước lượng Odd ratio

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

8. Hồi quy

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