1 TUẦN 6,7: Mô hình hồi quy

Yêu cầu: Chạy mô hình hồi quy của các biến định tính trong câu số 2, thực hiện các bài toán liên quan.

1.1 Phân tích hai biến là gender và education:

1.1.1 Ước lượng hàm hồi quy cho dữ liệu nhị thức

-Hàm liên kết cho dữ liệu nhị phân: logit

fit <- glm(factor(trinhdo) ~ gender, family = binomial(link = 'logit'), data = d )
fit

## 
## Call:  glm(formula = factor(trinhdo) ~ gender, family = binomial(link = "logit"), 
##     data = d)
## 
## Coefficients:
##  (Intercept)  genderfemale  
##       -0.201        -0.137  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       731 
## Residual Deviance: 730   AIC: 734

-Hàm liên kết cho dữ liệu nhị phân: probit

fit1 <- glm(data = d, factor (trinhdo) ~ gender, family = binomial(link = 'probit'))
fit1

## 
## Call:  glm(formula = factor(trinhdo) ~ gender, family = binomial(link = "probit"), 
##     data = d)
## 
## Coefficients:
##  (Intercept)  genderfemale  
##      -0.1261       -0.0852  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       731 
## Residual Deviance: 730   AIC: 734

-Hàm liên kết cho dữ liệu nhị phân: cloglog

fit2 <- glm(data = d, factor(trinhdo) ~ gender, family = binomial(link = 'cloglog'))
fit2

## 
## Call:  glm(formula = factor(trinhdo) ~ gender, family = binomial(link = "cloglog"), 
##     data = d)
## 
## Coefficients:
##  (Intercept)  genderfemale  
##       -0.515        -0.104  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       731 
## Residual Deviance: 730   AIC: 734

Tại đây em đã tiến hành phân tích dữ liệu nhị phân theo 3 loại hàm liên kết là logit, probit, cloglog ta có các phương trình sau:

Hàm logit: ta có hàm là y= -0,201 - 0,137x
Hàm probit: ta có hàm là: y= -0,1261 - 0,852x
Hàm cloglog: hàm là: y= -0,515 - 0,104x

cả 3 hàm đều a,b cho ra các giá trị âm nhưng có đều không giống về số a giao động từ [-0,515;-0,201] và b thuộc khoảng

1.1.2 Ước lượng hàm hồi quy cho dữ liệu Poisson

Hai biến này không phải dữ liệu có phân phối poisson nên không thể thực hiện ước lượng hàm hồi quy cho dữ liệu Poisson

1.1.3 Đánh giá mô hình

Sau khi ước lượng theo cái hàm liên kế khác nhau ta tiếng hành đánh giá mô hình:

-Hàm liên kết cho dữ liệu nhị phân: logit

summary (fit)

## 
## Call:
## glm(formula = factor(trinhdo) ~ gender, family = binomial(link = "logit"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
##  -1.09   -1.09   -1.04    1.26    1.32  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)  
## (Intercept)    -0.201      0.118   -1.70    0.089 .
## genderfemale   -0.137      0.175   -0.78    0.437  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 731.08  on 533  degrees of freedom
## Residual deviance: 730.47  on 532  degrees of freedom
## AIC: 734.5
## 
## Number of Fisher Scoring iterations: 4

BrierScore (fit)

## [1] 0.2454

-Hàm liên kết cho dữ liệu nhị phân: probit

summary (fit1)

## 
## Call:
## glm(formula = factor(trinhdo) ~ gender, family = binomial(link = "probit"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
##  -1.09   -1.09   -1.04    1.26    1.32  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)  
## (Intercept)   -0.1261     0.0739   -1.71    0.088 .
## genderfemale  -0.0852     0.1095   -0.78    0.436  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 731.08  on 533  degrees of freedom
## Residual deviance: 730.47  on 532  degrees of freedom
## AIC: 734.5
## 
## Number of Fisher Scoring iterations: 3

BrierScore(fit1)

## [1] 0.2454

-Hàm liên kết cho dữ liệu nhị phân: cloglog

summary (fit2)

## 
## Call:
## glm(formula = factor(trinhdo) ~ gender, family = binomial(link = "cloglog"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
##  -1.09   -1.09   -1.04    1.26    1.32  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -0.515      0.089   -5.79  7.2e-09 ***
## genderfemale   -0.104      0.134   -0.78     0.44    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 731.08  on 533  degrees of freedom
## Residual deviance: 730.47  on 532  degrees of freedom
## AIC: 734.5
## 
## Number of Fisher Scoring iterations: 4

BrierScore(fit2)

## [1] 0.2454

Qua ba chỉ số đánh giá mô hình ta thấy chúng đều giống nhau như:

AIC: 734.5

Beviance: 730.47

Brier Score: 0.2454

Vậy thể kết luân là cả ba hàm liên kết có ước lượng này là như nhau khi tiến về 0 thì độ tin cậy càng cao.

1.2 Phân tích hai biến là education và wage

1.2.1 Ước lượng hàm hồi quy cho dữ liệu nhị thức

-Hàm liên kết cho dữ liệu nhị phân: logit

i <- glm(data = d, factor(trinhdo) ~ thunhap, family = binomial(link = 'logit'))
i

## 
## Call:  glm(formula = factor(trinhdo) ~ thunhap, family = binomial(link = "logit"), 
##     data = d)
## 
## Coefficients:
##  (Intercept)  thunhapnhiều  
##       -0.689         1.337  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       731 
## Residual Deviance: 682   AIC: 686

-Hàm liên kết cho dữ liệu nhị phân: probit

i1 <- glm(data = d, factor(trinhdo) ~ thunhap, family = binomial(link = 'probit'))
i1

## 
## Call:  glm(formula = factor(trinhdo) ~ thunhap, family = binomial(link = "probit"), 
##     data = d)
## 
## Coefficients:
##  (Intercept)  thunhapnhiều  
##       -0.428         0.832  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       731 
## Residual Deviance: 682   AIC: 686

-Hàm liên kết cho dữ liệu nhị phân: log

i2 <- glm(data = d, factor(trinhdo) ~ thunhap, family = binomial(link = 'log'))
i2

## 
## Call:  glm(formula = factor(trinhdo) ~ thunhap, family = binomial(link = "log"), 
##     data = d)
## 
## Coefficients:
##  (Intercept)  thunhapnhiều  
##       -1.096         0.675  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       731 
## Residual Deviance: 682   AIC: 686

Tại đây em đã tiến hành phân tích dữ liệu nhị phân theo 3 loại hàm liên kết là logit, probit, log ta có các phương trình sau:

Hàm logit: ta có hàm là y= -0,689 + 1.337x

Hàm probit: ta có hàm là: y= -0,428 + 0,832x

Hàm log: hàm là: y= -1,096 + 0,675 x

cả 3 hàm đều a cho ra các giá trị âm nhưng có đều không giống về số a giao động từ [-1,096;-0,428] và b là số dương thuộc khoảng [0,675;1,337]

1.2.2 Ước lượng hàm hồi quy cho dữ liệu Poisson

t <- glm(data = d, formula = education ~ wage, family = poisson(link = 'log'))
summary (t)

## 
## Call:
## glm(formula = education ~ wage, family = poisson(link = "log"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -3.596  -0.324  -0.078   0.412   1.517  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  2.43724    0.02387  102.10  < 2e-16 ***
## wage         0.01401    0.00219    6.39  1.6e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 294.30  on 533  degrees of freedom
## Residual deviance: 255.15  on 532  degrees of freedom
## AIC: 2606
## 
## Number of Fisher Scoring iterations: 4

Câu lệnh cho ta thấy hàm ước lượng hồi quy cho hai biến là số năm đi học và thu nhập của những người tham gia khảo sát và hình thành phương trình như sau: y = 2,4272 + 0,014x

1.2.3 Đánh giá mô hình

Sau khi ước lượng theo cái hàm liên kế khác nhau ta tiếng hành đánh giá mô hình:

-Hàm liên kết cho dữ liệu nhị phân: logit

summary (i)

## 
## Call:
## glm(formula = factor(trinhdo) ~ thunhap, family = binomial(link = "logit"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.462  -0.902  -0.902   0.917   1.480  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -0.689      0.111   -6.24  4.5e-10 ***
## thunhapnhiều    1.337      0.197    6.78  1.2e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 731.08  on 533  degrees of freedom
## Residual deviance: 682.49  on 532  degrees of freedom
## AIC: 686.5
## 
## Number of Fisher Scoring iterations: 4

BrierScore (i)

## [1] 0.2234

-Hàm liên kết cho dữ liệu nhị phân: probit

summary (i1)

