Bài tập

library(AER)
library(tidyverse)
library(DT)
library(DescTools)
library(ggplot2)
library(epitools)
data("CreditCard")
d <- CreditCard
datatable(d)

1 Giải thích biến định tính

• Biến đầu tiên là card đại diện cho việc đơn đăng ký thẻ tín dụng của một cá nhân có được chấp nhận hay không. Nếu yes là đăng ký được chấp nhận và no là không được chấp nhận

• Biến định tính thứ hai được chọn lựa là owner biến này phản ánh tình trạng sở hữu nhà của cá nhân. Nó cho biết liệu một cá nhân có sở hữu nhà hay không. Kết quả thu được là yes thì cá nhân có sở hữu nhà và no thì không sở hữu

• Dựa vào đó chúng ta sẽ kiểm tra liệu việc sở hữu nhà có ảnh hưởng đến khả năng được chấp nhận thẻ tín dụng hay không.

2 Bảng tần số và đồ thị

# Thay đổi giá trị của biến `card`và owner
d$card <- recode(d$card, "yes" = "chapnhan", "no" = "tuchoi")
d$owner <- recode(d$owner, "yes" = "conha", "no" = "khongconha")

• Trước tiên chúng ta cần thay đổi các giá trị trong biến card thay vì là kết quả là “yes” sẽ được biến đổi thành “chapnhan” đại diện cho tình trạng đơn đăng ký thẻ tín dụng được chấp nhận và ngược lại “no” tương ứng với “tuchoi”.

• Tương tự với biến owner sẽ thay đổi “yes” thành “conha” và ngược lại “no” sẽ là “khongconha”. Để khi phân tích giữa hai biến tránh bị nhầm lẫn kết quả.

Biến card

table(d$card)%>% addmargins()

## 
##   tuchoi chapnhan      Sum 
##      296     1023     1319

c <- as.data.frame(table(d$card)) 
colnames(c) <- c("Card", "Count")

ggplot(c, aes(x = Card, y = Count, fill = Card)) +
  geom_bar(stat = "identity") +
  labs(title = "Biểu đồ cột", x = "Tình trạng đăng ký tín dụng", y = "Số lượng") +
  theme_minimal()

• Dựa vào kết quả bảng và đồ thị cột cho thấy Có 296 đơn đăng ký thẻ tín dụng bị từ chối trên tổng số 1319 đơn đăng ký.

• Ngoài ra có 1023 đơn đăng ký thẻ tín dụng được chấp nhận trên tổng số 1319 đơn đăng ký.

prop.table(table(d$card)) %>% addmargins()

## 
##    tuchoi  chapnhan       Sum 
## 0.2244124 0.7755876 1.0000000

# Tính tỷ lệ phần trăm
c1 <- prop.table(table(d$card)) * 100

# Vẽ biểu đồ tròn
pie(c1, labels = paste(names(c1), round(c1, 2), "%"),
    main = "Đồ thị tròn đăng ký thẻ")

• Dựa vào kết quả trên ta nhận thấy Có 296 đơn đăng ký thẻ tín dụng bị từ chối (no), chiếm khoảng 22.45% tổng số đơn đăng ký.

• Có 1023 đơn đăng ký thẻ tín dụng được chấp nhận (yes), chiếm khoảng 77.55% tổng số đơn đăng ký.

Biến owner

table(d$owner) %>% as.data.frame() ->o
colnames(o)<-c("value","count")
o

##        value count
## 1 khongconha   738
## 2      conha   581

ggplot(o, aes(x = value, y = count, fill = value)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = count), vjust = -0.3, size = 3.5) +
  labs(title = "Biểu đồ cột", x = "Tình trạng", y = "Số lượng") +
  theme_minimal()

• Dựa vào kết quả phân tích và độ thị cho thấy Có 738 cá nhân không sở hữu nhà và 581 cá nhân sở hữu nhà.

table(d$owner)  %>% prop.table() %>% addmargins()

