Nhiệm vụ tuần 5

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

## Warning: package 'ggplot2' was built under R version 4.3.3

## Warning: package 'psych' was built under R version 4.3.3

## 
## Attaching package: 'psych'

## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha

## Warning: package 'DescTools' was built under R version 4.3.3

## 
## Attaching package: 'DescTools'

## The following objects are masked from 'package:psych':
## 
##     AUC, ICC, SD

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.3     ✔ tibble    3.2.1
## ✔ purrr     1.0.2     ✔ tidyr     1.3.0
## ✔ readr     2.1.5     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ psych::%+%()    masks ggplot2::%+%()
## ✖ psych::alpha()  masks ggplot2::alpha()
## ✖ 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
## 
## Attaching package: 'scales'
## 
## 
## The following object is masked from 'package:purrr':
## 
##     discard
## 
## 
## The following object is masked from 'package:readr':
## 
##     col_factor
## 
## 
## The following objects are masked from 'package:psych':
## 
##     alpha, rescale

## Warning: package 'AER' was built under R version 4.3.3

## Loading required package: car

## Warning: package 'car' was built under R version 4.3.3

## Loading required package: carData

## Warning: package 'carData' was built under R version 4.3.3

## 
## Attaching package: 'car'
## 
## The following object is masked from 'package:purrr':
## 
##     some
## 
## The following object is masked from 'package:DescTools':
## 
##     Recode
## 
## The following object is masked from 'package:psych':
## 
##     logit
## 
## The following object is masked from 'package:dplyr':
## 
##     recode
## 
## Loading required package: lmtest

## Warning: package 'lmtest' was built under R version 4.3.3

## Loading required package: zoo

## Warning: package 'zoo' was built under R version 4.3.3

## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## Loading required package: sandwich

## Warning: package 'sandwich' was built under R version 4.3.3

## Loading required package: survival
## 
## Attaching package: 'survival'
## 
## The following object is masked from 'package:epitools':
## 
##     ratetable

## Warning: package 'datarium' was built under R version 4.3.3

## Warning: package 'Ecdat' was built under R version 4.3.3

## Loading required package: Ecfun

## Warning: package 'Ecfun' was built under R version 4.3.3

## 
## Attaching package: 'Ecfun'
## 
## The following object is masked from 'package:DescTools':
## 
##     BoxCox
## 
## The following object is masked from 'package:base':
## 
##     sign
## 
## 
## Attaching package: 'Ecdat'
## 
## The following object is masked from 'package:carData':
## 
##     Mroz
## 
## The following object is masked from 'package:datasets':
## 
##     Orange

## Warning: package 'ISLR' was built under R version 4.3.3

1 Bộ dữ liệu Credit

Bộ dữ liệu Credit chứa thông tin về khách hàng vay tín dụng từ một ngân hàng, với mục tiêu chính là dự đoán khả năng vỡ nợ của khách hàng dựa trên các đặc điểm nhân khẩu học và tài chính của họ. Đây là một bộ dữ liệu lý tưởng để nghiên cứu về rủi ro tín dụng, hành vi vay mượn của người tiêu dùng, và phân tích tài chính cá nhân.

Bộ dữ liệu này có tổng cộng 400 quan sát và 11 biến.

Các biến định tính (Qualitative/Categorical Variables) nổi bật:

• Gender: Giới tính của khách hàng (Male/Female).

• Student: Tình trạng sinh viên (Yes/No). Sinh viên thường có hành vi chi tiêu và thu nhập khác biệt.

• Married: Tình trạng hôn nhân (Yes/No). Tình trạng hôn nhân có thể ảnh hưởng đến khả năng tài chính và quyết định vay mượn.

• Ethnicity: Dân tộc của khách hàng (Caucasian/Asian/African American). Biến này có thể được sử dụng để kiểm tra sự khác biệt trong việc cấp tín dụng giữa các nhóm dân tộc, hoặc liệu có sự phân biệt đối xử hay không.