## 
## Call:
## glm(formula = factor(trinhdo) ~ thunhap, family = binomial(link = "probit"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.462  -0.902  -0.902   0.917   1.480  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   -0.4282     0.0676   -6.34  2.3e-10 ***
## thunhapnhiều   0.8315     0.1209    6.88  6.0e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 731.08  on 533  degrees of freedom
## Residual deviance: 682.49  on 532  degrees of freedom
## AIC: 686.5
## 
## Number of Fisher Scoring iterations: 4

BrierScore(i1)

## [1] 0.2234

-Hàm liên kết cho dữ liệu nhị phân: log

summary (i2)

## 
## Call:
## glm(formula = factor(trinhdo) ~ thunhap, family = binomial(link = "log"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.462  -0.902  -0.902   0.917   1.480  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   -1.0959     0.0736   -14.9  < 2e-16 ***
## thunhapnhiều   0.6753     0.0925     7.3  2.9e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 731.08  on 533  degrees of freedom
## Residual deviance: 682.49  on 532  degrees of freedom
## AIC: 686.5
## 
## Number of Fisher Scoring iterations: 5

BrierScore(i2)

## [1] 0.2234

Qua ba chỉ số đánh giá ước lượng mô hình nhị phân:

AIC: 686.5

Deviance: 682.49

Brier Score: 0.2234

Ta thấy các chỉ số của 3 hàm liên kết đều giống nhau cho nến không hàm liên kết nào hình thành được mô hình nào tốt nhất. Giá trị của Brier Score thể hiện chênh lệch giữa xác suất thực tế và xác xuất tính từ mô hình la 0,2234.

1.3 Phân tích hai biến là education và age

1.3.1 Ước lượng hàm hồi quy cho dữ liệu nhị thức

-Hàm liên kết cho dữ liệu nhị phân: logit

t <- glm(data = d, factor(trinhdo) ~ tuoi, family = binomial(link = 'logit'))
t

## 
## Call:  glm(formula = factor(trinhdo) ~ tuoi, family = binomial(link = "logit"), 
##     data = d)
## 
## Coefficients:
##   (Intercept)  tuoiThế kỉ 14  
##        -0.023         -0.719  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       731 
## Residual Deviance: 716   AIC: 720

-Hàm liên kết cho dữ liệu nhị phân: probit

t1 <- glm(data = d, factor(trinhdo) ~ tuoi, family = binomial(link = 'probit'))
t1

## 
## Call:  glm(formula = factor(trinhdo) ~ tuoi, family = binomial(link = "probit"), 
##     data = d)
## 
## Coefficients:
##   (Intercept)  tuoiThế kỉ 14  
##       -0.0144        -0.4461  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       731 
## Residual Deviance: 716   AIC: 720

-Hàm liên kết cho dữ liệu nhị phân: log

t2 <- glm(data = d, factor(trinhdo) ~ tuoi, family = binomial(link = 'log'))
t2

## 
## Call:  glm(formula = factor(trinhdo) ~ tuoi, family = binomial(link = "log"), 
##     data = d)
## 
## Coefficients:
##   (Intercept)  tuoiThế kỉ 14  
##        -0.705         -0.427  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       731 
## Residual Deviance: 716   AIC: 720

Tại đây em đã tiến hành phân tích dữ liệu nhị phân theo 3 loại hàm liên kết là logit, probit, log ta có các phương trình sau:

Hàm logit: ta có hàm là y= -0,023 - 0,719x

Hàm probit: ta có hàm là: y= -0,0144 - 0,4461x

Hàm log: hàm là: y= -0,705 - 0,427 x

cả 3 hàm đều a cho ra các giá trị âm nhưng có đều không giống về số a giao động từ [-0,705;-0,0144] và b cũng là số âm thuộc khoảng [-0,719;-0,427]

1.3.2 Ước lượng hàm hồi quy cho dữ liệu Poisson

t <- glm(data = d, formula = education ~ age, family = poisson(link = 'log'))
summary(t)

## 
## Call:
## glm(formula = education ~ age, family = poisson(link = "log"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -3.909  -0.385  -0.164   0.489   1.572  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  2.66139    0.03953   67.33   <2e-16 ***
## age         -0.00259    0.00103   -2.51    0.012 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 294.30  on 533  degrees of freedom
## Residual deviance: 287.96  on 532  degrees of freedom
## AIC: 2638
## 
## Number of Fisher Scoring iterations: 4

Câu lệnh cho ta thấy hàm ước lượng hồi quy cho hai biến là số năm đi học và tuổi của những người tham gia khảo sát và hình thành phương trình như sau: y = 2,6613 - 0,0026x

1.3.3 Đánh giá mô hình

Sau khi ước lượng theo cái hàm liên kế khác nhau ta tiếng hành đánh giá mô hình:

-Hàm liên kết cho dữ liệu nhị phân: logit

summary (t)

## 
## Call:
## glm(formula = education ~ age, family = poisson(link = "log"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -3.909  -0.385  -0.164   0.489   1.572  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  2.66139    0.03953   67.33   <2e-16 ***
## age         -0.00259    0.00103   -2.51    0.012 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 294.30  on 533  degrees of freedom
## Residual deviance: 287.96  on 532  degrees of freedom
## AIC: 2638
## 
## Number of Fisher Scoring iterations: 4

BrierScore(t)

## [1] -156.6

-Hàm liên kết cho dữ liệu nhị phân: probit

summary (t1)

## 
## Call:
## glm(formula = factor(trinhdo) ~ tuoi, family = binomial(link = "probit"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.168  -1.168  -0.883   1.187   1.504  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -0.0144     0.0672   -0.21  0.83022    
## tuoiThế kỉ 14  -0.4461     0.1168   -3.82  0.00013 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 731.08  on 533  degrees of freedom
## Residual deviance: 716.30  on 532  degrees of freedom
## AIC: 720.3
## 
## Number of Fisher Scoring iterations: 4

BrierScore(t1)

## [1] 0.239

-Hàm liên kết cho dữ liệu nhị phân: log

summary (t2)

## 
## Call:
## glm(formula = factor(trinhdo) ~ tuoi, family = binomial(link = "log"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.168  -1.168  -0.883   1.187   1.504  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -0.7047     0.0542  -13.00  < 2e-16 ***
## tuoiThế kỉ 14  -0.4267     0.1193   -3.58  0.00035 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 731.08  on 533  degrees of freedom
## Residual deviance: 716.30  on 532  degrees of freedom
## AIC: 720.3
## 
## Number of Fisher Scoring iterations: 5

BrierScore(t2)

## [1] 0.239

Các chỉ số đánh giá mô hình ước lượng hồi quy cho dữ liệu nhị phân:

AIC: 720,3

Deviance: 731,08

Brier Score thể hiện chênh lệch giữa xác suất thực tế và xác xuất tính từ mô hình là 0,239

Ta thấy các chỉ số của 3 hàm liên kết không có gì khác nhau nên không có mô hình nào tốt nhất.

1.4 Phân tích hai biến là occupation và ethnicity

1.4.1 Ước lượng hàm hồi quy cho dữ liệu nhị thức

-Hàm liên kết cho dữ liệu nhị phân: logit

op <- glm(data = d, factor (Ver) ~ Ver1, family = binomial(link = 'logit'))
op

## 
## Call:  glm(formula = factor(Ver) ~ Ver1, family = binomial(link = "logit"), 
##     data = d)
## 
## Coefficients:
##        (Intercept)  Ver1Chuyên môn cao  
##              -1.44               -0.22  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       497 
## Residual Deviance: 496   AIC: 500

-Hàm liên kết cho dữ liệu nhị phân: probit

op1 <- glm(data = d, factor (Ver) ~ Ver1, family = binomial(link = 'probit'))
op1

## 
## Call:  glm(formula = factor(Ver) ~ Ver1, family = binomial(link = "probit"), 
##     data = d)
## 
## Coefficients:
##        (Intercept)  Ver1Chuyên môn cao  
##             -0.873              -0.123  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       497 
## Residual Deviance: 496   AIC: 500

-Hàm liên kết cho dữ liệu nhị phân: cloglog

op2 <- glm(data = d, factor (Ver) ~ Ver1, family = binomial(link = 'cloglog'))
op2

## 
## Call:  glm(formula = factor(Ver) ~ Ver1, family = binomial(link = "cloglog"), 
##     data = d)
## 
## Coefficients:
##        (Intercept)  Ver1Chuyên môn cao  
##              -1.55               -0.20  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       497 
## Residual Deviance: 496   AIC: 500

Tại đây em đã tiến hành phân tích dữ liệu nhị phân theo 3 loại hàm liên kết là logit, probit, cloglog ta có các phương trình sau:

