1 BÀI VỀ NHÀ TUẦN 5

1.1 Dữ liệu đầu vào

setwd("D:/HỌC TẬP/Phân tích dữ liệu định tính")
library(xlsx)
library(readxl)

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

library(data.table)

## Warning: package 'data.table' was built under R version 4.2.3

d <- read.xlsx("Car Ownership.xlsx",1)
data.table(d)

##                Occupation   MI  CS YE       FS                          FH Car
##   1:                Nurse 4500 720  3   Stable       No significant issues Yes
##   2:   Software Developer 7800 800  5   Stable       No significant issues Yes
##   3:                 Chef 3200 650  2 Unstable Missed payments in the past  No
##   4:           Accountant 6500 750  7   Stable       No significant issues Yes
##   5:          Salesperson 3000 600  1 Unstable Missed payments in the past  No
##  ---                                                                          
## 393:      Project Manager 7000 730  5   Stable       No significant issues Yes
## 394:                 Chef 4500 680  4   Stable       No significant issues Yes
## 395:    Interior Designer 5500 690  4   Stable       No significant issues Yes
## 396:    Medical Assistant 3500 640  3   Stable       No significant issues  No
## 397: Customer Service Rep 3200 641  4   Stable       No significant issues  No
##      NC
##   1:  0
##   2:  0
##   3:  0
##   4:  1
##   5:  0
##  ---   
## 393:  0
## 394:  0
## 395:  1
## 396:  1
## 397:  2

1.2 Mô hình 1

Mô hình logit

\(log(\pi/1-\pi)\) = \(\beta_0\) + \(\beta_1\)MI + \(\beta_2\)CS + \(\beta_3\)FS + \(\beta_4\)FH + \(\beta_5\)YE + \(\beta_6\)NC

fit1 <- glm(factor(Car) ~ MI + CS + FS + FH + YE + NC, family = binomial(link = 'logit'), data = d)

summary(fit1)

## 
## Call:
## glm(formula = factor(Car) ~ MI + CS + FS + FH + YE + NC, family = binomial(link = "logit"), 
##     data = d)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.69171  -0.00021   0.01653   0.21608   2.21641  
## 
## Coefficients:
##                                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                   -2.343e+01  6.523e+03  -0.004 0.997134    
## MI                             1.644e-03  4.843e-04   3.395 0.000685 ***
## CS                            -3.061e-03  9.937e-03  -0.308 0.758054    
## FSUnstable                     1.633e+01  6.523e+03   0.003 0.998003    
## FHMissed payments in the past -1.629e+01  9.380e+02  -0.017 0.986147    
## FHNo significant issues        1.598e+01  6.523e+03   0.002 0.998045    
## YE                             9.819e-01  3.156e-01   3.111 0.001864 ** 
## NC                            -3.078e-01  2.391e-01  -1.288 0.197892    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 512.89  on 396  degrees of freedom
## Residual deviance: 175.17  on 389  degrees of freedom
## AIC: 191.17
## 
## Number of Fisher Scoring iterations: 17

Mô hình probit

\(probit(\pi/1-\pi)\) = \(\beta_0\) + \(\beta_1\)MI + \(\beta_2\)CS + \(\beta_3\)FS + \(\beta_4\)FH + \(\beta_5\)YE + \(\beta_6\)NC

fit2 <- glm(factor(Car) ~ MI + CS + FS + FH + YE + NC, family = binomial(link = 'probit'), data = d)

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

summary(fit2)

## 
## Call:
## glm(formula = factor(Car) ~ MI + CS + FS + FH + YE + NC, family = binomial(link = "probit"), 
##     data = d)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.70503  -0.00013   0.00082   0.19927   2.18526  
## 
## Coefficients:
##                                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                   -8.672e+00  1.569e+03  -0.006 0.995589    
## MI                             8.720e-04  2.609e-04   3.342 0.000832 ***
## CS                            -1.211e-03  5.570e-03  -0.217 0.827926    
## FSUnstable                     4.449e+00  1.569e+03   0.003 0.997737    
## FHMissed payments in the past -4.819e+00  2.106e+02  -0.023 0.981742    
## FHNo significant issues        4.308e+00  1.569e+03   0.003 0.997809    
## YE                             5.660e-01  1.776e-01   3.186 0.001442 ** 
## NC                            -1.752e-01  1.351e-01  -1.297 0.194644    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 512.89  on 396  degrees of freedom
## Residual deviance: 175.40  on 389  degrees of freedom
## AIC: 191.4
## 
## Number of Fisher Scoring iterations: 17

Mô hình cloglog

\(cloglog(\pi/1-\pi)\) = \(\beta_0\) + \(\beta_1\)MI + \(\beta_2\)CS + \(\beta_3\)FS + \(\beta_4\)FH + \(\beta_5\)YE + \(\beta_6\)NC

fit3 <- glm(factor(Car) ~ MI + CS + FS + FH + YE + NC, family = binomial(link = 'cloglog'), data = d)

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

summary(fit3)

## 
## Call:
## glm(formula = factor(Car) ~ MI + CS + FS + FH + YE + NC, family = binomial(link = "cloglog"), 
##     data = d)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.59276  -0.00019   0.00000   0.15223   2.18499  
## 
## Coefficients:
##                                 Estimate Std. Error z value Pr(>|z|)   
## (Intercept)                   -2.284e+01  6.236e+03  -0.004  0.99708   
## MI                             6.375e-04  2.405e-04   2.650  0.00804 **
## CS                             1.984e-03  5.867e-03   0.338  0.73526   
## FSUnstable                     1.633e+01  6.236e+03   0.003  0.99791   
## FHMissed payments in the past -1.614e+01  9.354e+02  -0.017  0.98624   
## FHNo significant issues        1.661e+01  6.236e+03   0.003  0.99787   
## YE                             6.517e-01  2.003e-01   3.254  0.00114 **
## NC                            -2.363e-01  1.454e-01  -1.625  0.10418   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 512.89  on 396  degrees of freedom
## Residual deviance: 178.13  on 389  degrees of freedom
## AIC: 194.13
## 
## Number of Fisher Scoring iterations: 17

1.2.1 Chọn mô hình phù hợp

1.2.1.1 AIC - Akaike Information Criterion

aic1 <- AIC(fit1)
aic2 <- AIC(fit2)
aic3 <- AIC(fit3)
AIC <-cbind(aic1, aic2, aic3)
AIC

##          aic1     aic2     aic3
## [1,] 191.1709 191.3966 194.1345

Giá trị của AIC càng nhỏ thì mô hình càng tốt. Trong 3 mô hình thì mô hình logit có giá trị AIC là nhỏ nhất (191,1709). Vì vậy mô hình logit là tốt nhất.

1.2.1.2 Deviance

de1 <- deviance(fit1)
de2 <- deviance(fit2)
de3 <- deviance(fit3)
deviance <- cbind(de1,de2,de3)
deviance

##           de1      de2      de3
## [1,] 175.1709 175.3966 178.1345

Giá trị của Deviance càng nhỏ thì mô hình càng tốt. Trong 3 mô hình thì mô hình logit có giá trị deviance là nhỏ nhất (175,1709). Vì vậy mô hình logit là tốt nhất.

1.2.1.3 Brier Score

library(DescTools)

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

## 
## Attaching package: 'DescTools'

## The following object is masked from 'package:data.table':
## 
##     %like%

BrierScore(fit1)

## [1] 0.06958084

library(DescTools)
BrierScore(fit2)

## [1] 0.07013952

library(DescTools)
BrierScore(fit3)

## [1] 0.07149978

Giá trị của Brier Score càng nhỏ nghĩa là chênh lệch giữa xác suất thực tế và xác suất tính từ mô hình càng nhỏ, nghĩa là mô hình càng tốt. Trong 3 mô hình thì mô hình logit có giá trị Brier Score là nhỏ nhất (0,0695). Vì vậy mô hình logit là tốt nhất.

1.2.1.4 Ma trận nhầm lẫn

library(caret)

## Warning: package 'caret' was built under R version 4.2.3

## Loading required package: ggplot2

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

## Loading required package: lattice

## 
## Attaching package: 'caret'

## The following objects are masked from 'package:DescTools':
## 
##     MAE, RMSE

confusionMatrix(table(predict(fit1, type="response") >= 0.5,fit1$data$Car == 'Yes'))

## Confusion Matrix and Statistics
## 
##        
##         FALSE TRUE
##   FALSE   120   15
##   TRUE     18  244
##                                           
##                Accuracy : 0.9169          
##                  95% CI : (0.8852, 0.9421)
##     No Information Rate : 0.6524          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.8158          
##                                           
##  Mcnemar's Test P-Value : 0.7277          
##                                           
##             Sensitivity : 0.8696          
##             Specificity : 0.9421          
##          Pos Pred Value : 0.8889          
##          Neg Pred Value : 0.9313          
##              Prevalence : 0.3476          
##          Detection Rate : 0.3023          
##    Detection Prevalence : 0.3401          
##       Balanced Accuracy : 0.9058          
##                                           
##        'Positive' Class : FALSE           
##