Các biến định lượng (Quantitative/Numerical Variables) nổi bật:

• Income: Thu nhập hàng năm của khách hàng (tính bằng ngàn đô la). Đây là một yếu tố quan trọng ảnh hưởng đến khả năng trả nợ.

• Limit: Hạn mức tín dụng của khách hàng (tính bằng đô la).

• Rating: Điểm tín dụng của khách hàng (thường là một thước đo của uy tín tài chính).

• Cards: Số lượng thẻ tín dụng mà khách hàng đang sở hữu.

• Age: Tuổi của khách hàng.

• Education: Số năm học vấn của khách hàng.

• Balance: Số dư nợ tín dụng trung bình hàng tháng của khách hàng (tính bằng đô la). Đây thường là biến phụ thuộc chính khi dự đoán khả năng vỡ nợ hoặc rủi ro tín dụng.

d <- Credit
datatable(d)

• Cấu trúc bộ dữ liệu

str(d)

## 'data.frame':    400 obs. of  12 variables:
##  $ ID       : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ Income   : num  14.9 106 104.6 148.9 55.9 ...
##  $ Limit    : int  3606 6645 7075 9504 4897 8047 3388 7114 3300 6819 ...
##  $ Rating   : int  283 483 514 681 357 569 259 512 266 491 ...
##  $ Cards    : int  2 3 4 3 2 4 2 2 5 3 ...
##  $ Age      : int  34 82 71 36 68 77 37 87 66 41 ...
##  $ Education: int  11 15 11 11 16 10 12 9 13 19 ...
##  $ Gender   : Factor w/ 2 levels " Male","Female": 1 2 1 2 1 1 2 1 2 2 ...
##  $ Student  : Factor w/ 2 levels "No","Yes": 1 2 1 1 1 1 1 1 1 2 ...
##  $ Married  : Factor w/ 2 levels "No","Yes": 2 2 1 1 2 1 1 1 1 2 ...
##  $ Ethnicity: Factor w/ 3 levels "African American",..: 3 2 2 2 3 3 1 2 3 1 ...
##  $ Balance  : int  333 903 580 964 331 1151 203 872 279 1350 ...

Bộ dữ liệu Credit được sử dụng trong nghiên cứu này chứa thông tin của 400 khách hàng vay tín dụng, với tổng cộng 12 biến. Cấu trúc của bộ dữ liệu (str(d)) cho thấy sự kết hợp của cả biến định lượng và định tính. Các biến định lượng bao gồm ID, Income, Limit, Rating, Cards, Age, Education, và Balance (đều là kiểu số nguyên hoặc số thực), cung cấp thông tin về tài chính và nhân khẩu học. Trong khi đó, các biến định tính bao gồm Gender, Student, Married, và Ethnicity (đều được định dạng là yếu tố với các cấp độ tương ứng), đại diện cho các đặc điểm phân loại của khách hàng. Sự đa dạng trong cấu trúc biến này tạo nền tảng vững chắc cho việc phân tích toàn diện các yếu tố ảnh hưởng đến rủi ro tín dụng và hành vi tài chính.

• Lọc các biến định lượng của bộ dữ liệu Credit

d1 <- subset(d,select=-c(Income, Limit, Rating, Cards, Age, Education, Balance))
datatable(d1)

• Kiểm tra dữ liệu bị thiếu

a <-is.na(d1)
datatable(a)

sum(is.na(d1))

## [1] 0

which(is.na(d1))

## integer(0)

Để đảm bảo chất lượng dữ liệu, quá trình kiểm tra dữ liệu bị thiếu (missing data) đã được tiến hành trên bộ dữ liệu Credit. Bằng cách sử dụng các hàm kiểm tra trong R như is.na() và sum(is.na()), kết quả cho thấy toàn bộ bộ dữ liệu không chứa bất kỳ giá trị NA nào. Cụ thể, tổng số giá trị thiếu được xác định là 0, đồng thời không có chỉ số nào được trả về cho các vị trí có dữ liệu thiếu. Điều này khẳng định bộ dữ liệu Credit là hoàn chỉnh và không yêu cầu bất kỳ bước xử lý dữ liệu thiếu nào, giúp quá trình phân tích tiếp theo được thực hiện trên nền tảng dữ liệu đáng tin cậy.