Hàm logit: ta có hàm là y= -1,44 -0,22x
Hàm probit: ta có hàm là: y= -0,873 -0,123 x
Hàm log: hàm là: y= -1,55 -0,20 x

cả 3 hàm đều a cho ra các giá trị âm nhưng có đều không giống về số a giao động từ [-1,55;-0,873] và b là số dương thuộc khoảng [-0,22;-0,123]

1.4.2 Ước lượng hàm hồi quy cho dữ liệu Poisson

Hai biến này không phải dữ liệu có phân phối poisson nên không thể thực hiện ước lượng hàm hồi quy cho dữ liệu Poisson.

1.4.3 Đánh giá mô hình

Sau khi ước lượng theo cái hàm liên kế khác nhau ta tiếng hành đánh giá mô hình:

-Hàm liên kết cho dữ liệu nhị phân: logit

summary (op)

## 
## Call:
## glm(formula = factor(Ver) ~ Ver1, family = binomial(link = "logit"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -0.652  -0.652  -0.590  -0.590   1.916  
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          -1.441      0.153   -9.44   <2e-16 ***
## Ver1Chuyên môn cao   -0.220      0.229   -0.96     0.34    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 496.96  on 533  degrees of freedom
## Residual deviance: 496.03  on 532  degrees of freedom
## AIC: 500
## 
## Number of Fisher Scoring iterations: 4

BrierScore (op)

## [1] 0.1448

-Hàm liên kết cho dữ liệu nhị phân: probit

summary (op1)

## 
## Call:
## glm(formula = factor(Ver) ~ Ver1, family = binomial(link = "probit"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -0.652  -0.652  -0.590  -0.590   1.916  
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)         -0.8730     0.0867  -10.07   <2e-16 ***
## Ver1Chuyên môn cao  -0.1234     0.1279   -0.96     0.33    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 496.96  on 533  degrees of freedom
## Residual deviance: 496.03  on 532  degrees of freedom
## AIC: 500
## 
## Number of Fisher Scoring iterations: 4

BrierScore(op1)

## [1] 0.1448

-Hàm liên kết cho dữ liệu nhị phân: log

summary (op2)

## 
## Call:
## glm(formula = factor(Ver) ~ Ver1, family = binomial(link = "cloglog"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -0.652  -0.652  -0.590  -0.590   1.916  
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          -1.549      0.138  -11.26   <2e-16 ***
## Ver1Chuyên môn cao   -0.200      0.208   -0.96     0.34    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 496.96  on 533  degrees of freedom
## Residual deviance: 496.03  on 532  degrees of freedom
## AIC: 500
## 
## Number of Fisher Scoring iterations: 5

BrierScore(op2)

## [1] 0.1448

Các chỉ số đánh giá mô hình ước lượng hồi quy cho dữ liệu nhị phân:

AIC: 500

Deviance: 496.96

Brier Score: 0,1448.

Ta thấy các chỉ số của 3 hàm liên kết không có gì khác nhau nên không có mô hình nào tốt nhất. Đánh giá Brier Score thể hiện chênh lệch giữa xác suất thực tế và xác xuất tính từ mô hình là 0,1448. Có thể nói đây là ước lượng tốt nhất trong 4 cặp dữ liệu đã đánh giá.

1.5 Phân tích hai biến là occupation và marreid

1.5.1 Ước lượng hàm hồi quy cho dữ liệu nhị thức

-Hàm liên kết cho dữ liệu nhị phân: log

ok <- glm(data = d, formula = married ~ Ver1, family = binomial(link = 'log'))
ok

## 
## Call:  glm(formula = married ~ Ver1, family = binomial(link = "log"), 
##     data = d)
## 
## Coefficients:
##        (Intercept)  Ver1Chuyên môn cao  
##            -0.4366              0.0292  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       688 
## Residual Deviance: 688   AIC: 692

-Hàm liên kết cho dữ liệu nhị phân: probit

ok1 <- glm(data = d, formula = married ~ Ver1, family = binomial(link = 'probit'))
ok1

## 
## Call:  glm(formula = married ~ Ver1, family = binomial(link = "probit"), 
##     data = d)
## 
## Coefficients:
##        (Intercept)  Ver1Chuyên môn cao  
##             0.3751              0.0521  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       688 
## Residual Deviance: 688   AIC: 692

-Hàm liên kết cho dữ liệu nhị phân: cauchit

ok2 <- glm(data = d, formula = married ~ Ver1, family = binomial(link = 'cauchit'))
ok2

## 
## Call:  glm(formula = married ~ Ver1, family = binomial(link = "cauchit"), 
##     data = d)
## 
## Coefficients:
##        (Intercept)  Ver1Chuyên môn cao  
##             0.4946              0.0773  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  532 Residual
## Null Deviance:       688 
## Residual Deviance: 688   AIC: 692

Tại đây em đã tiến hành phân tích dữ liệu nhị phân theo 3 loại hàm liên kết là log, probit, cauchit ta có các phương trình sau:

Hàm log, ta có hàm là y= -0,4366 -0,0292x
Hàm probit, ta có hàm là: y= 0,3751 + 0.0521x
Hàm cauchit, hàm là: y= -0,4946 +0,773x

Cả 3 hàm đều a và b đều không giống về số a giao động từ [-0,4946;0,3751] và b thuộc khoảng [-0,367;0,773]

1.5.2 Ước lượng hàm hồi quy cho dữ liệu Poisson

Hai biến này không phải dữ liệu có phân phối poisson nên không thể thực hiện ước lượng hàm hồi quy cho dữ liệu Poisson.

1.5.3 Đánh giá mô hình

Sau khi ước lượng theo cái hàm liên kế khác nhau ta tiếng hành đánh giá mô hình:

-Hàm liên kết cho dữ liệu nhị phân: log

summary (ok)

## 
## Call:
## glm(formula = married ~ Ver1, family = binomial(link = "log"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.480  -1.442   0.903   0.934   0.934  
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)         -0.4366     0.0445   -9.82   <2e-16 ***
## Ver1Chuyên môn cao   0.0292     0.0627    0.47     0.64    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 687.81  on 533  degrees of freedom
## Residual deviance: 687.60  on 532  degrees of freedom
## AIC: 691.6
## 
## Number of Fisher Scoring iterations: 5

BrierScore (ok)

## [1] 0.2257

-Hàm liên kết cho dữ liệu nhị phân: probit

summary (ok1)

## 
## Call:
## glm(formula = married ~ Ver1, family = binomial(link = "probit"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.480  -1.442   0.903   0.934   0.934  
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          0.3751     0.0773    4.86  1.2e-06 ***
## Ver1Chuyên môn cao   0.0521     0.1118    0.47     0.64    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 687.81  on 533  degrees of freedom
## Residual deviance: 687.60  on 532  degrees of freedom
## AIC: 691.6
## 
## Number of Fisher Scoring iterations: 4

BrierScore(ok1)

## [1] 0.2257

-Hàm liên kết cho dữ liệu nhị phân: cauchit

summary (ok2)

## 
## Call:
## glm(formula = married ~ Ver1, family = binomial(link = "cauchit"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.480  -1.442   0.903   0.934   0.934  
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          0.4946     0.1123    4.40  1.1e-05 ***
## Ver1Chuyên môn cao   0.0773     0.1664    0.46     0.64    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 687.81  on 533  degrees of freedom
## Residual deviance: 687.60  on 532  degrees of freedom
## AIC: 691.6
## 
## Number of Fisher Scoring iterations: 5

BrierScore(ok2)

## [1] 0.2257

Đánh giá mô hình ước lượng hồi quy cho dữ liệu nhị phân bằng 3 hàm liên kết là log, probit, cauchit ta nhận được loại chỉ số khác nhau:

Các chỉ số đánh giá mô hình ước lượng hồi quy cho dữ liệu nhị phân bằng 2 hàm liên kết log, probit:

AIC: 619.6

Deviance: 687.81

Brier Score: 0,2257
Các chỉ số đánh giá mô hình ước lượng hồi quy cho dữ liệu nhị phân bằng hàm liên kết cauchit:

AIC: 500

Deviance: 496.96

Brier Score: 0,1448.

Ta thấy các chỉ số của hàm liên kết cauchit đều nhỏ hơn các chỉ số đánh giá của 2 hàm liên kết còn lại chứng minh mô hình đánh giá bằng hàm liên kết tốt hơn với hai mô hình còn lại.

1.6 Phân tích ba biến là gender, education và wage

Ước lượng hồi quy

ft <- glm(factor(trinhdo) ~ gender+thunhap, family = binomial(link = 'logit'), data = d )
ft