MH logit có độ chính xác toàn thể là 91,69%, độ nhạy là 86,96% và độ hiệu quả là 94,21%

library(caret)
confusionMatrix(table(predict(fit2, type="response") >= 0.5,fit2$data$Car == 'Yes'))

## Confusion Matrix and Statistics
## 
##        
##         FALSE TRUE
##   FALSE   120   15
##   TRUE     18  244
##                                           
##                Accuracy : 0.9169          
##                  95% CI : (0.8852, 0.9421)
##     No Information Rate : 0.6524          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.8158          
##                                           
##  Mcnemar's Test P-Value : 0.7277          
##                                           
##             Sensitivity : 0.8696          
##             Specificity : 0.9421          
##          Pos Pred Value : 0.8889          
##          Neg Pred Value : 0.9313          
##              Prevalence : 0.3476          
##          Detection Rate : 0.3023          
##    Detection Prevalence : 0.3401          
##       Balanced Accuracy : 0.9058          
##                                           
##        'Positive' Class : FALSE           
##

MH probit có độ chính xác toàn thể là 91,69%, độ nhạy là 86,96% và độ hiệu quả là 94,21%

library(caret)
confusionMatrix(table(predict(fit3, type="response") >= 0.5,fit3$data$Car == 'Yes'))

## Confusion Matrix and Statistics
## 
##        
##         FALSE TRUE
##   FALSE   120   17
##   TRUE     18  242
##                                           
##                Accuracy : 0.9118          
##                  95% CI : (0.8795, 0.9378)
##     No Information Rate : 0.6524          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.8053          
##                                           
##  Mcnemar's Test P-Value : 1               
##                                           
##             Sensitivity : 0.8696          
##             Specificity : 0.9344          
##          Pos Pred Value : 0.8759          
##          Neg Pred Value : 0.9308          
##              Prevalence : 0.3476          
##          Detection Rate : 0.3023          
##    Detection Prevalence : 0.3451          
##       Balanced Accuracy : 0.9020          
##                                           
##        'Positive' Class : FALSE           
##

MH cloglog có độ chính xác toàn thể là 91,18%, độ nhạy là 86,96% và độ hiệu quả là 93,44%

Kết luận: Trong 3 mô hình thì mô hình logit và mô hình probit đều có độ chính xác toàn thể là 91,69%, độ nhạy là 86,96% và độ hiệu quả là 94,21% (cao nhất). Nhưng chỉ số AIC, Deviance và Brier Score cho thấy mô hình lotgit tốt hơn. Vì vậy, dựa trên 4 tiêu chí đánh giá trên ta đi đến kết luận mô hình logit là phù hợp nhất.

Mặc khác ở kết quả hồi quy logistic cả 3 mô hình đều cho thấy trong tất cả 6 biến độc lập chỉ có 2 biến là có ý nghĩa thống kê ở mức 5% là biến MI và YE. Ta tiến hàng bỏ các biến không có ý nghĩa thống kê và chạy lại mô hình mới.

1.3 Mô hình 2

Mô hình logit

\(log(\pi/1-\pi)\) = \(\beta_0\) + \(\beta_1\)MI + \(\beta_5\)YE

f1 <- glm(factor(Car) ~ MI + YE , family = binomial(link = 'logit'), data = d)
          
summary(f1)

## 
## Call:
## glm(formula = factor(Car) ~ MI + YE, family = binomial(link = "logit"), 
##     data = d)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.64568  -0.27735   0.01721   0.21658   2.40346  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -9.5229258  1.1768718  -8.092 5.88e-16 ***
## MI           0.0013592  0.0003329   4.083 4.45e-05 ***
## YE           1.2392617  0.2890771   4.287 1.81e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 512.89  on 396  degrees of freedom
## Residual deviance: 183.82  on 394  degrees of freedom
## AIC: 189.82
## 
## Number of Fisher Scoring iterations: 8

Mô hình probit

\(probit(\pi/1-\pi)\) = \(\beta_0\) + \(\beta_1\)MI + \(\beta_5\)YE

f2 <- glm(factor(Car) ~ MI + YE , family = binomial(link = 'probit'), data = d)

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

summary(f2)

## 
## Call:
## glm(formula = factor(Car) ~ MI + YE, family = binomial(link = "probit"), 
##     data = d)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.69164  -0.26842   0.00098   0.19468   2.39688  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -5.2886669  0.5989162  -8.830  < 2e-16 ***
## MI           0.0007421  0.0001831   4.054 5.05e-05 ***
## YE           0.7019320  0.1595153   4.400 1.08e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 512.89  on 396  degrees of freedom
## Residual deviance: 184.03  on 394  degrees of freedom
## AIC: 190.03
## 
## Number of Fisher Scoring iterations: 8

Mô hình cloglog

\(cloglog(\pi/1-\pi)\) = \(\beta_0\) + \(\beta_1\)MI + \(\beta_5\)YE

f3 <- glm(factor(Car) ~ MI + YE, family = binomial(link = 'cloglog'), data = d)

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

summary(f3)

## 
## Call:
## glm(formula = factor(Car) ~ MI + YE, family = binomial(link = "cloglog"), 
##     data = d)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -3.10811  -0.41508   0.00000   0.08935   2.14578  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -6.0328388  0.7035045  -8.575  < 2e-16 ***
## MI           0.0006726  0.0001885   3.567 0.000361 ***
## YE           0.8489936  0.1846105   4.599 4.25e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 512.89  on 396  degrees of freedom
## Residual deviance: 191.32  on 394  degrees of freedom
## AIC: 197.32
## 
## Number of Fisher Scoring iterations: 10

1.3.1 Chọn mô hình phù hợp

1.3.1.1 AIC - Akaike Information Criterion

aic1 <- AIC(f1)
aic2 <- AIC(f2)
aic3 <- AIC(f3)
AIC <-cbind(aic1, aic2, aic3)
AIC

##          aic1     aic2     aic3
## [1,] 189.8186 190.0302 197.3155

Giá trị của AIC càng nhỏ thì mô hình càng tốt. Trong 3 mô hình thì mô hình logit có giá trị AIC là nhỏ nhất (189,8186). Vì vậy mô hình logit là tốt nhất.

1.3.1.2 Deviance

de1 <- deviance(f1)
de2 <- deviance(f2)
de3 <- deviance(f3)
deviance <- cbind(de1,de2,de3)
deviance

##           de1      de2      de3
## [1,] 183.8186 184.0302 191.3155

Giá trị của Deviance càng nhỏ thì mô hình càng tốt. Trong 3 mô hình thì mô hình logit có giá trị deviance là nhỏ nhất (183,8186). Vì vậy mô hình logit là tốt nhất.

1.3.1.3 Brier Score

library(DescTools)
BrierScore(f1)

## [1] 0.07191108

library(DescTools)
BrierScore(f2)

## [1] 0.07231477

library(DescTools)
BrierScore(f3)

## [1] 0.07401281

Giá trị của Brier Score càng nhỏ nghĩa là chênh lệch giữa xác suất thực tế và xác suất tính từ mô hình càng nhỏ, nghĩa là mô hình càng tốt. Trong 3 mô hình thì mô hình logit có giá trị Brier Score là nhỏ nhất (0,07191108). Vì vậy mô hình logit là tốt nhất.

1.3.1.4 Ma trận nhầm lẫn

library(caret)
confusionMatrix(table(predict(f1, type="response") >= 0.5,f1$data$Car == 'Yes'))

## Confusion Matrix and Statistics
## 
##        
##         FALSE TRUE
##   FALSE   120   19
##   TRUE     18  240
##                                           
##                Accuracy : 0.9068          
##                  95% CI : (0.8738, 0.9335)
##     No Information Rate : 0.6524          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.7949          
##                                           
##  Mcnemar's Test P-Value : 1               
##                                           
##             Sensitivity : 0.8696          
##             Specificity : 0.9266          
##          Pos Pred Value : 0.8633          
##          Neg Pred Value : 0.9302          
##              Prevalence : 0.3476          
##          Detection Rate : 0.3023          
##    Detection Prevalence : 0.3501          
##       Balanced Accuracy : 0.8981          
##                                           
##        'Positive' Class : FALSE           
##

MH logit có độ chính xác toàn thể là 90,68%, độ nhạy là 86,96% và độ hiệu quả là 92,66%

library(caret)
confusionMatrix(table(predict(f2, type="response") >= 0.5,f2$data$Car == 'Yes'))

## Confusion Matrix and Statistics
## 
##        
##         FALSE TRUE
##   FALSE   120   19
##   TRUE     18  240
##                                           
##                Accuracy : 0.9068          
##                  95% CI : (0.8738, 0.9335)
##     No Information Rate : 0.6524          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.7949          
##                                           
##  Mcnemar's Test P-Value : 1               
##                                           
##             Sensitivity : 0.8696          
##             Specificity : 0.9266          
##          Pos Pred Value : 0.8633          
##          Neg Pred Value : 0.9302          
##              Prevalence : 0.3476          
##          Detection Rate : 0.3023          
##    Detection Prevalence : 0.3501          
##       Balanced Accuracy : 0.8981          
##                                           
##        'Positive' Class : FALSE           
##