2 Phân tích mô tả các biến định tính

2.1 Biến Gender

Thống kê mô tả biến Gender thông qua bảng tần số, tần suất và đồ thị.

Bảng tần số:

table(d1$Gender)

## 
##   Male Female 
##    193    207

Bảng tần suất:

a2 <- table(d1$Gender)/sum(nrow(d1))
a2

## 
##   Male Female 
## 0.4825 0.5175

Vậy trong bộ dữ liệu này có 48.25% nam và 51.75% nữ.

Đồ thị biểu diễn tỷ lệ phần trăm giới tính khách hàng vay tín dụng từ một ngân hàng:

pie(a2,
    labels = paste(names(a2), round(a2, 2), "%"),
    main = "Biểu đồ tròn: Tỷ lệ Gender") 

• Nhận xét về biến Gender trong bộ dữ liệu Credit:

  • Phân tích biến Gender (Giới tính) trong bộ dữ liệu khách hàng vay tín dụng của ngân hàng cho thấy sự phân bổ tương đối đồng đều giữa nam và nữ. Cụ thể, trong tổng số 400 khách hàng, có 193 khách hàng nam và 207 khách hàng nữ.

  • Khi tính toán tần suất tương đối, tỷ lệ khách hàng nam chiếm khoảng 48.25%, trong khi khách hàng nữ chiếm 51.75%. Mặc dù có một sự chênh lệch nhỏ, với số lượng nữ giới nhiều hơn một chút, sự phân phối này vẫn cho thấy ngân hàng đang phục vụ một tập khách hàng khá cân bằng về giới tính.

  • Điều này có ý nghĩa quan trọng trong việc đảm bảo tính đại diện của dữ liệu khi phân tích hành vi vay tín dụng và rủi ro tín dụng. Đồng thời, nó cũng gợi mở khả năng không có sự thiên lệch đáng kể về giới tính trong tập khách hàng hiện tại của ngân hàng, giúp các mô hình dự đoán tín dụng không bị ảnh hưởng quá nhiều bởi yếu tố giới tính.

2.2 Biến Married

Thống kê mô tả biến Married thông qua bảng tần số, tần suất và đồ thị.

Bảng tần số:

table(d1$Married)

## 
##  No Yes 
## 155 245

Bảng tần suất:

a4 <- table(d1$Married)/sum(nrow(d1))
a4

## 
##     No    Yes 
## 0.3875 0.6125

Vậy trong bộ dữ liệu này có 38.75% chưa kết hơn và 61.25% đã kết hôn. Đồ thị biểu diễn tỷ lệ phần trăm tình trạng hôn nhân của khách hàng vay tín dụng từ một ngân hàng:

pie(a4,
    labels = paste(names(a4), round(a4, 2), "%"),
    main = "Biểu đồ tròn: Tỷ lệ Married") 

• Nhận xét về biến Married trong bộ dữ liệu Credit:

  Dựa trên kết quả phân tích biến “Married” (Tình trạng hôn nhân) từ bộ dữ liệu Credit, chúng ta thấy rằng trong số những khách hàng vay tín dụng, nhóm đã kết hôn chiếm tỷ lệ lớn hơn (61.25%) so với nhóm chưa kết hôn (38.75%), được thể hiện rõ ràng qua bảng tần số, tần suất và biểu đồ tròn. Điều này có thể gợi ý rằng các tổ chức tín dụng có thể có xu hướng ưu tiên hoặc đánh giá cao hơn đối với các cá nhân đã kết hôn khi xét duyệt khoản vay, có thể do giả định về sự ổn định tài chính và trách nhiệm cao hơn.