## 
## Call:  glm(formula = factor(trinhdo) ~ gender + thunhap, family = binomial(link = "logit"), 
##     data = d)
## 
## Coefficients:
##  (Intercept)  genderfemale  thunhapnhiều  
##       -0.732         0.083         1.353  
## 
## Degrees of Freedom: 533 Total (i.e. Null);  531 Residual
## Null Deviance:       731 
## Residual Deviance: 682   AIC: 688

Tại đây em đã tiến hành phân tích dữ liệu nhị phân với loại hàm liên kết là logitta có các phương trình \(logit(\pi)= log(\frac{\pi}{1-\pi}) = -0.732 +0.083x +1.353y353y\)

Đánh giá mô hình

summary(ft)

## 
## Call:
## glm(formula = factor(trinhdo) ~ gender + thunhap, family = binomial(link = "logit"), 
##     data = d)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.487  -0.917  -0.886   0.927   1.500  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -0.732      0.148   -4.96  7.0e-07 ***
## genderfemale    0.083      0.187    0.44     0.66    
## thunhapnhiều    1.353      0.201    6.74  1.6e-11 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 731.08  on 533  degrees of freedom
## Residual deviance: 682.30  on 531  degrees of freedom
## AIC: 688.3
## 
## Number of Fisher Scoring iterations: 4

BrierScore(ft)

## [1] 0.2234

confusionMatrix(table(predict(ft, type="response") >= 0.5 ,fit$data$trinhdo == '1'))

## Confusion Matrix and Statistics
## 
##        
##         FALSE TRUE
##   FALSE   245  123
##   TRUE     57  109
##                                         
##                Accuracy : 0.663         
##                  95% CI : (0.621, 0.703)
##     No Information Rate : 0.566         
##     P-Value [Acc > NIR] : 2.71e-06      
##                                         
##                   Kappa : 0.291         
##                                         
##  Mcnemar's Test P-Value : 1.27e-06      
##                                         
##             Sensitivity : 0.811         
##             Specificity : 0.470         
##          Pos Pred Value : 0.666         
##          Neg Pred Value : 0.657         
##              Prevalence : 0.566         
##          Detection Rate : 0.459         
##    Detection Prevalence : 0.689         
##       Balanced Accuracy : 0.641         
##                                         
##        'Positive' Class : FALSE         
##

Các chỉ số đánh giá mô hình ước lượng hồi quy cho dữ liệu nhị phân bằng hàm liên kết logit:

AIC: 688,3

Deviance: 682.30

Brier Score: 0.2234

Ma trận nhầm lẫn ta có thể nhận thấy việc tính toán tỷ lệ lỗi rất đơn giản và chính xác. Nếu một mô hình hoạt động với độ chính xác 66,3% thì tỷ lệ lỗi sẽ là 33,7%.

2 TUẦN 5: Thống kê mô tả cho hai biến

Yêu cầu: Phân tích thống kê mô tả của 2 biến phụ thuộc ở câu 2 với 5 biến còn lại trong câu 3, nhận xét về kết quả phân tích này

2.1 Phân tích hai biến là gender và education:

2.1.1 Đồ thị cột

trinhdo <-cut(d$education, breaks=c(1,12,18), labels=c('thấp', ' cao'))
table(trinhdo)

## trinhdo
## thấp  cao 
##  302  232

table(trinhdo)/sum(table(trinhdo))

## trinhdo
##   thấp    cao 
## 0.5655 0.4345

k <- data.frame(d$wage, d$education, d$experience, d$age, d$ethnicity, d$region, d$gender, d$occupation, d$sector, d$union, d$married, trinhdo)
k |> ggplot(aes(x = d.gender, y = after_stat(count))) + geom_bar(fill = 'blue') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + facet_grid(. ~ trinhdo) + labs(x = 'Giới tính', y = 'Số người')

Đồ thị thấy tại trình độ nào thì nam vẫn nhiều hơn nữ nhưng tại trình độ cao thì khoảng cách này xa hơn. Tại đây người học đại học tới cao học thì ít hơn người người học cấp ba trở xuống rất nhiều.

2.1.2 Bảng tần số

tmp <- table(k$trinhdo, d$gender)
tmp

##       
##        male female
##   thấp  159    143
##    cao  130    102

tmp1 <- prop.table(tmp)
tmp1

##       
##          male female
##   thấp 0.2978 0.2678
##    cao 0.2434 0.1910

addmargins(tmp1)

##       
##          male female    Sum
##   thấp 0.2978 0.2678 0.5655
##    cao 0.2434 0.1910 0.4345
##   Sum  0.5412 0.4588 1.0000

Nhìn vào ba bảng tần số ta có thể thấy ít nhất là nữ giới có học vấn cao chỉ có gần 19% trong tổng số ba nhóm còn lại.

2.1.3 Rủi ro tương đối

Rủi ro tương đối là một tỷ lệ 2 xác suất: Xác suất của những trình độ học tập của người tham gia khảo sát và xác suất để người đó mang 1 trong 2 giới tính nam hoặc nữ.

riskratio(tmp)

## $data
##        
##         male female Total
##   thấp   159    143   302
##    cao   130    102   232
##   Total  289    245   534
## 
## $measure
##       risk ratio with 95% C.I.
##        estimate  lower upper
##   thấp   1.0000     NA    NA
##    cao   0.9285 0.7696  1.12
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao     0.4383       0.4835     0.4364
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ giữa hai giới tính là nam và nữ có các trình độ học tập thấp (dưới 12 năm) bằng 9285% so với tỉ lệ giữa hai giới tính có trình độ học tập cao (từ 12 đến 18 năm).

Ngược lại, Khi có thêm tham số rev = ‘c’ thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên.

riskratio(tmp, rev = 'c')

## $data
##        
##         female male Total
##   thấp     143  159   302
##    cao     102  130   232
##   Total    245  289   534
## 
## $measure
##       risk ratio with 95% C.I.
##        estimate  lower upper
##   thấp    1.000     NA    NA
##    cao    1.064 0.9103 1.244
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao     0.4383       0.4835     0.4364
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

2.1.4 Tỷ lệ chệnh lệch

oddsratio(tmp)

## $data
##        
##         male female Total
##   thấp   159    143   302
##    cao   130    102   232
##   Total  289    245   534
## 
## $measure
##       odds ratio with 95% C.I.
##        estimate lower upper
##   thấp   1.0000    NA    NA
##    cao   0.8728 0.618 1.231
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao     0.4383       0.4835     0.4364
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ giữa hai giới tính là nam và nữ có các trình độ học tập thấp (dưới 12 năm) bằng 87,28% so với tỉ lệ giữa hai giới tính có trình độ học tập cao (từ 12 đến 18 năm).

Ngoài ra, Khi có thêm tham số rev = ‘c’ thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên.

oddsratio(tmp, rev = 'c')

## $data
##        
##         female male Total
##   thấp     143  159   302
##    cao     102  130   232
##   Total    245  289   534
## 
## $measure
##       odds ratio with 95% C.I.
##        estimate  lower upper
##   thấp    1.000     NA    NA
##    cao    1.146 0.8123 1.618
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao     0.4383       0.4835     0.4364
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

2.1.5 Thống kê suy diễn: Kiểm tra tính độc lập của hai biến

chisq.test(tmp)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tmp
## X-squared = 0.48, df = 1, p-value = 0.5

Kết quả cho thấy giữa giữa trình đọ học tập với giới tính của những người thực hiện khảo sát là hai biến có liên hệ với nhau.

2.2 Phân tích hai biến là education và wage

2.2.1 Chuyển thành biến có hai biểu hiện

Trong hay biến thì education đã được chuyển thành nhị thức. Sau đây em sẽ chuyển biến wage thành nhị thức, ở biến thu nhập tôi chia thành biẻu hiện người có thu nhập thấp là người có thu nhập từ 0 đến 10 USD/h sau đó là người có thu nhập cao từ 10 USD/h trở lên đên 44,5 USD/h. Tiếp theo tôi gán nó vào data k.

thunhap <-cut(d$wage, breaks=c(0,10,44.5), labels=c('ít', 'nhiều'))
table(thunhap)

## thunhap
##    ít nhiều 
##   368   166

k <- data.frame(d$wage, d$education, d$experience, d$age, d$ethnicity, d$region, d$gender, d$occupation, d$sector, d$union, d$married, trinhdo,thunhap)

Kết quả cho ra có 368 người có thu nhập thấp và 166 người có thu nhập cao.

2.2.2 Bảng và biểu đồ cột

e <- table(k$trinhdo, k$thunhap)
e

