1 Tuần 3 và tuần 4

1.1 Thống kê mô tả cho các biến định tính và định lượng

1.1.1 Lập bảng tần số, tần suất, đồ thị cho biến occupation (Hình thức lao động)

table(p$occupation)
## 
## white  blue 
##   290   305
table(p$occupation)/sum(table(p$occupation))*100
## 
##   white    blue 
## 48.7395 51.2605
p |> ggplot(map=aes(x= occupation, y= after_stat(count))) + geom_bar(fill='yellow') + geom_text(aes(label= scales :: percent(after_stat(count/sum(count)),accuracy=.01)), stat = 'count', color= 'red', vjust= -.5) + xlab('Hình thức lao động') + ylab('Số người')

oc <- p %>% group_by(occupation) %>% summarise( n=n()) %>% mutate( percent=n/sum(n))
oc |> ggplot(aes(x='', y=percent, fill= occupation)) + geom_bar(stat='identity', width = 1) + geom_text(aes(label = paste0(round(percent*100), "%")), position = position_stack(vjust = 0.5))+
  coord_polar("y", start = 0) +
  scale_fill_manual(values = c("skyblue", "plum"), name = "Hình thức lao động") +
  labs(title = "BIỂU ĐỒ PHÂN BỐ HÌNH THỨC LAO ĐỘNG") +
  theme_minimal()

Trong 595 người tham gia khảo sát thì có 290 người (48,74%) làm nhân viên văn phòng và 305 người (51,26%) làm lao động tay chân.

1.1.2 Lập bảng tần số, tần suất, đồ thị cho biến married (Tình trạng hôn nhân)

table(p$married)
## 
##  no yes 
## 116 479
table(p$married)/sum(table(p$married))*100
## 
##      no     yes 
## 19.4958 80.5042
p |> ggplot(aes(x= married, y=after_stat(count))) + geom_bar( fill= 'plum') + geom_text(aes(label= scales :: percent(after_stat(count/sum(count)),accuracy=.05)), stat = 'count', color= 'red', vjust= -.5) + xlab('Tình trạng hôn nhân') +ylab('Số người')

ma <- p %>% group_by(married) %>% summarise( n=n()) %>% mutate( percent=n/sum(n))
ma |> ggplot(aes(x='', y=percent, fill= married)) + geom_bar(stat='identity', width = 1) + geom_text(aes(label = paste0(round(percent*100), "%")), position = position_stack(vjust = 0.5))+
  coord_polar("y", start = 0) +
  scale_fill_manual(values = c("skyblue", "plum"), name = "Tình trạng hôn nhân") +
  labs(title = "BIỂU ĐỒ PHÂN BỐ TÌNH TRẠNG HÔN NHÂN") +
  theme_minimal()

Trong 595 người tham gia khảo sát có 116 người (19,5%) chưa lập gia đình và 479 người (80,5%) đã lập gia đình.

1.1.3 Lập bảng tần số, tần suất, đồ thị cho biến gender (giới tính)

table(p$gender)
## 
##   male female 
##    528     67
table(p$gender)/sum(table(p$gender))*100
## 
##    male  female 
## 88.7395 11.2605
p |> ggplot(aes(x=gender, y=after_stat(count))) + geom_bar(fill= 'skyblue') + geom_text(aes(label = scales::percent( after_stat(count/sum(count))), accuracy =.05), stat = 'count', color= 'black', vjust=-.5) + xlab('Giới tính') + ylab('Số người')

ge <- p %>% group_by(gender) %>% summarise( n=n()) %>% mutate( percent =n/sum(n)) 
ge |> ggplot(aes(x='', y=percent, fill= gender)) + geom_bar(stat='identity', width = 1) + geom_text(aes(label = paste0(round(percent*100), "%")), position = position_stack(vjust = 0.5))+
  coord_polar("y", start = 0) +
  scale_fill_manual(values = c("skyblue", "plum"), name = "Giới tính") +
  labs(title = "BIỂU ĐỒ PHÂN BỐ GIỚI TÍNH") +
  theme_minimal()

Trong số 595 người tham gia khảo sát có 528 nam và 67 nữ. Trong đó tỉ lệ nam giới chiếm 88,74%. và tỉ lệ nữ giới chiếm 11,26%.

1.1.4 Lập bảng tần số, tần suất, đồ thị của biến ethnicity (dân tộc)

table(p$ethnicity)
## 
## other  afam 
##   552    43
table(p$ethnicity)/sum(table(p$ethnicity))*100
## 
##     other      afam 
## 92.773109  7.226891
p |> ggplot(aes( x = ethnicity, y = after_stat(count))) +
  geom_bar(fill = 'slategray') +
  geom_text(aes(label = scales::percent( after_stat(count/sum(count)))), stat = 'count', color = 'white', vjust = 1.5) +
  theme_classic() + 
  labs(x = 'Dân tộc', y = 'Số người')

dt <- p %>% group_by(ethnicity) %>% summarise( n=n()) %>% mutate( percent =n/sum(n)) 
dt |> ggplot(aes(x='', y=percent, fill= ethnicity)) + geom_bar(stat='identity', width = 1) + geom_text(aes(label = paste0(round(percent*100), "%")), position = position_stack(vjust = 0.5))+
  coord_polar("y", start = 0) +
  scale_fill_manual(values = c("slategray", "plum"), name = "Dân tộc") +
  labs(title = "BIỂU ĐỒ PHÂN BỐ DÂN TỘC") +
  theme_minimal()

Trong số 595 người tham gia khảo sát có 43 người là người Mỹ gốc phi chiếm 7,23% và 552 người là người dân tộc khác chiếm 92,77%.

1.1.5 Lập bảng tần số, tần suất, đồ thị cho biến weeks (số tuần đi làm)

summary(p$weeks)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    5.00   46.00   48.00   46.45   49.00   52.00
var(p$weeks)
## [1] 26.88449
sd(p$weeks)
## [1] 5.185025

Số tuần đi làm ít nhất là 5 tuần và số tuần đi làm nhiều nhất là 52 tuần.

Số tuần đi làm trung bình là 46,45 tuần.

Số tuần đi làm có phương sai là 26,88.

Số tuần đi làm có độ lệch chuẩn là 5,19.

Có 25% số người trong cuộc khảo sát có số tuần đi làm ít hơn 46 tuần.

Có 50% số người trong cuộc khảo sát có số tuần đi làm ít hơn 48 tuần.

Có 75% số người trong cuộc khảo sát có số tuần đi làm ít hơn 52 tuần.

ID <- seq(1,595, lenght = lenght(p$weeks))
## Warning: In seq.default(1, 595, lenght = lenght(p$weeks)) :
##  extra argument 'lenght' will be disregarded
pID <- mutate(p,ID)
pID |> ggplot(aes( x= ID, y=weeks )) + geom_col( fill= 'lightpink') + xlab('ID') + ylab(' Số tuần đi làm ')

Biểu đồ thể hiện số tuần đi làm của người tham gia khảo sát.

1.1.6 Lập bảng tần số, tần suất, đồ thị cho biến education (Học vấn)

summary(p$education)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    4.00   12.00   12.00   12.85   16.00   17.00
var(p$education)
## [1] 7.784133
sd(p$education)
## [1] 2.790006

Trong cuộc khảo sát người có học vấn thấp nhất là 4 và cao nhất là 27.

Trình độ học vấn trung bình là 12,85

Trình độ học vấn có phương sai là 7,78 và độ lệch chuẩn là 2,79.

pID |> ggplot(aes( x= ID, y=education )) + geom_col( fill= 'slategray') + geom_col( data=pID |> filter (education > 12), color = 'pink') + xlab('ID') + ylab(' Trình độ học vấn ')

