Các gói dữ liệu sẽ dùng trong bài nghiên cứu
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library (readxl)
library (ggplot2)
library (DescTools)
library(epitools)
library(caret)
## Warning: package 'caret' was built under R version 4.3.1
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following objects are masked from 'package:DescTools':
##
## MAE, RMSE
##
## The following object is masked from 'package:purrr':
##
## lift
library(DT)
## Warning: package 'DT' was built under R version 4.3.1
Để đánh giá các mô hình hồi cổ điển chúng ta thường dựa vào hệ số xác định mô hình (\(R^2\)), nhưng đối với mô các mô hình hồi quy tuyến tính tổng quát chúng ta sử dụng các tiêu chí sau:
AIC được đề xuất bởi Akaike Hirotugu, một nhà thống kê học người Nhật. AIC là một tiêu chí được sử dụng một cách phổ biến để đánh giá một mô hình hồi quy được ước lượng bởi phương pháp Maximum Likekihood (ML). Một cách chung chung giá trị của AIC càng nhỏ thì mô hình càng tốt. AIC được tính bằng công thức sau:
\(AIC = −2ln(L) + 2k\)
Với \(L\) là giá trị cực đại của hàm hợp lý (likelihood function) và \(k\) là số tham số của mô hình.
Khi thực hiện việc ước lượng mô hình hồi quy bằng lệnh glm thì chỉ số AIC đã được tính toán và thể hiện trên bảng kết quả ( bằng lệnh summary).
Deviance cũng là một tiêu chí rất phổ biến được sử dụng để đánh giá một mô hình hồi quy được ước lượng bởi phương pháp Hợp lý cực đại (ML). Một cách tổng quá, cũng giống như chỉ tiêu AIC, giá trị của Deviance càng nhỏ thì mô hình càng tốt.
Lưu ý: Khi thực hiện việc ước lượng mô hình hồi quy bằng lệnh glm thì chỉ số AIC và Deviance đã được tính toán và thể hiện trên bảng kết quả ( bằng lệnh summary).
Là chỉ tiêu dùng để đánh giá mô hình hồi quy logistic, Brier Score được tính như sau:
Trong đó: \(p_i,o_i\) lần lượt là giá trị xác suất quan sát được, và giá trị xác suất tính ra từ mô hình.
Là ma trận thể hiện sự nhầm lẫn của mô hình.
Edu <- read_excel("DiemThiHocSinh.xlsx", sheet = "Sheet1")
\(FinalScore= β_0+β_1 Gender+β_2 ParentEduc+β_3 ParentMaritalStatus+β_4 PracticeSport+β_5 IsFirstChild+β_6 NrSiblings+β_7 WklyStudyHours\)
logit <- glm(factor (FinalScore) ~ Edu$Gender + Edu$ParentEduc + Edu$ParentMaritalStatus + Edu$PracticeSport + Edu$IsFirstChild + Edu$NrSiblings + Edu$WklyStudyHours, family = binomial(link = "logit"), data = Edu)
summary(logit)
##
## Call:
## glm(formula = factor(FinalScore) ~ Edu$Gender + Edu$ParentEduc +
## Edu$ParentMaritalStatus + Edu$PracticeSport + Edu$IsFirstChild +
## Edu$NrSiblings + Edu$WklyStudyHours, family = binomial(link = "logit"),
## data = Edu)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.70377 0.54642 -3.118 0.001821 **
## Edu$Gendermale 0.52298 0.21452 2.438 0.014771 *
## Edu$ParentEducbachelor's degree 0.18304 0.36158 0.506 0.612691
## Edu$ParentEduchigh school 0.84312 0.23459 3.594 0.000326 ***
## Edu$ParentEducmaster's degree -1.65731 1.03109 -1.607 0.107980
## Edu$ParentMaritalStatusmarried -0.98965 0.26591 -3.722 0.000198 ***
## Edu$ParentMaritalStatussingle -0.48612 0.29333 -1.657 0.097466 .
## Edu$ParentMaritalStatuswidowed -0.53631 0.66128 -0.811 0.417352
## Edu$PracticeSportregularly 0.40799 0.39298 1.038 0.299189
## Edu$PracticeSportsometimes 0.45440 0.38359 1.185 0.236178
## Edu$IsFirstChildyes -0.69110 0.21717 -3.182 0.001461 **
## Edu$NrSiblings -0.07135 0.07451 -0.958 0.338271
## Edu$WklyStudyHours> 10 -0.25871 0.32282 -0.801 0.422899
## Edu$WklyStudyHours5 đến 10 -0.26171 0.23711 -1.104 0.269689
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 684.63 on 999 degrees of freedom
## Residual deviance: 628.17 on 986 degrees of freedom
## AIC: 656.17
##
## Number of Fisher Scoring iterations: 6
BrierScore(logit)
## [1] 0.09075891
a <- predict(logit, type = "response")
b <- ifelse(a > 0.5, "1", "0")
c <-factor(b, levels = c("0","1"))
d <- factor(Edu$FinalScore, labels = c("0","1"))
confusionMatrix(table(c, d))
## Confusion Matrix and Statistics
##
## d
## c 0 1
## 0 892 108
## 1 0 0
##
## Accuracy : 0.892
## 95% CI : (0.8711, 0.9106)
## No Information Rate : 0.892
## P-Value [Acc > NIR] : 0.5256
##
## Kappa : 0
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 1.000
## Specificity : 0.000
## Pos Pred Value : 0.892
## Neg Pred Value : NaN
## Prevalence : 0.892
## Detection Rate : 0.892
## Detection Prevalence : 1.000
## Balanced Accuracy : 0.500
##
## 'Positive' Class : 0
##
probit <- glm(factor (FinalScore) ~ Edu$Gender + Edu$ParentEduc + Edu$ParentMaritalStatus + Edu$PracticeSport + Edu$IsFirstChild + Edu$NrSiblings + Edu$WklyStudyHours, family = binomial(link = "probit"), data = Edu)
summary(probit)
##
## Call:
## glm(formula = factor(FinalScore) ~ Edu$Gender + Edu$ParentEduc +
## Edu$ParentMaritalStatus + Edu$PracticeSport + Edu$IsFirstChild +
## Edu$NrSiblings + Edu$WklyStudyHours, family = binomial(link = "probit"),
## data = Edu)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.99031 0.28292 -3.500 0.000465 ***
## Edu$Gendermale 0.29429 0.11249 2.616 0.008894 **
## Edu$ParentEducbachelor's degree 0.10257 0.18434 0.556 0.577923
## Edu$ParentEduchigh school 0.46033 0.12211 3.770 0.000163 ***
## Edu$ParentEducmaster's degree -0.78359 0.43997 -1.781 0.074914 .
## Edu$ParentMaritalStatusmarried -0.53247 0.14453 -3.684 0.000229 ***
## Edu$ParentMaritalStatussingle -0.25966 0.16133 -1.610 0.107492
## Edu$ParentMaritalStatuswidowed -0.32050 0.35491 -0.903 0.366499
## Edu$PracticeSportregularly 0.18709 0.19802 0.945 0.344751
## Edu$PracticeSportsometimes 0.20898 0.19254 1.085 0.277734
## Edu$IsFirstChildyes -0.36435 0.11536 -3.158 0.001587 **
## Edu$NrSiblings -0.03776 0.03875 -0.974 0.329833
## Edu$WklyStudyHours> 10 -0.13741 0.17026 -0.807 0.419646
## Edu$WklyStudyHours5 đến 10 -0.13773 0.12645 -1.089 0.276060
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 684.63 on 999 degrees of freedom
## Residual deviance: 627.17 on 986 degrees of freedom
## AIC: 655.17
##
## Number of Fisher Scoring iterations: 6
BrierScore(probit)
## [1] 0.09087243
a <- predict(probit, type = "response")
b <- ifelse(a > 0.5, "1", "0")
c <-factor(b, levels = c("0","1"))
d <- factor(Edu$FinalScore, labels = c("0","1"))
confusionMatrix(table(c, d))
## Confusion Matrix and Statistics
##
## d
## c 0 1
## 0 892 108
## 1 0 0
##
## Accuracy : 0.892
## 95% CI : (0.8711, 0.9106)
## No Information Rate : 0.892
## P-Value [Acc > NIR] : 0.5256
##
## Kappa : 0
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 1.000
## Specificity : 0.000
## Pos Pred Value : 0.892
## Neg Pred Value : NaN
## Prevalence : 0.892
## Detection Rate : 0.892
## Detection Prevalence : 1.000
## Balanced Accuracy : 0.500
##
## 'Positive' Class : 0
##
cloglog <- glm(factor (FinalScore) ~ Edu$Gender + Edu$ParentEduc + Edu$ParentMaritalStatus + Edu$PracticeSport + Edu$IsFirstChild + Edu$NrSiblings + Edu$WklyStudyHours, family = binomial(link = "cloglog"), data = Edu)
summary(cloglog)
##
## Call:
## glm(formula = factor(FinalScore) ~ Edu$Gender + Edu$ParentEduc +
## Edu$ParentMaritalStatus + Edu$PracticeSport + Edu$IsFirstChild +
## Edu$NrSiblings + Edu$WklyStudyHours, family = binomial(link = "cloglog"),
## data = Edu)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.81474 0.50835 -3.570 0.000357 ***
## Edu$Gendermale 0.47782 0.19780 2.416 0.015705 *
## Edu$ParentEducbachelor's degree 0.16113 0.34038 0.473 0.635946
## Edu$ParentEduchigh school 0.77092 0.21786 3.539 0.000402 ***
## Edu$ParentEducmaster's degree -1.61306 1.01298 -1.592 0.111298
## Edu$ParentMaritalStatusmarried -0.90959 0.23918 -3.803 0.000143 ***
## Edu$ParentMaritalStatussingle -0.43609 0.26243 -1.662 0.096567 .
## Edu$ParentMaritalStatuswidowed -0.45615 0.60378 -0.755 0.449953
## Edu$PracticeSportregularly 0.39444 0.37104 1.063 0.287755
## Edu$PracticeSportsometimes 0.44341 0.36258 1.223 0.221359
## Edu$IsFirstChildyes -0.65015 0.19844 -3.276 0.001052 **
## Edu$NrSiblings -0.06741 0.06909 -0.976 0.329199
## Edu$WklyStudyHours> 10 -0.23983 0.29757 -0.806 0.420271
## Edu$WklyStudyHours5 đến 10 -0.23575 0.21595 -1.092 0.274973
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 684.63 on 999 degrees of freedom
## Residual deviance: 628.19 on 986 degrees of freedom
## AIC: 656.19
##
## Number of Fisher Scoring iterations: 6
BrierScore(cloglog)
## [1] 0.09065076
a <- predict(cloglog, type = "response")
b <- ifelse(a > 0.5, "1", "0")
c <-factor(b, levels = c("0","1"))
d <- factor(Edu$FinalScore, labels = c("0","1"))
confusionMatrix(table(c, d))
## Confusion Matrix and Statistics
##
## d
## c 0 1
## 0 891 107
## 1 1 1
##
## Accuracy : 0.892
## 95% CI : (0.8711, 0.9106)
## No Information Rate : 0.892
## P-Value [Acc > NIR] : 0.5256
##
## Kappa : 0.0143
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.998879
## Specificity : 0.009259
## Pos Pred Value : 0.892786
## Neg Pred Value : 0.500000
## Prevalence : 0.892000
## Detection Rate : 0.891000
## Detection Prevalence : 0.998000
## Balanced Accuracy : 0.504069
##
## 'Positive' Class : 0
##
| Mô hình | Chỉ số AIC | Deviance | Brier Score | Confusion matrix |
|---|---|---|---|---|
| logit | 656.17 | 628.17 | 0.09075891 | 0.892 |
| probit | 655.17 | 627.17 | 0.09087243 | 0.892 |
| cloglog | 656.19 | 628.19 | 0.1216907 | 0.892 |
| Lựa chọn | probit | probit | logit | cả 3 |
Dựa vào bảng kết quả của 3 mô hình, các chỉ số AIC và Deviance đều chỉ ra mô hình probit là tốt nhất. Chỉ số Brier Score lại cho kết quả là mô hình tốt nhất. Ma trận nhầm lẫn thì cho kết quả là cả 3 mô hình đều tốt như nhau.
Do đó, mô hình probit là đạt nhiều tiêu chí nhất nên ta có thể kết luận rằng mô hình probit là phù hợp nhất trong 3 mô hình để mô tả sự ảnh hưởng của các yếu tố cá nhân và xã hội đến điểm số.
Giả thuyết:
\(H_0\): Giới tính và xếp loại học tập độc lập với nhau
\(H_1\): Giới tính và xếp loại học tập không độc lập với nhau
gil <- table (Edu$Gender, Edu$FinalScore)
gil
##
## Đạt Không đạt
## female 472 43
## male 420 65
chisq.test(gil)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: gil
## X-squared = 6.1047, df = 1, p-value = 0.01348
Vì p_value = 0.01348 < 0.05 nên ta thừa nhận giả thuyết \(H_0\). Nghĩa là giới tính và xếp loại học tập của học sinh độc lập với nhau.
Giả thuyết:
\(H_0\): Tình trạng hôn nhân và xếp loại học tập độc lập với nhau
\(H_1\): Tình trạng hôn nhân và xếp loại học tập không độc lập với nhau
gil <- table (Edu$ParentMaritalStatus, Edu$FinalScore)
gil
##
## Đạt Không đạt
## divorced 132 29
## married 521 46
## single 214 30
## widowed 25 3
chisq.test(gil)
## Warning in chisq.test(gil): Chi-squared approximation may be incorrect
##
## Pearson's Chi-squared test
##
## data: gil
## X-squared = 13.51, df = 3, p-value = 0.003654
Vì p_value = 0.003654 < 0.05 nên ta thừa nhận giả thuyết \(H_0\). Nghĩa là tình trạng hôn nhân của phụ huynh và xếp loại học tập của học sinh độc lập với nhau.
Giả thuyết:
\(H_0\): Thói quen luyện tập thể thao và xếp loại học tập độc lập với nhau
\(H_1\): Thói quen luyện tập thể thao và xếp loại học tập không độc lập với nhau
gil <- table (Edu$PracticeSport, Edu$FinalScore)
gil
##
## Đạt Không đạt
## never 115 9
## regularly 323 42
## sometimes 454 57
chisq.test(gil)
##
## Pearson's Chi-squared test
##
## data: gil
## X-squared = 1.8708, df = 2, p-value = 0.3924
Vì p_value = 0.3924 > 0.05 nên chưa đủ cơ sở để bác bỏ giả thuyết \(H_0\). Nghĩ là chưa đủ chứng cứ để kết luận rằng thói quen luyện tập thể thao và xếp loại học tập của học sinh có liên quan với nhau.
Giả thuyết:
\(H_0\): Con đầu lòng và xếp loại học tập độc lập với nhau
\(H_1\): Con đầu lòng và xếp loại học tập không độc lập với nhau
gil <- table (Edu$IsFirstChild, Edu$FinalScore)
gil
##
## Đạt Không đạt
## no 300 52
## yes 592 56
chisq.test(gil)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: gil
## X-squared = 8.2743, df = 1, p-value = 0.004021
Vì p_value = 0.004021 < 0.05 nên ta thừa nhận giả thuyết \(H_0\). Nghĩa là Việc học sinh có phải là con đầu lòng hay không và biến xếp loại học tập độc lập với nhau.
Giả thuyết:
\(H_0\): Số giờ tự học hàng tuần và xếp loại học tập độc lập với nhau
\(H_1\): Số giờ tự học hàng tuần và xếp loại học tập không độc lập với nhau
gil <- table (Edu$WklyStudyHours, Edu$FinalScore)
gil
##
## Đạt Không đạt
## < 5 247 36
## > 10 156 17
## 5 đến 10 489 55
chisq.test(gil)
##
## Pearson's Chi-squared test
##
## data: gil
## X-squared = 1.5227, df = 2, p-value = 0.467
Vì p_value = 0.8184 > 0.05 nên chưa đủ cơ sở để bác bỏ giả thuyết \(H_0\). Nghĩ là chưa đủ cơ sở để chứng minh rằng số giờ tự học hàng tuần và xếp loại học tập của học sinh có liên quan với nhau.
Ước lượng tỷ lệ số học sinh sống trong gia đình có nhiều hơn 5 con và đồng thời kiểm định xem tỷ lệ học sinh sống trong gia đình có nhiều hơn 5 con có phải là 36% hay không. Ta kiểm định giả thuyết:
\(H_0\): Tỷ lệ học sinh số trong gia đình có nhiều hơn 5 con là 25%
\(H_1\): Tỷ lệ học sinh số trong gia đình có nhiều hơn 5 con không phải là 25%
nrb <- Edu[Edu$NrSiblings > 5,]
prop.test(length(nrb$NrSiblings), length(nrb$NrSiblings), p = 0.25)
##
## 1-sample proportions test with continuity correction
##
## data: length(nrb$NrSiblings) out of length(nrb$NrSiblings), null probability 0.25
## X-squared = 209.02, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.25
## 95 percent confidence interval:
## 0.9360461 1.0000000
## sample estimates:
## p
## 1
Vì p_value = 2.2e-16 < 0.05 nên ta bác bỏ giả thuyết \(H_0\). Nghĩa là tỷ lệ học sinh sống trong gia đình có nhiều hơn 5 con không phải là 25%.
Với độ tin cậy 95%, ước lượng tỷ lệ học sinh sống trong gia đình có nhiều hơn 5 con nằm trong khoảng từ 0.9360461 đến 1.
Giả thuyết:
\(H_0\): không có sự khác biệt đáng kể trong tỷ lệ giữa nam và nữ về số lượng học sinh sống trong gia đình có nhiều hơn 5 con.
\(H_1\): có sự khác biệt đáng kể trong tỷ lệ giữa nam và nữ về số lượng học sinh sống trong gia đình có nhiều hơn 5 con.
nrbm <- Edu[Edu$Gender == 'male',]
nrbf <- Edu[Edu$Gender == 'female',]
nrbm1 <- nrbm[nrbm$NrSiblings > 5,]
nrbf1 <- nrbf[nrbf$NrSiblings > 5,]
a <- c(nrow(nrbm), nrow(nrbf))
b <- c(nrow(nrbm1), nrow(nrbf1))
prop.test(b,a)
##
## 2-sample test for equality of proportions with continuity correction
##
## data: b out of a
## X-squared = 0.25883, df = 1, p-value = 0.6109
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.02364003 0.04417852
## sample estimates:
## prop 1 prop 2
## 0.07628866 0.06601942
Vì p_value = 0.6109 > 0.05 nên chưa đủ cơ sở để bác bỏ giả thuyết \(H_0\). Nghĩ là chưa đủ cơ sở để chứng minh rằng có sự khác biệt đáng kể trong tỷ lệ giữa nam và nữ về số lượng học sinh sống trong gia đình có nhiều hơn 5 con.
Với độ tin cậy 95%, khoảng chênh lệch giữa giữa nam và nữ về số lượng học sinh sống trong gia đình có nhiều hơn 5 con nằm trong khoảng từ -0.02364003 đến 0.04417852.
Đối với đề tài kiểm tra xem liệu xếp loại học tập bị ảnh hưởng như thế nào bởi các yếu tố cá nhân và xã hội, tôi sử dụng bộ dữ liệu gồm 7 biến định tính và 1 biến định lượng.
Edu <- read_excel("DiemThiHocSinh.xlsx", sheet = "Sheet1")
str(Edu)
## tibble [1,000 × 12] (S3: tbl_df/tbl/data.frame)
## $ Gender : chr [1:1000] "female" "female" "female" "male" ...
## $ ParentEduc : chr [1:1000] "bachelor's degree" "associate's degree" "master's degree" "associate's degree" ...
## $ ParentMaritalStatus: chr [1:1000] "married" "married" "single" "married" ...
## $ PracticeSport : chr [1:1000] "regularly" "sometimes" "sometimes" "never" ...
## $ IsFirstChild : chr [1:1000] "yes" "yes" "yes" "no" ...
## $ NrSiblings : num [1:1000] 4 1 5 2 1 2 2 2 4 1 ...
## $ WklyStudyHours : chr [1:1000] "< 5" "5 đến 10" "< 5" "5 đến 10" ...
## $ MathScore : num [1:1000] 71 69 87 45 76 73 85 41 65 37 ...
## $ ReadingScore : num [1:1000] 71 90 93 56 78 84 93 43 64 59 ...
## $ WritingScore : num [1:1000] 74 88 91 42 75 79 89 39 68 50 ...
## $ AveScore : num [1:1000] 72 82.3 90.3 47.7 76.3 ...
## $ FinalScore : chr [1:1000] "Đạt" "Đạt" "Đạt" "Không đạt" ...
dnt <- Edu[,c("Gender","ParentEduc","ParentMaritalStatus","PracticeSport","IsFirstChild","WklyStudyHours","FinalScore")]
dnt
## # A tibble: 1,000 × 7
## Gender ParentEduc ParentMaritalStatus PracticeSport IsFirstChild
## <chr> <chr> <chr> <chr> <chr>
## 1 female bachelor's degree married regularly yes
## 2 female associate's degree married sometimes yes
## 3 female master's degree single sometimes yes
## 4 male associate's degree married never no
## 5 male associate's degree married sometimes yes
## 6 female associate's degree married regularly yes
## 7 female associate's degree widowed never no
## 8 male associate's degree married sometimes yes
## 9 male high school single sometimes no
## 10 female high school married regularly yes
## # ℹ 990 more rows
## # ℹ 2 more variables: WklyStudyHours <chr>, FinalScore <chr>
Giới tính
dnt |> ggplot(aes(Gender)) + geom_bar() + ylab ("Số học sinh") + xlab ("Giới tính")
prop.table(table(Edu$Gender))
##
## female male
## 0.515 0.485
Trong tổng số 1000 học sinh, số học sinh nam là 485 học sinh (chiếm tỷ lệ 48,5% và học sinh nữ là 515 học sinh (chiếm tỷ lệ 51,5%).
Trình độ học vấn của phụ huynh
dnt |> ggplot(aes(ParentEduc)) + geom_bar() + ylab ("Số người") + xlab ("Trình độ học vấn của phụ huynh")
prop.table(table(Edu$ParentEduc))
##
## associate's degree bachelor's degree high school master's degree
## 0.421 0.131 0.384 0.064
Đối với trình độ học vấn của phụ huynh, phụ huynh có trình độ cao đẳng và trung học phổ thông chiếm tỷ lệ nhiều nhất. Trình độ cao đẳng chiếm 42,1% và trung học phổ thông chiếm 38,4%. Phụ huynh có trình độ đại học chiếm 13,1%. Phụ huynh có trình độ học vấn là Thạc sĩ chiếm tỷ lệ thấp nhất với 6,4%.
Tình trạng hôn nhân của phụ huynh
dnt |> ggplot(aes(ParentMaritalStatus)) + geom_bar() + ylab ("Số người") + xlab ("Tình trạng hôn nhân")
prop.table(table(Edu$ParentMaritalStatus))
##
## divorced married single widowed
## 0.161 0.567 0.244 0.028
Có đến hơn một nữa phụ huynh của học sinh đã kết hôn và vẫn còn sống với nhau (cụ thể là tỷ lệ học sinh có phụ huynh đã kết hôn chiếm 56,7%). Trong khi đó, tỷ lệ học sinh có phụ huynh vẫn còn độc thân chiếm 24,4%, tỷ lệ học sinh có phụ huynh đã ly hôn chiếm 16,1% và cuối cùng là tỷ lệ học sinh có phụ huynh ở goá chiếm tỷ lệ thấp nhất với 2,8%.
Thói quen tập thể thao của học sinh
dnt |> ggplot(aes(PracticeSport)) + geom_bar() + ylab ("Số học sinh") + xlab ("Thói quen tập thể thao")
prop.table(table(Edu$PracticeSport))
##
## never regularly sometimes
## 0.124 0.365 0.511
Số học sinh có thói quen luyện tập thể dục thể thao là khá cao, chiếm tỷ lệ là 87,6%. Trong tổng số 1000 học sinh, có khoảng 51,1% học sinh là thường xuyên tập thểo thao, 36,5% học sinh thỉnh thoảng tập thể thao và còn 12,4% học sinh nói rằng mình chưa bao giờ tập thể thao.
Học sinh có phải là con đầu lòng hay không?
dnt |> ggplot(aes(IsFirstChild)) + geom_bar() + ylab ("Số học sinh") + xlab ("Có phải là con đầu lòng?")
prop.table(table(Edu$IsFirstChild))
##
## no yes
## 0.352 0.648
Đối với biến Có phải là con đầu lòng hay không thì qua thống kê, có khoảng 64,8% học sinh là con đầu lòng, khoảng 35,2% học sinh không phải là con đầu lòng.
Số giờ tự học hàng tuần
dnt |> ggplot(aes(WklyStudyHours)) + geom_bar() + ylab ("Số học sinh") + xlab ("Số giờ tự học hàng tuần")
prop.table(table(Edu$WklyStudyHours))
##
## < 5 > 10 5 đến 10
## 0.283 0.173 0.544
Tỷ lệ học sinh có số giờ tự học hàng tuần ít hơn 5 tiếng là 28,3%, số giờ tự học hàng tuần từ 5 tiếng đến 10 tiếng là 54,4%, số giờ tự học hàng tuần nhiều hơn 10 tiếng là 17,3%.
Kết quả học tập
dnt |> ggplot(aes(FinalScore)) + geom_bar() + ylab ("Số học sinh") + xlab ("Kết quả học tập")
prop.table(table(Edu$FinalScore))
##
## Đạt Không đạt
## 0.892 0.108
Tỷ lệ học sinh có kết quả là Đạt là 89,2% tương đương với 892 học sinh trong tổng số 1000 học sinh xếp loại đạt, còn lại là 10,8% (tương đương với 108 học sinh) xếp loại Không đạt.
dnl <- data.frame(Edu$NrSiblings)
summary(dnl)
## Edu.NrSiblings
## Min. :1.000
## 1st Qu.:2.000
## Median :3.000
## Mean :3.066
## 3rd Qu.:4.000
## Max. :8.000
prop.table(table(Edu$NrSiblings))
##
## 1 2 3 4 5 6 7 8
## 0.144 0.265 0.228 0.210 0.082 0.050 0.010 0.011
dnl |> ggplot(aes(Edu$NrSiblings)) + geom_bar() + ylab ("Số học sinh") + xlab ("Số con trong gia đình")
Số con trong một gia đình dao động trong khoảng từ 1 đến 8 con. Trong đó số gia đình có từ 2 đến 4 con là nhiều nhất với tỷ lệ lần lượt là 26,5%, 22,8% và 21%. Tỷ lệ gia đình có 7 đến 8 con là ít nhất với tỷ lệ khoảng 1%.
rik <- table(Edu$Gender, Edu$FinalScore)
addmargins(rik)
##
## Đạt Không đạt Sum
## female 472 43 515
## male 420 65 485
## Sum 892 108 1000
RelRisk(rik)
## [1] 1.058345
Tỷ lệ học sinh xếp loại đạt mà là nữ gấp 1,06 lần tỷ lệ học sinh xếp loại đạt mà là nam. Điều này có nghĩa là tỷ lệ xác suất xảy ra sự kiện “học sinh xếp loại đạt mà là nữ” nhiều hơn so với xác xuất xảy ra sự kiện “học sinh xếp loại đạt mà là nam”.
ric <- table(Edu$IsFirstChild, Edu$FinalScore)
addmargins(ric)
##
## Đạt Không đạt Sum
## no 300 52 352
## yes 592 56 648
## Sum 892 108 1000
RelRisk(ric)
## [1] 0.9328931
Tỷ lệ học sinh xếp loại đạt mà không phải là con đầu lòng/Tỷ lệ học sinh xếp loại đạt và là con đầu lòng là 93,3%. Điều này có nghĩa là tỷ lệ xác suất xảy ra sự kiện “học sinh xếp loại đạt mà không phải con đầu lòng” thấp hơn so với xác xuất xảy ra sự kiện “học sinh xếp loại đạt và là con đầu lòng”.
odo <- table(Edu$Gender, Edu$FinalScore)
odo
##
## Đạt Không đạt
## female 472 43
## male 420 65
OddsRatio(odo)
## [1] 1.698782
Tỷ lệ học sinh xếp loại Đạt và là nữ gấp 1,7 lần Tỷ lệ học sinh xếp loại Đạt và là nam. Điều này có nghĩa là xác xuất xảy ra sự kiện “Học sinh nữ xếp loại Đạt” nhiều hơn xác xuất xảy ra sự kiện “Học sinh nam xếp loại Đạt”.
oddsratio(odo)
## $data
##
## Đạt Không đạt Total
## female 472 43 515
## male 420 65 485
## Total 892 108 1000
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## female 1.000000 NA NA
## male 1.695902 1.131695 2.564952
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## female NA NA NA
## male 0.01035325 0.01081267 0.01009062
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
odr <- table(Edu$IsFirstChild, Edu$FinalScore)
odr
##
## Đạt Không đạt
## no 300 52
## yes 592 56
OddsRatio(odr)
## [1] 0.545738
Tỷ lệ học sinh xếp loại Đạt không phải là con đầu lòng/Tỷ lệ học sinh xếp loại Đạt và là con đầu lòng 54.57%. Điều này có nghĩa là xác xuất xảy ra sự kiện “Xếp loại Đạt không phải là con đầu lòng” thấp hơn xác xuất xảy ra sự kiện “Xếp loại đạt và là con đầu lòng”.
Đề tài: Kiểm tra xem xếp loại học tập chịu ảnh hưởng như thế nào bởi các yếu tố cá nhân và xã hội. Với biến phụ thuộc đầu vào là FinalScore. Biến độc lập là Gender,ParentEduc, ParentMaritalStatus, PracticeSport, IsFirstChild, NrSiblings và WklyStudyHours.
Edu <- read_excel("DiemThiHocSinh.xlsx", sheet = "Sheet1")
str(Edu)
## tibble [1,000 × 12] (S3: tbl_df/tbl/data.frame)
## $ Gender : chr [1:1000] "female" "female" "female" "male" ...
## $ ParentEduc : chr [1:1000] "bachelor's degree" "associate's degree" "master's degree" "associate's degree" ...
## $ ParentMaritalStatus: chr [1:1000] "married" "married" "single" "married" ...
## $ PracticeSport : chr [1:1000] "regularly" "sometimes" "sometimes" "never" ...
## $ IsFirstChild : chr [1:1000] "yes" "yes" "yes" "no" ...
## $ NrSiblings : num [1:1000] 4 1 5 2 1 2 2 2 4 1 ...
## $ WklyStudyHours : chr [1:1000] "< 5" "5 đến 10" "< 5" "5 đến 10" ...
## $ MathScore : num [1:1000] 71 69 87 45 76 73 85 41 65 37 ...
## $ ReadingScore : num [1:1000] 71 90 93 56 78 84 93 43 64 59 ...
## $ WritingScore : num [1:1000] 74 88 91 42 75 79 89 39 68 50 ...
## $ AveScore : num [1:1000] 72 82.3 90.3 47.7 76.3 ...
## $ FinalScore : chr [1:1000] "Đạt" "Đạt" "Đạt" "Không đạt" ...
datatable(Edu)
Gender là giới tính của học sinh bao gồm 2 lựa chọn: male (Nam) hoặc female (Nữ).
ParentEduc là trình độ học vấn của phụ huynh bao gồm từ high school đến master’degree (trung học phổ thông/ Cao đẳng/ Đại học/Thạc sĩ).
ParentMaritalStatus là tình trạng hôn nhân của cha mẹ bao gồm: married/single/widowed/divorced (Đã kết hôn/ Độc thân/Goá/Ly hôn).
PracticeSport là thói quen luyện tập thể thao bao gồm: never/sometimes/regularly (Không bao giờ/Thỉnh thoảng/Thường xuyên).
IsFirstChild: nếu đứa trẻ là con đầu lòng thì chọn yes, ngược lại là no.
NrSiblings là số anh chị em trong nhà (từ 1 đến 8).
WklyStudyHours là số giờ tự học hàng tuần bao gồm: <5, 5 đến 10, >10.
MathScore là điểm kiểm tra toán (từ 0 đến 100).
ReadingScore là điểm kiểm tra đọc (từ 0 đến 100).
WritingScore là điểm kiểm tra viết (từ 0 đến 100).
AvaScore là điểm trung bình 3 môn MathScore, ReadingScore, WritingScore.
FinalScore Xếp loại học tập (Đạt hoặc Không đạt).