GIỚI THIỆU BỘ DỮ LIỆU

 library(DT)
library(dplyr)
library(tidyverse)
 d<-d<- read.csv("C:/Users/LENOVO/Downloads/DoctorVisits.csv")
str(d)
## 'data.frame':    5190 obs. of  13 variables:
##  $ rownames : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ visits   : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ gender   : chr  "female" "female" "male" "male" ...
##  $ age      : num  0.19 0.19 0.19 0.19 0.19 0.19 0.19 0.19 0.19 0.19 ...
##  $ income   : num  0.55 0.45 0.9 0.15 0.45 0.35 0.55 0.15 0.65 0.15 ...
##  $ illness  : int  1 1 3 1 2 5 4 3 2 1 ...
##  $ reduced  : int  4 2 0 0 5 1 0 0 0 0 ...
##  $ health   : int  1 1 0 0 1 9 2 6 5 0 ...
##  $ private  : chr  "yes" "yes" "no" "no" ...
##  $ freepoor : chr  "no" "no" "no" "no" ...
##  $ freerepat: chr  "no" "no" "no" "no" ...
##  $ nchronic : chr  "no" "no" "no" "no" ...
##  $ lchronic : chr  "no" "no" "no" "no" ...
datatable(d)

Bộ dữ liệu “DoctorVisits” có nguồn gốc từ Khảo sát Y tế Úc 1977–1978. với 12 biến và 5190 quan sát với mô tả các biến như sau:

  • visits: số lần thăm khám bác sĩ trong 2 tuần qua.
  • gender : giới tính
  • age : tuổi thực tế chia 100
  • income : thu nhập hàng năm với đơn vị chục ngàn dô
  • illness: số lần mắc bệnh trong 2 tuần qua.
  • reduced: số ngày nghỉ việc do bị bệnh.
  • health : điểm sức khỏe tính theo phương pháp Goldberg.
  • private : có bảo hiểm y tế cá nhân
  • freepoor : được miễn bảo hiểm y tế chính phủ do thu nhập thấp.
  • freerepat : được miễn bảo hiểm y tế do lớn tuổi, khuyết tật hay cực chiến binh.
  • nchronic : bị bệnh mãn tính nhưng không bị giới hạn hoạt động
  • lchronic: bị bệnh mãn tính và bị giới hạn hoạt động.

Thống kê mô tả biến income

summary(d$income)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.2500  0.5500  0.5832  0.9000  1.5000
sd(d$income)
## [1] 0.3689067
ggplot(d, aes(x = income)) +
  geom_density(fill = "red", color = "pink", alpha = 0.5) +
  labs(x = "biểu đồ mức thu nhập")

Nhận xét:

  • Biến thu nhập có giá trị dao động từ 0 đến 1.5, với trung vị là 0.5500 và giá trị trung bình là 0.5832.
  • Sự chênh lệch giữa giá trị trung bình và trung vị cho thấy dữ liệu có thể bị lệch phảivới độ lệch chuẩn là 0.3689067
  • Phân phối thu nhập trong mẫu có sự biến thiên đáng kể và có xu hướng tập trung phần lớn ở khoảng 0.25 đến 0.90.

Thống kê mô tả biến AGE

summary(d$age)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.1900  0.2200  0.3200  0.4064  0.6200  0.7200
sd(d$age)
## [1] 0.2047818
ggplot(d, aes(x = age)) +
  geom_density(fill = "darkgray", color = "white", alpha = 0.5) +
  labs(x = "biểu đồ tuổi")

Nhận xét :

  • Biến age có giá trị dao động từ 0.19 đến 0.72 , với trung vị là 0.32 và giá trị trung bình là 0.4064.
  • Sự chênh lệch giữa giá trị trung bình và trung vị cho thấy dữ liệu có thể bị lệch phải. Độ lệch chuẩn là 0.2047818, chỉ ra mức độ biến thiên của tuổi trong mẫu dữ liệu.
  • Phân phối tuổi trong mẫu có sự biến thiên nhất định và có xu hướng tập trung phần lớn ở khoảng 0.2200 đến 0.6200.

