bài tập

Giới thiệu dữ liệu

Bộ dữ liệu bao gồm 8802 quan sát và 11 biến trong cuộc khảo sát về các chỉ tiêu y tế bao gồm các biến sau:

health: tình trạng sức khỏe (yes: khỏe, no: không khỏe)

age: độ tuổi

limit: giới hạn hay rào cản nào liên quan đến BHYT (yes: có, no: không)

gender: giới tính (male: nam, female: nữ)

insurance: cá nhân có bảo hiểm y tế hay không (yes: có BHYT, no: không có BHYT)

married: tình trạng hôn nhân (yes: đã kết hôn, no: chưa kết hôn)

selfemp: tình trạng làm việc tự do (yes: có, no: không)

family: số thành viên trong gia đình

region: khu vực sống

ethnicity: chủng tộc (afam: người Mỹ gốc Phi, cauc: người da trắng, other: khác)

education: trình độ học vấn (none: không có bằng cấp, ged: tương đương THPT, highschool: THPT, banchelor: cử nhân, master: thạc sĩ, phd: tiến sĩ, other: khác)

• Khai báo datasheet và gán datasheet vào d

library("tidyverse")

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── 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("AER")

## Loading required package: car
## Loading required package: carData
## 
## Attaching package: 'car'
## 
## 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("HealthInsurance")
d <- HealthInsurance
data.table::data.table(d)

Bảng tần suất

• Bảng tần số cho biến health

table(d$health)

## 
##   no  yes 
##  629 8173

table(d$health)/sum(table(d$health))

## 
##      no     yes 
## 0.07146 0.92854

Nhận xét: Có 629 người có sức khỏe không tốt chiếm 7,1% và 8173 người có sức khỏe tốt chiếm 92,9%.

• Bảng tần số cho biến insurance

table(d$insurance)

## 
##   no  yes 
## 1750 7052

table(d$insurance)/sum(table(d$insurance))

## 
##     no    yes 
## 0.1988 0.8012

Nhận xét: số người không có BHYT là 1750 người chiếm 19,88% và người có BHYT là 7052 người chiếm 80,12%.

• Bảng tần số cho biến married

table(d$married)

## 
##   no  yes 
## 3369 5433

table(d$married)/sum(table(d$married))

## 
##     no    yes 
## 0.3828 0.6172

Nhận xét: Số người đã kết hôn là 5433 người chiếm 61,72% còn lại 3369 người chưa kết hôn chiếm 38,28%.

• Bảng tần số cho biến ethniccity

table(d$ethnicity)

## 
## other  afam  cauc 
##   365  1083  7354

table(d$ethnicity)/sum(table(d$ethnicity))

## 
##   other    afam    cauc 
## 0.04147 0.12304 0.83549

Nhận xét: có 1083 người Mỹ gốc Phi chiếm 12,304%, người da trắng chiếm 83,549% với 7354 người còn lại là chủng tộc khác với 365 người chiếm 4,147%.

• Bảng tần số cho biến education

table(d$education)

## 
##       none        ged highschool   bachelor     master        phd      other 
##       1119        374       4434       1549        524        135        667

table(d$education)/sum(table(d$education))

## 
##       none        ged highschool   bachelor     master        phd      other 
##    0.12713    0.04249    0.50375    0.17598    0.05953    0.01534    0.07578

Nhận xét: có 374 người có trình độ học vấn tương đương THPT chiếm 4,249%, 4434 người có trình độ học vấn THPT chiếm 50,375%, cùng với đó người có trình độ cử nhân, thạc sĩ, tiến sĩ lần lượt là 524 người (chiếm 5,953%), 135 người (chiếm 1,534%), 667 người (chiếm 7,578%) cuối cùng là khác với 1119 người chiếm 12,713%.

Vẽ đồ thị

• Vẽ đồ thị cho biến health

library(ggplot2)
ggplot(d, aes(x =health)) +
  geom_bar(fill = "skyblue", color = "black") 

• Vẽ đồ thị cho biến insurance

ggplot(d, aes(x =insurance)) +
  geom_bar(fill = "green", color = "black")

• Vẽ đồ thị cho biến married

ggplot(d, aes(x = married)) +
  geom_bar(fill = "blue", color = "black")

