Untitled

BÀI THỰC HÀNH TUẦN 3

1 Giới thiệu bộ dữ liệu

Bộ dữ liệu có 675 quan sát và 12 biến gồm :

School: trình độ học của trẻ (“Hauptschule”, “Realschule” và “Gymnasium”, tương ứng với các ý nghĩa là trường cấp hai có chương trình học phổ thông đại trà, trường cấp hai có chương trình học phổ thông nâng cao và trường cấp hai dành cho học sinh khá, giỏi.)

Birthyear: năm sinh của trẻ

Gender: giới tính (Có 2 biểu hiện female: nữ, male: nam)

Kids: số con trong nhà

Parity: thứ tự sinh của người khảo sát

Income: thu nhập trong gia đình (Đơn vị EURO)

Size: qui mô gia đình (Số người trong gia đình)

State: tiểu bang sinh sống

Marital: tình trạng hôn nhân của mẹ người khảo sát (Có 5 biểu hiện gồm “maried”: đã kết hôn, “widowed”: góa, “divorced”: li dị, “separated”: li thân, “single”: độc thân)

Meducation: trình độ giáo dụng của người mẹ

Memployment: yếu tố quyết định mức độ việc làm của người mẹ (Có 3 biểu hiện gồm “fulltime”: toàn thời gian, “partime”: bán thời gian và “none”: không có việc làm)

Year: năm thực hiện khảo sát

library(magrittr)

## Warning: package 'magrittr' was built under R version 4.3.1

library(scales)

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

library(ggplot2)

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

library(dplyr)

## Warning: package 'dplyr' was built under R version 4.3.1

## 
## 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

library(forcats)
library(AER)

## 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.1

## Loading required package: carData

## 
## Attaching package: 'car'

## The following object is masked from 'package:dplyr':
## 
##     recode

## 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

library(epitools)

## Warning: package 'epitools' was built under R version 4.3.1

## 
## Attaching package: 'epitools'

## The following object is masked from 'package:survival':
## 
##     ratetable

1.1 Thống kê mô tả

library(readxl)

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

data <- read_excel("C:/Users/Dell/Downloads/GSOEP9402.xlsx")
View(data)
str(data)

## tibble [675 × 13] (S3: tbl_df/tbl/data.frame)
##  $ rownames   : num [1:675] 1 2 3 4 5 6 7 8 9 10 ...
##  $ school     : chr [1:675] "Gymnasium" "Gymnasium" "Gymnasium" "Gymnasium" ...
##  $ birthyear  : num [1:675] 1981 1981 1980 1984 1982 ...
##  $ gender     : chr [1:675] "female" "female" "female" "female" ...
##  $ kids       : num [1:675] 2 2 3 1 4 3 3 1 4 2 ...
##  $ parity     : num [1:675] 2 2 3 1 4 1 3 1 4 2 ...
##  $ income     : num [1:675] 35160 65748 120962 60101 34829 ...
##  $ size       : num [1:675] 4 3 3 3 4 5 3 3 5 4 ...
##  $ state      : chr [1:675] "Berlin" "Berlin" "Berlin" "Berlin" ...
##  $ marital    : chr [1:675] "married" "married" "married" "married" ...
##  $ meducation : num [1:675] 14.5 10.5 12 10.5 10 15 15 13 15 9 ...
##  $ memployment: chr [1:675] "none" "parttime" "parttime" "parttime" ...
##  $ year       : num [1:675] 1995 1995 1994 1998 1996 ...

head(data)

## # A tibble: 6 × 13
##   rownames school     birthyear gender  kids parity  income  size state  marital
##      <dbl> <chr>          <dbl> <chr>  <dbl>  <dbl>   <dbl> <dbl> <chr>  <chr>  
## 1        1 Gymnasium       1981 female     2      2  35160.     4 Berlin married
## 2        2 Gymnasium       1981 female     2      2  65748.     3 Berlin married
## 3        3 Gymnasium       1980 female     3      3 120962.     3 Berlin married
## 4        4 Gymnasium       1984 female     1      1  60101.     3 Berlin married
## 5        5 Realschule      1982 male       4      4  34829.     4 Berlin divorc…
## 6        6 Realschule      1980 female     3      1  42584.     5 Berlin married
## # ℹ 3 more variables: meducation <dbl>, memployment <chr>, year <dbl>

1.2 Các dạng đồ thị

School là biến thể hiện loại trường trung học cơ sở, gồm 3 biểu hiện:

table(data$school)

## 
##   Gymnasium Hauptschule  Realschule 
##         277         199         199

round((table(data$school)/sum(table(data$school))*100),2)

## 
##   Gymnasium Hauptschule  Realschule 
##       41.04       29.48       29.48

• Có 277 trường cấp 2 dành cho học sinh khá giỏi chiếm tỷ lệ 41.04%

• Có 199 trường cấp 2 có chương trình học đại trà chiếm tỷ lệ 29.48%