MH probit có độ chính xác toàn thể là 90,68%, độ nhạy là 86,96% và độ hiệu quả là 92,66%

library(caret)
confusionMatrix(table(predict(f3, type="response") >= 0.5,f3$data$Car == 'Yes'))

## Confusion Matrix and Statistics
## 
##        
##         FALSE TRUE
##   FALSE   123   26
##   TRUE     15  233
##                                           
##                Accuracy : 0.8967          
##                  95% CI : (0.8625, 0.9249)
##     No Information Rate : 0.6524          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.7765          
##                                           
##  Mcnemar's Test P-Value : 0.1183          
##                                           
##             Sensitivity : 0.8913          
##             Specificity : 0.8996          
##          Pos Pred Value : 0.8255          
##          Neg Pred Value : 0.9395          
##              Prevalence : 0.3476          
##          Detection Rate : 0.3098          
##    Detection Prevalence : 0.3753          
##       Balanced Accuracy : 0.8955          
##                                           
##        'Positive' Class : FALSE           
##

MH cloglog có độ chính xác toàn thể là 89,67%, độ nhạy là 89,13% và độ hiệu quả là 89,96%

Kết luận: Trong 3 mô hình thì mô hình logit và mô hình probit đều có độ chính xác toàn thể là 90,68%, độ nhạy là 86,96% và độ hiệu quả là 92,66% (cao nhất). Nhưng chỉ số AIC, Deviance và Brier Score cho thấy mô hình lotgit tốt hơn. Vì vậy, dựa trên 4 tiêu chí đánh giá trên ta đi đến kết luận mô hình logit là phù hợp nhất.

2 BÀI VỀ NHÀ TUẦN 3,4: THỐNG KÊ CHO 1 BIẾN

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.

2.1 Biến Car

2.1.1 Thống kê mô tả

table(d$Car)/sum(table(d$Car))

## 
##        No       Yes 
## 0.3476071 0.6523929

library(ggplot2)
d |> ggplot(aes(x = Car, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  theme_classic() +
  labs(x = 'Quyền sở hữu ô tô', y = 'Số người')

Trong tổng số 397 người khảo sát thì có 65% người trong đó sở hữu xe và 35% người không sở hữu xe

2.1.2 Ước lượng tỷ lệ

Ước lượng tỷ lệ người đã có xe, đồng thời kiểm định xem tỷ lệ (%) người đã có xe có phải là 50% không?

ul <- d[d$Car == "Yes",]
prop.test(length(ul$Car), length(d$Car), p = 0.5)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(ul$Car) out of length(d$Car), null probability 0.5
## X-squared = 36.272, df = 1, p-value = 1.716e-09
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.6030046 0.6987823
## sample estimates:
##         p 
## 0.6523929

Ta có p_value < 0,05 nên ta bác bỏ \(H_0\). Vì vậy tỉ lệ người đã có xe không bằng 50%. Khoảng ước lượng tỷ lệ người đã có xe với độ tin cậy 95% là (0,6030046 ; 0,6987823).

2.2 Biến Occupation

2.2.1 Thống kê mô tả

table(d$Occupation)

## 
##            Account Executive              Account Manager 
##                            4                            3 
##                   Accountant                    Architect 
##                            9                            9 
##                 Art Director                     Attorney 
##                            1                            3 
##          Automotive Mechanic                  Bank Teller 
##                            1                            4 
##                      Barista                    Bartender 
##                            1                            1 
##             Business Analyst               Business Owner 
##                            3                            1 
##                    Carpenter                         Chef 
##                            3                           26 
##               Civil Engineer          Computer Programmer 
##                            1                            1 
##          Computer Technician          Construction Worker 
##                            1                            5 
##             Customer Service         Customer Service Rep 
##                            2                            7 
##             Customer Support                 Data Analyst 
##                            1                            3 
##               Data Scientist             Dental Assistant 
##                            5                            3 
##             Dental Hygienist                      Dentist 
##                            7                            1 
##                     Designer          Electrical Engineer 
##                            2                            1 
##                  Electrician    Elementary School Teacher 
##                           17                            1 
##                     Engineer                 Entrepreneur 
##                            3                            1 
##                Event Planner          Executive Assistant 
##                            4                            3 
##             Fashion Designer            Financial Advisor 
##                            2                            6 
##            Financial Analyst            Financial Manager 
##                            7                            1 
##            Financial Planner           Fitness Instructor 
##                            1                            1 
##             Flight Attendant               Graphic Artist 
##                            1                            2 
##             Graphic Designer                 Hair Stylist 
##                           15                            2 
##                  Hairdresser                HR Generalist 
##                            1                            3 
##                   HR Manager                HR Specialist 
##                            1                            1 
##              Human Resources      Human Resources Manager 
##                            5                            5 
##              Insurance Agent        Insurance Underwriter 
##                            8                            1 
##            Interior Designer            Investment Banker 
##                            3                            1 
##                IT Consultant                   IT Manager 
##                            1                            6 
##        IT Support Specialist                       Lawyer 
##                            1                            4 
##        Management Consultant                    Marketing 
##                            1                            2 
##            Marketing Analyst        Marketing Coordinator 
##                            1                            5 
##            Marketing Manager         Marketing Specialist 
##                            6                            1 
##                     Mechanic          Mechanical Designer 
##                            3                            1 
##          Mechanical Engineer        Mechanical Technician 
##                            4                            3 
##            Medical Assistant                     Musician 
##                            4                            2 
##                        Nurse           Nurse Practitioner 
##                           10                            1 
##               Office Manager                  Optometrist 
##                            2                            1 
##             Personal Trainer                   Pharmacist 
##                            5                            4 
##                 Photographer   Physical Education Teacher 
##                            3                            4 
##           Physical Therapist Physical Therapist Assistant 
##                           10                            1 
##             Physical Trainer                    Physician 
##                            2                            3 
##          Physician Assistant                      Plumber 
##                            3                            6 
##               Police Officer              Project Manager 
##                            1                            4 
##                 Psychologist             Public Relations 
##                            2                            1 
##            Real Estate Agent             Registered Nurse 
##                            9                            1 
##               Retail Manager           Retail Salesperson 
##                            4                            1 
##                Sales Manager         Sales Representative 
##                            9                            8 
##                  Salesperson         Social Media Manager 
##                            3                            1 
##                Social Worker           Software Architect 
##                            5                            1 
##           Software Developer            Software Engineer 
##                            4                            5 
##                      Teacher                 Veterinarian 
##                            4                            6 
##      Veterinarian Technician              Waiter/Waitress 
##                            1                            1 
##                 Web Designer                Web Developer 
##                            6                            8 
##                       Writer 
##                            7

library(ggplot2)
d |> ggplot(aes(Occupation)) +
  geom_bar()

Trong tổng số 397 người khảo sát thì có đến 26 người làm nghề chef và là nghề nghiệp nhiều nhất khảo sát được.

2.2.2 Ước lượng tỷ lệ

Ước lượng tỷ lệ người làm nghề chef, đồng thời kiểm định xem tỷ lệ (%) người làm nghề chef có phải là 10% không?

ul <- d[d$Occupation == "Chef",]
prop.test(length(ul$Occupation), length(d$Occupation), p = 0.1)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(ul$Occupation) out of length(d$Occupation), null probability 0.1
## X-squared = 4.8766, df = 1, p-value = 0.02722
## alternative hypothesis: true p is not equal to 0.1
## 95 percent confidence interval:
##  0.04404677 0.09568659
## sample estimates:
##          p 
## 0.06549118

Ta có p_value < 0,05 nên ta bác bỏ \(H_0\). Vì vậy tỉ lệ người làm nghề chef không bằng 10%. Khoảng ước lượng tỷ lệ người làm nghề chef với độ tin cậy 95% là (0,04404677 ; 0,09568659).

2.3 Biến Monthly Income

2.3.1 Thống kê mô tả

summary(d$MI)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1500    3500    4600    5364    6900   15000

Thu nhập trong 1 tháng nhỏ nhất là 1500 USD; lớn nhất là 15000 USD; thu nhập trung bình là 5364 USD; 25% dữ liệu nhỏ hơn 3500 USD (giá trị tứ phân vị thứ nhất); 50% dữ liệu nhỏ hơn 4600 USD (giá trị trung vị); 75% dữ liệu nhỏ hơn 6900 USD (giá trị tứ phân vị thứ ba).

hist(d$MI)

income <- cut(d$MI, breaks= c(0 , 4000 , 15000), labels= c('thap' , 'cao'))
table(income)

## income
## thap  cao 
##  144  253

table(income)/sum(table(income))

## income
##      thap       cao 
## 0.3627204 0.6372796

library(ggplot2)
d |> ggplot(aes(x = income, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  theme_classic() +
  labs(x = 'Monthly Income', y = 'Số người')

Trong tổng số 397 người khảo sát thì có 36% người có thu nhập 1 tháng trong khoảng (0,4000] và 42,8% người có thu nhập 1 tháng trong khoảng (4000,15000].

2.3.2 Ước lượng tỷ lệ

Ước lượng tỷ lệ người có thu nhập mỗi tháng trên 10000USD, đồng thời kiểm định xem tỷ lệ (%) người thu nhập mỗi tháng trên 10000USD có phải là 10% không?

ul <- d[d$MI > 10000,]
prop.test(length(ul$MI), length(d$MI), p = 0.1)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(ul$MI) out of length(d$MI), null probability 0.1
## X-squared = 22.257, df = 1, p-value = 2.385e-06
## alternative hypothesis: true p is not equal to 0.1
## 95 percent confidence interval:
##  0.01463550 0.05050911
## sample estimates:
##          p 
## 0.02770781

Ta có p_value < 0,05 nên ta bác bỏ \(H_0\). Vì vậy tỉ lệ người có thu nhập mỗi tháng trên 10000USD không bằng 10%. Khoảng ước lượng tỷ lệ người có thu nhập mỗi tháng trên 10000USD với độ tin cậy 95% là ( 0,01463550 ; 0,05050911).

2.4 Biến Credit Score

2.4.1 Thống kê mô tả

summary(d$CS)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   560.0   650.0   693.0   701.4   750.0   890.0

Điểm tín dụng nhỏ nhất là 560; lớn nhất là 890; thu nhập trung bình là 701,4; 25% dữ liệu nhỏ hơn 650 (giá trị tứ phân vị thứ nhất); 50% dữ liệu nhỏ hơn 693 (giá trị trung vị); 75% dữ liệu nhỏ hơn 750 (giá trị tứ phân vị thứ ba).

credit <- cut(d$CS, breaks= c(500 , 700 , 890), labels= c('low', 'high'))
table(credit)

## credit
##  low high 
##  212  185

table(credit)/sum(table(credit))

## credit
##      low     high 
## 0.534005 0.465995

library(ggplot2)
d |> ggplot(aes(x = credit, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  theme_classic() +
  labs(x = 'Credit Score', y = 'Số người')

Trong tổng số 397 người khảo sát thì có 53,4% người có điểm tín dụng trong khoảng (500,700] và 46,6% người có điểm tín dụng trong khoảng (700,890].

2.4.2 Ước lượng tỷ lệ

Ước lượng tỷ lệ người có điểm tín dụng trên 800, đồng thời kiểm định xem tỷ lệ (%) người có điểm tín dụng trên 800 có phải là 20% không?

ul <- d[d$CS > 800,]
prop.test(length(ul$CS), length(d$CS), p = 0.2)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(ul$CS) out of length(d$CS), null probability 0.2
## X-squared = 45.737, df = 1, p-value = 1.352e-11
## alternative hypothesis: true p is not equal to 0.2
## 95 percent confidence interval:
##  0.04198476 0.09276907
## sample estimates:
##          p 
## 0.06297229

Ta có p_value < 0,05 nên ta bác bỏ \(H_0\). Vì vậy tỉ lệ người có điểm tín dụng trên 800 không bằng 20%. Khoảng ước lượng tỷ lệ người có điểm tín dụng trên 800 với độ tin cậy 95% là (0,04198476 ; 0,09276907).

2.5 Biến Years of Employment

2.5.1 Thống kê mô tả

summary(d$YE)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   3.000   4.000   4.272   6.000  12.000

Kinh nghiệm làm việc nhỏ nhất là 1 năm; lớn nhất là 12 năm; kinh nghiệm làm việc trung bình là 4.272 năm ; 25% dữ liệu nhỏ hơn 3 năm (giá trị tứ phân vị thứ nhất); 50% dữ liệu nhỏ hơn 4 năm (giá trị trung vị); 75% dữ liệu nhỏ hơn 6 năm (giá trị tứ phân vị thứ ba).

years <- cut(d$YE, breaks= c(0 , 3 , 12), labels= c('it', 'nhieu'))
table(years)

## years
##    it nhieu 
##   149   248

table(years)/sum(table(years))

## years
##        it     nhieu 
## 0.3753149 0.6246851

library(ggplot2)
d |> ggplot(aes(x = years, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  theme_classic() +
  labs(x = 'Years of Employment', y = 'Số người')

Trong tổng số 397 người khảo sát thì có 38% người kinh nghiệm làm việc trong khoảng (0,3] và 62% người kinh nghiệm làm việc trong khoảng (3,12].

2.5.2 Ước lượng tỷ lệ

Ước lượng tỷ lệ người có kinh nghiệm làm việc trên 10 năm, đồng thời kiểm định xem tỷ lệ (%) người có kinh nghiệm làm việc trên 10 năm có phải là 20% không?

ul <- d[d$YE > 10,]
prop.test(length(ul$years), length(d$YE), p = 0.2)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(ul$years) out of length(d$YE), null probability 0.2
## X-squared = 98.004, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.2
## 95 percent confidence interval:
##  0.00000000 0.01194674
## sample estimates:
## p 
## 0

Ta có p_value < 0,05 nên ta bác bỏ \(H_0\). Vì vậy tỉ lệ người có kinh nghiệm làm việc trên 10 năm không bằng 20%. Khoảng ước lượng tỷ lệ người có kinh nghiệm làm việc trên 10 năm với độ tin cậy 95% là (0,00000000 ; 0,01194674).

2.6 Biến Finance Status

2.6.1 Thống kê mô tả

table(d$FS)/sum(table(d$FS))

## 
##    Stable  Unstable 
## 0.7758186 0.2241814

library(ggplot2)
d |> ggplot(aes(x = FS, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  theme_classic() +
  labs(x = 'Finance Status', y = 'Số người')

Trong tổng số 397 người khảo sát thì có 78% người tài chính ổn định và 22% người tài chính không ổn định.

2.6.2 Ước lượng tỷ lệ

Ước lượng tỷ lệ người có tình trạng tài chính ổn định, đồng thời kiểm định xem tỷ lệ (%) người có tình trạng tài chính ổn định có phải là 50% không?

ul <- d[d$FS == "Stable",]
prop.test(length(ul$FS), length(d$FS), p = 0.5)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(ul$FS) out of length(d$FS), null probability 0.5
## X-squared = 119.71, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.7309357 0.8152538
## sample estimates:
##         p 
## 0.7758186

Ta có p_value < 0,05 nên ta bác bỏ \(H_0\). Vì vậy tỉ lệ người có tình trạng tài chính ổn định không bằng 50%. Khoảng ước lượng tỷ lệ người có tình trạng tài chính ổn định với độ tin cậy 95% là (0,7309357 ; 0,8152538).

2.7 Biến Finance History

2.7.1 Thống kê mô tả

table(d$FH)/sum(table(d$FH))

## 
##               Late payments Missed payments in the past 
##                   0.1183879                   0.1083123 
##       No significant issues 
##                   0.7732997

library(ggplot2)
d |> ggplot(aes(x = FH, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  theme_classic() +
  labs(x = 'Finance History', y = 'Số người')

Trong tổng số 397 người khảo sát thì có 11,8% người thanh toán sau ngày đến hạn (Late payments); 10,8% người trong quá khứ bỏ lỡ một khoản thanh toán hóa đơn hoàn toàn (Missed payments in the past) và 77,3% người không có vấn đề về lịch sử tài chính (No significant issues).

2.7.2 Ước lượng tỷ lệ

Ước lượng tỷ lệ người có lịch sử tài chính không vấn đề, đồng thời kiểm định xem tỷ lệ (%) người có lịch sử tài chính không vấn đề có phải là 50% không?

ul <- d[d$FH == "No significant issues",]
prop.test(length(ul$FH), length(d$FS), p = 0.5)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(ul$FH) out of length(d$FS), null probability 0.5
## X-squared = 117.52, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.7282819 0.8129202
## sample estimates:
##         p 
## 0.7732997

Ta có p_value < 0,05 nên ta bác bỏ \(H_0\). Vì vậy tỉ lệ người có lịch sử tài chính không vấn đề không bằng 50%. Khoảng ước lượng tỷ lệ người có lịch sử tài chính không vấn đề với độ tin cậy 95% là (0,7282819 ; 0,8129202).

2.8 Numbers of Children

2.8.1 Thống kê mô tả

children <- factor(d$NC == 0, levels = c(FALSE, TRUE), labels = c("Dacocon", "Khongcon"))
table(children)

## children
##  Dacocon Khongcon 
##      244      153

table(children)/sum(table(children))

## children
##   Dacocon  Khongcon 
## 0.6146096 0.3853904

library(ggplot2)
d |> ggplot(aes(x = children, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  theme_classic() +
  labs(x = 'Numbers of Children', y = 'Số người')

Trong tổng số 397 người khảo sát thì có 61% người đã có con và 39% người chưa có con.

2.8.2 Ước lượng tỷ lệ

Ước lượng tỷ lệ người có số con trên 4, đồng thời kiểm định xem tỷ lệ (%) người có số con trên 4 có phải là 10% không?

ul <- d[d$NC > 4,]
prop.test(length(ul$NC), length(d$NC), p = 0.1)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(ul$NC) out of length(d$NC), null probability 0.1
## X-squared = 43.007, df = 1, p-value = 5.454e-11
## alternative hypothesis: true p is not equal to 0.1
## 95 percent confidence interval:
##  0.00000000 0.01194674
## sample estimates:
## p 
## 0

Ta có p_value < 0,05 nên ta bác bỏ \(H_0\). Vì vậy tỉ lệ người có số con trên 4 không bằng 10%. Khoảng ước lượng tỷ lệ người có số con trên 4 với độ tin cậy 95% là (0,00000000 ; 0,01194674).

3 BÀI VỀ NHÀ TUẦN 3,4: THỐNG KÊ CHO 2 BIẾN

k <- data.frame(d$Car, d$FS, d$FH, d$Occupation, years, income, credit, children)

3.1 Phân tích quyết định mua xe của khách hàng theo tình trạng tài chính

3.1.1 Bảng tần số

cpp <- table(d$Car, d$FS)
cpp <- prop.table(cpp)
addmargins(cpp)

##      
##           Stable   Unstable        Sum
##   No  0.13602015 0.21158690 0.34760705
##   Yes 0.63979849 0.01259446 0.65239295
##   Sum 0.77581864 0.22418136 1.00000000

d |> ggplot(aes(x = Car, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  facet_grid(. ~ FS) +
 # theme_classic() +
  labs(x = 'Quyền sở hữu ô tô', y = 'Số người')

Nhận xét: Trong tổng số 397 người khảo sát được

77,6% người thuộc nhóm tài chính ổn định, trong đó:

Người đã có xe chiếm 64%
Người chưa có xe chiếm 13,6%

22,4% người thuộc nhóm tài chính không ổn định, trong đó:

Người đã có xe chiếm 21,1%
Người chưa có xe chiếm 1,3%

3.1.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

library(DescTools)
cpp <- table(d$Car, d$FS)
addmargins(cpp)

##      
##       Stable Unstable Sum
##   No      54       84 138
##   Yes    254        5 259
##   Sum    308       89 397

RelRisk(cpp)

## [1] 0.3990072

Tỷ lệ người tài chính ổn định nhưng không có xe gần bằng 40% tỷ lệ người tài chính ổn định và có xe. Hay nói cách khác tỷ lệ người tài chính ổn định và có xe cao hơn gấp 2,5 lần (1/0,3990072) tỷ lệ người tài chính ổn định nhưng không có xe.

cpp <- table(d$Car, d$FS)
library(epitools)
riskratio(cpp, rev = 'c')

## $data
##        
##         Unstable Stable Total
##   No          84     54   138
##   Yes          5    254   259
##   Total       89    308   397
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate    lower    upper
##   No  1.000000       NA       NA
##   Yes 2.506221 2.033962 3.088132
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact   chi.square
##   No          NA           NA           NA
##   Yes          0 3.167693e-42 5.308648e-41
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ người tài chính ổn định và có xe cao hơn gấp 2,5 lần tỷ lệ người tài chính ổn định nhưng không có xe.

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

cpp <- table(d$Car, d$FS)
cpp

##      
##       Stable Unstable
##   No      54       84
##   Yes    254        5

OddsRatio(cpp)

## [1] 0.01265467

Tỷ lệ người tài chính ổn định so với người tài chính chưa ổn định mà không có xe gần bằng 1,3% tỷ lệ người tài chính ổn định so với người tài chính chưa ổn định mà đã có xe.

cpp <- table(d$Car, d$FS)
cpp

##      
##       Stable Unstable
##   No      54       84
##   Yes    254        5

oddsratio(cpp, rev = 'r')

## $data
##        
##         Stable Unstable Total
##   Yes      254        5   259
##   No        54       84   138
##   Total    308       89   397
## 
## $measure
##      odds ratio with 95% C.I.
##       estimate    lower    upper
##   Yes  1.00000       NA       NA
##   No  75.71606 32.09469 226.2817
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact   chi.square
##   Yes         NA           NA           NA
##   No           0 3.167693e-42 5.308648e-41
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ người tài chính ổn định so với người tài chính chưa ổn định mà đã có xe cao hơn gấp 75 lần tỷ lệ người tài chính ổn định so với người tài chính chưa ổn định mà không có xe.

3.1.4 Kiểm tra tính độc lập

Giả thuyết \(H_0\): X, Y độc lập

cpp <- table(d$Car, d$FS)
cpp

##      
##       Stable Unstable
##   No      54       84
##   Yes    254        5

chisq.test(cpp)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cpp
## X-squared = 176.45, df = 1, p-value < 2.2e-16

Kết quả kiểm định cho thấy p- value < 0,05 nên ta bác bỏ \(H_0\). Vậy quyền sở hữu xe và tình trạng tài chính có liên quan với nhau .

3.2 Phân tích quyết định mua xe của khách hàng theo kinh nghiệm làm việc

3.2.1 Bảng tần số

cpp <- table(d$Car, k$years)
cpp <- prop.table(cpp)
addmargins(cpp)

##      
##               it      nhieu        Sum
##   No  0.30478589 0.04282116 0.34760705
##   Yes 0.07052897 0.58186398 0.65239295
##   Sum 0.37531486 0.62468514 1.00000000

k |> ggplot(aes(x = d.Car, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  facet_grid(. ~ years) +
 # theme_classic() +
  labs(x = 'Quyền sở hữu ô tô', y = 'Số người')

Nhận xét: Trong tổng số 397 người khảo sát được

37,5% người thuộc nhóm ít (có kinh nghiệm làm việc từ 3 năm trở xuống) trong đó:

Người đã có xe chiếm 7,1%
Người chưa có xe chiếm 30,5%

42,5% người thuộc nhóm nhiều (có kinh nghiệm làm việc từ 3 năm trở lên), trong đó:

Người đã có xe chiếm 58,2%
Người chưa có xe chiếm 4,3%

3.2.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

library(DescTools)
cpp <- table(d$Car, k$years)
addmargins(cpp)

##      
##        it nhieu Sum
##   No  121    17 138
##   Yes  28   231 259
##   Sum 149   248 397

RelRisk(cpp)

## [1] 8.110507

Tỷ lệ người không có xe có kinh nghiệm làm việc từ 3 năm trở xuống hơn gấp 8,1 lần tỷ lệ người có xe có kinh nghiệm làm việc từ 3 năm trở xuống.

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

cpp <- table(d$Car, k$years)
cpp

##      
##        it nhieu
##   No  121    17
##   Yes  28   231

OddsRatio(cpp)

## [1] 58.72059

Tỷ lệ người có kinh nghiệm làm việc từ 3 năm trở xuống so với người có kinh nghiệm làm việc từ 3 năm trở lên mà chưa có xe cao hơn gấp 58 lần tỷ lệ người có kinh nghiệm làm việc từ 3 năm trở xuống so với người có kinh nghiệm làm việc từ 3 năm trở lên mà đã có xe.

3.2.4 Kiểm tra tính độc lập

Giả thuyết \(H_0\): X, Y độc lập

cpp <- table(d$Car, k$years)
cpp

##      
##        it nhieu
##   No  121    17
##   Yes  28   231

chisq.test(cpp)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cpp
## X-squared = 223.64, df = 1, p-value < 2.2e-16

Kết quả kiểm định cho thấy p- value < 0,05 nên ta bác bỏ \(H_0\). Vậy quyền sở hữu xe và kinh nghiệm làm việc có liên quan với nhau .

3.3 Phân tích quyết định mua xe của khách hàng theo điểm tín dụng

3.3.1 Bảng tần số

cpp <- table(d$Car, k$credit)
cpp <- prop.table(cpp)
addmargins(cpp)

##      
##              low       high        Sum
##   No  0.33501259 0.01259446 0.34760705
##   Yes 0.19899244 0.45340050 0.65239295
##   Sum 0.53400504 0.46599496 1.00000000

k |> ggplot(aes(x = d.Car, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  facet_grid(. ~ credit) +
 # theme_classic() +
  labs(x = 'Quyền sở hữu ô tô', y = 'Số người')

Nhận xét: Trong tổng số 397 người khảo sát được

54% người thuộc nhóm low (điểm tín dụng 700 trở xuống) trong đó:

Người đã có xe chiếm 34%
Người chưa có xe chiếm 20%

46% người thuộc nhóm high (điểm tín dụng 700 trở lên), trong đó:

Người đã có xe chiếm 1%
Người chưa có xe chiếm 45%

3.3.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

library(DescTools)
cpp <- table(d$Car, k$credit)
addmargins(cpp)

##      
##       low high Sum
##   No  133    5 138
##   Yes  79  180 259
##   Sum 212  185 397

RelRisk(cpp)

## [1] 3.159695

Tỷ lệ người không có xe có điểm tín dụng 700 trở xuống hơn gấp 3,2 lần tỷ lệ người có xe có điểm tín dụng 700 trở lên.

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

cpp <- table(d$Car, k$credit)
cpp

##      
##       low high
##   No  133    5
##   Yes  79  180

OddsRatio(cpp)

## [1] 60.60759

Tỷ lệ người có điểm tín dụng 700 trở xuống so với người có điểm tín dụng 700 trở lên mà chưa có xe cao hơn gấp 60 lần tỷ lệ người có điểm tín dụng 700 trở xuống so với người có điểm tín dụng 700 trở lên mà đã có xe.

3.3.4 Kiểm tra tính độc lập

Giả thuyết \(H_0\): X, Y độc lập

cpp <- table(d$Car, k$credit)
cpp

##      
##       low high
##   No  133    5
##   Yes  79  180

chisq.test(cpp)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cpp
## X-squared = 154.36, df = 1, p-value < 2.2e-16

Kết quả kiểm định cho thấy p- value < 0,05 nên ta bác bỏ \(H_0\). Vậy quyền sở hữu xe và điểm tín dụng có liên quan với nhau .

3.4 Phân tích quyết định mua xe của khách hàng theo số con

3.4.1 Bảng tần số

cpp <- table(d$Car, k$children)
cpp <- prop.table(cpp)
addmargins(cpp)

##      
##         Dacocon  Khongcon       Sum
##   No  0.1813602 0.1662469 0.3476071
##   Yes 0.4332494 0.2191436 0.6523929
##   Sum 0.6146096 0.3853904 1.0000000

k |> ggplot(aes(x = d.Car, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  facet_grid(. ~ children) +
 # theme_classic() +
  labs(x = 'Quyền sở hữu ô tô', y = 'Số người')

Nhận xét: Trong tổng số 397 người khảo sát được

61,5% người thuộc nhóm đã có con trong đó:

Người đã có xe chiếm 43,3%
Người chưa có xe chiếm 18,1%

38,5% người thuộc nhóm không con, trong đó:

Người đã có xe chiếm 21,9%
Người chưa có xe chiếm 16,6%

3.4.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

cpp <- table(d$Car, k$children)
library(epitools)
riskratio(cpp, rev = 'c')

## $data
##        
##         Khongcon Dacocon Total
##   No          66      72   138
##   Yes         87     172   259
##   Total      153     244   397
## 
## $measure
##      risk ratio with 95% C.I.
##       estimate    lower    upper
##   No  1.000000       NA       NA
##   Yes 1.272844 1.061351 1.526482
## 
## $p.value
##      two-sided
##        midp.exact fisher.exact  chi.square
##   No           NA           NA          NA
##   Yes 0.005977916  0.006741118 0.005514824
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ người đã có con mà sở hữu xe cao hơn gấp 1,27 lần tỷ lệ người đã có con nhưng không có xe.

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

cpp <- table(d$Car, k$children)
cpp

##      
##       Dacocon Khongcon
##   No       72       66
##   Yes     172       87

oddsratio(cpp, rev = 'r')

## $data
##        
##         Dacocon Khongcon Total
##   Yes       172       87   259
##   No         72       66   138
##   Total     244      153   397
## 
## $measure
##      odds ratio with 95% C.I.
##       estimate    lower    upper
##   Yes 1.000000       NA       NA
##   No  1.809072 1.185659 2.764979
## 
## $p.value
##      two-sided
##        midp.exact fisher.exact  chi.square
##   Yes          NA           NA          NA
##   No  0.005977916  0.006741118 0.005514824
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ người đã có con so với người không con mà đã có xe cao hơn gấp 1,8 lần tỷ lệ người đã có con so với người không con mà chưa có xe.

3.4.4 Kiểm tra tính độc lập

Giả thuyết \(H_0\): X, Y độc lập

cpp <- table(d$Car, k$children)
cpp

##      
##       Dacocon Khongcon
##   No       72       66
##   Yes     172       87

chisq.test(cpp)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cpp
## X-squared = 7.1131, df = 1, p-value = 0.007652

Kết quả kiểm định cho thấy p- value < 0,05 nên ta bác bỏ \(H_0\). Vậy quyền sở hữu xe và số con có liên quan với nhau .

3.5 Phân tích thu nhập hàng tháng theo tình trạng tài chính

3.5.1 Bảng tần số

cpp <- table(k$income, d$FS)
cpp <- prop.table(cpp)
addmargins(cpp)

##       
##             Stable    Unstable         Sum
##   thap 0.146095718 0.216624685 0.362720403
##   cao  0.629722922 0.007556675 0.637279597
##   Sum  0.775818640 0.224181360 1.000000000

k |> ggplot(aes(x = income, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  facet_grid(. ~ d.FS) +
 # theme_classic() +
  labs(x = 'Thu nhập mỗi tháng', y = 'Số người')

Nhận xét: Trong tổng số 397 người khảo sát được

77,6% người thuộc nhóm tài chính ổn định, trong đó:

Người thu nhập thấp chiếm 14,6%
Người thu nhập cao chiếm 63%

22,4% người thuộc nhóm tài chính không ổn định, trong đó:

Người thu nhập thấp chiếm 21,7%
Người thu nhập cao chiếm 0,8%

3.5.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

cpp <- table(k$income, d$FS)
library(epitools)
riskratio(cpp, rev = 'c')

## $data
##        
##         Unstable Stable Total
##   thap        86     58   144
##   cao          3    250   253
##   Total       89    308   397
## 
## $measure
##       risk ratio with 95% C.I.
##        estimate    lower    upper
##   thap 1.000000       NA       NA
##   cao  2.453319 2.009929 2.994521
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact   chi.square
##   thap         NA           NA           NA
##   cao           0 9.703964e-44 3.250256e-41
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ người tài chính ổn định và thu nhập cao hơn gấp 2,4 lần tỷ lệ người tài chính ổn định nhưng thu nhập thấp.

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

cpp <- table(d$Car, d$FS)
cpp

##      
##       Stable Unstable
##   No      54       84
##   Yes    254        5

OddsRatio(cpp)

## [1] 0.01265467

cpp <- table(k$income, d$FS)
cpp

##       
##        Stable Unstable
##   thap     58       86
##   cao     250        3

oddsratio(cpp, rev = 'r')

## $data
##        
##         Stable Unstable Total
##   cao      250        3   253
##   thap      58       86   144
##   Total    308       89   397
## 
## $measure
##       odds ratio with 95% C.I.
##        estimate    lower    upper
##   cao    1.0000       NA       NA
##   thap 116.0891 41.50903 495.5882
## 
## $p.value
##       two-sided
##        midp.exact fisher.exact   chi.square
##   cao          NA           NA           NA
##   thap          0 9.703964e-44 3.250256e-41
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ người tài chính ổn định so với người tài chính chưa ổn định mà có thu nhập cao hơn gấp 116 lần tỷ lệ người tài chính ổn định so với người tài chính chưa ổn định mà yhu nhập thấp.

3.5.4 Kiểm tra tính độc lập

Giả thuyết \(H_0\): X, Y độc lập

cpp <- table(k$income, d$FS)
cpp

##       
##        Stable Unstable
##   thap     58       86
##   cao     250        3

chisq.test(cpp)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cpp
## X-squared = 177.44, df = 1, p-value < 2.2e-16

Kết quả kiểm định cho thấy p- value < 0,05 nên ta bác bỏ \(H_0\). Vậy thu nhập mỗi tháng và tình trạng tài chính có liên quan với nhau .

3.6 Phân tích thu nhập hàng tháng theo kinh nghiệm làm việc

3.6.1 Bảng tần số

cpp <- table(k$income, k$years)
cpp <- prop.table(cpp)
addmargins(cpp)

##       
##                it      nhieu        Sum
##   thap 0.31989924 0.04282116 0.36272040
##   cao  0.05541562 0.58186398 0.63727960
##   Sum  0.37531486 0.62468514 1.00000000

k |> ggplot(aes(x = income, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  facet_grid(. ~ years) +
 # theme_classic() +
  labs(x = 'Thu nhập mỗi tháng', y = 'Số người')

Nhận xét: Trong tổng số 397 người khảo sát được

37,5% người thuộc nhóm ít (có kinh nghiệm làm việc từ 3 năm trở xuống) trong đó:

Người thu nhập thấp chiếm 32%
Người thu nhập cao chiếm 5,5%

42,5% người thuộc nhóm nhiều (có kinh nghiệm làm việc từ 3 năm trở lên), trong đó:

Người thu nhập thấp chiếm 4,3%
Người thu nhập cao chiếm 58,2%

3.6.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

library(DescTools)
cpp <- table(k$income, k$years)
addmargins(cpp)

##       
##         it nhieu Sum
##   thap 127    17 144
##   cao   22   231 253
##   Sum  149   248 397

RelRisk(cpp)

## [1] 10.14236

Tỷ lệ người thu nhập thấp, có kinh nghiệm làm việc từ 3 năm trở xuống hơn gấp 10,1 lần tỷ lệ người thu nhập cao, có kinh nghiệm làm việc từ 3 năm trở lên.

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

cpp <- table(k$income, k$years)
cpp

##       
##         it nhieu
##   thap 127    17
##   cao   22   231

OddsRatio(cpp)

## [1] 78.44118

Tỷ lệ người có kinh nghiệm làm việc từ 3 năm trở xuống so với người có kinh nghiệm làm việc từ 3 năm trở lên mà thu nhập thấp hơn gấp 74 lần tỷ lệ người có kinh nghiệm làm việc từ 3 năm trở xuống so với người có kinh nghiệm làm việc từ 3 năm trở lên mà thu nhập cao.

3.6.3 Kiểm tra tính độc lập

Giả thuyết \(H_0\): X, Y độc lập

cpp <- table(k$income, k$years)
cpp

##       
##         it nhieu
##   thap 127    17
##   cao   22   231

chisq.test(cpp)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cpp
## X-squared = 244, df = 1, p-value < 2.2e-16

Kết quả kiểm định cho thấy p- value < 0,05 nên ta bác bỏ \(H_0\). Vậy thu nhập mỗi tháng và kinh nghiệm làm việc có liên quan với nhau .

3.7 Phân tích thu nhập hàng tháng theo điểm tín dụng

3.7.1 Bảng tần số

cpp <- table(k$income, k$credit)
cpp <- prop.table(cpp)
addmargins(cpp)

##       
##                low        high         Sum
##   thap 0.357682620 0.005037783 0.362720403
##   cao  0.176322418 0.460957179 0.637279597
##   Sum  0.534005038 0.465994962 1.000000000

k |> ggplot(aes(x = income, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  facet_grid(. ~ credit) +
 # theme_classic() +
  labs(x = 'Thu nhập mỗi tháng', y = 'Số người')

Nhận xét: Trong tổng số 397 người khảo sát được

53% người thuộc nhóm low (điểm tín dụng 700 trở xuống) trong đó:

Người thu nhập thấp chiếm 36%
Người thu nhập cao chiếm 18%

47% người thuộc nhóm high (điểm tín dụng 700 trở lên), trong đó:

Người thu nhập thấp chiếm 1%
Người thu nhập cao chiếm 46%

3.7.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

library(DescTools)
cpp <- table(k$income, k$credit)
addmargins(cpp)

##       
##        low high Sum
##   thap 142    2 144
##   cao   70  183 253
##   Sum  212  185 397

RelRisk(cpp)

## [1] 3.564087

Tỷ lệ người thu nhập thấp có điểm tín dụng 700 trở xuống hơn gấp 3,6 lần tỷ lệ người thu nhập cao có điểm tín dụng 700 trở lên.

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

cpp <- table(k$income, k$credit)
cpp

##       
##        low high
##   thap 142    2
##   cao   70  183

OddsRatio(cpp)

## [1] 185.6143

Tỷ lệ người có điểm tín dụng 700 trở xuống so với người có điểm tín dụng 700 trở lên mà thu nhập thấp hơn gấp 186 lần tỷ lệ người có điểm tín dụng 700 trở xuống so với người có điểm tín dụng 700 trở lên mà thu nhập cao.

3.7.4 Kiểm tra tính độc lập

Giả thuyết \(H_0\): X, Y độc lập

cpp <- table(k$income, k$credit)
cpp

##       
##        low high
##   thap 142    2
##   cao   70  183

chisq.test(cpp)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cpp
## X-squared = 182.76, df = 1, p-value < 2.2e-16

Kết quả kiểm định cho thấy p- value < 0,05 nên ta bác bỏ \(H_0\). Vậy thu nhập mỗi tháng và điểm tín dụng có liên quan với nhau .

3.8 Phân tích thu nhập hàng tháng theo số con

3.8.1 Bảng tần số

cpp <- table(k$income, k$children)
cpp <- prop.table(cpp)
addmargins(cpp)

##       
##          Dacocon  Khongcon       Sum
##   thap 0.1763224 0.1863980 0.3627204
##   cao  0.4382872 0.1989924 0.6372796
##   Sum  0.6146096 0.3853904 1.0000000

k |> ggplot(aes(x = income, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  facet_grid(. ~ children) +
 # theme_classic() +
  labs(x = 'Thu nhập mỗi tháng', y = 'Số người')

Nhận xét: Trong tổng số 397 người khảo sát được

61,5% người thuộc nhóm đã có con trong đó:

Người thu nhập thấp chiếm 17,6%
Người thu nhập cao chiếm 43,8%

38,5% người thuộc nhóm không con, trong đó:

Người thu nhập thấp chiếm 18,6%
Người thu nhập cao chiếm 19,9%

3.8.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

cpp <- table(k$income, k$children)
library(epitools)
riskratio(cpp, rev = 'c')

## $data
##        
##         Khongcon Dacocon Total
##   thap        74      70   144
##   cao         79     174   253
##   Total      153     244   397
## 
## $measure
##       risk ratio with 95% C.I.
##        estimate    lower    upper
##   thap 1.000000       NA       NA
##   cao  1.414794 1.173097 1.706288
## 
## $p.value
##       two-sided
##          midp.exact fisher.exact  chi.square
##   thap           NA           NA          NA
##   cao  8.416319e-05 0.0001055465 7.22221e-05
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Tỷ lệ người đã có con mà thu nhập cao hơn gấp 1,4 lần tỷ lệ người đã có con nhưng thu nhập thấp.

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

cpp <- table(k$income, k$children)
cpp

##       
##        Dacocon Khongcon
##   thap      70       74
##   cao      174       79

oddsratio(cpp, rev = 'r')

## $data
##        
##         Dacocon Khongcon Total
##   cao       174       79   253
##   thap       70       74   144
##   Total     244      153   397
## 
## $measure
##       odds ratio with 95% C.I.
##        estimate    lower    upper
##   cao  1.000000       NA       NA
##   thap 2.321982 1.524744 3.550759
## 
## $p.value
##       two-sided
##          midp.exact fisher.exact  chi.square
##   cao            NA           NA          NA
##   thap 8.416319e-05 0.0001055465 7.22221e-05
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tỷ lệ người đã có con so với người không con mà thu nhập cao hơn gấp 2,3 lần tỷ lệ người đã có con so với người không con mà thu nhập thấp.

3.8.4 Kiểm tra tính độc lập

Giả thuyết \(H_0\): X, Y độc lập

cpp <- table(k$income, k$children)
cpp

##       
##        Dacocon Khongcon
##   thap      70       74
##   cao      174       79

chisq.test(cpp)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cpp
## X-squared = 14.912, df = 1, p-value = 0.0001126

Kết quả kiểm định cho thấy p- value < 0,05 nên ta bác bỏ \(H_0\). Vậy thu nhập mỗi tháng và số con có liên quan với nhau .

3.9 Phân tích quyết định mua xe của khách hàng theo thu nhập hàng tháng

3.9.1 Bảng tần số

cpp <- table(d$Car, k$income)
cpp <- prop.table(cpp)
addmargins(cpp)

##      
##             thap        cao        Sum
##   No  0.30226700 0.04534005 0.34760705
##   Yes 0.06045340 0.59193955 0.65239295
##   Sum 0.36272040 0.63727960 1.00000000

k |> ggplot(aes(x = d.Car, y = after_stat(count))) +
  geom_bar(fill = 'pink') +
  geom_text(aes(label = scales::percent(after_stat(count/sum(count)))), stat = 'count', color = 'black', vjust = - .5) +
  facet_grid(. ~ income) +
 # theme_classic() +
  labs(x = 'Quyền sở hữu ô tô', y = 'Số người')

Nhận xét: Trong tổng số 397 người khảo sát được

36,2% người thuộc nhóm thu nhập thấp, trong đó:

Người đã có xe chiếm 6%
Người chưa có xe chiếm 30,2%

63,8% người thuộc nhóm thu nhập cao, trong đó:

Người đã có xe chiếm 59,2%
Người chưa có xe chiếm 4,5%

3.9.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

library(DescTools)
cpp <- table(d$Car, k$income)
addmargins(cpp)

##      
##       thap cao Sum
##   No   120  18 138
##   Yes   24 235 259
##   Sum  144 253 397

RelRisk(cpp)

## [1] 9.384058

Tỷ lệ người không có xe mà thu nhập thấp hơn gấp 9,4 lần tỷ lệ người có xe mà thu nhập cao.

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

cpp <- table(d$Car, k$income)
cpp

##      
##       thap cao
##   No   120  18
##   Yes   24 235

OddsRatio(cpp)

## [1] 65.27778

Tỷ lệ người thu nhập thấp so với người thu nhập cao mà không có xe hơn gấp 65 lần tỷ lệ người thu nhập thấp so với người thu nhập cao mà đã có xe.

3.9.4 Kiểm tra tính độc lập

Giả thuyết \(H_0\): X, Y độc lập

cpp <- table(k$income, d$Car)
cpp

##       
##         No Yes
##   thap 120  24
##   cao   18 235

chisq.test(cpp)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  cpp
## X-squared = 231.73, df = 1, p-value < 2.2e-16

Kết quả kiểm định cho thấy p- value < 0,05 nên ta bác bỏ \(H_0\). Vậy quyền sở hữu ô tô và thu nhập mỗi tháng là có liên quan với nhau.

4 BÀI VỀ NHÀ TUẦN 2

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 Biến phụ thuộc là biến định tính

Xem biến Quyền sở hữu xe (Car) là biến phụ thuộc nhằm mục đích đo lường các yếu tố ảnh hưởng đến quyết định có mua ô tô hay không thông qua các yếu tố như thông tin về nghề nghiệp (Occupation), tình trạng tài chính (Finance Status), lịch sử tài chính (Finance History), thu nhập hàng tháng (Monthly Income), điểm tín dụng (Credit Score), số năm làm việc (Years of Employment), số con (Number of Children). Từ đó, xác định được đối tượng khách hàng phù hợp, triển khai những chính sách khuyến mãi, bán hàng kịp thời.

4.2 Biến phụ thuộc là biến định lượng

Xem thu nhập hàng tháng (Monthly Income) là biến phụ thuộc nhằm mục đích xem xét mối quan hệ giữa thu nhập trung bình hàng tháng với các biến độc lập như quyền sở hữu xe (Car), tình trạng tài chính (Finance Status), thu nhập hàng tháng (Monthly Income), điểm tín dụng (Credit Score), số năm làm việc (Years of Employment), số con (Number of Children).

Giả sử thu nhập hàng tháng (Y) là biến phụ thuộc, biến độc lập định lượng số năm làm việc (X).

Biến độc lập định tính quyền sở hữu xe (D) có 2 phạm trù Yes và No.

Đặt D = 1 nếu là Yes, D = 0 nếu là No.

Mô hình: \(Y = \beta_1 + \beta_2D + \beta_3X + u\)

Nếu là Yes (D = 1) - > \(Y = (\beta_1 + \beta_2) + \beta_3X + u\)
Nếu là No (D = 0) - > \(Y = \beta_1 + \beta_3X + u\)

Ý nghĩa

Giá trị trung bình của Y là \(\beta_1\) (đơn vị) khi \(X = 0\) và biến định tính là No.
X không đổi, giá trị trung bình của Y khi biến định tính là Yes cao hơn giá trị trung bình của Y khi biến định tính là No \(\beta_2\) (đơn vị).
Khi X tăng 1 đơn vị thì giá trị trung bình của Y tăng \(\beta_3\) (đơn vị) trong cả 2 trường hợp biến định tính là Yes hoặc No.

5 BÀI VỀ NHÀ TUẦN 1

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 quan sát.

5.1 Dữ liệu đầu vào

Bộ dữ liệu 397 quan sát có 8 biến bao gồm 4 biến định tính (thông tin về nghề nghiệp, tình trạng tài chính, lịch sử tài chính và quyền sở hữu xe hơi) và 4 biến định lượng (thu nhập hàng tháng, điểm tín dụng, số năm làm việc, số con). Thông tin nguồn dữ liệu được lấy từ kaggle nguồn: https://www.kaggle.com/datasets/rkiattisak/car-ownership-predictionbeginner-intermediate

Occupation: thông tin về nghề nghiệp.
MI (Monthly Income): thông tin về số tiền mỗi cá nhân kiếm được trong một tháng.
CS (Credit Score): thông tin về điểm tín dụng của mỗi cá nhân, biểu thị bằng số về mức độ đáng tin cậy của họ.
YE (Years of Employment): thông tin về khoảng thời gian mỗi cá nhân đã được tuyển dụng tại công việc hiện tại của họ.
FS (Finance Status): thông tin về tình trạng tài chính của mỗi cá nhân (Stable: ổn định / Unstable: không ổn định).
FH (Finance History): thông tin về lịch sử tài chính của mỗi cá nhân, bao gồm hành vi trong quá khứ của họ với việc thanh toán hóa đơn, vay tiền và quản lý tín dụng (No significant issues: Không vấn đề / Missed payments in the past: trong quá khứ bỏ lỡ một khoản thanh toán hóa đơn hoàn toàn / Late payments: thanh toán sau ngày đến hạn).
NC (Number of Children): Số con của mỗi cá nhân.
Car: cho biết mỗi cá nhân có sở hữu ô tô hay không (Yes/No).

setwd("D:/HỌC TẬP/Phân tích dữ liệu định tính")
library(xlsx)
library(readxl)
library(data.table)
d <- read.xlsx("Car Ownership.xlsx",1)
data.table(d)

##                Occupation   MI  CS YE       FS                          FH Car
##   1:                Nurse 4500 720  3   Stable       No significant issues Yes
##   2:   Software Developer 7800 800  5   Stable       No significant issues Yes
##   3:                 Chef 3200 650  2 Unstable Missed payments in the past  No
##   4:           Accountant 6500 750  7   Stable       No significant issues Yes
##   5:          Salesperson 3000 600  1 Unstable Missed payments in the past  No
##  ---                                                                          
## 393:      Project Manager 7000 730  5   Stable       No significant issues Yes
## 394:                 Chef 4500 680  4   Stable       No significant issues Yes
## 395:    Interior Designer 5500 690  4   Stable       No significant issues Yes
## 396:    Medical Assistant 3500 640  3   Stable       No significant issues  No
## 397: Customer Service Rep 3200 641  4   Stable       No significant issues  No
##      NC
##   1:  0
##   2:  0
##   3:  0
##   4:  1
##   5:  0
##  ---   
## 393:  0
## 394:  0
## 395:  1
## 396:  1
## 397:  2

BTVN

Cao Phạm Hằng

2023-06-13

1 BÀI VỀ NHÀ TUẦN 5

1.1 Dữ liệu đầu vào

1.2 Mô hình 1

1.2.1 Chọn mô hình phù hợp

1.2.1.1 AIC - Akaike Information Criterion

1.2.1.2 Deviance

1.2.1.3 Brier Score

1.2.1.4 Ma trận nhầm lẫn

1.3 Mô hình 2

1.3.1 Chọn mô hình phù hợp

1.3.1.1 AIC - Akaike Information Criterion

1.3.1.2 Deviance

1.3.1.3 Brier Score

1.3.1.4 Ma trận nhầm lẫn

2 BÀI VỀ NHÀ TUẦN 3,4: THỐNG KÊ CHO 1 BIẾN

2.1 Biến Car

2.1.1 Thống kê mô tả

2.1.2 Ước lượng tỷ lệ

2.2 Biến Occupation

2.2.1 Thống kê mô tả

2.2.2 Ước lượng tỷ lệ

2.3 Biến Monthly Income

2.3.1 Thống kê mô tả

2.3.2 Ước lượng tỷ lệ

2.4 Biến Credit Score

2.4.1 Thống kê mô tả

2.4.2 Ước lượng tỷ lệ

2.5 Biến Years of Employment

2.5.1 Thống kê mô tả

2.5.2 Ước lượng tỷ lệ

2.6 Biến Finance Status

2.6.1 Thống kê mô tả

2.6.2 Ước lượng tỷ lệ

2.7 Biến Finance History

2.7.1 Thống kê mô tả

2.7.2 Ước lượng tỷ lệ

2.8 Numbers of Children

2.8.1 Thống kê mô tả

2.8.2 Ước lượng tỷ lệ

3 BÀI VỀ NHÀ TUẦN 3,4: THỐNG KÊ CHO 2 BIẾN

3.1 Phân tích quyết định mua xe của khách hàng theo tình trạng tài chính

3.1.1 Bảng tần số

3.1.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

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

3.1.4 Kiểm tra tính độc lập

3.2 Phân tích quyết định mua xe của khách hàng theo kinh nghiệm làm việc

3.2.1 Bảng tần số

3.2.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

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

3.2.4 Kiểm tra tính độc lập

3.3 Phân tích quyết định mua xe của khách hàng theo điểm tín dụng

3.3.1 Bảng tần số

3.3.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

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

3.3.4 Kiểm tra tính độc lập

3.4 Phân tích quyết định mua xe của khách hàng theo số con

3.4.1 Bảng tần số

3.4.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

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

3.4.4 Kiểm tra tính độc lập

3.5 Phân tích thu nhập hàng tháng theo tình trạng tài chính

3.5.1 Bảng tần số

3.5.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

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

3.5.4 Kiểm tra tính độc lập

3.6 Phân tích thu nhập hàng tháng theo kinh nghiệm làm việc

3.6.1 Bảng tần số

3.6.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

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

3.6.3 Kiểm tra tính độc lập

3.7 Phân tích thu nhập hàng tháng theo điểm tín dụng

3.7.1 Bảng tần số

3.7.2 Rủi ro tương đối (Relative Risk/Risk Ratio)

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

3.7.4 Kiểm tra tính độc lập

3.8 Phân tích thu nhập hàng tháng theo số con

3.8.1 Bảng tần số