• Vẽ đồ thị cho biến ethnicity

ggplot(d, aes(x =ethnicity)) +
  geom_bar(fill = "purple", color = "black")

• Vẽ đồ thị cho biến education

ggplot(d, aes(x =education)) +
  geom_bar(fill = "orange", color = "black")

• Vẽ biểu đồ thể hiện tình trạng hôn nhân và bảo hiểm y tế

b <- data.frame(d$married, d$insurance)
ggplot(b, aes(x = d$married, fill = d$insurance)) +
  geom_bar(position = "dodge") +
  labs(title = "married and insurance ",
       x = "Married",
       y = "Count",
       fill = "Insurance")

Ước lượng tỷ lệ

library(DescTools)

## 
## Attaching package: 'DescTools'

## The following object is masked from 'package:car':
## 
##     Recode

a <- table(d$married,d$insurance)
addmargins(a)

##      
##         no  yes  Sum
##   no   976 2393 3369
##   yes  774 4659 5433
##   Sum 1750 7052 8802

Relative risk

RelRisk(a)

## [1] 2.034

     Nhận xét: Relative risk được tính cho việc có bảo hiểm y tế hay không giữa người đã kết hôn và chưa kết hôn. Trong trường hợp này RR là 1.644, điều này có nghĩa là những người đã kết hôn có khả năng có bảo hiểm y tế cao hơn những người chưa kết hôn. Cụ thể, những người đã kết hôn có khả năng có bảo hiểm y tế cao hơn khoảng 1.644 lần so với những người chưa kết hôn. Điều này cho thấy rằng tình trạng hôn nhân có ảnh hưởng đáng kể đến việc sở hữu BHYT.

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

table(d$insurance, d$married)

##      
##         no  yes
##   no   976  774
##   yes 2393 4659

m <- matrix(c(976, 2393, 774, 4659), nrow = 2)
RelRisk(m, conf.level = .95)

## rel. risk    lwr.ci    upr.ci 
##     1.644     1.558     1.732

     RR = 1.644: Những người đã kết hôn có khả năng có bảo hiểm y tế cao hơn 1.644 lần so với những người chưa kết hôn.

     Khoảng tin cậy (1.588 đến 1.732): Khoảng tin cậy này không chứa 1 và khá hẹp, cho thấy kết quả là có ý nghĩa thống kê và đáng tin cậy.

     Kết quả này cho thấy rằng tình trạng hôn nhân là một yếu tố quan trọng ảnh hưởng đến việc sở hữu bảo hiểm y tế. Chính sách và các chương trình khuyến khích bảo hiểm y tế có thể cần xem xét các yếu tố gia đình và hôn nhân để tăng tỷ lệ sở hữu bảo hiểm.

Odd ratios(tỷ lệ chênh)

addmargins(a)

##      
##         no  yes  Sum
##   no   976 2393 3369
##   yes  774 4659 5433
##   Sum 1750 7052 8802

odd_ratio1 <- ((976/3369)/(2393/3369))
odd_ratio1

## [1] 0.4079

odd_ratio2 <- ((774/5433)/(4659/5433))
odd_ratio2

## [1] 0.1661

OddsRatio(a)

## [1] 2.455

     OR = 2.455 cho thấy những người đã kết hôn có tỷ lệ odds sở hữu bảo hiểm y tế cao hơn 2.455 lần so với những người chưa kết hôn. Điều này chỉ ra một mối liên hệ mạnh mẽ giữa tình trạng hôn nhân và việc sở hữu bảo hiểm y tế.

• Khoảng ước lượng cho odd ratios

OddsRatio(a, conf.level = .95)

## odds ratio     lwr.ci     upr.ci 
##      2.455      2.207      2.731

     Cận dưới (2.207) và Cận trên (2.731): Khoảng tin cậy này cho biết rằng, với mức độ tin cậy (thường là 95%), OR thực sự nằm trong khoảng từ 2.207 đến 2.731. Vì toàn bộ khoảng tin cậy nằm trên 1, chúng ta có thể kết luận rằng có một mối liên hệ có ý nghĩa thống kê giữa tình trạng hôn nhân và việc sở hữu bảo hiểm y tế. Điều này có nghĩa là sự khác biệt quan sát được không phải là do ngẫu nhiên