Untitled

Giới thiệu về dataset socsupport

SocSupport là một gói dữ liệu trong phần mềm R dùng để nghiên cứu các yếu tố hỗ trợ xã hội. Dữ liệu này được thu thập từ một cuộc khảo sát về hỗ trợ xã hội và các loại hỗ trợ khác.

gender: Giới tính (nữ, nam)

age: Độ tuổi (được phân loại theo nhóm)

country: Quốc gia (Úc hoặc các nước khác)

marital: Tình trạng hôn nhân (đã kết hôn, khác, độc thân)

livewith: Cùng sống với ai (một mình, bạn bè, gia đình khác, bố mẹ, người yêu, ký túc xá)

employment: Tình trạng việc làm (hưởng lương toàn thời gian, hưởng lương bán thời gian, trợ cấp chính phủ, khác, trợ cấp nuôi con)

firstyr: Năm học đầu tiên (năm nhất hoặc khác)

enrolment: Loại hình nhập học (full-time - toàn thời gian,part-tiem - bán thời gian)

Các biến bắt đầu bằng emotional (cảm xúc):

emotional: Mức độ sẵn có của hỗ trợ về mặt tình cảm

emotionalsat: Mức độ hài lòng với hỗ trợ về mặt tình cảm

Các biến bắt đầu bằng tangible (vật chất):

tangible: Mức độ sẵn có của hỗ trợ về mặt vật chất

tangiblesat: Mức độ hài lòng với hỗ trợ về mặt vật chất

Các biến bắt đầu bằng affect (tình cảm):

affect: Mức độ sẵn có của nguồn hỗ trợ tình cảm

affectsat: Mức độ hài lòng với nguồn hỗ trợ tình cảm

Các biến bắt đầu bằng psi (tương tác xã hội tích cực):

psi: Mức độ sẵn có của tương tác xã hội tích cực

psisat: Mức độ hài lòng với tương tác xã hội tích cực

esupport: Mức độ hỗ trợ về mặt tình cảm

psupport: Mức độ hỗ trợ thiết thực

supsources: Tổng mức độ hỗ trợ xã hội

BDI: Điểm đánh giá mức độ trầm cảm theo Beck Depression Inventory

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(epitools)
library(DescTools)

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

library(DT)

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

library(ggplot2)
library(ggcorrplot)
library(GLMsData)
library(readxl)
socsupport <- read_excel("C:/Users/chaua/Downloads/socsupport.xlsx")
View(socsupport)
t <- socsupport

Lập bảng tần số

m <- table(t$enrolment,t$country)
prop.table(m)

##            
##             australia  other
##   full-time    0.7263 0.1053
##   part-time    0.1684 0.0000

Nhận xét: Có 72.63% người làm việc full time là người Úc, 10.53% người làm việc full time là không phải người Úc, 16.84% là người Úc làm việc part time

addmargins(table(t$enrolment,t$country))

##            
##             australia other Sum
##   full-time        69    10  79
##   part-time        16     0  16
##   Sum              85    10  95

h <- addmargins(table(t$enrolment,t$country))
prop.table(h)

##            
##             australia   other     Sum
##   full-time   0.18158 0.02632 0.20789
##   part-time   0.04211 0.00000 0.04211
##   Sum         0.22368 0.02632 0.25000

Nhận xét:

Từ bảng phân phối biên, thì người có quốc tịch Úc là 22.368% còn người có quốc tịch khác chiếm 2.632%

Đối với công việc làm full-time chiếm 20.789%, còn với công việc làm part-time chiếm 4.211% # Vẽ đồ thị

t |> ggplot(aes(x = t$country, y = after_stat(count))) + geom_bar(fill = 'skyblue') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + theme_classic() + labs(x = 'Quốc tịch Úc', y = 'Số người')

## Warning: Use of `t$country` is discouraged.
## ℹ Use `country` instead.
## Use of `t$country` is discouraged.
## ℹ Use `country` instead.

t |> ggplot(aes(x = t$enrolment, y = after_stat(count))) + geom_bar(fill = 'darkblue') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + theme_classic() + labs(x = 'Công việc', y = 'Số người')

## Warning: Use of `t$enrolment` is discouraged.
## ℹ Use `enrolment` instead.

## Warning: Use of `t$enrolment` is discouraged.
## ℹ Use `enrolment` instead.

ggplot(t, aes(country, fill = enrolment)) + geom_bar(position = 'dodge')

# Ước lượng tỉ lệ ## enrolment