## 
## khongconha      conha        Sum 
##  0.5595148  0.4404852  1.0000000

o1 <- prop.table(table(d$owner)) * 100
pie(o1, labels = paste(names(o1), round(o1, 2), "%"),
    main = "biểu đồ tròn")

- Trong tổng số người được khảo sát thì 738 cá nhân không sở hữu nhà chiếm khoảng 55.95% tổng số quan sát.

• Hơn thế, những cá nhân sở hữu nhà, chiếm khoảng 44.05% tổng số quan sát.

Bảng tần số cho hai biến

d1 <- table(d$owner,d$card)
addmargins(d1)

##             
##              tuchoi chapnhan  Sum
##   khongconha    206      532  738
##   conha          90      491  581
##   Sum           296     1023 1319

barplot(d1, beside = TRUE, legend = TRUE, 
        col = c("skyblue", "lightgreen"),
        main = "Biểu đồ tần suất giữa owner và card",
        xlab = "Card",
        ylab = "Tần suất",
        names.arg = c("tuchoi", "chapnhan"))

• Trong nhóm không sở hữu nhà, có 532 người được chấp nhận thẻ tín dụng và 206 người bị từ chối.

• Trong nhóm sở hữu nhà, có 491 người được chấp nhận thẻ tín dụng và 90 người bị từ chối.

table(d$owner,d$card) %>% prop.table() %>% addmargins()

##             
##                  tuchoi   chapnhan        Sum
##   khongconha 0.15617892 0.40333586 0.55951478
##   conha      0.06823351 0.37225171 0.44048522
##   Sum        0.22441243 0.77558757 1.00000000

• Tỷ lệ người không có nhà bị từ chối đơn tín dụng chiếm tỷ lệ là 15.62% trên tổng số đơn, cao hơn hơn so với tỷ lệ người có nhà bị từ chối giấy đăng ký tín dụng vì tỷ lệ này chiếm khoảng 6.8% so với tổng số đơn.

• Tỷ lệ người không có nhà được chấp nhận đơn tín dụng chiếm tỷ lệ là 40.33 so với tổng số. Ngược lại tỷ lệ người có nhà được chấp nhận đơn tín dụng chiếm 37.2% trên tổng số đơn tín dụng đăng ký.

3 Ước lượng tỷ lệ

Ước lượng tỷ lệ đối với người sở hữu nhà

# lọc người có sở hữu nhà 
owner_card_yes <- table(d[d$owner == "conha", ]$card)
owner_card_yes

## 
##   tuchoi chapnhan 
##       90      491

• Trước tiên ta cần lọc kết quả về tình trạng đơn đăng ký tín dụng theo nhóm người có sở hữu nhà. Kết quả thu được như trên.

# Ước lượng tỷ lệ đối với cá nhân được chấp nhận tín dụng 
prop.test(owner_card_yes["chapnhan"], sum(owner_card_yes), p = 0.7)

## 
##  1-sample proportions test with continuity correction
## 
## data:  owner_card_yes["chapnhan"] out of sum(owner_card_yes), null probability 0.7
## X-squared = 57.556, df = 1, p-value = 3.284e-14
## alternative hypothesis: true p is not equal to 0.7
## 95 percent confidence interval:
##  0.8124964 0.8730278
## sample estimates:
##         p 
## 0.8450947

• Sau đó ước lượng tỷ lệ với giả thuyết không (H0): Tỷ lệ người chấp nhận tín dụng (p) trong nhóm sở hữu nhà là 0.7 (70%).

• Kết quả từ kiểm định cho thấy giá trị p-value là 3.284e-14, rất gần với 0 và nhỏ hơn giá trị \(\alpha=0.05\). Điều này cho thấy có bằng chứng mạnh mẽ để bác bỏ giả thuyết rằng tỷ lệ người sở hữu thẻ tín dụng trong nhóm sở hữu nhà là 70%.