##       
##         ít nhiều
##   thấp 245    57
##    cao 123   109

e1 <- prop.table(e)
e1

##       
##            ít  nhiều
##   thấp 0.4588 0.1067
##    cao 0.2303 0.2041

addmargins(e)

##       
##         ít nhiều Sum
##   thấp 245    57 302
##    cao 123   109 232
##   Sum  368   166 534

Biểu đồ cột

k |> ggplot(aes(x = thunhap, 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) + facet_grid(. ~ trinhdo) + labs(x = 'Thu nhập', y = 'Số người') + coord_flip()

Nhìn vào bảng và biểu đồ ta thấy người có thu nhập nhiều chiếm khá ít chi khoảng 30% người có thu nhập như vậy. Và biểu đồ cho ta thấy phần lớn người có trình độ thấp có tièn lương ít chứng tỏ học vấn có qua hệ đến mức lương được tính theo giờ của những người này.

2.2.3 Rủi ro tương đối

riskratio(e)

## $data
##        
##          ít nhiều Total
##   thấp  245    57   302
##    cao  123   109   232
##   Total 368   166   534
## 
## $measure
##       risk ratio with 95% C.I.
##        estimate lower upper
##   thấp    1.000    NA    NA
##    cao    2.489 1.899 3.264
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao  3.916e-12    5.973e-12  3.493e-12
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ giữa thu nhập dưới 10 USD/h và cao hơn 10 USD/h có các trình độ học tập thấp (dưới 12 năm) bằng 2,48 lần so với tỉ lệ giữa hai loại thu nhập dưới 10 USD/h và cao hơn 10 USD/h.

Ngược lại, Khi có thêm tham số rev = ‘c’ thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên.

riskratio(e, rev = 'c')

## $data
##        
##         nhiều  ít Total
##   thấp     57 245   302
##    cao    109 123   232
##   Total   166 368   534
## 
## $measure
##       risk ratio with 95% C.I.
##        estimate  lower  upper
##   thấp   1.0000     NA     NA
##    cao   0.6535 0.5723 0.7463
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao  3.916e-12    5.973e-12  3.493e-12
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

2.2.4 Tỷ lệ chệnh lệch

oddsratio(e)

## $data
##        
##          ít nhiều Total
##   thấp  245    57   302
##    cao  123   109   232
##   Total 368   166   534
## 
## $measure
##       odds ratio with 95% C.I.
##        estimate lower upper
##   thấp    1.000    NA    NA
##    cao    3.794 2.586 5.617
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao  3.916e-12    5.973e-12  3.493e-12
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ giữa thu nhập dưới 10 USD/h và cao hơn 10 USD/h có các trình độ học tập thấp (dưới 12 năm) bằng 3.79 lần so với tỉ lè giữa hai loại thu nhập dưới 10 USD/h và cao hơn 10 USD/h.

Ngược lại, Khi có thêm tham số rev = ‘c’ thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên.

oddsratio(e, rev = 'c')

## $data
##        
##         nhiều  ít Total
##   thấp     57 245   302
##    cao    109 123   232
##   Total   166 368   534
## 
## $measure
##       odds ratio with 95% C.I.
##        estimate lower  upper
##   thấp   1.0000    NA     NA
##    cao   0.2636 0.178 0.3867
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao  3.916e-12    5.973e-12  3.493e-12
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

2.2.5 Thống kê suy diễn: Kiểm tra tính độc lập của hai biến

chisq.test(e)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  e
## X-squared = 47, df = 1, p-value = 7e-12

Kết quả cho thấy giữa giữa trình độ học tập với thu nhập của những người thực hiện khảo sát là độc lập với nhau.

2.3 Phân tích hai biến là education và age

2.3.1 Bảng tần số và biểu đồ

tuoi <-cut(d$age, breaks=c(1,39,64), labels=c('Thế kỉ 16', 'Thế kỉ 14'))
k <- data.frame(k, tuoi)
P <- table(k$trinhdo, k$tuoi)
P

##       
##        Thế kỉ 16 Thế kỉ 14
##   thấp       176       126
##    cao       172        60

P1 <- prop.table(P)
P1

##       
##        Thế kỉ 16 Thế kỉ 14
##   thấp    0.3296    0.2360
##    cao    0.3221    0.1124

addmargins(P)

##       
##        Thế kỉ 16 Thế kỉ 14 Sum
##   thấp       176       126 302
##    cao       172        60 232
##   Sum        348       186 534

boxplot(d$age ~ k$trinhdo, col = c('blue', 'sienna', 'palevioletred1', 'green'))

Nhìn vào các lệnh thống kê cho thấy tình trạng giáo dục ngày càng được cải thiện vì trình độ giáo dục của của những người trẻ có học vấn cao hơn so nhóm người trung niên hơn 20%.

2.3.2 Rủi ro tương đối

riskratio(P)

## $data
##        
##         Thế kỉ 16 Thế kỉ 14 Total
##   thấp        176       126   302
##    cao        172        60   232
##   Total       348       186   534
## 
## $measure
##       risk ratio with 95% C.I.
##        estimate  lower  upper
##   thấp   1.0000     NA     NA
##    cao   0.6199 0.4801 0.8002
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao  0.0001302    0.0001651  0.0001373
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ giữa độ tuổi của người thuộc nhóm tuổi trẻ và nhóm tuổi trung niên là người có trình độ học vấn cao là bằng 61,99% so với tỷ lệ ggiữa độ tuổi của người thuộc nhóm tuổi trẻ và nhóm tuổi trung niên là người có trình độ học vấn thấp.

Ngược lại, Khi có thêm tham số rev = ‘c’ thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên.

riskratio(P, rev = 'c')

## $data
##        
##         Thế kỉ 14 Thế kỉ 16 Total
##   thấp        126       176   302
##    cao         60       172   232
##   Total       186       348   534
## 
## $measure
##       risk ratio with 95% C.I.
##        estimate lower upper
##   thấp    1.000    NA    NA
##    cao    1.272 1.126 1.437
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao  0.0001302    0.0001651  0.0001373
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

2.3.3 Tỷ lệ chệnh lệch

oddsratio(P)

## $data
##        
##         Thế kỉ 16 Thế kỉ 14 Total
##   thấp        176       126   302
##    cao        172        60   232
##   Total       348       186   534
## 
## $measure
##       odds ratio with 95% C.I.
##        estimate  lower  upper
##   thấp   1.0000     NA     NA
##    cao   0.4884 0.3349 0.7068
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao  0.0001302    0.0001651  0.0001373
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ giữa độ tuổi của người thuộc nhóm tuổi trẻ và nhóm tuổi trung niên là người có trình độ học vấn cao là bằng 48,84% so với tỷ lệ ggiữa độ tuổi của người thuộc nhóm tuổi trẻ và nhóm tuổi trung niên là người có trình độ học vấn thấp.

Ngược lại, Khi có thêm tham số rev = ‘c’ thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên.

oddsratio(P, rev = 'c')

## $data
##        
##         Thế kỉ 14 Thế kỉ 16 Total
##   thấp        126       176   302
##    cao         60       172   232
##   Total       186       348   534
## 
## $measure
##       odds ratio with 95% C.I.
##        estimate lower upper
##   thấp    1.000    NA    NA
##    cao    2.048 1.415 2.986
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact chi.square
##   thấp         NA           NA         NA
##    cao  0.0001302    0.0001651  0.0001373
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

2.3.4 Thống kê suy diễn: Kiểm tra tính độc lập của hai biến

chisq.test(P)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  P
## X-squared = 14, df = 1, p-value = 2e-04

Kết quả cho thấy giữa giữa trình độ học tập với thu nhập của những người thực hiện khảo sát độc lập với nhau.

2.4 Phân tích hai biến là occupation và ethnicity

2.4.1 Chuyển thành biến có hai biểu hiện

p <- table(d$ethnicity,d$occupation)
p

##           
##            worker technical services office sales management
##   cauc        130        93       60     77    34         46
##   hispanic      7         5        6      5     1          3
##   other        19         7       17     15     3          6

Ver <- d %>% mutate(dantoc = case_when(ethnicity == "cauc" ~ 3, ethnicity == "hispanic" ~ 4, ethnicity == "other" ~ 4))
Ver <-cut(Ver$dantoc, breaks=c(0,3,4), labels=c('người Mỹ', 'người nơi khác'))
table(Ver)

## Ver
##       người Mỹ người nơi khác 
##            440             94

Ver1 <- d %>% mutate(nghe = case_when( occupation== "worker" ~ 1, occupation == "technical" ~ 3, occupation == "services" ~ 1, occupation== "office" ~ 3, occupation== "sales" ~ 1, occupation== "management" ~ 3))
Ver1 <-cut(Ver1$nghe, breaks=c(0,1,3), labels=c('Chuyên môn thấp', 'Chuyên môn cao'))
table(Ver1)

## Ver1
## Chuyên môn thấp  Chuyên môn cao 
##             277             257

k <- data.frame(k, Ver, Ver1)

Trong hai các câu lệnh này việc đầu tiên tôi thực hiện là chuyển biến ethnicity về còn hai biểu hiện là người gốc Mỹ và người nơi khác. Sau đó tôi 6 nhóm nghề nghiệp của biến ethnicity thành 2 nhóm là nhóm ngành có chuyên môn thấp bao gồm: worker, services, sales; còn lại là nhóm ngành có chuyên môn cao.

2.4.2 Bảng tần số và biểu đồ

l <- table(k$Ver, k$Ver1)
l

##                 
##                  Chuyên môn thấp Chuyên môn cao
##   người Mỹ                   224            216
##   người nơi khác              53             41

l1 <- prop.table(l)
l1

##                 
##                  Chuyên môn thấp Chuyên môn cao
##   người Mỹ               0.41948        0.40449
##   người nơi khác         0.09925        0.07678

addmargins(l)

##                 
##                  Chuyên môn thấp Chuyên môn cao Sum
##   người Mỹ                   224            216 440
##   người nơi khác              53             41  94
##   Sum                        277            257 534

Biểu đồ

k |> ggplot(aes(x = Ver, y = after_stat(count))) + geom_bar(fill = 'blue') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + facet_grid(. ~ Ver1) + labs(x = 'Dân tộc', y = 'Số người')

Thống kê bảng cho ta thấy hơn 80% người là người gốc Mỹ và người có chuyên môn cao và người có chuyên môn thấp ở đây gần bằng nhau.

2.4.3 Rủi ro tương đối

riskratio(l)

## $data
##                 
##                  Chuyên môn thấp Chuyên môn cao Total
##   người Mỹ                   224            216   440
##   người nơi khác              53             41    94
##   Total                      277            257   534
## 
## $measure
##                 risk ratio with 95% C.I.
##                  estimate  lower upper
##   người Mỹ         1.0000     NA    NA
##   người nơi khác   0.8885 0.6928 1.139
## 
## $p.value
##                 two-sided
##                  midp.exact fisher.exact chi.square
##   người Mỹ               NA           NA         NA
##   người nơi khác     0.3381        0.364      0.335
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ giữa nghề nghiệp cần chuyên môn thấp và nghề nghiệp cần chuyên môn cao là người của các dân tộc là người khác bằng 88,85% so với tỷ lệ giữa nghề nghiệp cần chuyên môn thấp và nghề nghiệp cần chuyên môn cao là người có dân tộc gốc Mỹ.

Ngược lại, Khi có thêm tham số rev = ‘c’ thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên.

riskratio(l, rev = 'c')

## $data
##                 
##                  Chuyên môn cao Chuyên môn thấp Total
##   người Mỹ                  216             224   440
##   người nơi khác             41              53    94
##   Total                     257             277   534
## 
## $measure
##                 risk ratio with 95% C.I.
##                  estimate  lower upper
##   người Mỹ          1.000     NA    NA
##   người nơi khác    1.108 0.9067 1.353
## 
## $p.value
##                 two-sided
##                  midp.exact fisher.exact chi.square
##   người Mỹ               NA           NA         NA
##   người nơi khác     0.3381        0.364      0.335
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

2.4.4 Tỷ lệ chệnh lệch

oddsratio(l)

## $data
##                 
##                  Chuyên môn thấp Chuyên môn cao Total
##   người Mỹ                   224            216   440
##   người nơi khác              53             41    94
##   Total                      277            257   534
## 
## $measure
##                 odds ratio with 95% C.I.
##                  estimate  lower upper
##   người Mỹ         1.0000     NA    NA
##   người nơi khác   0.8032 0.5102 1.257
## 
## $p.value
##                 two-sided
##                  midp.exact fisher.exact chi.square
##   người Mỹ               NA           NA         NA
##   người nơi khác     0.3381        0.364      0.335
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ giữa nghề nghiệp cần chuyên môn thấp và nghề nghiệp cần chuyên môn cao là người của các dân tộc là người khác bằng 80.32% so với tỷ lệ giữa nghề nghiệp cần chuyên môn thấp và nghề nghiệp cần chuyên môn cao là người có dân tộc gốc Mỹ.

Ngược lại, Khi có thêm tham số rev = ‘c’ thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên.

oddsratio(l, rev = 'c')

## $data
##                 
##                  Chuyên môn cao Chuyên môn thấp Total
##   người Mỹ                  216             224   440
##   người nơi khác             41              53    94
##   Total                     257             277   534
## 
## $measure
##                 odds ratio with 95% C.I.
##                  estimate  lower upper
##   người Mỹ          1.000     NA    NA
##   người nơi khác    1.245 0.7956  1.96
## 
## $p.value
##                 two-sided
##                  midp.exact fisher.exact chi.square
##   người Mỹ               NA           NA         NA
##   người nơi khác     0.3381        0.364      0.335
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

2.4.5 Thống kê suy diễn: Kiểm tra tính độc lập của hai biến

chisq.test(l)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  l
## X-squared = 0.72, df = 1, p-value = 0.4

Kết quả cho thấy giữa giữa trình độ học tập với thu nhập của những người thực hiện khảo sát có liên hệ với nhau.

2.5 Phân tích hai biến là occupation và married

m <- table(k$d.married, k$Ver1)
m

##      
##       Chuyên môn thấp Chuyên môn cao
##   no               98             86
##   yes             179            171

m1 <- prop.table(m)
m1

##      
##       Chuyên môn thấp Chuyên môn cao
##   no           0.1835         0.1610
##   yes          0.3352         0.3202

addmargins(m)

##      
##       Chuyên môn thấp Chuyên môn cao Sum
##   no               98             86 184
##   yes             179            171 350
##   Sum             277            257 534

Biểu đồ

k |> ggplot(aes(x = d.married, y = after_stat(count))) + geom_bar(fill = 'blue') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + facet_grid(. ~ Ver1)

Bảng cùng biểu đồ thể hiện người có chuyên môn thấp cùng chuyên môn cao có tỷ lệ kết hôn gần bằng nhau. Nhưng có thể thấy người chưa kết hôn có chuyên môn thấp cao hơn người chưa kết hôn có chuyên môn cao khoảng 2%.

2.5.1 Rủi ro tương đối

riskratio(m)

## $data
##        
##         Chuyên môn thấp Chuyên môn cao Total
##   no                 98             86   184
##   yes               179            171   350
##   Total             277            257   534
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate  lower upper
##   no     1.000     NA    NA
##   yes    1.045 0.8663 1.261
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   no          NA           NA         NA
##   yes     0.6432       0.6498     0.6416
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ giữa nghề nghiệp cần chuyên môn thấp và nghề nghiệp cần chuyên môn cao là người còn độc thân gấp 4,5% so với tỷ lệ giữa nghề nghiệp cần chuyên môn thấp và nghề nghiệp cần chuyên môn cao là người đã kết hôn.

Mặc khác, Khi có thêm tham số rev = ‘c’ thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên.

riskratio(l, rev = 'c')

## $data
##                 
##                  Chuyên môn cao Chuyên môn thấp Total
##   người Mỹ                  216             224   440
##   người nơi khác             41              53    94
##   Total                     257             277   534
## 
## $measure
##                 risk ratio with 95% C.I.
##                  estimate  lower upper
##   người Mỹ          1.000     NA    NA
##   người nơi khác    1.108 0.9067 1.353
## 
## $p.value
##                 two-sided
##                  midp.exact fisher.exact chi.square
##   người Mỹ               NA           NA         NA
##   người nơi khác     0.3381        0.364      0.335
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

2.5.2 Tỷ lệ chệnh lệch

oddsratio(m)

## $data
##        
##         Chuyên môn thấp Chuyên môn cao Total
##   no                 98             86   184
##   yes               179            171   350
##   Total             277            257   534
## 
## $measure
##      odds ratio with 95% C.I.
##       estimate  lower upper
##   no     1.000     NA    NA
##   yes    1.088 0.7609 1.558
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   no          NA           NA         NA
##   yes     0.6432       0.6498     0.6416
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ giữa nghề nghiệp cần chuyên môn thấp và nghề nghiệp cần chuyên môn cao là người còn độc thân gấp 8,8% so với tỷ lệ giữa nghề nghiệp cần chuyên môn thấp và nghề nghiệp cần chuyên môn cao là người đã kết hôn.

Ngoài ra, Khi có thêm tham số rev = ‘c’ thì sẽ thực hiện việc đổi chỗ 2 cột trong bảng ngẫu nhiên.

oddsratio(m, rev = 'c')

## $data
##        
##         Chuyên môn cao Chuyên môn thấp Total
##   no                86              98   184
##   yes              171             179   350
##   Total            257             277   534
## 
## $measure
##      odds ratio with 95% C.I.
##       estimate  lower upper
##   no    1.0000     NA    NA
##   yes   0.9189 0.6418 1.314
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   no          NA           NA         NA
##   yes     0.6432       0.6498     0.6416
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

2.5.3 Thống kê suy diễn: Kiểm tra tính độc lập của hai biến

chisq.test(m)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  m
## X-squared = 0.14, df = 1, p-value = 0.7

Kết quả cho thấy giữa giữa trình độ học tập với thu nhập của những người thực hiện khảo sát là độc lập với nhau.

3 TUẦN 3,4: Thống kê mô tả cho 1 biến

Yêu cầu: Làm thống kê mô tả để phân tích cho ít nhất 5 biến ( vừa định tính định lượng và có 2 biến đã chọn ở câu 2), nhận xét về kết quả phân tích này.

3.1 Thống kê mô tả của biến “gender”

table(d$gender)

## 
##   male female 
##    289    245

table(d$gender)/sum(table(d$gender))

## 
##   male female 
## 0.5412 0.4588

d |> ggplot(aes(x = gender, y = after_stat(count))) + geom_bar(fill = 'navy') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'magenta', vjust = - .5) + theme_classic() + labs(x = 'Giới tính', y = 'Số người')