3 Phân thích sự tác động của các yếu tố đến tình trạng hôn nhân

3.1 Biến Married và biến Student

Bảng tần số chéo

f <- table(d1$Student, d1$Married)
addmargins(f)

##      
##        No Yes Sum
##   No  135 225 360
##   Yes  20  20  40
##   Sum 155 245 400

Bảng tần suất chéo theo tỷ lệ hàng

f1 <- prop.table(f,margin=1)
f1

##      
##          No   Yes
##   No  0.375 0.625
##   Yes 0.500 0.500

Trực quan hóa

f2 <- as.data.frame(f1)
colnames(f2) <- c("Student", "Married", "Proportion")

ggplot(f2,aes(x=Married, y=Proportion, fill=Student)) + geom_bar(stat = "identity", position="dodge") + labs(title=" Tỷ lệ sinh viên theo tình trạng hôn nhân ", x="Tình trạng hôn nhân", y = "Tỷ lệ", fill="Tình trạng sinh viên") + theme_minimal() + scale_y_continuous(labels = scales::percent) + scale_x_discrete(labels=c("No"="Chưa kết hôn", "Yes"="Đã kết hôn")) + scale_fill_manual(values=c("Yes"="pink", "No"="blue")) + geom_text(aes(label=Proportion), position=position_dodge(width=0.9),vjust=0.5)

Đánh giá mối quan hệ giữa hai biến

Xem xét giữa hai biến có mối quan hệ có ý nghĩa thống kê hay độc lập với nhau bằng cách sử dụng kiểm định Chi-bình phương.
Đặt giả thuyết:

\[ \begin{cases} H_0: \text{Biến Married và biến Student không có mối quan hệ.} \\ H_1: \text{Biến Married và biến Student có mối quan hệ.} \end{cases} \]

 chisq.test(f)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  f
## X-squared = 1.8726, df = 1, p-value = 0.1712

Relative risk
TH1: Chưa kết hôn làm biến tham chiếu.

riskratio(f)

## $data
##        
##          No Yes Total
##   No    135 225   360
##   Yes    20  20    40
##   Total 155 245   400
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate     lower    upper
##   No       1.0        NA       NA
##   Yes      0.8 0.5808839 1.101769
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   No          NA           NA         NA
##   Yes  0.1314841    0.1277251  0.1236886
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

TH2: Đã kết hôn làm tham chiếu

riskratio(f,rev="b")

## $data
##        
##         Yes  No Total
##   Yes    20  20    40
##   No    225 135   360
##   Total 245 155   400
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate     lower    upper
##   Yes     1.00        NA       NA
##   No      0.75 0.5352316 1.050947
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   Yes         NA           NA         NA
##   No   0.1314841    0.1277251  0.1236886
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Odd ratio

oddsratio(f)

## $data
##        
##          No Yes Total
##   No    135 225   360
##   Yes    20  20    40
##   Total 155 245   400
## 
## $measure
##      odds ratio with 95% C.I.
##        estimate     lower    upper
##   No  1.0000000        NA       NA
##   Yes 0.6008255 0.3092448 1.166806
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   No          NA           NA         NA
##   Yes  0.1314841    0.1277251  0.1236886
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

3.2 Biến Married và Gender

Bảng tần số chéo

l <- table(d1$Married, d1$Gender)
addmargins(l)

##      
##        Male Female Sum
##   No     76     79 155
##   Yes   117    128 245
##   Sum   193    207 400

Bảng tần suất chéo theo tỷ lệ hàng

l1 <- prop.table(l,margin=1)
l1

##      
##            Male    Female
##   No  0.4903226 0.5096774
##   Yes 0.4775510 0.5224490

Trực quan hóa

l2 <- as.data.frame(l1)
colnames(l2) <- c("Married", "Gender", "Proportion")