prop.test(owner_card_yes["tuchoi"], sum(owner_card_yes), p = 0.4)

## 
##  1-sample proportions test with continuity correction
## 
## data:  owner_card_yes["tuchoi"] out of sum(owner_card_yes), null probability 0.4
## X-squared = 144.4, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.4
## 95 percent confidence interval:
##  0.1269722 0.1875036
## sample estimates:
##         p 
## 0.1549053

• Phần này ước lượng tỷ lệ với giả thuyết không (H0): Tỷ lệ người không chấp nhận tín dụng (p) trong nhóm sở hữu nhà là 0.4 (40%).

• Dựa trên giá trị p-value rất nhỏ so với giá trị \(\alpha=0.05\), chúng ta có đủ bằng chứng để bác bỏ giả thuyết không và kết luận rằng tỷ lệ bị từ chối tín dụng của nhóm người sở hữu nhà là khác nhau so với giả thuyết ban đầu (40%).

Ước lượng tỷ lệ đối với cá nhân không sở hữu nhà

# lọc người có sở hữu nhà 
owner_card_no <- table(d[d$owner == "khongconha", ]$card)
owner_card_no

## 
##   tuchoi chapnhan 
##      206      532

• Lọc kết quả về tình trạng đơn đăng ký tín dụng theo nhóm người không sở hữu nhà. Kết quả thu được như trên và đã được giải thích phần lập bảng.

# Ước lượng tỷ lệ 
prop.test(owner_card_no["chapnhan"], sum(owner_card_no), p = 0.4)

## 
##  1-sample proportions test with continuity correction
## 
## data:  owner_card_no["chapnhan"] out of sum(owner_card_no), null probability 0.4
## X-squared = 315.25, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.4
## 95 percent confidence interval:
##  0.6867260 0.7526733
## sample estimates:
##         p 
## 0.7208672

• H0 (Giả thuyết không): Tỷ lệ chấp nhận tín dụng trong nhóm người không sở hữu nhà là bằng 40%.

• Dựa trên kết quả ta thấy giá trị p-value rất nhỏ so với giá trị \(\alpha=0.05\), chúng ta có đủ bằng chứng để bác bỏ giả thuyết không. Kết luận rằng tỷ lệ chấp nhận tín dụng của nhóm người không sở hữu nhà là khác nhau so với giả thuyết ban đầu (40%).

prop.test(owner_card_no["tuchoi"], sum(owner_card_no), p = 0.6)

## 
##  1-sample proportions test with continuity correction
## 
## data:  owner_card_no["tuchoi"] out of sum(owner_card_no), null probability 0.6
## X-squared = 315.25, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.6
## 95 percent confidence interval:
##  0.2473267 0.3132740
## sample estimates:
##         p 
## 0.2791328

• Ta có giả thuyết H0: Tỷ lệ bị từ chối tín dụng trong nhóm người không sở hữu nhà là bằng 60%.

• Với giá trị p-value rất nhỏ, chúng ta bác bỏ giả thuyết không. Do đó, chúng ta kết luận rằng tỷ lệ bị từ chối tín dụng trong nhóm người không sở hữu nhà không bằng 60%.

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

d_tuchoi <- d[d$card == 'tuchoi',]
d_chapnhan <- d[d$card == 'chapnhan',]

tuchoi_conha <- d_tuchoi[d_tuchoi$owner == 'conha',]
chapnhan_conha <- d_chapnhan[d_chapnhan$owner == 'conha' ,]

a <- c(nrow(d_tuchoi), nrow(d_chapnhan))
a

## [1]  296 1023

b <- c(nrow(tuchoi_conha), nrow(chapnhan_conha))
b

## [1]  90 491

prop.test(b,a)

## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  b out of a
## X-squared = 28.114, df = 1, p-value = 1.144e-07
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.2387763 -0.1130374
## sample estimates:
##    prop 1    prop 2 
## 0.3040541 0.4799609