Thống kê mô tả biến Gender

g<- table (d$gender)
addmargins(g)
## 
## female   male    Sum 
##   2702   2488   5190
prop.table(g)*100
## 
##   female     male 
## 52.06166 47.93834
d |> ggplot(aes(gender)) +
  geom_bar()

Có 5190 quan sát trong đó :

  • 2702 nữ chiếm 52,06%
  • 2488 nam chiếm 47.93% Qua đó thấy số lượng nữ nhiều hơn nam nhưng sự chênh lệch này không đáng kể

Thống kê mô tả biến private

bh<- table(d$private)
addmargins(bh)
## 
##   no  yes  Sum 
## 2892 2298 5190
prop.table(bh)*100
## 
##       no      yes 
## 55.72254 44.27746
d |> ggplot(aes(private)) +
  geom_bar(fill="blue")

Trong 5190 người tham gia khảo sát thì có :

  • 2892 người không có bảo hiểm cá nhân, chiếm 55,72%
  • 2294 người có bảo hiểm cá nhân, chiếm 44,28% Có thể thấy số lượng người không có bảo hiểm nhiều hơn chiếm số lượng lớn hơn rõ rệt.

PHÂN TÍCH VỚI BIẾN THU NHẬP VỚI CÁC BIẾN LIÊN QUAN

Bảng tần số

gt<- table(d$income,d$gender)
gt
##       
##        female male
##   0        50   29
##   0.01     19   16
##   0.06     41   39
##   0.15    145  104
##   0.25    864  331
##   0.35    281  181
##   0.45    223  177
##   0.55    246  221
##   0.65    228  227
##   0.75    177  264
##   0.9     222  367
##   1.1     108  253
##   1.3      49  113
##   1.5      49  166

  • Ở các mức thu nhập thấp, số lượng nữ thường nhiều hơn nam. Ví dụ, ở mức thu nhập 0, có 50 nữ và 29 nam; ở mức 0.15, có 145 nữ và 104 nam. Điều này có thể cho thấy rằng tỷ lệ nữ có thu nhập thấp cao hơn nam.

  • Ở các mức thu nhập trung bình, sự chênh lệch giữa số lượng nữ và nam không quá lớn nhưng vẫn có xu hướng nữ nhiều hơn nam. Ví dụ, ở mức thu nhập 0.25, có 864 nữ và 331 nam; ở mức 0.65, có 228 nữ và 227 nam. Mức thu nhập 0.75 là ngoại lệ, nơi có 177 nữ và 264 nam, cho thấy ở mức thu nhập này nam nhiều hơn nữ.

  • Ở các mức thu nhập cao, số lượng nam thường nhiều hơn nữ. Ví dụ, ở mức thu nhập 0.9, có 222 nữ và 367 nam; ở mức 1.5, có 49 nữ và 166 nam. Điều này có thể cho thấy rằng tỷ lệ nam có thu nhập cao hơn nữ. => Nhận xét chung:

  • Phân bố thu nhập: Bảng tần số cho thấy một xu hướng rõ ràng rằng nữ thường chiếm ưu thế ở các mức thu nhập thấp và trung bình, trong khi nam thường chiếm ưu thế ở các mức thu nhập cao.

  • Chênh lệch giới tính: Sự chênh lệch giới tính rõ rệt nhất ở mức thu nhập 0.25, nơi số lượng nữ gấp hơn hai lần số lượng nam (864 nữ so với 331 nam).

  • Tính đa dạng: Ở các mức thu nhập trung bình (0.25 - 0.65), có sự phân bố khá đều giữa nam và nữ, nhưng sự phân bố này thay đổi khi tiến tới các mức thu nhập cao hơn, nơi nam chiếm ưu thế.