Biến gander là biến định tính, thực hiện một phép đếm đơn giản ta thấy có 289 (chiếm 54,12%) người nam và 245 người nữ (chiếm 45,88%) tham gia vào cuộc khảo sát.

3.2 Thống kê mô tả của biến “wage”

summary(d$wage)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00    5.25    7.78    9.02   11.25   44.50

luong <- d$wage
table(cut(luong,4))

## 
## (0.957,11.9]  (11.9,22.8]  (22.8,33.6]  (33.6,44.5] 
##          412          110           11            1

d |> ggplot(aes(wage)) + geom_bar(aes(y = (..count..)), color = 'blue', fill = 'green')

## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Theo thống kê giữa biến ta có thể nhận ra có 412 người thu nhập từ (0.957,11.9],110 người thu nhập từ (11.9,22.8], 11 người thu nhập từ (22.8,33.6], 1 người thu nhập từ (33.6,44.5] USD/h. Vì biến wage là biến định lượng nên thống kê cơ bản ta còn thấy được tiên lương it nhất là 1 USD/h, nhiều nhất là 44.5 USD/h, lương trung bình là 9.02 USD/h, giá trị trung bình của vecto là 9.02.

3.3 Thống kê mô tả của biến “ethnicity”

table(d$ethnicity)

## 
##     cauc hispanic    other 
##      440       27       67

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