ggplot(l2,aes(x=Married, y=Proportion, fill=Gender)) + geom_bar(stat = "identity", position="dodge") + labs(title=" Tỷ lệ giới tính theo tình trạng hôn nhân ", x="Tình trạng hôn nhân", y = "Tỷ lệ", fill="Tình trạng giới tính") + theme_minimal() + scale_y_continuous(labels = scales::percent) + scale_x_discrete(labels=c("No"="Chưa kết hôn", "Yes"="Đã kết hôn")) + scale_fill_manual(values=c("orange", "seagreen")) + geom_text(aes(label = round(Proportion, 2)), position=position_dodge(width=0.9),vjust=0.5)

Đánh giá mối quan hệ giữa hai biến

Xem xét giữa hai biến có mối quan hệ có ý nghĩa thống kê hay độc lập với nhau bằng cách sử dụng kiểm định Chi-bình phương.
Đặt giả thuyết:

\[ \begin{cases} H_0: \text{Biến Married và biến Gender độc lập.} \\ H_1: \text{Biến Married và biến Gender không độc lập.} \end{cases} \]

 chisq.test(l)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  l
## X-squared = 0.021415, df = 1, p-value = 0.8837

Relative risk
TH1: Chưa kết hôn làm biến tham chiếu.

riskratio(l)

## $data
##        
##          Male Female Total
##   No       76     79   155
##   Yes     117    128   245
##   Total   193    207   400
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate     lower    upper
##   No  1.000000        NA       NA
##   Yes 1.025058 0.8431306 1.246241
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   No          NA           NA         NA
##   Yes  0.8041984    0.8375793  0.8033343
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

TH2: Đã kết hôn làm tham chiếu

riskratio(l,rev="b")

## $data
##        
##         Female  Male Total
##   Yes      128   117   245
##   No        79    76   155
##   Total    207   193   400
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate    lower   upper
##   Yes 1.000000       NA      NA
##   No  1.026744 0.834629 1.26308
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   Yes         NA           NA         NA
##   No   0.8041984    0.8375793  0.8033343
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Odd ratio

oddsratio(l)

## $data
##        
##          Male Female Total
##   No       76     79   155
##   Yes     117    128   245
##   Total   193    207   400
## 
## $measure
##      odds ratio with 95% C.I.
##       estimate     lower    upper
##   No  1.000000        NA       NA
##   Yes 1.052341 0.7027552 1.575668
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   No          NA           NA         NA
##   Yes  0.8041984    0.8375793  0.8033343
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

3.3 Biến Married và Ethnicity

Bảng tần số chéo

g <- table(d1$Married, d1$Ethnicity)
addmargins(g)

##      
##       African American Asian Caucasian Sum
##   No                47    32        76 155
##   Yes               52    70       123 245
##   Sum               99   102       199 400

Bảng tần suất chéo theo tỷ lệ hàng

g1 <- prop.table(g,margin=1)
g1

##      
##       African American     Asian Caucasian
##   No         0.3032258 0.2064516 0.4903226
##   Yes        0.2122449 0.2857143 0.5020408

Trực quan hóa

g2 <- as.data.frame(g1)
colnames(g2) <- c("Married", "Ethnicity", "Proportion")

ggplot(g2,aes(x=Married, y=Proportion, fill=Ethnicity)) + geom_bar(stat = "identity", position="dodge") + labs(title=" Tỷ lệ dân tộc theo tình trạng hôn nhân ", x="Tình trạng hôn nhân", y = "Tỷ lệ", fill="Tình trạng dân tộc") + theme_minimal() + scale_y_continuous(labels = scales::percent) + scale_x_discrete(labels=c("No"="Chưa kết hôn", "Yes"="Đã kết hôn")) + scale_fill_manual(values=c("lightgreen", "salmon", "coral")) + geom_text(aes(label = round(Proportion, 2)), position=position_dodge(width=0.9),vjust=0.5)

Đánh giá mối quan hệ giữa hai biến