ttf <- t[t$enrolment == 'full-time',]
ttp <- t[t$enrolment == 'part-time',]
prop.test(length(ttf$enrolment), length(t$enrolment), p = 0.5)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(ttf$enrolment) out of length(t$enrolment), null probability 0.5
## X-squared = 40, df = 1, p-value = 2e-10
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.7379 0.8978
## sample estimates:
##      p 
## 0.8316

prop.test(length(ttp$enrolment), length(t$enrolment), p = 0.5)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(ttp$enrolment) out of length(t$enrolment), null probability 0.5
## X-squared = 40, df = 1, p-value = 2e-10
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.1022 0.2621
## sample estimates:
##      p 
## 0.1684

Giả thuyết null (H0): Tỷ lệ thực tế (p) của một loại ghi danh nhất định trong dân số bằng 0,5 (50%).

Giả thuyết thay thế (H1): Tỷ lệ thực tế (p) không bằng 0,5.

+++ Đối với dữ liệu full-time

Giá trị p rất nhỏ (2e-10) cho thấy chúng ta có thể bác bỏ giả thuyết null. Điều này có nghĩa là có bằng chứng mạnh mẽ cho thấy tỷ lệ thực tế của một loại ghi danh nhất định trong dân số không phải là 50%.

Khoảng tin cậy (0,7379 - 0,8978) cho biết rằng chúng ta có 95% tin tưởng rằng tỷ lệ thực tế nằm trong khoảng từ 73,79% đến 89,78%.

Ước tính mẫu (p = 0,8316) cho thấy tỷ lệ quan sát cao hơn (trên 83%) rơi vào một loại ghi danh cụ thể so với 50% dự kiến dưới giả thuyết null.

+++ Đối với dữ liệu part-time

Giá trị p rất nhỏ (2e-10) cho thấy chúng ta có thể bác bỏ giả thuyết null. Điều này có nghĩa là có bằng chứng mạnh mẽ cho thấy tỷ lệ thực tế của một loại ghi danh nhất định trong dân số không phải là 50%.

Khoảng tin cậy (0.1022 - 0.2621) cho biết rằng chúng ta có 95% tin tưởng rằng tỷ lệ thực tế nằm trong khoảng từ 10,22% đến 26,21%.

Ước tính mẫu (p = 0.1684) cho thấy tỷ lệ quan sát (16,84%) rơi vào một loại ghi danh cụ thể, thấp hơn so với 50% dự kiến dưới giả thuyết null. ## country

tta <- t[t$country == 'australia',]
tto <- t[t$country == 'other',]
prop.test(length(tta$country ), length(t$country ), p = 0.5)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(tta$country) out of length(t$country), null probability 0.5
## X-squared = 58, df = 1, p-value = 3e-14
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.8107 0.9456
## sample estimates:
##      p 
## 0.8947

prop.test(length(tto$country ), length(t$country ), p = 0.5)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(tto$country) out of length(t$country), null probability 0.5
## X-squared = 58, df = 1, p-value = 3e-14
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.05439 0.18930
## sample estimates:
##      p 
## 0.1053

Giả thuyết null (H0): Tỷ lệ thực tế (p) của một loại ghi danh nhất định trong dân số bằng 0,5 (50%).

Giả thuyết thay thế (H1): Tỷ lệ thực tế (p) không bằng 0,5. +++ Đối với dữ liệu australia

Giá trị p rất nhỏ (3e-14) cung cấp bằng chứng mạnh mẽ để bác bỏ giả thuyết null (tỷ lệ sinh viên từ nhóm quốc gia này bằng 50% trong dân số).

Khoảng tin cậy cho thấy chúng ta có thể tin tưởng với độ tin cậy 95% rằng tỷ lệ thực tế của sinh viên từ nhóm quốc gia này nằm trong khoảng 81,07% đến 94,56%.

Ước tính mẫu (89.47%) cho thấy tỷ lệ sinh viên từ nhóm quốc gia này trong mẫu cao hơn nhiều so với 50% (giả thuyết null).

+++ Đối với dữ liệu other

Giá trị p rất nhỏ (3e-14) cung cấp bằng chứng mạnh mẽ để bác bỏ giả thuyết null (tỷ lệ sinh viên từ nhóm quốc gia này bằng 50% trong dân số).

Khoảng tin cậy cho thấy chúng ta có thể tin tưởng với độ tin cậy 95% rằng tỷ lệ thực tế của sinh viên từ nhóm quốc gia này nằm trong khoảng 5,44% đến 18,93%.