prop.table(gt)
##       
##             female        male
##   0    0.009633911 0.005587669
##   0.01 0.003660886 0.003082852
##   0.06 0.007899807 0.007514451
##   0.15 0.027938343 0.020038536
##   0.25 0.166473988 0.063776493
##   0.35 0.054142582 0.034874759
##   0.45 0.042967245 0.034104046
##   0.55 0.047398844 0.042581888
##   0.65 0.043930636 0.043737958
##   0.75 0.034104046 0.050867052
##   0.9  0.042774566 0.070712909
##   1.1  0.020809249 0.048747592
##   1.3  0.009441233 0.021772640
##   1.5  0.009441233 0.031984586
bhtn<- ftable(d$private,d$gender,d$income)
bhtn
##               0 0.01 0.06 0.15 0.25 0.35 0.45 0.55 0.65 0.75 0.9 1.1 1.3 1.5
##                                                                             
## no  female   25   15   18   88  642  174  116  118   84   54  58  22  15   4
##     male     17   14   24   69  276  129  111  146  130  157 189 106  46  45
## yes female   25    4   23   57  222  107  107  128  144  123 164  86  34  45
##     male     12    2   15   35   55   52   66   75   97  107 178 147  67 121

  • Xu hướng bảo hiểm y tế tư nhân theo giới tính và thu nhập:

    • Nữ giới:

    • Ở mức thu nhập thấp, tỷ lệ nữ không có bảo hiểm y tế tư nhân cao hơn tỷ lệ nữ có bảo hiểm y tế tư nhân. Ở mức thu nhập trung bình, tỷ lệ này có xu hướng cân bằng hơn.

    • Ở mức thu nhập cao, tỷ lệ nữ có bảo hiểm y tế tư nhân tăng lên, nhưng vẫn thấp hơn so với nam ở các mức thu nhập cao nhất.

    • Nam giới:

    • Ở mức thu nhập thấp và trung bình, tỷ lệ nam không có bảo hiểm y tế tư nhân cao hơn tỷ lệ nam có bảo hiểm y tế tư nhân.

    • Ở mức thu nhập cao, tỷ lệ nam có bảo hiểm y tế tư nhân tăng lên đáng kể và vượt qua tỷ lệ nữ có bảo hiểm y tế tư nhân.

  • Nhận xét chung:

    • Thu nhập và bảo hiểm y tế tư nhân: Thu nhập cao hơn thường đi kèm với tỷ lệ có bảo hiểm y tế tư nhân cao hơn, đặc biệt là ở nam giới.
    • Giới tính và bảo hiểm y tế tư nhân: Nữ giới có xu hướng không có bảo hiểm y tế tư nhân nhiều hơn nam giới ở các mức thu nhập thấp và trung bình, trong khi nam giới có tỷ lệ cao hơn ở các mức thu nhập cao.
    • Sự chênh lệch theo thu nhập: Ở các mức thu nhập thấp và trung bình, nữ giới thường chiếm ưu thế không có bảo hiểm y tế tư nhân, trong khi nam giới chiếm ưu thế ở các mức thu nhập cao khi có bảo hiểm y tế tư nhân.

Vẽ đồ thị

library(ggplot2)
tmp <- d
tmp <- table(d$gender)
tmp <- d |> group_by(gender) |> summarise(freq = n()) |> mutate(tmp, per = freq/sum(freq))
tmp |> ggplot(aes(x = '', y = per, fill = gender)) +
  geom_bar(stat = 'identity') + 
  coord_polar('y')

Từ đồ thị trên ta có thể thấy số lượng nữ nhiều hơn nam, nhưng sự chênh lệch này không đáng kể.

ggplot(data = d, aes(x = gender, y = income)) +
  geom_bar(stat = "identity") +geom_col(fill = 'green')+
  theme_minimal() +
  labs(title = "Income by Gender",
       x = "Gender",
       y = "Income")

Từ đồ thị có thể thấy thu nhập ở nữ giới thấp hơn ở nam đáng kể, tổng thu nhập ở nữ ở khoảng hơn 1250 trong khi thu nhập ở nam lên đến gần 1700.