• Giả thuyết của kiểm định là tỷ lệ người sở hữu nhà bị từ chối tín dụng bằng với tỷ lệ người người sở hữu nhà được chấp nhận tín dụng

• Giá trị p-value rất gần với 0 nhỏ hơn mức ý nghĩa 0.05, cho thấy có bằng chứng mạnh mẽ để bác bỏ giả thuyết không. Vì vậy tỷ lệ người sở hữu nhà bị từ chối tín dụng khác với tỷ lệ người người sở hữu nhà được chấp nhận tín dụng

4 Relative risk

Relative risk

addmargins(d1)

##             
##              tuchoi chapnhan  Sum
##   khongconha    206      532  738
##   conha          90      491  581
##   Sum           296     1023 1319

RelRisk(d1)

## [1] 1.801957

• RR > 1 trong trường hợp này cho thấy rằng người không sở hữu nhà có mức độ rủi ro cao hơn so với những người sở hữu nhà đối với việc bị từ chối thẻ tín dụng.

riskratio(d1)

## $data
##             
##              tuchoi chapnhan Total
##   khongconha    206      532   738
##   conha          90      491   581
##   Total         296     1023  1319
## 
## $measure
##             risk ratio with 95% C.I.
##              estimate    lower   upper
##   khongconha 1.000000       NA      NA
##   conha      1.172331 1.107586 1.24086
## 
## $p.value
##             two-sided
##                midp.exact fisher.exact   chi.square
##   khongconha           NA           NA           NA
##   conha      5.738991e-08 6.417142e-08 7.928759e-08
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

• Người không sở hữu nhà có tỷ số rủi ro là 1.000, người sở hữu nhà có tỷ số rủi ro là 1.172331, với khoảng tin cậy 95% từ 1.107586 đến 1.24086.

• Điều này có nghĩa là người sở hữu nhà có khả năng được chấp nhận tín dụng cao hơn 17.23% so với người không sở hữu nhà.

• Giá trị p nhỏ hơn 0.05, chúng ta bác bỏ giả thuyết không rằng không có sự khác biệt về tỷ lệ chấp nhận tín dụng giữa hai nhóm.

epitab(d1, method = 'riskratio', rev = 'c')

## $tab
##             
##              chapnhan        p0 tuchoi        p1 riskratio     lower     upper
##   khongconha      532 0.7208672    206 0.2791328 1.0000000        NA        NA
##   conha           491 0.8450947     90 0.1549053 0.5549521 0.4442401 0.6932555
##             
##                   p.value
##   khongconha           NA
##   conha      6.417142e-08
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

riskratio(d1, rev = 'c')

## $data
##             
##              chapnhan tuchoi Total
##   khongconha      532    206   738
##   conha           491     90   581
##   Total          1023    296  1319
## 
## $measure
##             risk ratio with 95% C.I.
##               estimate     lower     upper
##   khongconha 1.0000000        NA        NA
##   conha      0.5549521 0.4442401 0.6932555
## 
## $p.value
##             two-sided
##                midp.exact fisher.exact   chi.square
##   khongconha           NA           NA           NA
##   conha      5.738991e-08 6.417142e-08 7.928759e-08
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

• Người sở hữu nhà có tỷ số rủi ro là 0.5549521, với khoảng tin cậy 95% từ 0.4442401 đến 0.6932555.

• Điều này có nghĩa là người sở hữu nhà có nguy cơ bị từ chối tín dụng thấp hơn 44.50% so với người không sở hữu nhà.

• Giá trị p nhỏ hơn 0.05, chúng ta bác bỏ giả thuyết không rằng không có sự khác biệt về tỷ lệ từ chối tín dụng giữa hai nhóm.

Khoảng ước lượng cho Relative risk

m <- matrix(c(206 ,90 ,532,491),nrow = 2)
RelRisk(m, conf.level = .95)

## rel. risk    lwr.ci    upr.ci 
##  1.801957  1.445570  2.253737