Xem xét giữa hai biến có mối quan hệ có ý nghĩa thống kê hay độc lập với nhau bằng cách sử dụng kiểm định Chi-bình phương.
Đặt giả thuyết:

\[ \begin{cases} H_0: \text{Biến Married và biến Ethnicity độc lập.} \\ H_1: \text{Biến Married và biến Ethnicity không độc lập.} \end{cases} \]

 chisq.test(g)

## 
##  Pearson's Chi-squared test
## 
## data:  g
## X-squared = 5.5404, df = 2, p-value = 0.06265

Relative risk
TH1: Chưa kết hôn làm biến tham chiếu.

riskratio(g)

## $data
##        
##         African American Asian Caucasian Total
##   No                  47    32        76   155
##   Yes                 52    70       123   245
##   Total               99   102       199   400
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate    lower    upper
##   No  1.000000       NA       NA
##   Yes 1.416496 1.041096 1.927259
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   No          NA           NA         NA
##   Yes 0.02049846   0.06146181 0.06265036
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

TH2: Đã kết hôn làm tham chiếu

riskratio(g,rev="b")

## $data
##        
##         Caucasian Asian African American Total
##   Yes         123    70               52   245
##   No           76    32               47   155
##   Total       199   102               99   400
## 
## $measure
##      risk ratio with 95% C.I.
##        estimate     lower   upper
##   Yes 1.0000000        NA      NA
##   No  0.8169312 0.5782109 1.15421
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   Yes         NA           NA         NA
##   No   0.2462415   0.06146181 0.06265036
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Odd ratio

oddsratio(g)

## $data
##        
##         African American Asian Caucasian Total
##   No                  47    32        76   155
##   Yes                 52    70       123   245
##   Total               99   102       199   400
## 
## $measure
##      odds ratio with 95% C.I.
##       estimate    lower    upper
##   No  1.000000       NA       NA
##   Yes 1.967785 1.109418 3.527167
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   No          NA           NA         NA
##   Yes 0.02049846   0.06146181 0.06265036
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

---

4 Phân thích sự tác động của các yếu tố đến tình trạng giới tính

4.1 Biến Gender và biến Student

Bảng tần số chéo

s <- table(d1$Gender, d1$Student)
addmargins(s)

##         
##           No Yes Sum
##    Male  177  16 193
##   Female 183  24 207
##   Sum    360  40 400

Bảng tần suất chéo theo tỷ lệ hàng

s1 <- prop.table(s,margin=1)
s1

##         
##                  No        Yes
##    Male  0.91709845 0.08290155
##   Female 0.88405797 0.11594203

Trực quan hóa

s2 <- as.data.frame(s1)
colnames(s2) <- c("Gender", "Student", "Proportion")

ggplot(s2,aes(x=Gender, y=Proportion, fill=Student)) + geom_bar(stat = "identity", position="dodge") + labs(title=" Tỷ lệ sinh viên theo tình trạng giới tính ", x="Tình trạng giới tính", y = "Tỷ lệ", fill="Tình trạng sinh viên") + theme_minimal() + scale_y_continuous(labels = scales::percent) + scale_x_discrete(labels=c("Male"="Giới tính nam", "Female"="Giới tính nữ")) + scale_fill_manual(values=c("coral","blue")) + geom_text(aes(label=round(Proportion,2)), position=position_dodge(width=0.9),vjust=0.5)

Đánh giá mối quan hệ giữa hai biến

Xem xét giữa hai biến có mối quan hệ có ý nghĩa thống kê hay độc lập với nhau bằng cách sử dụng kiểm định Chi-bình phương.
Đặt giả thuyết:

\[ \begin{cases} H_0: \text{Biến Gender và biến Student không có mối quan hệ.} \\ H_1: \text{Biến Gender và biến Student có mối quan hệ.} \end{cases} \]

 chisq.test(s)

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

Relative risk
TH1: Giới tính nam làm biến tham chiếu.

riskratio(s)

## $data
##         
##           No Yes Total
##    Male  177  16   193
##   Female 183  24   207
##   Total  360  40   400
## 
## $measure
##         risk ratio with 95% C.I.
##          estimate     lower    upper
##    Male  1.000000        NA       NA
##   Female 1.398551 0.7664618 2.551913
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##    Male          NA           NA         NA
##   Female  0.2774055    0.3182176  0.2710384
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

TH2: Giới tính nữ làm tham chiếu

riskratio(s,rev="b")

## $data
##         
##          Yes  No Total
##   Female  24 183   207
##    Male   16 177   193
##   Total   40 360   400
## 
## $measure
##         risk ratio with 95% C.I.
##          estimate     lower    upper
##   Female 1.000000        NA       NA
##    Male  1.037374 0.9720291 1.107111
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##   Female         NA           NA         NA
##    Male   0.2774055    0.3182176  0.2710384
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Odd ratio

oddsratio(s)

## $data
##         
##           No Yes Total
##    Male  177  16   193
##   Female 183  24   207
##   Total  360  40   400
## 
## $measure
##         odds ratio with 95% C.I.
##          estimate     lower    upper
##    Male  1.000000        NA       NA
##   Female 1.445059 0.7454362 2.872414
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##    Male          NA           NA         NA
##   Female  0.2774055    0.3182176  0.2710384
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

4.2 Biến Gender và Married

Bảng tần số chéo

e <- table(d1$Gender, d1$Married)
addmargins(e)

##         
##           No Yes Sum
##    Male   76 117 193
##   Female  79 128 207
##   Sum    155 245 400

Bảng tần suất chéo theo tỷ lệ hàng

e1 <- prop.table(e,margin=1)
e1

##         
##                 No       Yes
##    Male  0.3937824 0.6062176
##   Female 0.3816425 0.6183575

Trực quan hóa

e2 <- as.data.frame(e1)
colnames(e2) <- c("Gender", "Married", "Proportion")

ggplot(e2,aes(x=Gender, y=Proportion, fill=Married)) + geom_bar(stat = "identity", position="dodge") + labs(title=" Tỷ lệ hôn nhân theo tình trạng giới tính ", x="Tình trạng giới tính", y = "Tỷ lệ", fill="Tình trạng hôn nhân") + theme_minimal() + scale_y_continuous(labels = scales::percent) +  scale_fill_manual(values=c("pink", "coral")) + geom_text(aes(label = round(Proportion, 2)), position=position_dodge(width=0.9),vjust=0.5)

Đánh giá mối quan hệ giữa hai biến

Xem xét giữa hai biến có mối quan hệ có ý nghĩa thống kê hay độc lập với nhau bằng cách sử dụng kiểm định Chi-bình phương.
Đặt giả thuyết:

\[ \begin{cases} H_0: \text{Biến Married và biến Gender độc lập.} \\ H_1: \text{Biến Married và biến Gender không độc lập.} \end{cases} \]

 chisq.test(e)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  e
## X-squared = 0.021415, df = 1, p-value = 0.8837

Relative risk
TH1: Giới tính nam làm biến tham chiếu.

riskratio(e)

## $data
##         
##           No Yes Total
##    Male   76 117   193
##   Female  79 128   207
##   Total  155 245   400
## 
## $measure
##         risk ratio with 95% C.I.
##          estimate     lower    upper
##    Male  1.000000        NA       NA
##   Female 1.020026 0.8725618 1.192411
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##    Male          NA           NA         NA
##   Female  0.8041984    0.8375793  0.8033343
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

TH2: Giới tính nữ làm tham chiếu

riskratio(e,rev="b")

## $data
##         
##          Yes  No Total
##   Female 128  79   207
##    Male  117  76   193
##   Total  245 155   400
## 
## $measure
##         risk ratio with 95% C.I.
##          estimate     lower  upper
##   Female  1.00000        NA     NA
##    Male   1.03181 0.8064772 1.3201
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##   Female         NA           NA         NA
##    Male   0.8041984    0.8375793  0.8033343
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Odd ratio