ggplot(d, aes(gender, fill = private)) + geom_bar(position = 'dodge')

Số lượng người không có bảo hiểm tư nhân ở nam và nữ gần như ngang bằng nhau, trong khi đó số lượng người sở hữu bảo hiểm ở nữ nhiêu hơn nam đang kể. Điều này cho thấy giới tính có ảnh hưởng phần nào đến các quyết định mua bảo hiểm.

Ưóc lượng tỷ lệ những người có thu nhập lớn hơn 0.5

tmp <- d[d$income>0.5,]

prop.test(length(tmp$income), length(d$income), p = 0.36)
## 
##  1-sample proportions test with continuity correction
## 
## data:  length(tmp$income) out of length(d$income), null probability 0.36
## X-squared = 563.82, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.36
## 95 percent confidence interval:
##  0.5046057 0.5319759
## sample estimates:
##         p 
## 0.5183044

Với giả thuyết: \[H_{o}: \text{Tỷ lệ thực tế của những người có thu nhập > 0.5 = 0.36.}\\ H_{1}: \text{Tỷ lệ thực tế của những người có thu nhập > 0.5 không ≠ 0.36.}\]

Từ kết quả trên ta đưa ra một số nhận xét sau: - p-value < 2.2e-16: Giá trị p-value rất nhỏ, nhỏ hơn mức ý nghĩa thông thường (0.05), cho thấy rằng chúng ta có đủ bằng chứng để bác bỏ giả thuyết \(H_{0}\). Nghĩa là, tỷ lệ thực tế của những người có thu nhập lớn hơn 0.5 trong dữ liệu của bạn khác biệt đáng kể so với tỷ lệ 0.36 đã đưa ra. - Khoảng tin cậy cho tỷ lệ thực tế nằm trong khoảng từ 0.5046 đến 0.5320, nghĩa là chúng ta tự tin 95% rằng tỷ lệ thực tế của những người có thu nhập lớn hơn 0.5 nằm trong khoảng này. - Tỷ lệ thực tế của những người có thu nhập lớn hơn 0.5 trong dữ liệu của bạn là khoảng 51.83%.

Ước lượng chênh lệch tỷ lệ thu nhập >0.5 giữa nam và nữ

tmpm <- d[d$gender == 'male',]
tmpf <- d[d$gender == 'female',]

tmpm3 <- tmpm[tmpm$income> 0.5,]
tmpf3 <- tmpf[tmpf$income > 0.5,]

a <- c(nrow(tmpm), nrow(tmpf))
b <- c(nrow(tmpm3), nrow(tmpf3))

prop.test(b,a)
## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  b out of a
## X-squared = 318.55, df = 1, p-value < 2.2e-16
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  0.2214553 0.2748932
## sample estimates:
##    prop 1    prop 2 
## 0.6475080 0.3993338

Với giả thuyết: \[H_{o}: \text{Không có sự khác biệt về tỷ lệ thu nhập >0.5 giữa nam và nữ}\\ H_{1}: \text{Có sự khác biệt về tỷ lệ thu nhập >0.5 giữa nam và nữ}\]

Từ kết quả trên ta đưa ra một số nhận xét sau:

  • p-value < 2.2e-16: Giá trị p-value rất nhỏ, nhỏ hơn mức ý nghĩa thông thường (0.05), cho thấy rằng chúng ta có đủ bằng chứng để bác bỏ giả thuyết không. Nghĩa là, tỷ lệ thu nhập >0.5 giữa nam và nữ có sự khác biệt đáng kể.
  • Chênh lệch tỷ lệ thu nhập >0.5 giữa nam và nữ nằm trong khoảng từ 22.15% đến 27.49%, với tỷ lệ ở nam cao hơn so với nữ.
  • Tỷ lệ thu nhập >0.5 ở nam là khoảng 64.75%, trong khi ở nữ là khoảng 39.93%.

Ưóc lượng Relative risk của lượng người có bảo hiểm tư nhân trong từng giới tính