Ước tính mẫu (10.53%) cho thấy tỷ lệ sinh viên từ nhóm quốc gia này trong mẫu thấp hơn nhiều so với 50% (giả thuyết null). # Ước lượng tỉ lệ 2 biến

tf <- t[t$enrolment == 'full-time',]
tp <- t[t$enrolment == 'part-time',]

ta <- tf[tf$country == 'australia',]
to <- tp[tp$country == 'other',]


b <- c(nrow(ta), nrow(to))
a <- c(nrow(tf), nrow(tp))

prop.test(b,a)

## Warning in prop.test(b, a): Chi-squared approximation may be incorrect

## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  b out of a
## X-squared = 47, df = 1, p-value = 8e-12
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  0.7625 0.9843
## sample estimates:
## prop 1 prop 2 
## 0.8734 0.0000

Giả thuyết null (H0): Tỷ lệ thành công (p) trong hai nhóm là bằng nhau.

Giả thuyết thay thế (H1): Tỷ lệ thành công (p) giữa hai nhóm là khác nhau (khác biệt hai phía).

Giá trị p rất nhỏ (8e-12) cung cấp bằng chứng mạnh mẽ để bác bỏ giả thuyết null (tỷ lệ thành công giữa hai nhóm là bằng nhau).

Khoảng tin cậy cho thấy chúng ta có thể tin tưởng với độ tin cậy 95% rằng sự khác biệt thực tế giữa tỷ lệ thành công của hai nhóm nằm trong khoảng 76,25% đến 98,43%.

Ước tính mẫu cho thấy tỷ lệ thành công trong nhóm 1 (0,8734) cao hơn nhiều so với nhóm 2 (0,0000). # Relative risk

table(t$enrolment,t$country)

##            
##             australia other
##   full-time        69    10
##   part-time        16     0

x <- table(t$enrolment,t$country)
RelRisk(x)

## [1] 0.8734

Rủi ro trong ma trận này là 0.8734 < 1, cho thấy nhóm người không có quốc tịch Úc làm việc full-time có khả năng nhiều hơn nhóm người có quốc tịch khác Úc làm việc part-time # Odds Ratio

OddsRatio(x)

## [1] 0.2006

Chênh lệch trong ma trận này là 0.2006 < 1, cho thấy nhóm người Úc làm việc full-time có khả năng thấp hơn nhóm người Úc làm việc part-time

OddsRatio(x,conf.level = 0.05)

## odds ratio     lwr.ci     upr.ci 
##     0.2006     0.1829     0.2200

lwr.ci = 0.1829: Đây là giới hạn dưới của khoảng tin cậy 95%.

Chúng ta 95% tin tưởng rằng giá trị OR thực tế nằm trên hoặc bằng 0.1829.

upr.ci = 0.2200: Đây là giới hạn trên của khoảng tin cậy 95%.

Chúng ta 95% tin tưởng rằng giá trị OR thực tế nằm dưới hoặc bằng 0.2200. # Ước lượng

fitt <- glm(factor(enrolment) ~ country, family = binomial(link = 'logit'),data = socsupport)

summary(fitt)

## 
## Call:
## glm(formula = factor(enrolment) ~ country, family = binomial(link = "logit"), 
##     data = socsupport)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -1.462      0.277   -5.27  1.4e-07 ***
## countryother  -16.105   1251.054   -0.01     0.99    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 86.141  on 94  degrees of freedom
## Residual deviance: 82.221  on 93  degrees of freedom
## AIC: 86.22
## 
## Number of Fisher Scoring iterations: 16

Nhận xét:

(Intercept):

Estimate = -1.462: Đây là hệ số hồi quy cho hằng số (intercept) của mô hình. Nó đại diện cho log-odds dự đoán của biến phụ thuộc khi tất cả các biến độc lập bằng 0 (không thực tế trong trường hợp này).

Pr(>|z|) = 1.4e-07: Giá trị p rất nhỏ cho thấy hệ số hằng số có ý nghĩa thống kê.

countryother:

Estimate = -16.105: Hệ số hồi quy cho biến countryother (có thể là nhóm tham chiếu cho các quốc gia khác ngoài quốc gia mặc định).

Pr(>|z|) = 0.99: Giá trị p rất lớn cho thấy không đủ bằng chứng để kết luận hệ số hồi quy này khác biệt so với 0. Điều này có thể cho thấy không có sự khác biệt đáng kể về tỷ lệ odds giữa nhóm countryother và nhóm tham chiếu về loại hình ghi danh.