Biểu đồ thể hiện trình độ học vấn của những người tham gia khảo sát. Trong đó người có trình độ học vấn lớn hơn 12 được thể hiện bằng màu hồng và người có trình độ học vấn từ 4 đến 12 được thể hiện bằng màu xám.

1.1.7 Lập bảng tần số, tần suất, đồ thị của biến wage (thu nhập)

summary(p$wage)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     292     800    1080    1148    1350    5100
sd(p$wage)
## [1] 531.0814

Trong cuộc khảo sát mức thu nhập bé nhất là 292 và mức thu nhập cao nhất là 5100.

Mức thu nhập trung bình là 1148

Thu nhập có độ lệch chuẩn là 531,08

pID |> ggplot(aes( x= ID, y=wage )) + geom_col( fill= 'yellow') + geom_col( data=pID |> filter (wage > 2000), color = 'green') + xlab('ID') + ylab(' Thu nhập ')

Biểu đồ thể hiện trình độ thu nhập của những người tham gia khảo sát. Trong đó cngười có thu nhập lớn hơn 2000 được thể hiện bằng màu xanh lá và người có thu nhập nhỏ hơn 2000 được thể hiện bằng màu vàng.

1.2 Mối liên hệ giữa các biến

1.2.1 Hình thức lao động và Giới tính

b1 <- table(p$occupation,p$gender)
addmargins(b1)
##        
##         male female Sum
##   white  252     38 290
##   blue   276     29 305
##   Sum    528     67 595
RelRisk(b1)
## [1] 0.9602699
riskratio(b1)
## $data
##        
##         male female Total
##   white  252     38   290
##   blue   276     29   305
##   Total  528     67   595
## 
## $measure
##        risk ratio with 95% C.I.
##          estimate     lower    upper
##   white 1.0000000        NA       NA
##   blue  0.7256255 0.4600236 1.144577
## 
## $p.value
##        two-sided
##         midp.exact fisher.exact chi.square
##   white         NA           NA         NA
##   blue   0.1689485    0.1945769  0.1655334
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ nam giới làm việc văn phòng bằng 96,03% tỷ lệ nam giới làm việc lao động tay chân. Tỷ lệ nữ giới làm việc lao động tay chân bằng 72,56% tỷ lệ nữ giới làm việc văn phòng.

p |> count(occupation, gender) |>
  group_by(occupation) |>
  mutate(pH = n/sum(n)) |>
  ggplot(aes(x = occupation, y = n, fill = gender)) +
  geom_col() +
  geom_text(aes(label = percent(pH, accuracy = .01)), position = position_stack(vjust = 0.5), size = 4) +
  ylab('Giới tính') +
  xlab('Hình thức lao động')

oddsratio(b1)
## $data
##        
##         male female Total
##   white  252     38   290
##   blue   276     29   305
##   Total  528     67   595
## 
## $measure
##        odds ratio with 95% C.I.
##          estimate     lower    upper
##   white 1.0000000        NA       NA
##   blue  0.6980583 0.4144615 1.164493
## 
## $p.value
##        two-sided
##         midp.exact fisher.exact chi.square
##   white         NA           NA         NA
##   blue   0.1689485    0.1945769  0.1655334
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
oddsratio(b1, rev='c')
## $data
##        
##         female male Total
##   white     38  252   290
##   blue      29  276   305
##   Total     67  528   595
## 
## $measure
##        odds ratio with 95% C.I.
##         estimate     lower    upper
##   white 1.000000        NA       NA
##   blue  1.432554 0.8587428 2.412769
## 
## $p.value
##        two-sided
##         midp.exact fisher.exact chi.square
##   white         NA           NA         NA
##   blue   0.1689485    0.1945769  0.1655334
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ nữ giới trên nam giới của những người làm lao động tay chân bằng 69,8% tỷ lệ nữ giới trên nam giới của những người làm việc văn phòng.

Tỷ lệ nam giới trên nữ giới của những người làm lao động tay chân nhiều hơn 43% tỷ lệ nam giới trên nữ giới của những người làm việc văn phòng.

p |> count(occupation, gender) |>
  group_by(gender) |>
  mutate(pH = n/sum(n)) |>
  ggplot(aes(x = occupation, y = n, fill = gender)) +
  geom_col() +
  geom_text(aes(label = percent(pH, accuracy = .01)), position = position_stack(vjust = 0.5), size = 4) +
  ylab('Giới tính') +
  xlab('Hình thức lao động')

1.2.2 Hình thức lao động và Tình trạng hôn nhân

b2 <- table(p$occupation,p$married)
addmargins(b2)
##        
##          no yes Sum
##   white  60 230 290
##   blue   56 249 305
##   Sum   116 479 595
oddsratio(b2)
## $data
##        
##          no yes Total
##   white  60 230   290
##   blue   56 249   305
##   Total 116 479   595
## 
## $measure
##        odds ratio with 95% C.I.
##         estimate     lower    upper
##   white 1.000000        NA       NA
##   blue  1.159459 0.7718409 1.743969
## 
## $p.value
##        two-sided
##         midp.exact fisher.exact chi.square
##   white         NA           NA         NA
##   blue   0.4758193    0.5346737  0.4735158
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
oddsratio(b2, rev='r')
## $data
##        
##          no yes Total
##   blue   56 249   305
##   white  60 230   290
##   Total 116 479   595
## 
## $measure
##        odds ratio with 95% C.I.
##          estimate     lower    upper
##   blue  1.0000000        NA       NA
##   white 0.8624755 0.5734045 1.295604
## 
## $p.value
##        two-sided
##         midp.exact fisher.exact chi.square
##   blue          NA           NA         NA
##   white  0.4758193    0.5346737  0.4735158
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ người đã kết hôn trên người chưa kết hôn của những nguời làm việc lao động tay chân nhiều hơn 26% tỷ lệ người đã kết hôn trên người chưa kết hôn của những người làm nhân viên văn phòng.

Tỷ lệ người đã kết hôn trên người chưa kết hôn của những nguời làm nhân viên văn phòng bằng 86,25% tỷ lệ người đã kết hôn trên người chưa kết hôn của những người làm việc lao động tay chân.

p |> count(occupation, married) |>
  group_by(occupation) |>
  mutate(pH = n/sum(n)) |>
  ggplot(aes(x = occupation, y = n, fill = married)) +
  geom_col() +
  geom_text(aes(label = percent(pH, accuracy = .01)), position = position_stack(vjust = 0.5), size = 4) +
  ylab('Tình trạng hôn nhân') +
  xlab('Hình thức lao động')

RelRisk(b2)
## [1] 1.126847
riskratio(b2)
## $data
##        
##          no yes Total
##   white  60 230   290
##   blue   56 249   305
##   Total 116 479   595
## 
## $measure
##        risk ratio with 95% C.I.
##         estimate     lower    upper
##   white 1.000000        NA       NA
##   blue  1.029366 0.9508915 1.114316
## 
## $p.value
##        two-sided
##         midp.exact fisher.exact chi.square
##   white         NA           NA         NA
##   blue   0.4758193    0.5346737  0.4735158
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ những người đã lập gia đình làm việc lao động tay chân nhiều hơn 3% so với những người đã lập gia đình làm việc văn phòng.

Tỷ lệ những người chưa lập gia đình làm việc văn phòng nhiều hơn 13% so với những người chưa lập gia đình làm việc lao động tay chân.

1.2.3 Hình thức lao động và Dân tộc

b4 <- table(p$occupation, p$ethnicity)
addmargins(b4)
##        
##         other afam Sum
##   white   275   15 290
##   blue    277   28 305
##   Sum     552   43 595
RelRisk(b4)
## [1] 1.04413
riskratio(b4)
## $data
##        
##         other afam Total
##   white   275   15   290
##   blue    277   28   305
##   Total   552   43   595
## 
## $measure
##        risk ratio with 95% C.I.
##         estimate     lower    upper
##   white 1.000000        NA       NA
##   blue  1.774863 0.9680672 3.254051
## 
## $p.value
##        two-sided
##         midp.exact fisher.exact chi.square
##   white         NA           NA         NA
##   blue  0.06086567   0.08046835 0.05913103
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ người không phải là người Mỹ gốc phi làm nhân viên văn phòng nhiều hơn 4% so với tỷ lệ người không phải là người Mỹ gốc phi làm lao động tay chân.