library(epitools)
library(DescTools)
tmp <- table(d$gender, d$private)
addmargins(tmp)
##         
##            no  yes  Sum
##   female 1433 1269 2702
##   male   1459 1029 2488
##   Sum    2892 2298 5190
RelRisk(tmp)
## [1] 0.9043904
m <- matrix(c(1433,1459,1269,1029),nrow = 2)
RelRisk(m, conf.level = .95)
## rel. risk    lwr.ci    upr.ci 
## 0.9043904 0.8615773 0.9492873

Kết quả RR = 0.904 cho thấy lượng nữ giới không có bảo hiểm tư nhân gấp 0.904 lần lượng nam không có bảo hiểm. Điều này có thể được hiểu là trong dữ liệu , việc không có bảo hiểm tư nhân có thể liên quan đến các yếu tố khác (không phải giới tín). Và với khoảng tin cậy 95% thì tỷ lệ nguy cơ tương đối này nằm trong khoảng (0.8616;0.9493).

riskratio(tmp)
## $data
##         
##            no  yes Total
##   female 1433 1269  2702
##   male   1459 1029  2488
##   Total  2892 2298  5190
## 
## $measure
##         risk ratio with 95% C.I.
##           estimate     lower     upper
##   female 1.0000000        NA        NA
##   male   0.8806204 0.8280106 0.9365729
## 
## $p.value
##         two-sided
##            midp.exact fisher.exact   chi.square
##   female           NA           NA           NA
##   male   4.853326e-05 4.997577e-05 4.856833e-05
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ risk ratio ở nam = 0.8806204, điều này cho thấy lượng nam giới sở hữu bảo hiểm tư nhân gấp 0.88 lượng nữ sở bảo hiểm tư nhân, đồng thời với độ tin cậy 95% thì tỷ lệ này biến động trong khoảng (0.8280106;0.9365729).

Ưóc lượng Odd ratio

OddsRatio(tmp)
## [1] 0.7964246
oddsratio(tmp, rev = 'c')
## $data
##         
##           yes   no Total
##   female 1269 1433  2702
##   male   1029 1459  2488
##   Total  2298 2892  5190
## 
## $measure
##         odds ratio with 95% C.I.
##          estimate    lower    upper
##   female  1.00000       NA       NA
##   male    1.25552 1.124923 1.401488
## 
## $p.value
##         two-sided
##            midp.exact fisher.exact   chi.square
##   female           NA           NA           NA
##   male   4.853326e-05 4.997577e-05 4.856833e-05
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Gía trị OR = 0.796 cho thấy tỉ lệ giữa người không có bảo hiểm tư nhân và có bảo hiểm tư nhân ở nữ gấp 0.796 lần tỉ lệ này ở nam. Và tỷ lệ giữa người có bảo hiểm và không có bảo hiểm ở nữ nhiều hơn ở nam khoảng 26%.

Hồi quy

d |> ggplot(aes(income, age)) + 
  geom_point(color = 'red') + 
  geom_smooth(formula =y ~ x, method = 'lm')

Ươc lượng hàm hồi quy tổng quát

fit <- lm(income ~ age, data = d)

summary(fit)
## 
## Call:
## lm(formula = income ~ age, data = d)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.68883 -0.22885 -0.09976  0.22582  1.06999 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.78161    0.01096   71.35   <2e-16 ***
## age         -0.48833    0.02407  -20.28   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3551 on 5188 degrees of freedom
## Multiple R-squared:  0.07348,    Adjusted R-squared:  0.0733 
## F-statistic: 411.5 on 1 and 5188 DF,  p-value: < 2.2e-16

Dựa trên thông số ước lượng, phương trình hồi quy tuyến tính có thể viết là: \[income = 0.78161 − 0.48833 *age\] Với giá trị \(p-value = 2*10^\text{-16}\) < \(\alpha\) và Significance codes đạt mức *** tức p<0.001 nên ta kết luận biến age có ý nghĩa thống kê với biến income hay tuổi tác có tác động đáng kể đến thu nhập cá nhân.