• Có 199 trường cấp 2 có chương trình học nâng cao chiếm tỷ lệ 29.48%

data %>% ggplot(map = aes(x=school, y= after_stat(count)))+geom_bar(fill = 'pink')+geom_text(aes(label=percent(after_stat(count/sum(count)),accuracy = .01)), stat = 'count', color = 'white',vjust = 4) + labs(tiltle = 'Độ thị thể hiện số lượng học sinh đang theo học tại từng loại trường THCS', x = 'Loại trường THCS', y = 'số lượng học sinh')

• Như vậy, loại trường có số học sinh theo học nhiều nhất là trường trung học cơ sở dành cho học sinh khá giỏi, cùng nhiều hơn hai loại trường còn lại 78 học sinh (khoảng 11.56%). Loại trường trung học cơ sở có chương trình đại trà và loại trung học cơ sở chương trình nâng cao đều có cùng số người theo học là 199 người (chiếm 29.48% so với tổng thể).

table(data$gender)

## 
## female   male 
##    348    327

round((table(data$gender)/sum(table(data$gender))*100),2)

## 
## female   male 
##  51.56  48.44

data |>ggplot(aes(gender))+geom_bar()

Trong 675 học sinh trung học cở được khảo sát có:

• 327 học sinh thuộc giới tính nam (48,44%)
• 348 học sinh thuộc giới tính nữ ( chiếm 51,56%) Như vậy trong tổng số học sinh được khảo sát số học sinh có giới tính nữ nhiều hơn số học sinh có giới tính nam 21 người (khoảng 3,12% so với tổng số học sinh).

table(data$marital)

## 
##  divorced   married separated    single   widowed 
##        59       566        29        11        10

round((table(data$marital)/sum(table(data$marital))*100),2)

## 
##  divorced   married separated    single   widowed 
##      8.74     83.85      4.30      1.63      1.48

data %>% ggplot(map=aes(forcats::fct_infreq(marital))) + geom_bar(fill ='lightpink') + geom_text(aes(label=scales::percent(after_stat(count/sum(count)), accuracy= 0.01)), stat = 'count', color = 'darkblue', hjust = 0.5) + labs(title = 'Biểu đồ thể hiện tình trạng hôn nhân của mẹ người được khảo sát', y = 'Số lượng', x = 'Tình trạng hôn nhân') + coord_flip()

Tình trạng hôn nhân của mẹ các học sinh trung học cơ sở được khảo sát, chia thành 5 nhóm gồm:

• Đã kết hôn có 566 người, chiếm 83,85%
• Li hôn có 59 người, chiếm 8,74%
• Ly thân có 29 người, chiếm 4,3%
• Độc thân có 11 người, chiếm 1,63%
• Góa chồng có 10 người, chiếm 1,48%

table(data$memployment)

## 
## fulltime     none parttime 
##       89      302      284

round(table(data$memployment)/sum(table(data$memployment))*100,2)

## 
## fulltime     none parttime 
##    13.19    44.74    42.07

data %>% ggplot(aes(x = memployment, y = after_stat(count))) + geom_bar(fill = 'salmon') + labs(title = 'Biểu đồ thể hiện tình trạng việc làm của mẹ người khảo sát')

d1 <- table(data$memployment)
d1 <- data |> group_by(memployment) |> summarise(freq = n()) |> mutate(d1, per = freq/sum(freq))
d1 %>% ggplot(aes(x = '', y = per, fill = memployment)) +
geom_bar(stat = 'identity') + 
coord_polar('y')+
geom_text(aes(label = paste0(round(per*100), "%")), position = position_stack(vjust = 0.5))

Tình trạng việc làm của người mẹ 675 học sinh được khảo sát được chia làm 3 nhóm gồm:

• Làm việc toàn thời gian (fulltime): có 89 người, chiếm khoảng 13%.
• Làm việc bán thời gian (parttime): 284 người, chiếm khoảng 42%.
• Không có việc làm (none): 302 người, chiếm khoảng 45%

1.3 Bảng tần số - bảng tần suất

tmp <- table(data$gender,data$school)
prop.table(tmp)

##         
##          Gymnasium Hauptschule Realschule
##   female 0.2237037   0.1422222  0.1496296
##   male   0.1866667   0.1525926  0.1451852

addmargins(tmp)

##         
##          Gymnasium Hauptschule Realschule Sum
##   female       151          96        101 348
##   male         126         103         98 327
##   Sum          277         199        199 675

data %>% count(school,gender) %>% group_by(school) %>% mutate(psl=n/sum(n)) %>% ggplot(aes(x=school, y = n, fill = gender)) + geom_col()+geom_text(aes(label= percent(psl, accuracy = .01)), position = position_stack(vjust = 0.5), size = 3) + ylab('số học sinh') + xlab('loại trường THCS')

Kết quả trên cho chúng ta biết số lượng học sinh ở từ loại trường học theo giới tính, trong tổng số 675 học sinh được khảo sát

• Loại trường trung học cơ sở chương trình đại trà có 103 học sinh nam (khoảng 15,26%), và 96 học sinh nữ (khoảng 14,22%).
• Loại trường trung học cở sở chương trình nâng cao có 98 học sinh nam (khoảng 14,52%), và 101 học sinh nữ (14,97%)
• Loại trường trung học cở sở dành cho học sinh khá giỏi có 126 học sinh nam (khoảng 18,67%), và 151 học sinh nữ (22,37%)

Như vậy trong loại trường trung cơ sở chương trình đại trà có tỉ lệ học sinh nam nhiều hơn học sinh nữ 7 học sinh. Ở loại trường trung học cơ sở chương trình nâng cao và loại trường trung học cơ sở dành cho học sinh khá giỏi thì tỉ lệ học sinh nữ nhiều hơn học sinh nam lần lượt là 3 học sinh và 25 học sinh.

Trong phần trăm giới tính học sinh ở từng loại trường của 675 người được khảo sát, tỉ lệ học sinh nữ ở trường trung học cơ sở dành cho học sinh khá giỏi chiếm nhiều nhất (151 học sinh, 22,37%), tỉ lệ học sinh nữ ở loại trường trung học cơ sở chương trình đại trà là thấp nhất (96 người, 14,22%).

1.4 Relative Risk/Risk Ratio

library(epiR)

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

## Package epiR 2.0.74 is loaded

## Type help(epi.about) for summary information

## Type browseVignettes(package = 'epiR') to learn how to use epiR for applied epidemiological analyses

## 

school2 <- forcats::fct_collapse(data$school, "trường khá"= c("Hauptschule","Realschule"), "trường giỏi"=c("Gymnasium"))
data<- mutate(data,school2)
tmp <- table(data$gender,data$school2)
addmargins(tmp)

##         
##          trường giỏi trường khá Sum
##   female         151        197 348
##   male           126        201 327
##   Sum            277        398 675

riskratio(tmp)

## $data
##         
##          trường giỏi trường khá Total
##   female         151        197   348
##   male           126        201   327
##   Total          277        398   675
## 
## $measure
##         risk ratio with 95% C.I.
##          estimate     lower    upper
##   female 1.000000        NA       NA
##   male   1.085829 0.9574756 1.231388
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##   female         NA           NA         NA
##   male     0.200976    0.2108657  0.1996713
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

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

## $tab
##         
##          trường khá        p0 trường giỏi        p1 riskratio     lower
##   female        197 0.5660920         151 0.4339080 1.0000000        NA
##   male          201 0.6146789         126 0.3853211 0.8880248 0.7402228
##         
##             upper   p.value
##   female       NA        NA
##   male   1.065339 0.2108657
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

1.5 Tỷ lệ chênh (Odd Ratio)

oddsratio(tmp)

## $data
##         
##          trường giỏi trường khá Total
##   female         151        197   348
##   male           126        201   327
##   Total          277        398   675
## 
## $measure
##         odds ratio with 95% C.I.
##          estimate     lower    upper
##   female 1.000000        NA       NA
##   male   1.222218 0.8986989 1.663859
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##   female         NA           NA         NA
##   male     0.200976    0.2108657  0.1996713
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỉ lệ giữa xác suất học sinh trường khá và xác suất học sinh trường giỏi trong những học sinh giới tính nam so với Tỉ lệ giữa xác suất học sinh trường khá và xác suất học sinh trường giỏi trong những học sinh giới tính nữ là 1,22.

Con số này cho biết tỉ lệ khả năng học sinh nam học tại trường khá cao hơn 22% so với tỉ lệ học sinh nữ học tai loại trường này.

oddsratio(tmp,rev = 'c')

## $data
##         
##          trường khá trường giỏi Total
##   female        197         151   348
##   male          201         126   327
##   Total         398         277   675
## 
## $measure
##         odds ratio with 95% C.I.
##           estimate     lower   upper
##   female 1.0000000        NA      NA
##   male   0.8181854 0.6010126 1.11272
## 
## $p.value
##         two-sided
##          midp.exact fisher.exact chi.square
##   female         NA           NA         NA
##   male     0.200976    0.2108657  0.1996713
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỉ lệ giữa học sinh nam học tại trường giỏi và học sinh nam học tại trường khá so với tỉ lệ học sinh học nữ tại trường giỏi và học sinh học nữ tại trường khá là 0,81.

Con số này cho biết, tỉ lệ học sinh nam tại trường loại giỏi ít hơn 18% so tỉ lệ học sinh nữ

1.6 Khoảng ước lượng tỷ lệ

tmp <- data[data$size > 4,]


prop.test(length(data$size), length(data$size), p = 0.35)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(data$size) out of length(data$size), null probability 0.35
## X-squared = 1250.7, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.35
## 95 percent confidence interval:
##  0.9929454 1.0000000
## sample estimates:
## p 
## 1