• Ước lượng cho Tỷ lệ Rủi ro Tương đối giữa nhóm không sở hữu nhà và nhóm sở hữu nhà là khoảng 1.80.

• Khoảng tin cậy 95% cho ước lượng này là từ khoảng 1.45 đến 2.25. Điều này ngụ ý rằng 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ừ 1.45 đến 2.25.

5 Odd ratio

OddsRatio(d1)

## [1] 2.11249

oddsratio(d1)

## $data
##             
##              tuchoi chapnhan Total
##   khongconha    206      532   738
##   conha          90      491   581
##   Total         296     1023  1319
## 
## $measure
##             odds ratio with 95% C.I.
##              estimate   lower    upper
##   khongconha  1.00000      NA       NA
##   conha       2.10957 1.60448 2.791356
## 
## $p.value
##             two-sided
##                midp.exact fisher.exact   chi.square
##   khongconha           NA           NA           NA
##   conha      5.738991e-08 6.417142e-08 7.928759e-08
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

• Odds Ratio: Người sở hữu nhà có tỷ lệ chấp nhận tín dụng cao gấp 2.11 lần so với người không sở hữu nhà.

• Ý nghĩa thống kê: Giá trị p rất nhỏ cho thấy sự khác biệt này là có ý nghĩa thống kê.

• Khoảng tin cậy: Khoảng tin cậy 95% (từ 1.60448 đến 2.791356) không chứa giá trị 1, củng cố thêm sự tin cậy vào kết quả này.

oddsratio(d1, rev = 'c')

## $data
##             
##              chapnhan tuchoi Total
##   khongconha      532    206   738
##   conha           491     90   581
##   Total          1023    296  1319
## 
## $measure
##             odds ratio with 95% C.I.
##               estimate     lower     upper
##   khongconha 1.0000000        NA        NA
##   conha      0.4740542 0.3582489 0.6232548
## 
## $p.value
##             two-sided
##                midp.exact fisher.exact   chi.square
##   khongconha           NA           NA           NA
##   conha      5.738991e-08 6.417142e-08 7.928759e-08
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

• Người sở hữu nhà có odds ratio là 0.4740542, với khoảng tin cậy 95% từ 0.3582489 đến 0.6232548. Điều này có nghĩa là người sở hữu nhà có tỷ lệ bị từ chối tín dụng thấp hơn so với người không sở hữu nhà. Khoảng tin cậy không chứa giá trị 1, cho thấy sự khác biệt này là có ý nghĩa thống kê.

• Các giá trị p (p-values) cho người sở hữu nhà là rất nhỏ 5,74.10^-8, cho thấy sự khác biệt về tỷ lệ bị từ chối tín dụng giữa người sở hữu nhà và người không sở hữu nhà là rất có ý nghĩa thống kê. Giá trị p nhỏ hơn 0.05, chúng ta bác bỏ giả thuyết không rằng không có sự khác biệt về tỷ lệ bị từ chối tín dụng giữa hai nhóm.

epitab(d1, method = 'oddsratio')

## $tab
##             
##              tuchoi        p0 chapnhan        p1 oddsratio    lower    upper
##   khongconha    206 0.6959459      532 0.5200391   1.00000       NA       NA
##   conha          90 0.3040541      491 0.4799609   2.11249 1.602406 2.784944
##             
##                   p.value
##   khongconha           NA
##   conha      6.417142e-08
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

• Odds Ratio cho người sở hữu nhà là 2.11249. Điều này có nghĩa là người sở hữu nhà có tỷ lệ bị chấp nhận tín dụng cao hơn 2.11249 lần so với người không sở hữu nhà.
• Khoảng Tin Cậy 95% (95% Confidence Interval): từ 1.60 đến 2.78 Khoảng tin cậy này không chứa giá trị 1, cho thấy sự khác biệt về tỷ lệ bị chấp nhận tín dụng giữa hai nhóm là có ý nghĩa thống kê.