## 
##     cauc hispanic    other 
##  0.82397  0.05056  0.12547

pie(table(d$ethnicity), col = rainbow(3), main = "Biểu đồ tròn của dân tộc")

Biến ethnicity là biến định tính, thực hiện một phép đếm đơn giản có thể thấy trong những người khảo sát nhiều nhất là người Hoa Kỳ có 440 người chiếm 82,397%, người Tây Ban Nha có 27 người khoảng 5,056%, cuối cùng là người bên ngoài là 67 người có 12,547%.

3.4 Thống kê mô tả cho biến “age”

tuoi <-cut(d$age, breaks=c(1,39,64), labels=c('trẻ', ' trung niên'))
table(tuoi)

## tuoi
##         trẻ  trung niên 
##         348         186

table(tuoi)/sum(table(tuoi))

## tuoi
##         trẻ  trung niên 
##      0.6517      0.3483

k <- data.frame(k, tuoi)
pie(table(k$tuoi), col = rainbow(2), main = "Biểu đồ tròn ")

Theo độ tuổi, tôi chia làm hai nhóm đầu tiên là nhóm người trẻ từ 18 đến 39 tuổi và có được số người trẻ là 348 người (chiếm 65,17%), sau đó là người trung niên từ 40 đên 64 tuổi có 186 người (khoảng 34,83%).

3.5 Thống kê mô tả cho biến “married”

table(d$married)

## 
##  no yes 
## 184 350

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

## 
##     no    yes 
## 0.3446 0.6554

d |> ggplot(aes(x = married, y = after_stat(count))) + geom_bar(fill = 'blue') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'magenta', vjust = - .5) + theme_classic() + labs(x = 'Giới tính', y = 'Số người') + coord_flip()

Qua thống kê mô tả biến định tính là married, ta thấy số người đã kết hôn là 350 người (có 65.54%) và người chưa kết hôn là 184 người (chiếm 34,46%)

4 TUẦN 2: Chọn biến phụ thuộc

Yêu cầu: Chọn 1 hoặc 2 biến định tính và 1 biến định lượng làm biến phụ thuộc để phân tích, giải thích lý do

4.1 Phân loại các biến trong dữ liệu

4.1.1 Dữ liệu định tính

Biến ethnicity: Dân tộc (gồm 3 biểu hiện “cauc” là người Hoa Kỳ, “hispanic” là người gốc Tây Ban Nha, “other” là người nơi khác.
Biến region: bạn có sống ở phía Nam không? (south/other)
Biến gender: Giới tính.
Biến occupation: Nghề nghiệp (gồm 6 biểu hiện “worker” là thợ hoặc công nhân dây chuyền lắp ráp,“technical” là công nhân kỹ thuật hoặc chuyên nghiệp ,“services” là nhân viên dịch vụ,“office” là nhân viên văn phòng và thư ký,“sales” là nhân viên bán hàng,“management” là quản lý và điều hành).
Biến sector: Lĩnh vực làm việc ( có hai biểu hiện “manufacturing” là chế tạo hoặc khai khoáng, “construction” là xây dựng, “other” là lĩnh vực khác).
Biến union: Bạn có làm việc với đoàn thể hay không?
Biến married: Bạn đã kết hôn hay chưa?

4.1.2 Dữ liệu định lượng

Biến wage: Tiền lương (USD/h).
Biến education: Số năm đi học.
Biến experience: Số năm kinh nghiệp.
Biến age: Tuổi.

4.2 Chọn 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 ‘nghề nghiệp’ làm biến phụ thuộc. Biến bao gồm 6 biểu hiện “worker” là thợ hoặc công nhân dây chuyền lắp ráp,“technical” là công nhân kỹ thuật hoặc chuyên nghiệp ,“services” là nhân viên dịch vụ,“office” là nhân viên văn phòng và thư ký,“sales” là nhân viên bán hàng,“management” là quản lý và điều hành.

Lý do em chọn biến này là vì em muốn biết nghề nghiệp của một người có bị ảnh hưởng bởi các yếu tố như dân tộc của người đó là gì, năm đi học mà người đó đi học và số tiền lương một giờ họ đi làm, … hay không?

Thống kê mô tả của biến “occupation”

table(d$occupation)

## 
##     worker  technical   services     office      sales management 
##        156        105         83         97         38         55

table(d$occupation)/sum(table(d$occupation))

## 
##     worker  technical   services     office      sales management 
##    0.29213    0.19663    0.15543    0.18165    0.07116    0.10300

d |> ggplot(aes(x = occupation, y = after_stat(count))) + geom_bar(fill = 'blue') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'green', vjust = - .5) + theme_classic() + labs(x = 'Nghề nghiệp', y = 'Số người')

Biến occupation là biến định tính, thực hiện một phép đếm đơn giản ta thấy trong 6 nghề nghiệp có 156 người (có 29,213%) là thợ hoặc công nhân dây chuyền lắp ráp, 105 người (chiếm 19,663%) là công nhân kỹ thuật hoặc chuyên nghiệp ,83 người(khoảng 15,543%) là nhân viên dịch vụ,97 người (chiếm 18,165%) là nhân viên văn phòng và thư ký,38 người (khoảng 7,116%) là nhân viên bán hàng và 55 người là quản lý và điều hành khoảng 10,3%.

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

Đối với biến định lượng, em chọn biến education làm biến phụ thuộc, đây là biến thể hiện số năm đi học của người được khảo sát.

Em chọn biến định lượng education làm biến phục thuộc, tại đây em muốn xác định các ảnh hưởng của các yếu tố trong bảng khảo sát như thu nhập theo giờ của một người, dân tộc, hay ngành nghề mà học làm có liên quan già không ?, …