Tỷ lệ người Mỹ gốc phi làm lao động tay chân nhiều hơn 77% lần tỷ lệ người Mỹ gốc phi làm nhân viên văn phòng.

OddsRatio(b4)
## [1] 1.853189
oddsratio(b4)
## $data
##        
##         other afam Total
##   white   275   15   290
##   blue    277   28   305
##   Total   552   43   595
## 
## $measure
##        odds ratio with 95% C.I.
##         estimate     lower    upper
##   white 1.000000        NA       NA
##   blue  1.842634 0.9729152 3.626703
## 
## $p.value
##        two-sided
##         midp.exact fisher.exact chi.square
##   white         NA           NA         NA
##   blue  0.06086567   0.08046835 0.05913103
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
oddsratio(b4, rev='c')
## $data
##        
##         afam other Total
##   white   15   275   290
##   blue    28   277   305
##   Total   43   552   595
## 
## $measure
##        odds ratio with 95% C.I.
##          estimate     lower    upper
##   white 1.0000000        NA       NA
##   blue  0.5426749 0.2757326 1.027839
## 
## $p.value
##        two-sided
##         midp.exact fisher.exact chi.square
##   white         NA           NA         NA
##   blue  0.06086567   0.08046835 0.05913103
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ người Mỹ gốc phi trên người không phải người Mỹ gốc phi của những người làm việc lao động tay chân nhiều hơn 84% tỷ lệ người Mỹ gốc phi trên người không phải người Mỹ gốc phi của những người làm nhân viên văn phòng.

Tỷ lệ người không phải là người Mỹ gốc phi trên người Mỹ gốc phi của những người làm việc lao động tay chân bằng 54,27% tỷ lệ người không phải là người Mỹ gốc phi trên người Mỹ gốc phi của những người làm nhân viên văn phòng.

1.2.4 Hình thức lao động và Mức lương

p$tn <- cut( p$wage, breaks=c(291,1400,5101), labels=c('thấp','cao'))
b3 <- table( p$tn, p$occupation)
addmargins(b3)
##       
##        white blue Sum
##   thấp   181  281 462
##   cao    109   24 133
##   Sum    290  305 595
RelRisk(b3)
## [1] 0.4780373
riskratio(b3)
## $data
##        
##         white blue Total
##   thấp    181  281   462
##   cao     109   24   133
##   Total   290  305   595
## 
## $measure
##       risk ratio with 95% C.I.
##         estimate    lower    upper
##   thấp 1.0000000       NA       NA
##   cao  0.2966848 0.205032 0.429308
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact   chi.square
##   thấp         NA           NA           NA
##   cao           0 8.606852e-19 3.406973e-18
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tôi chia biến thu nhập (wage) ra làm hai phần là thu nhập thấp và thu nhập cao. Trong đó, những người có thu nhập thấp là người có mức lương dưới 1400 và người có thu nhập cao là người có mức lương trên 1400.

Tỷ lệ người làm việc văn phòng có thu nhập thấp bằng 50,88% tỷ lệ người làm việc văn phòng có thu nhập cao.

Tỷ lệ người làm việc lao động tay chân có thu nhập cao bằng 29,94% tỷ lệ người làm việc lao động tay chân có thu nhập thấp.

oddsratio(b3)
## $data
##        
##         white blue Total
##   thấp    181  281   462
##   cao     109   24   133
##   Total   290  305   595
## 
## $measure
##       odds ratio with 95% C.I.
##         estimate      lower    upper
##   thấp 1.0000000         NA       NA
##   cao  0.1429556 0.08658083 0.227504
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact   chi.square
##   thấp         NA           NA           NA
##   cao           0 8.606852e-19 3.406973e-18
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
oddsratio(b3, rev='c')
## $data
##        
##         blue white Total
##   thấp   281   181   462
##   cao     24   109   133
##   Total  305   290   595
## 
## $measure
##       odds ratio with 95% C.I.
##        estimate    lower   upper
##   thấp  1.00000       NA      NA
##   cao   6.99555 4.395528 11.5499
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact   chi.square
##   thấp         NA           NA           NA
##   cao           0 8.606852e-19 3.406973e-18
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Với mức ý nghĩa 5% ta có:

Tỷ lệ người làm việc lao động tay chân trên người làm việc văn phòng trong số những người có thu nhập cao bằng 15,38% tỷ lệ người làm việc lao động tay chân trên người làm việc văn phòng trong số những người có thu nhập thấp.

Tỷ lệ người làm việc văn phòng trên người làm việc lao động tay chân trong số những người thu nhập cao bằng 6.5 lần tỷ lệ người làm việc văn phòng trên người làm việc lao động tay chân trong số những người thu nhập thấp.

2 Tuần 5

2.1 Thống kê suy diễn

2.1.1 Kiểm định tính độc lập cho 2 biến định tính

2.1.1.1 Kiểm định tính độc lập cho 2 biến occupation (Hình thức lao động) và gender (Giới tính)

Đặt gỉa thiết:

H0: 2 biến hình thức lao động và giới tính độc lập với nhau

H1: 2 biến hình thức lao động và giới tính không độc lập với nhau

chisq.test(b1)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  b1
## X-squared = 1.58, df = 1, p-value = 0.2088

Kết quả này cho chúng ta thấy rằng p-value = 0.2088 > 0.05. Nên ta chấp nhận giả thiết H0. Vậy hình thức lao động và giới tính độc lập với nhau.

2.1.1.2 Kiểm định tính độc lập cho 2 biến occupation (Hình thức lao động) và married (Tình trạng hôn nhân)

Đặt giả thiết

H0: Hai biến độc lập

H1: Hai biến không độc lập

chisq.test(b2)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  b2
## X-squared = 0.37608, df = 1, p-value = 0.5397

Kết quả này cho chúng ta thấy rằng p-value = 0.5397 > 0.05. Nên ta chấp nhận giả thiết H0. Vậy hình thức lao động và tình trạng hôn nhân độc lập với nhau.

2.1.1.3 Kiểm định tính độc lập cho 2 biến occupation (Hình thức lao động) và wage (Thu nhập)

Đặt giả thiết:

H0: Hai biến độc lập

H1: Hai biến không độc lập

chisq.test(b3)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  b3
## X-squared = 73.936, df = 1, p-value < 2.2e-16
chisq.test(p$occupation, p$wage)
## Warning in chisq.test(p$occupation, p$wage): Chi-squared approximation may be
## incorrect
## 
##  Pearson's Chi-squared test
## 
## data:  p$occupation and p$wage
## X-squared = 394.52, df = 355, p-value = 0.07265

Kết quả này cho chúng ta thấy rằng p-value < 0.05. Nên ta chưa đủ cơ sở bác bỏ giả thiết H0. Vậy hình thức lao động và thu nhập là 2 biến không độc lập với nhau.

2.1.1.4 Kiểm định tính độc lập cho 2 biến occupation (Hình thức lao động) và ethnicity (dân tộc)

Đặt giả thiết:

H0: Hai biến độc lập

H1: Hai biến không độc lập

chisq.test(b4)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  b4
## X-squared = 2.9889, df = 1, p-value = 0.08384

Kết quả này cho chúng ta thấy rằng p-value = 0.08384 > 0.05. Nên ta chấp nhận giả thiết H0. Vậy hình thức lao động và dân tộc là 2 biến độc lập với nhau.

2.1.2 Bài toán ước lượng

2.1.2.1 Bài toán ước lượng cho biến wage (thu nhập)

tt <- p[p$wage > 2000,]
prop.test(length(tt$wage), length(p$wage))
## 
##  1-sample proportions test with continuity correction
## 
## data:  length(tt$wage) out of length(p$wage), null probability 0.5
## X-squared = 457.96, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.04330844 0.08358244
## sample estimates:
##         p 
## 0.0605042

Với độ tin cậy 95% ta có tỉ lệ người có mức thu nhập cao hơn 2000 trong cuộc khảo sát nằm trong khoảng từ 4,33% đến 8,36%.

tt1 <-  p[p$wage <= 1000,]
prop.test(length(tt1$wage) ,length(p$wage))
## 
##  1-sample proportions test with continuity correction
## 
## data:  length(tt1$wage) out of length(p$wage), null probability 0.5
## X-squared = 13.613, df = 1, p-value = 0.0002246
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.3836172 0.4644434
## sample estimates:
##         p 
## 0.4235294

Với độ tin cậy 95% ta có tỉ lệ người có mức thu nhập thấp hơn 1000 trong cuộc khảo sát nằm trong khoảng từ 38,36% đến 46.44%.

2.1.2.2 Bài toán ước lượng cho biến education (Học vấn)

tt2 <- p[p$education > 12,]
prop.test( length(tt2$education), length(p$education))
## 
##  1-sample proportions test with continuity correction
## 
## data:  length(tt2$education) out of length(p$education), null probability 0.5
## X-squared = 14.85, df = 1, p-value = 0.0001164
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.3803202 0.4610617
## sample estimates:
##         p 
## 0.4201681

Với độ tin cậy 95% ta có tỷ lệ người có trình độ học vấn cao hơn 12 của những người tham gia khảo sát nằm trong khoảng từ 38,03% đến 46,1%.

tt3 <-  p[p$education == 12,]
prop.test(length(tt3$education), length(p$education))
## 
##  1-sample proportions test with continuity correction
## 
## data:  length(tt3$education) out of length(p$education), null probability 0.5
## X-squared = 46.313, df = 1, p-value = 1.008e-11
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.3213017 0.3998656
## sample estimates:
##         p 
## 0.3596639

Với độ tin cậy 95%,ta có tỷ lệ người có trình độ học vấn bằng 12 của những người tham gia khảo sát nằm trong khoảng từ 32,13% đến 39,99%.

2.1.3 Hồi quy

MHlog <- glm( occupation ~ wage, family= binomial( link = 'logit'), data=p)
summary(MHlog)
## 
## Call:
## glm(formula = occupation ~ wage, family = binomial(link = "logit"), 
##     data = p)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  2.2544008  0.2716953   8.298   <2e-16 ***
## wage        -0.0019678  0.0002353  -8.364   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 824.47  on 594  degrees of freedom
## Residual deviance: 726.40  on 593  degrees of freedom
## AIC: 730.4
## 
## Number of Fisher Scoring iterations: 4
BrierScore(MHlog)
## [1] 0.2133125
MHlog0 <- glm( wage ~ education, family= poisson( link = 'log'), data=p)
summary(MHlog0)
## 
## Call:
## glm(formula = wage ~ education, family = poisson(link = "log"), 
##     data = p)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept) 6.0571989  0.0061290   988.3   <2e-16 ***
## education   0.0752810  0.0004479   168.1   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 129811  on 594  degrees of freedom
## Residual deviance: 100917  on 593  degrees of freedom
## AIC: 106151
## 
## Number of Fisher Scoring iterations: 4
MHlog1 <- glm( occupation ~ tn, family= binomial( link = 'cloglog'), data=p)
summary(MHlog1)
## 
## Call:
## glm(formula = occupation ~ tn, family = binomial(link = "cloglog"), 
##     data = p)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -0.06500    0.06186  -1.051    0.293    
## tncao       -1.54944    0.21361  -7.253 4.06e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 824.47  on 594  degrees of freedom
## Residual deviance: 744.22  on 593  degrees of freedom
## AIC: 748.22
## 
## Number of Fisher Scoring iterations: 5
BrierScore(MHlog1)
## [1] 0.2180805
MHlog2 <- glm( occupation ~ tn, family= binomial( link = 'probit'), data=p)
summary(MHlog2)
## 
## Call:
## glm(formula = occupation ~ tn, family = binomial(link = "probit"), 
##     data = p)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  0.27470    0.05912   4.647 3.37e-06 ***
## tncao       -1.18834    0.13998  -8.490  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 824.47  on 594  degrees of freedom
## Residual deviance: 744.22  on 593  degrees of freedom
## AIC: 748.22
## 
## Number of Fisher Scoring iterations: 4
BrierScore(MHlog2)
## [1] 0.2180805
MHlog3 <- glm( occupation ~ gender, family= binomial( link = 'probit'), data=p)
summary(MHlog3)
## 
## Call:
## glm(formula = occupation ~ gender, family = binomial(link = "probit"), 
##     data = p)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)
## (Intercept)   0.05700    0.05458   1.044    0.296
## genderfemale -0.22616    0.16330  -1.385    0.166
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 824.47  on 594  degrees of freedom
## Residual deviance: 822.54  on 593  degrees of freedom
## AIC: 826.54
## 
## Number of Fisher Scoring iterations: 3

3 Tuần 2

3.1 Chọn 1 biến định tính làm biến phụ thuộc

Đối với biến định tính, em chọn biến occupation làm biến phụ thuộc. Đây là biến phản ánh hình thức lao động của người tham gia khảo sát, gồm có 2 biểu hiện là nhân viên văn phòng và lao động tay chân. Lý do em chọn biến này là vì em muốn biết việc lựa chọn hình thức lao động có bị ảnh hưởng bởi các yếu tố như giới tính, tình trạng hôn nhân, học vấn, nơi sinh sống, … không.

3.2 Chọn 1 biến định lượng làm biến phụ thuộc

Đối với biến định lượng, em chọn biến wage làm biến phụ thuộc. Đây là biến cho biết mức lương của người tham gia khảo sát. Lý do em chọn biến này là vì em muốn biết mức lương của người tham gia khảo sát có bị ảnh hưởng bởi các yếu tố như giới tính, tình trạng hôn nhân, học vấn, nơi sinh sống, … không.

4 Tuần 1

4.1 Giải thích bộ dữ liệu

PSID1982: đây là bộ dữ liệu khảo sát 595 người ở Hoa Kỳ năm 1982. Mục tiêu nghiên cứu hình thức lao động có bị ảnh hưởng bởi các yếu tố như giới tính, tình trạng hôn nhân, học vấn, nơi sinh sống, …

Bộ dữ liệu có 595 quan sát gồm 12 biến bao gồm 4 biến định lượng và 8 biến định tính.

  • experience: số năm làm việc toàn thời gian
  • weeks: số tuần làm việc
  • occupation: hình thức lao động? Gồm có 2 biểu hiện white (nhân viên văn phòng) và blue (lao động tay chân)
  • industry: có làm việc trong ngành sản xuất không?
  • south: có cư trú ở miền Nam không?
  • smsa: có cư trú trong khu vực thống kê tiêu chuẩn không? (khu vực thống kê tiêu chuẩn là khu vực đô thị hóa với thành phố trung tâm có ít nhất 50,000 cư dân và dân số khu vực là 100,000 dân)
  • married: bạn đã kết hôn chưa? Gồm có 2 biểu hiện là no (chưa có gia đình) và yes (đã có gia đình)
  • gender: giới tính? Gồm có 2 biểu hiện là female (nữ) và male (nam).
  • union: Tiền lương của bạn có phải do hợp đồng công đoàn quy định không?
  • educations: số năm đi học?
  • ethnicity: dân tộc? Gồm 2 biểu hiện là afam (người Mỹ gốc Phi) và other (khác)
  • wage: thu nhập