oddsratio(e)

## $data
##         
##           No Yes Total
##    Male   76 117   193
##   Female  79 128   207
##   Total  155 245   400
## 
## $measure
##         odds ratio with 95% C.I.
##          estimate     lower    upper
##    Male  1.000000        NA       NA
##   Female 1.052341 0.7027552 1.575668
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##    Male          NA           NA         NA
##   Female  0.8041984    0.8375793  0.8033343
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

4.3 Biến Gender và Ethnicity

Bảng tần số chéo

k <- table(d1$Gender, d1$Ethnicity)
addmargins(k)

##         
##          African American Asian Caucasian Sum
##    Male                49    47        97 193
##   Female               50    55       102 207
##   Sum                  99   102       199 400

Bảng tần suất chéo theo tỷ lệ hàng

k1 <- prop.table(k,margin=1)
k1

##         
##          African American     Asian Caucasian
##    Male         0.2538860 0.2435233 0.5025907
##   Female        0.2415459 0.2657005 0.4927536

Trực quan hóa

k2 <- as.data.frame(k1)
colnames(k2) <- c("Gender", "Ethnicity", "Proportion")

ggplot(k2,aes(x=Gender, y=Proportion, fill=Ethnicity)) + geom_bar(stat = "identity", position="dodge") + labs(title=" Tỷ lệ dân tộc theo tình trạng giới tính ", x="Tình trạng giới tính", y = "Tỷ lệ", fill="Tình trạng dân tộc") + theme_minimal() + scale_y_continuous(labels = scales::percent)  + scale_fill_manual(values=c("pink", "salmon", "coral")) + geom_text(aes(label = round(Proportion, 2)), position=position_dodge(width=0.9),vjust=0.5)

Đánh giá mối quan hệ giữa hai biến

Xem xét giữa hai biến có mối quan hệ có ý nghĩa thống kê hay độc lập với nhau bằng cách sử dụng kiểm định Chi-bình phương.
Đặt giả thuyết:

\[ \begin{cases} H_0: \text{Biến Gender và biến Ethnicity độc lập.} \\ H_1: \text{Biến Gender và biến Ethnicity không độc lập.} \end{cases} \]

 chisq.test(k)

## 
##  Pearson's Chi-squared test
## 
## data:  k
## X-squared = 0.27352, df = 2, p-value = 0.8722

Relative risk
TH1: Giới tính nam làm biến tham chiếu.

riskratio(k)

## $data
##         
##          African American Asian Caucasian Total
##    Male                49    47        97   193
##   Female               50    55       102   207
##   Total                99   102       199   400
## 
## $measure
##         risk ratio with 95% C.I.
##          estimate     lower    upper
##    Male  1.000000        NA       NA
##   Female 1.069909 0.8136325 1.406907
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##    Male          NA           NA         NA
##   Female  0.6313153    0.8823079  0.8721816
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

TH2: Giới tính nữ làm tham chiếu

riskratio(k,rev="b")

## $data
##         
##          Caucasian Asian African American Total
##   Female       102    55               50   207
##    Male         97    47               49   193
##   Total        199   102               99   400
## 
## $measure
##         risk ratio with 95% C.I.
##           estimate     lower    upper
##   Female 1.0000000        NA       NA
##    Male  0.9316919 0.6786396 1.279103
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##   Female         NA           NA         NA
##    Male   0.6640575    0.8823079  0.8721816
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Odd ratio

oddsratio(k)

## $data
##         
##          African American Asian Caucasian Total
##    Male                49    47        97   193
##   Female               50    55       102   207
##   Total                99   102       199   400
## 
## $measure
##         odds ratio with 95% C.I.
##          estimate     lower    upper
##    Male  1.000000        NA       NA
##   Female 1.145781 0.6570981 2.001313
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##    Male          NA           NA         NA
##   Female  0.6313153    0.8823079  0.8721816
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

---