Thống kê mô tả của biến “education”

min(d$education)

## [1] 2

max(d$education)

## [1] 18

median(d$education)

## [1] 12

Biến education là biến định lượng, xét tahys người học ít nhất là 2 năm, nhiều nhất là 18 năm, vtrung vị của biến này là 12 năm.

cap <-cut(d$education, breaks=c(1,5,8,12,16,18), labels=c('Cấp 1', 'Cấp 2', 'Cấp 3',' Đại học','Thạc sĩ'))
table(cap)

## cap
##    Cấp 1    Cấp 2    Cấp 3  Đại học  Thạc sĩ 
##        4       23      275      177       55

table(cap)/sum(table(cap))

## cap
##    Cấp 1    Cấp 2    Cấp 3  Đại học  Thạc sĩ 
## 0.007491 0.043071 0.514981 0.331461 0.102996

trinhdo <-cut(d$education, breaks=c(1,12,18), labels=c('thấp', ' cao'))
table(trinhdo)

## trinhdo
## thấp  cao 
##  302  232

table(trinhdo)/sum(table(trinhdo))

## trinhdo
##   thấp    cao 
## 0.5655 0.4345

k <- data.frame(d$wage, d$education, d$experience, d$age, d$ethnicity, d$region, d$gender, d$occupation, d$sector, d$union, d$married, trinhdo)

k  |> ggplot(aes(x = trinhdo, y = after_stat(count))) + geom_bar(fill = 'blue') + geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'red', vjust = - .5) + theme_classic() + labs(x = 'Trình độ', y = 'Số người')+ coord_flip()

Theo cuộc khảo sát thì đa phần mọi người đều đi học em thực hiện việc lập bảng và phân người khảo sát thành các cấp khác nhau:

Người đi học từ 1-5 năm được gọi là cấp 1 chỉ có 4 người(khoảng 0.74%) trong thống kê này.
Người đi học từ 5-8 năm là học cấp 2 có 23 người ( khoảng 4,31%).
Người đi học từ 8-12 năm là học cấp 3 là nhiều nhất có 275 người (chiếm 51,5%).
Người học từ 12-16 năm là đi học đại học có 177 người khoảng 33,15%.
Người học Thạc sĩ là phải học từ 17-18 năm khoảng 10,3% có 55 người.

Người có trình độ thấp nhiêu hơn người trình độ cao.

5 TUẦN 1: Trình bày dataset

Yêu cầu: Tìm một dataset có dữ liệu định tính, dữ liệu định lượng, có trên 5 biến và nhiều hơn 300

5.1 Mô tả dữ liệu

Data có tên là: CPS1985

Mô tả: Dữ liệu là dữ liệu chéo bắt nguồn từ khảo sát dân số hiện tại của tháng 5 năm 1985 của Cục điều tra dân số Hoa Kỳ. Bộ dữ liệu gồm 534 biến với 11 biến (có 7 biến định tính và 4 biến định lượng). Trong đó:

Biến wage: Tiền lương (USD/h).
Biến education: Số năm đi học.
Biến experience: Số năm kinh nghiệp.
Biến age: Tuổi.
Biến ethnicity: Dân tộc (gồm 3 biểu hiện “cauc” là người Hoa Kỳ, “hispanic” là người gốc Tây Ban Nha, “other” là người nơi khác.
Biến region: bạn có sống ở phía Nam không? (south/other)
Biến gender: Giới tính.
Biến occupation: Nghề nghiệp (gồm 6 biểu hiện “worker” là thợ hoặc công nhân dây chuyền lắp ráp,“technical” là công nhân kỹ thuật hoặc chuyên nghiệp ,“services” là nhân viên dịch vụ,“office” là nhân viên văn phòng và thư ký,“sales” là nhân viên bán hàng,“management” là quản lý và điều hành).
Biến sector: Lĩnh vực làm việc ( có hai biểu hiện “manufacturing” là chế tạo hoặc khai khoáng, “construction” là xây dựng, “other” là lĩnh vực khác).
Biến union: Bạn có làm việc với đoàn thể hay không?
Biến married: Bạn đã kết hôn hay chưa?

data("CPS1985")
d <- CPS1985
datatable(CPS1985)

5.2 Mục tiêu phân tích:

Dữ liệu được dùng trong bài báo “Berndt, E.R. (1991). The Practice of Econometrics. New York: Addison-Wesley.”

Tôi muốn dùng bộ dữ liệu này để tiến hành phân tích và tìm hiểu xem mối liên hệ của các biến đối với biến này như: xem xét về trình độ học tập của các dân tộc khác nhau, giới tính của người theo dân tộc, tính độ thu nhập theo giờ của các dân tộc khác nhau trên vùng này sẽ như thể nào, mức lương làm theo giờ của họ có giống nhau hay không,…

Phân tích dữ liệu định tính

Huỳnh Thị Thùy Dương

2023-06-12

1 TUẦN 6,7: Mô hình hồi quy

1.1 Phân tích hai biến là gender và education:

1.1.1 Ước lượng hàm hồi quy cho dữ liệu nhị thức

1.1.2 Ước lượng hàm hồi quy cho dữ liệu Poisson

1.1.3 Đánh giá mô hình

1.2 Phân tích hai biến là education và wage

1.2.1 Ước lượng hàm hồi quy cho dữ liệu nhị thức

1.2.2 Ước lượng hàm hồi quy cho dữ liệu Poisson

1.2.3 Đánh giá mô hình

1.3 Phân tích hai biến là education và age

1.3.1 Ước lượng hàm hồi quy cho dữ liệu nhị thức

1.3.2 Ước lượng hàm hồi quy cho dữ liệu Poisson

1.3.3 Đánh giá mô hình

1.4 Phân tích hai biến là occupation và ethnicity

1.4.1 Ước lượng hàm hồi quy cho dữ liệu nhị thức

1.4.2 Ước lượng hàm hồi quy cho dữ liệu Poisson

1.4.3 Đánh giá mô hình

1.5 Phân tích hai biến là occupation và marreid

1.5.1 Ước lượng hàm hồi quy cho dữ liệu nhị thức

1.5.2 Ước lượng hàm hồi quy cho dữ liệu Poisson

1.5.3 Đánh giá mô hình

1.6 Phân tích ba biến là gender, education và wage

2 TUẦN 5: Thống kê mô tả cho hai biến

2.1 Phân tích hai biến là gender và education:

2.1.1 Đồ thị cột

2.1.2 Bảng tần số

2.1.3 Rủi ro tương đối

2.1.4 Tỷ lệ chệnh lệch

2.1.5 Thống kê suy diễn: Kiểm tra tính độc lập của hai biến

2.2 Phân tích hai biến là education và wage

2.2.1 Chuyển thành biến có hai biểu hiện

2.2.2 Bảng và biểu đồ cột

2.2.3 Rủi ro tương đối

2.2.4 Tỷ lệ chệnh lệch

2.2.5 Thống kê suy diễn: Kiểm tra tính độc lập của hai biến

2.3 Phân tích hai biến là education và age

2.3.1 Bảng tần số và biểu đồ

2.3.2 Rủi ro tương đối

2.3.3 Tỷ lệ chệnh lệch

2.3.4 Thống kê suy diễn: Kiểm tra tính độc lập của hai biến

2.4 Phân tích hai biến là occupation và ethnicity

2.4.1 Chuyển thành biến có hai biểu hiện

2.4.2 Bảng tần số và biểu đồ

2.4.3 Rủi ro tương đối

2.4.4 Tỷ lệ chệnh lệch

2.4.5 Thống kê suy diễn: Kiểm tra tính độc lập của hai biến

2.5 Phân tích hai biến là occupation và married

2.5.1 Rủi ro tương đối

2.5.2 Tỷ lệ chệnh lệch

2.5.3 Thống kê suy diễn: Kiểm tra tính độc lập của hai biến

3 TUẦN 3,4: Thống kê mô tả cho 1 biến

3.1 Thống kê mô tả của biến “gender”

3.2 Thống kê mô tả của biến “wage”

3.3 Thống kê mô tả của biến “ethnicity”

3.4 Thống kê mô tả cho biến “age”

3.5 Thống kê mô tả cho biến “married”

4 TUẦN 2: Chọn biến phụ thuộc

4.1 Phân loại các biến trong dữ liệu

4.1.1 Dữ liệu định tính

4.1.2 Dữ liệu định lượng

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

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

5 TUẦN 1: Trình bày dataset

5.1 Mô tả dữ liệu

5.2 Mục tiêu phân tích: