PTDLDT

library("DescTools") 
library("epitools")
library("ggplot2")
library("caret")

## Loading required package: lattice

## 
## Attaching package: 'caret'

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

QT <- read.csv("D:/PTDLĐT/Quatrinh.csv")
str(QT)

## 'data.frame':    954 obs. of  7 variables:
##  $ Age  : int  34 34 37 30 30 27 34 34 30 36 ...
##  $ FF   : chr  "No" "Yes" "No" "No" ...
##  $ AIC  : chr  "Middle Income" "Low Income" "Middle Income" "Middle Income" ...
##  $ SO   : int  6 5 3 2 1 1 4 2 3 1 ...
##  $ ASTSM: chr  "No" "Yes" "Yes" "No" ...
##  $ BH   : chr  "Yes" "No" "No" "No" ...
##  $ TG   : chr  "No" "Yes" "No" "No" ...

1 Nhiệm vụ 5: Ước lượng mô hình hồi quy

1.1 Mô hình cloglog

MH1 <- glm(factor (TG) ~ QT$FF + QT$AIC + QT$ASTSM + QT$BH + QT$Age + QT$SO, family = binomial(link = "cloglog"), data= QT)
summary(MH1)

## 
## Call:
## glm(formula = factor(TG) ~ QT$FF + QT$AIC + QT$ASTSM + QT$BH + 
##     QT$Age + QT$SO, family = binomial(link = "cloglog"), data = QT)
## 
## Coefficients:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          1.04701    0.71389   1.467 0.142473    
## QT$FFNo Record       0.08047    0.37829   0.213 0.831553    
## QT$FFYes             1.35304    0.20740   6.524 6.86e-11 ***
## QT$AICLow Income    -0.22446    0.18647  -1.204 0.228690    
## QT$AICMiddle Income -1.24948    0.30223  -4.134 3.56e-05 ***
## QT$ASTSMYes          0.53956    0.15292   3.528 0.000418 ***
## QT$BHYes            -0.57075    0.17377  -3.285 0.001021 ** 
## QT$Age              -0.09822    0.02241  -4.383 1.17e-05 ***
## QT$SO                0.23231    0.04305   5.396 6.82e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1039.88  on 953  degrees of freedom
## Residual deviance:  772.02  on 945  degrees of freedom
## AIC: 790.02
## 
## Number of Fisher Scoring iterations: 9

AIC = 790.02

Deviance = 772.02

BrierScore(MH1)

## [1] 0.1281922

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.

# Ma trận nhầm lẫn
a <- predict(MH1, type = "response")
b <- ifelse(a > 0.5, "1", "0")
c <-factor(b, levels = c("0","1"))
d <- factor(QT$TG, labels = c("0","1"))
confusionMatrix(table(c, d))

## Confusion Matrix and Statistics
## 
##    d
## c     0   1
##   0 686 127
##   1  44  97
##                                           
##                Accuracy : 0.8208          
##                  95% CI : (0.7949, 0.8446)
##     No Information Rate : 0.7652          
##     P-Value [Acc > NIR] : 1.844e-05       
##                                           
##                   Kappa : 0.4277          
##                                           
##  Mcnemar's Test P-Value : 3.594e-10       
##                                           
##             Sensitivity : 0.9397          
##             Specificity : 0.4330          
##          Pos Pred Value : 0.8438          
##          Neg Pred Value : 0.6879          
##              Prevalence : 0.7652          
##          Detection Rate : 0.7191          
##    Detection Prevalence : 0.8522          
##       Balanced Accuracy : 0.6864          
##                                           
##        'Positive' Class : 0               
## 

1.2 Mô hình probit

MH2 <- glm(factor (TG) ~ QT$FF + QT$AIC + QT$ASTSM + QT$BH + QT$Age + QT$SO, family = binomial(link = "probit"), data = QT)
summary(MH2)

## 
## Call:
## glm(formula = factor(TG) ~ QT$FF + QT$AIC + QT$ASTSM + QT$BH + 
##     QT$Age + QT$SO, family = binomial(link = "probit"), data = QT)
## 
## Coefficients:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          1.21797    0.52888   2.303 0.021282 *  
## QT$FFNo Record       0.07389    0.22820   0.324 0.746092    
## QT$FFYes             0.99767    0.15886   6.280 3.38e-10 ***
## QT$AICLow Income    -0.30761    0.16111  -1.909 0.056222 .  
## QT$AICMiddle Income -0.89139    0.21453  -4.155 3.25e-05 ***
## QT$ASTSMYes          0.41732    0.11201   3.726 0.000195 ***
## QT$BHYes            -0.49600    0.11989  -4.137 3.52e-05 ***
## QT$Age              -0.07628    0.01644  -4.639 3.51e-06 ***
## QT$SO                0.20798    0.03457   6.016 1.79e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1039.88  on 953  degrees of freedom
## Residual deviance:  762.53  on 945  degrees of freedom
## AIC: 780.53
## 
## Number of Fisher Scoring iterations: 6

AIC = 780.53

Deviance = 762.53

BrierScore(MH2)

## [1] 0.1276788

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.

# Ma trận nhầm lẫn
a <- predict(MH2, type = "response")
b <- ifelse(a > 0.5, "1", "0")
c <-factor(b, levels = c("0","1"))
d <- factor(QT$TG, labels = c("0","1"))
confusionMatrix(table(c, d))

## Confusion Matrix and Statistics
## 
##    d
## c     0   1
##   0 679 118
##   1  51 106
##                                           
##                Accuracy : 0.8229          
##                  95% CI : (0.7971, 0.8466)
##     No Information Rate : 0.7652          
##     P-Value [Acc > NIR] : 8.967e-06       
##                                           
##                   Kappa : 0.45            
##                                           
##  Mcnemar's Test P-Value : 3.836e-07       
##                                           
##             Sensitivity : 0.9301          
##             Specificity : 0.4732          
##          Pos Pred Value : 0.8519          
##          Neg Pred Value : 0.6752          
##              Prevalence : 0.7652          
##          Detection Rate : 0.7117          
##    Detection Prevalence : 0.8354          
##       Balanced Accuracy : 0.7017          
##                                           
##        'Positive' Class : 0               
## 

1.3 Mô hình logit

MH3 <- glm(factor (TG) ~ QT$FF + QT$AIC + QT$ASTSM + QT$BH + QT$Age + QT$SO, family = binomial(link = "logit"), data = QT)
summary(MH3)

## 
## Call:
## glm(formula = factor(TG) ~ QT$FF + QT$AIC + QT$ASTSM + QT$BH + 
##     QT$Age + QT$SO, family = binomial(link = "logit"), data = QT)
## 
## Coefficients:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          2.12159    0.92930   2.283   0.0224 *  
## QT$FFNo Record       0.10632    0.42122   0.252   0.8007    
## QT$FFYes             1.69250    0.27513   6.152 7.67e-10 ***
## QT$AICLow Income    -0.54247    0.26811  -2.023   0.0430 *  
## QT$AICMiddle Income -1.65412    0.37790  -4.377 1.20e-05 ***
## QT$ASTSMYes          0.79072    0.20021   3.949 7.83e-05 ***
## QT$BHYes            -0.85572    0.21835  -3.919 8.89e-05 ***
## QT$Age              -0.13111    0.02928  -4.478 7.54e-06 ***
## QT$SO                0.35356    0.06124   5.773 7.78e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1039.88  on 953  degrees of freedom
## Residual deviance:  762.95  on 945  degrees of freedom
## AIC: 780.95
## 
## Number of Fisher Scoring iterations: 5

AIC = 780.95

Deviance = 762.95

BrierScore(MH3)

## [1] 0.1272698

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.

# Ma trận nhầm lẫn
a <- predict(MH3, type = "response")
b <- ifelse(a > 0.5, "1", "0")
c <-factor(b, levels = c("0","1"))
d <- factor(QT$TG, labels = c("0","1"))
confusionMatrix(table(c, d))

## Confusion Matrix and Statistics
## 
##    d
## c     0   1
##   0 678 117
##   1  52 107
##                                           
##                Accuracy : 0.8229          
##                  95% CI : (0.7971, 0.8466)
##     No Information Rate : 0.7652          
##     P-Value [Acc > NIR] : 8.967e-06       
##                                           
##                   Kappa : 0.4519          
##                                           
##  Mcnemar's Test P-Value : 8.519e-07       
##                                           
##             Sensitivity : 0.9288          
##             Specificity : 0.4777          
##          Pos Pred Value : 0.8528          
##          Neg Pred Value : 0.6730          
##              Prevalence : 0.7652          
##          Detection Rate : 0.7107          
##    Detection Prevalence : 0.8333          
##       Balanced Accuracy : 0.7032          
##                                           
##        'Positive' Class : 0               
## 

1.4 Lựa chọn mô hình

Mô hình	AIC	Deviance	Brier Score	Độ chính xác	Độ nhạy	Độ đặc hiệu
Logit (MH3)	780.95	762.95	0.1272698	0.8229	0.9288	0.4777
Probit (MH2)	780.53	762.53	0.1276788	0.8229	0.9301	0.4732
Cloglog (MH1)	790.02	772.02	0.1281922	0.8208	0.9397	0.4330
Lựa chọn	MH2	MH2	MH1	MH1-2	MH3	MH1

Dựa vào các tiêu chí đánh giá một mô hình bao gồm AIC, Deviance và Confusion Matrix (Độ chính xác, độ nhạy) đều đưa ra kết quả cho thấy mô hình 2 - Mô hình sử dụng hàm Probit là tốt nhất trong 3 mô hình được đề xuất. Do đó mô hình hồi quy logistic với hàm tỷ lệ (complementary Probit link function) là mô hình tốt nhất.

2 Nhiệm vụ 4: Phân tích thống kê mô tả

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

2.1.1 “TG” và “FF”

• Kiểm định tính độc lập

Giả thuyết - Đối thuyết:

\(H_{0}\): TG và FF độc lập với nhau

\(H_{1}\): TG và FF không độc lập với nhau

AA <- table(QT$FF, QT$TG)
chisq.test(AA)

## 
##  Pearson's Chi-squared test
## 
## data:  AA
## X-squared = 177.31, df = 2, p-value < 2.2e-16

Vì p_value = 2.2e-16 < 0.05 nên ta thừa nhận giả thuyết \(H_{0}\). Nghĩa là TG và FF độc lập với nhau.

2.1.2 “TG” và “AIC”

• Kiểm định tính độc lập

Giả thuyết - Đối thuyết:

\(H_{0}\): TG và AIC độc lập với nhau

\(H_{1}\): TG và AIC không độc lập với nhau

BB <- table(QT$AIC, QT$TG)
chisq.test(BB)

## 
##  Pearson's Chi-squared test
## 
## data:  BB
## X-squared = 170.17, df = 2, p-value < 2.2e-16

Vì p_value = 2.2e-16 < 0.05 nên ta thừa nhận giả thuyết \(H_{0}\). Nghĩa là TG và AIC độc lập với nhau.

2.1.3 “TG” và “ASTSM”

• Kiểm định tính độc lập

Giả thuyết - Đối thuyết:

\(H_{0}\): TG và ASTSM độc lập với nhau

\(H_{1}\): TG và ASTSM không độc lập với nhau

CC <- table(QT$ASTSM, QT$TG)
chisq.test(CC)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  CC
## X-squared = 4.8471, df = 1, p-value = 0.02769

Vì p_value = 0.02769 < 0.05 nên ta thừa nhận giả thuyết \(H_{0}\). Nghĩa là TG và ASTSM độc lập với nhau.

2.1.4 “TG” và “BH”

• Kiểm định tính độc lập

Giả thuyết - Đối thuyết:

\(H_{0}\): TG và BH độc lập với nhau

\(H_{1}\): TG và BH không độc lập với nhau

DD <- table(QT$BH, QT$TG)
chisq.test(DD)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  DD
## X-squared = 39.518, df = 1, p-value = 3.251e-10

Vì p_value = 3.251e-10 < 0.05 nên ta thừa nhận giả thuyết \(H_{0}\). Nghĩa là TG và BH độc lập với nhau.

2.2 Khoảng ước lượng cho tỷ lệ

Ước lượng tỷ lệ khách hàng không rời đi với trình trạng rời đu=i có phải là 30% hay không (nghĩa là chúng ta kiểm định giả thuyết” \(H_0\): p= 0.30”)

N <- QT[QT$TG == "No",]
prop.test(length(N$TG),length(QT$TG),p= 0.3)

## 
##  1-sample proportions test with continuity correction
## 
## data:  length(N$TG) out of length(QT$TG), null probability 0.3
## X-squared = 980.91, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.3
## 95 percent confidence interval:
##  0.7367284 0.7915014
## sample estimates:
##         p 
## 0.7651992

Vì p_value < 0.05 nên ta bác bỏ giả thuyết \(H_0\). Do đó tỷ lệ khách hàng không rời đi không phải bằng 30% với mức ý nghĩa 5%.

3 Nhiệm vụ 3: Thống kê mô tả

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

3.1 Thống kê mô tả cho một biến

3.1.1 Biến TG

• Bảng tần số

table(QT$TG)

## 
##  No Yes 
## 730 224

• Bảng tần suất

table(QT$TG)/sum(table(QT$TG))

## 
##        No       Yes 
## 0.7651992 0.2348008

• Biểu đồ

ggplot(QT,aes(TG)) + geom_bar(color ="black", fill = "pink") + ylab("Số khách hàng") + xlab("Tình trạng khách hàng rời đi")

Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 954 khách hàng thì có 730 khách hàng không rời đi chiếm 76,52% và có 224 khách hàng mua bảo hiểm du lịch chiếm 23,48%.

3.1.2 Biến FF

• Bảng tần số

table(QT$FF)

## 
##        No No Record       Yes 
##       608        60       286

• Bảng tần suất

table(QT$FF)/sum(table(QT$FF))

## 
##         No  No Record        Yes 
## 0.63731656 0.06289308 0.29979036

• Biểu đồ

ggplot(QT,aes(FF)) + geom_bar(color ="black", fill = "pink") + ylab("Số khách hàng") + xlab("Tình trạng thường xuyên đi các chuyến bay của khách hàng")

Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 954 khách hàng thì có 608 khách hàng không thường xuyên đi các chuyến bay, chiếm 63,73%, có 286 khách hàng thường xuyên đi các chuyến bay, chiếm 29,98% và có 60 khách hàng không có hồ sơ về tình trạng thường xuyên đi các chuyến bay, chiếm 6,29%.

3.1.3 Biến AIC

• Bảng tần số

table(QT$AIC)

## 
##   High Income    Low Income Middle Income 
##           159           386           409

• Bảng tần suất

table(QT$AIC)/sum(table(QT$AIC))

## 
##   High Income    Low Income Middle Income 
##     0.1666667     0.4046122     0.4287212

• Biểu đồ

pie(table(QT$AIC), col = rainbow(3), main = "Biểu đồ thể hiện tình trạng thu nhập của khách hàng ")

Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 954 khách hàng thì có 159 khách hàng có mức thu nhập cao, chiếm 16,67%, có 386 khách hàng có mức thu nhập thâos, chiếm 40,46% và có 409 khách hàng có mức thu nhập trung bình, chiếm 42,87%.

3.1.4 Biến ASTSM

• Bảng tần số

table(QT$ASTSM)

## 
##  No Yes 
## 594 360

• Bảng tần suất

table(QT$ASTSM)/sum(table(QT$ASTSM))

## 
##        No       Yes 
## 0.6226415 0.3773585

• Biểu đồ

ggplot(QT,aes(ASTSM)) + geom_bar(color ="black", fill = "pink") + ylab("Số khách hàng") + xlab("Tình trạng tài khoản của khách hàng có đồng bộ với MXH của họ không")

Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 954 khách hàng thì có 594 khách hàng có tài khoản công ty không đồng bộ với MXH của họ, chiếm 62,26% và có 360 khách hàng có tài khoản công ty có đồng bộ với MXH của họ, chiếm 37,74%.

3.1.5 Biến BH

• Bảng tần số

table(QT$BH)

## 
##  No Yes 
## 576 378

• Bảng tần suất

table(QT$BH)/sum(table(QT$BH))

## 
##        No       Yes 
## 0.6037736 0.3962264

• Biểu đồ

pie(table(QT$BH), col = rainbow(2), main = "Biểu đồ thể hiện tình trạng khách hàng có sử dụng dịch vụ đặt nơi nghỉ của công ty")

Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 954 khách hàng thì có 576 khách hàng không đặt dịch vụ nơi nghỉ của công ty, chiếm 60,38% và có 378 khách hàng có đặt dịch vụ nơi nghỉ của công ty, chiếm 39,62%.

3.1.6 Biến Age

summary(QT$Age)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   27.00   30.00   31.00   32.11   35.00   38.00

Dựa vào kết quả thống kê mô tả, ta thấy khách hàng của công ty du lịch và lữ hành có độ tuổi từ 27 tuổi đến 38 tuổi, trung bình (mean) là 32,11 tuổi. 1st Qu.(first quartile) = 30 có nghĩa là 25% đối tượng nghiên cứu có độ tuổi bằng hoặc nhỏ hơn 30 tuổi. Tương tự, 3rd Qu.(Third quartile) = 35 có nghĩa là 75% đối tượng có độ tuổi bằng hoặc thấp hơn 35 tuổi. Số trung vị (median) 31 cũng có nghĩa là 50% đối tượng có độ tuổi 31 trở xuống (hay 31 tuổi trở lên).

table(QT$Age)

## 
##  27  28  29  30  31  33  34  35  36  37  38 
##  62  71  70 236 103  29 107  52  67 126  31

table(QT$Age)/sum(table(QT$Age))

## 
##         27         28         29         30         31         33         34 
## 0.06498952 0.07442348 0.07337526 0.24737945 0.10796646 0.03039832 0.11215933 
##         35         36         37         38 
## 0.05450734 0.07023061 0.13207547 0.03249476

pie(table(QT$Age), col = rainbow(11), main = "Biểu đồ thể hiện độ tuổi của khách hàng ")

3.1.7 Biến SO

summary(QT$SO)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   1.000   2.000   2.437   4.000   6.000

Dựa vào kết quả thống kê mô tả, ta thấy Số dịch vụ được khách hàng chọn trong những năm gần đây của công ty du lịch và lữ hành từ 1 dịch vụ đến 6 dịch vụ, trung bình (mean) là 2.437. 1st Qu.(first quartile) = 1 có nghĩa là 25% đối tượng nghiên cứu có thu nhập hàng năm bằng hoặc nhỏ hơn 1 dịch vụ. Tương tự, 3rd Qu.(Third quartile) = 4 có nghĩa là 75% đối tượng có thu nhập hàng năm bằng hoặc thấp hơn 4 dịch vụ. Số trung vị (median) 2 cũng có nghĩa là 50% đối tượng có thu nhập hàng năm là 2 dịch vụ trở xuống (hay 2 dịch vụ trở lên).

table(QT$SO)

## 
##   1   2   3   4   5   6 
## 404 176 124 117  69  64

table(QT$SO)/sum(table(QT$SO))

## 
##          1          2          3          4          5          6 
## 0.42348008 0.18448637 0.12997904 0.12264151 0.07232704 0.06708595

pie(table(QT$SO), col = rainbow(6), main = "Biểu đồ thể hiện số dịch vụ được khách hàng chọn trong những năm gần đây của công ty")

3.2 Thống kê mô tả cho hai biến

3.2.1 Biến phụ thuộc :TG” và biến độc lập “FF”

• Biểu đồ

ggplot(QT, aes(FF, fill =TG )) + geom_bar(position = 'dodge')

• Bảng tần số

A <- table(QT$FF, QT$TG); A

##            
##              No Yes
##   No        539  69
##   No Record  52   8
##   Yes       139 147

• Bảng tần suất

A1 <- prop.table(A); A1

##            
##                      No         Yes
##   No        0.564989518 0.072327044
##   No Record 0.054507338 0.008385744
##   Yes       0.145702306 0.154088050

Dựa vào kết quả của bảng tần số và tần suất ta thấy: Có 69 khách hàng không thường xuyên đi các chuyến bay rời đi, chiếm 7,23%. Có 147 khách hàng thường xuyên đi các chuyến bay rời đi, chiếm 15,41%. Có 8 khách hàng không rõ thường xuyên đi các chuyến bay rời đi, chiếm 0,48%.

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

#Tần số biên
addmargins(A)

##            
##              No Yes Sum
##   No        539  69 608
##   No Record  52   8  60
##   Yes       139 147 286
##   Sum       730 224 954

riskratio(A)

## $data
##            
##              No Yes Total
##   No        539  69   608
##   No Record  52   8    60
##   Yes       139 147   286
##   Total     730 224   954
## 
## $measure
##            risk ratio with 95% C.I.
##             estimate     lower    upper
##   No        1.000000        NA       NA
##   No Record 1.174879 0.5938551 2.324374
##   Yes       4.529036 3.5303573 5.810225
## 
## $p.value
##            two-sided
##             midp.exact fisher.exact   chi.square
##   No                NA           NA           NA
##   No Record  0.6295064 6.707274e-01 6.460462e-01
##   Yes        0.0000000 6.106495e-37 6.473744e-39
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Theo kết quả trên ta thấy tỉ lệ rủi ro tương đối (risk ratio) của những khách hàng rời đi theo tình trạng thường xuyên đi các chuyến bay.

Với nhóm No Record: Tỷ lệ rủi ro tương đối ước tính là 1.174879. Điều này cho thấy nhóm “No Record” có tỷ lệ rủi ro tương đối cao hơn khoảng 1.17 lần so với nhóm tham chiếu “No”. Khoảng tin cậy 95% cho tỷ lệ rủi ro tương đối nằm trong khoảng từ 0.5938551 đến 2.324374. Điều này cho biết rằng chúng ta có độ tin cậy 95% rằng tỷ lệ rủi ro tương đối thực sự nằm trong khoảng này.

Với nhóm Yes: Tỷ lệ rủi ro tương đối ước tính là 4.529036. Điều này cho thấy nhóm “Yes” có tỷ lệ rủi ro tương đối cao hơn khoảng 4.53 lần so với nhóm tham chiếu “No”. Khoảng tin cậy 95% cho tỷ lệ rủi ro tương đối nằm trong khoảng từ 3.5303573 đến 5.810225. Điều này cho biết rằng chúng ta có độ tin cậy 95% rằng tỷ lệ rủi ro tương đối thực sự nằm trong khoảng này.

• Tỷ lệ chênh lệch

epitab(A, method = 'oddsratio', rev='c') 

## $tab
##            
##             Yes         p0  No         p1 oddsratio      lower     upper
##   No         69 0.30803571 539 0.73835616 1.0000000         NA        NA
##   No Record   8 0.03571429  52 0.07123288 0.8320965 0.37938291 1.8250283
##   Yes       147 0.65625000 139 0.19041096 0.1210480 0.08603596 0.1703082
##            
##                  p.value
##   No                  NA
##   No Record 6.707274e-01
##   Yes       6.106495e-37
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Theo kết quả trên ta thấy tỉ lệ chênh. Tỷ lệ Odds Ratio là 0.8320965, cho thấy tỷ lệ chênh của nhóm “No Record” thấp hơn so với nhóm “No”. Tỷ lệ Odds Ratio là 0.1210480, cho thấy tỷ lệ chênh của nhóm “Yes” thấp hơn đáng kể so với nhóm “No”.

3.2.2 Biến phụ thuộc :TG” và biến độc lập “AIC”

• Biểu đồ

ggplot(QT, aes(AIC, fill =TG )) + geom_bar(position = 'dodge')

• Bảng tần số

B <- table(QT$AIC, QT$TG); B

##                
##                  No Yes
##   High Income    67  92
##   Low Income    282 104
##   Middle Income 381  28

• Bảng tần suất

B1 <- prop.table(B); B1

##                
##                         No        Yes
##   High Income   0.07023061 0.09643606
##   Low Income    0.29559748 0.10901468
##   Middle Income 0.39937107 0.02935010

Dựa vào kết quả của bảng tần số và tần suất ta thấy: Có 92 khách hàng có thu nhập cao rời đi, chiếm 9,64%. Có 104 khách hàng có thu nhập thấp rời đi, chiếm 10,9%. Có 28 khách hàng có thu nhập trung bình rời đi, chiếm 2,94%.

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

#Tần số biên
addmargins(B)

##                
##                  No Yes Sum
##   High Income    67  92 159
##   Low Income    282 104 386
##   Middle Income 381  28 409
##   Sum           730 224 954

riskratio(B)

## $data
##                
##                  No Yes Total
##   High Income    67  92   159
##   Low Income    282 104   386
##   Middle Income 381  28   409
##   Total         730 224   954
## 
## $measure
##                risk ratio with 95% C.I.
##                  estimate     lower     upper
##   High Income   1.0000000        NA        NA
##   Low Income    0.4656454 0.3770149 0.5751117
##   Middle Income 0.1183161 0.0808059 0.1732387
## 
## $p.value
##                two-sided
##                   midp.exact fisher.exact   chi.square
##   High Income             NA           NA           NA
##   Low Income    1.686307e-11 2.353008e-11 8.082985e-12
##   Middle Income 0.000000e+00 1.825713e-37 8.770272e-41
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

• Tỷ lệ chênh lệch

epitab(B, method = "oddsratio")

## $tab
##                
##                  No         p0 Yes        p1  oddsratio      lower      upper
##   High Income    67 0.09178082  92 0.4107143 1.00000000         NA         NA
##   Low Income    282 0.38630137 104 0.4642857 0.26857848 0.18241742 0.39543591
##   Middle Income 381 0.52191781  28 0.1250000 0.05352048 0.03258037 0.08791926
##                
##                      p.value
##   High Income             NA
##   Low Income    2.353008e-11
##   Middle Income 1.825713e-37
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Theo kết quả trên ta thấy tỉ lệ chênh. Tỷ lệ Odds Ratio là 0.26857848, cho thấy tỷ lệ chênh của nhóm “Low Income” thấp hơn so với nhóm “High Income”. Tỷ lệ Odds Ratio là 0.05352048, cho thấy tỷ lệ chênh của nhóm ” Middle Income” thấp hơn đáng kể so với nhóm “High Income”.

3.2.3 Biến phụ thuộc :TG” và biến độc lập “ASTSM”

• Biểu đồ

ggplot(QT, aes(ASTSM, fill =TG)) + geom_bar(position = 'dodge')

• Bảng tần số

C <- table(QT$ASTSM, QT$TG); C

##      
##        No Yes
##   No  469 125
##   Yes 261  99

• Bảng tần suất

C1 <- prop.table(C); C1

##      
##              No       Yes
##   No  0.4916143 0.1310273
##   Yes 0.2735849 0.1037736

Dựa vào kết quả của bảng tần số và tần suất ta thấy: Có 125 khách hàng Tài khoản công ty được đồng bộ hóa với mạng xã hội của họ rời đi, chiếm 13,1%. Có 99 Tài khoản công ty không được đồng bộ hóa với mạng xã hội của họ rời đi, chiếm 10,38%.

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

#Tần số biên
addmargins(C)

##      
##        No Yes Sum
##   No  469 125 594
##   Yes 261  99 360
##   Sum 730 224 954

riskratio(C, rev = "c")

## $data
##        
##         Yes  No Total
##   No    125 469   594
##   Yes    99 261   360
##   Total 224 730   954
## 
## $measure
##      risk ratio with 95% C.I.
##        estimate     lower     upper
##   No  1.0000000        NA        NA
##   Yes 0.9182303 0.8510578 0.9907045
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact chi.square
##   No          NA           NA         NA
##   Yes 0.02371352   0.02723027 0.02258363
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Theo kết quả trên ta thấy tỉ lệ rủi ro tương đối (risk ratio) của những khách hàng không rời đi theo tình trạng Tài khoản công ty được đồng bộ hóa với mạng xã hội của họ là 0.9182303 tức tỷ lệ khách hàng không rời đi là khách hàng Tài khoản công ty được đồng bộ hóa với mạng xã hội của họ ít hơn và xấp xỉ bằng tỷ lệ khách hàng không rời đi là khách hàng Tài khoản công ty không được đồng bộ hóa với mạng xã hội của họ.

• Tỷ lệ chênh lệch

epitab(C, method = "oddsratio")

## $tab
##      
##        No        p0 Yes        p1 oddsratio    lower    upper    p.value
##   No  469 0.6424658 125 0.5580357  1.000000       NA       NA         NA
##   Yes 261 0.3575342  99 0.4419643  1.423172 1.050056 1.928868 0.02723027
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

Theo kết quả trên ta thấy tỉ lệ chênh là 1.423172 tức tỉ lệ những khách hàng không rời đi/những khách hàng rời đi thuộc khách hàng Tài khoản công ty được đồng bộ hóa với mạng xã hội của họ khoảng 4,23% so với tỷ lệ khách hàng không rời đi/những khách hàng rời đi thuộc khách hàng Tài khoản công ty không đồng bộ hóa với mạng xã hội của họ.

3.2.4 Biến phụ thuộc :TG” và biến độc lập “BH”

• Biểu đồ

ggplot(QT, aes(BH , fill =TG)) + geom_bar(position = 'dodge')

• Bảng tần số

D <- table(QT$BH, QT$TG); D

##      
##        No Yes
##   No  400 176
##   Yes 330  48

• Bảng tần suất

D1 <- prop.table(D); D1

##      
##               No        Yes
##   No  0.41928721 0.18448637
##   Yes 0.34591195 0.05031447

Dựa vào kết quả của bảng tần số và tần suất ta thấy: Có 176 khách hàng đặt nhà nghỉ/khách sạn có sử dụng dịch vụ của công ty rời đi, chiếm 18,45%%. Có 48 khách hàng đặt nhà nghỉ/khách sạn có sử dụng dịch vụ của công ty không rời đi, chiếm 5,03%.

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

#Tần số biên
addmargins(D)

##      
##        No Yes Sum
##   No  400 176 576
##   Yes 330  48 378
##   Sum 730 224 954

epitab(D, method = "riskratio")

## $tab
##      
##        No        p0 Yes        p1 riskratio     lower     upper      p.value
##   No  400 0.6944444 176 0.3055556 1.0000000        NA        NA           NA
##   Yes 330 0.8730159  48 0.1269841 0.4155844 0.3104724 0.5562826 6.554016e-11
## 
## $measure
## [1] "wald"
## 
## $conf.level
## [1] 0.95
## 
## $pvalue
## [1] "fisher.exact"

• Tỷ lệ chênh lệch

oddsratio(D, rev = 'c')

## $data
##        
##         Yes  No Total
##   No    176 400   576
##   Yes    48 330   378
##   Total 224 730   954
## 
## $measure
##      odds ratio with 95% C.I.
##       estimate    lower    upper
##   No  1.000000       NA       NA
##   Yes 3.015503 2.137795 4.322722
## 
## $p.value
##      two-sided
##         midp.exact fisher.exact   chi.square
##   No            NA           NA           NA
##   Yes 6.269141e-11 6.554016e-11 1.960472e-10
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

4 Nhiệm vụ 2: Phân tích biến phụ thuộc

Nhiệm vụ: 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 Chọn biến phụ thuộc là biến định tính

Bài nghiên cứu chọn biến TG là biến phụ thuộc vì tác giả muốn xem xét quyết định rời đi của khách hàng sẽ chịu ảnh hưởng bởi các yếu tố nào.

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

Đối với biến định lượng, tác giả chọn biến SO làm biến phụ thuộc, đây là biến cho biết Số lần dịch vụ được chọn trong những năm gần đây.

5 Nhiệm vụ 1: Dữ liệu nghiên cứu

Nhiệm vụ: 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

Dữ liệu nghiên cứu về một công ty du lịch và lữ hành đang muốn dự đoán liệu một khách hàng sẽ rời đi hay không dựa trên các chỉ số được đưa ra dưới đây. Dữ liệu này bao gồm thông tin về 954 khách hàng. Bộ dữ liệu được lấy của tác giả Tejashvi từ website: https://www.kaggle.com/datasets/tejashvi14/tour-travels-customer-churn-prediction

5.2 Mô tả dữ liệu

Dữ liệu nghiên cứu gồm 954 quan sát với 7 biến bao gồm 5 biến định tính và 2 biến định lượng.

trong đó:

Biến định tính

• FF: Khách hàng có đi các chuyến bay thường xuyên hay không (Yes: Có; No: Không; No Record: Không có hồ sơ)

• AIC: Loại thu nhập hàng năm của khách hàng (Middle Income: Thu nhập trung bình; Low Income: Thu nhập thấp; High Income: Thu nhập cao)

• ASTSM: Tài khoản công ty của khách hàng có được đồng bộ hóa với mạng xã hội của họ hay không (Yes: Có; No: Không)

• BH: Khách hàng đặt nhà nghỉ/khách sạn có sử dụng dịch vụ của công ty hay không (Yes: Có; No: Không)

• TG: Tình trạng khách hàng có rời đi hay không (Yes: Khách hàng rời đi; No: Khách hàng không rời đi)

Biến định lượng

• Age: Số tuổi của khách hàng

• SO: Số dịch vụ được chọn trong những năm gần đây