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
baohiem <- read.csv("D:/PTDLĐT/Baohiemdulich.csv")
str(baohiem)
## 'data.frame': 1100 obs. of 9 variables:
## $ Age : int 31 31 34 28 28 25 31 31 28 33 ...
## $ Employment : chr "Government Sector" "Private Sector" "Private Sector" "Private Sector" ...
## $ Graduate : chr "Yes" "Yes" "Yes" "Yes" ...
## $ Income : int 400000 1250000 500000 700000 700000 1150000 1300000 1350000 1450000 800000 ...
## $ FamilyMembers : int 6 7 4 3 8 4 4 3 6 3 ...
## $ ChronicDiseases: chr "Yes" "No" "Yes" "Yes" ...
## $ FrequentFlyer : chr "No" "No" "No" "No" ...
## $ TravelledAbroad: chr "No" "No" "No" "No" ...
## $ TravelInsurance: chr "No" "No" "Yes" "No" ...
fit <- glm(factor (TravelInsurance) ~ baohiem$Employment + baohiem$FrequentFlyer + baohiem$TravelledAbroad, family = binomial(link = "logit"), data = baohiem)
summary(fit)
##
## Call:
## glm(formula = factor(TravelInsurance) ~ baohiem$Employment +
## baohiem$FrequentFlyer + baohiem$TravelledAbroad, family = binomial(link = "logit"),
## data = baohiem)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.5842 0.1488 -10.648 < 2e-16 ***
## baohiem$EmploymentPrivate Sector 0.4918 0.1680 2.928 0.00341 **
## baohiem$FrequentFlyerYes 0.7272 0.1711 4.249 2.15e-05 ***
## baohiem$TravelledAbroadYes 2.0933 0.1852 11.305 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1426.8 on 1099 degrees of freedom
## Residual deviance: 1194.3 on 1096 degrees of freedom
## AIC: 1202.3
##
## Number of Fisher Scoring iterations: 4
BrierScore(fit)
## [1] 0.1796875
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.
Giả thuyết - Đối thuyết:
\(H_{0}\): TravelInsurance và Employment độc lập với nhau
\(H_{1}\): TravelInsurance và Employment không độc lập với nhau
bh <- table(baohiem$Employment, baohiem$TravelInsurance)
chisq.test(bh)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: bh
## X-squared = 29.77, df = 1, p-value = 4.864e-08
Vì p_value = 4.864e-08 < 0.05 nên ta thừa nhận giả thuyết \(H_{0}\). Nghĩa là TravelInsurance và Employment độc lập với nhau.
Giả thuyết - Đối thuyết:
\(H_{0}\): TravelInsurance và Graduate độc lập với nhau
\(H_{1}\): TravelInsurance và Graduate không độc lập với nhau
a <- table(baohiem$Graduate, baohiem$TravelInsurance)
chisq.test(a)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: a
## X-squared = 0.38765, df = 1, p-value = 0.5335
Vì p_value = 0.5335 > 0.05 nên chưa đủ cơ sở để bác bỏ giả thuyết \(H_{0}\). Nghĩa là chưa đủ chứng cứ để kết luận rằng TravelInsurance và Graduate có liên quan với nhau.
Giả thuyết - Đối thuyết:
\(H_{0}\): TravelInsurance và ChronicDiseases độc lập với nhau
\(H_{1}\): TravelInsurance và ChronicDiseases không độc lập với nhau
b <- table(baohiem$ChronicDiseases, baohiem$TravelInsurance)
chisq.test(b)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: b
## X-squared = 0.26378, df = 1, p-value = 0.6075
Vì p_value = 0.6075 > 0.05 nên chưa đủ cơ sở để bác bỏ giả thuyết \(H_{0}\). Nghĩa là chưa đủ chứng cứ để kết luận rằng TravelInsurance và ChronicDiseases có liên quan với nhau.
Giả thuyết - Đối thuyết:
\(H_{0}\): TravelInsurance và FrequentFlyer độc lập với nhau
\(H_{1}\): TravelInsurance và FrequentFlyer không độc lập với nhau
c <- table(baohiem$FrequentFlyer, baohiem$TravelInsurance)
chisq.test(c)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: c
## X-squared = 63.729, df = 1, p-value = 1.428e-15
Vì p_value = 1.428e-15 < 0.05 nên ta thừa nhận giả thuyết \(H_{0}\). Nghĩa là TravelInsurance và FrequentFlyer độc lập với nhau.
Giả thuyết - Đối thuyết:
\(H_{0}\): TravelInsurance và TravelledAbroad độc lập với nhau
\(H_{1}\): TravelInsurance và TravelledAbroad không độc lập với nhau
d <- table(baohiem$TravelledAbroad, baohiem$TravelInsurance)
chisq.test(d)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: d
## X-squared = 206.94, df = 1, 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à TravelInsurance và TravelledAbroad độc lập với nhau.
Giả thuyết - Đối thuyết:
\(H_{0}\): TravelInsurance và Age độc lập với nhau
\(H_{1}\): TravelInsurance và Age không độc lập với nhau
age <- cut(baohiem$Age, breaks = c(24,30,35), labels=c("duoi30","tren30"))
e <- table(age, baohiem$TravelInsurance)
chisq.test(e)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: e
## X-squared = 16.028, df = 1, p-value = 6.24e-05
Vì p_value = 6.24e-05 < 0.05 nên ta thừa nhận giả thuyết \(H_{0}\). Nghĩa là TravelInsurance và Age độc lập với nhau.
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.
table(baohiem$TravelInsurance)
##
## No Yes
## 713 387
table(baohiem$TravelInsurance)/sum(table(baohiem$TravelInsurance))
##
## No Yes
## 0.6481818 0.3518182
ggplot(baohiem,aes(TravelInsurance)) + geom_bar(color ="black", fill = "pink") + ylab("Số khách hàng") + xlab("Tình trạng mua bảo hiểm du lịch")
Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 1100 khách hàng thì có 713 khách hàng không mua bảo hiểm du lịch chiếm 64,8% và có 387 khách hàng mua bảo hiểm du lịch chiếm 35,2%.
table(baohiem$Employment)
##
## Government Sector Private Sector
## 311 789
table(baohiem$Employment)/sum(table(baohiem$Employment))
##
## Government Sector Private Sector
## 0.2827273 0.7172727
ggplot(baohiem,aes(Employment)) + geom_bar(color ="black", fill = "pink") + ylab("Số khách hàng") + xlab("Lĩnh vực KH đang làm việc")
Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 1100 khách
hàng thì có 311 khách hàng làm việc thuộc lĩnh vực công quốc gia, chiếm
28,27% và có 789 khách hàng làm việc thuộc lĩnh vực tư nhân, chiếm
71,73%.
table(baohiem$Graduate)
##
## No Yes
## 162 938
table(baohiem$Graduate)/sum(table(baohiem$Graduate))
##
## No Yes
## 0.1472727 0.8527273
pie(table(baohiem$Graduate), col = rainbow(2), main = "Biểu đồ thể hiện tình trạng tốt nghiệp đại học của KH ")
Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 1100 khách
hàng thì có 162 khách hàng chưa tốt nghiệp đại học, chiếm 14,73% và có
938 khách hàng đã tốt nghiệp đại học, chiếm 85,27%.
table(baohiem$ChronicDiseases)
##
## No Yes
## 785 315
table(baohiem$ChronicDiseases)/sum(table(baohiem$ChronicDiseases))
##
## No Yes
## 0.7136364 0.2863636
ggplot(baohiem,aes(ChronicDiseases)) + geom_bar(color ="black", fill = "pink") + ylab("Số khách hàng") + xlab("Tình trạng mắc bệnh mãn tính")
Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 1100 khách
hàng thì có 785 khách hàng không mắc bênh mãn tính, chiếm 71,36% và có
315 khách hàng có mắc bênh mãn tính, chiếm 28,64%.
table(baohiem$FrequentFlyer)
##
## No Yes
## 865 235
table(baohiem$FrequentFlyer)/sum(table(baohiem$FrequentFlyer))
##
## No Yes
## 0.7863636 0.2136364
pie(table(baohiem$FrequentFlyer), col = rainbow(2), main = "Biểu đồ thể hiện tình trạng thường xuyên đặt vé máy bay của KH ")
Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 1100 khách
hàng thì có 865 khách hàng không thường xuyên đặt vé máy bay trong 2 năm
qua, chiếm 78,64% và có 235 khách hàng thường xuyên đặt vé máy bay trong
2 năm qua, chiếm 21,36%.
table(baohiem$TravelledAbroad)
##
## No Yes
## 884 216
table(baohiem$TravelledAbroad)/sum(table(baohiem$TravelledAbroad))
##
## No Yes
## 0.8036364 0.1963636
ggplot(baohiem,aes(TravelledAbroad)) + geom_bar(color ="black", fill = "pink") + ylab("Số khách hàng") + xlab("Tình trạng khách hàng đã từng đi du lịch nước ngoài")
Dựa vào kết quả của bảng tần suất và biểu đồ ta thấy trong 1100 khách
hàng thì có 884 khách hàng chưa từng đi du lịch nước ngoài, chiếm 80,36%
và có 216 khách hàng đã từng đi du lịch nước ngoài, chiếm 19,64%.
summary(baohiem$Age)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 25.00 28.00 29.00 29.63 32.00 35.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ừ 25 tuổi đến 35 tuổi, trung bình (mean) là 29,63 tuổi. 1st Qu.(first quartile) = 28 có nghĩa là 25% đối tượng nghiên cứu có độ tuổi bằng hoặc nhỏ hơn 28 tuổi. Tương tự, 3rd Qu.(Third quartile) = 32 có nghĩa là 75% đối tượng có độ tuổi bằng hoặc thấp hơn 32 tuổi. Số trung vị (median) 29 cũng có nghĩa là 50% đối tượng có độ tuổi 29 trở xuống (hay 29 tuổi trở lên).
table(baohiem$Age)
##
## 25 26 27 28 29 30 31 32 33 34 35
## 78 84 83 264 117 35 128 59 74 143 35
table(baohiem$Age)/sum(table(baohiem$Age))
##
## 25 26 27 28 29 30 31
## 0.07090909 0.07636364 0.07545455 0.24000000 0.10636364 0.03181818 0.11636364
## 32 33 34 35
## 0.05363636 0.06727273 0.13000000 0.03181818
baohiem |> ggplot(aes(Age)) + geom_bar(aes(y = (..count..)), color = 'black', fill = 'lightblue')
## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
summary(baohiem$Income)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 300000 600000 950000 941818 1250000 1800000
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ó thu nhập hàng năm từ 300.000 Rupees đến 1.800.000 Rupees, trung bình (mean) là 941.818 Rupees. 1st Qu.(first quartile) = 600.000 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 600.000 Rupees. Tương tự, 3rd Qu.(Third quartile) = 1.250.000 có nghĩa là 75% đối tượng có thu nhập hàng năm bằng hoặc thấp hơn 1.250.000 Rupees. Số trung vị (median) 950.000 cũng có nghĩa là 50% đối tượng có thu nhập hàng năm là 950.000 Rupees trở xuống (hay 950.000 Rupees trở lên).
table(cut(baohiem$Income,4))
##
## (2.98e+05,6.75e+05] (6.75e+05,1.05e+06] (1.05e+06,1.42e+06] (1.42e+06,1.8e+06]
## 306 338 357 99
table(cut(baohiem$Income,4))/sum(table(cut(baohiem$Income,4)))
##
## (2.98e+05,6.75e+05] (6.75e+05,1.05e+06] (1.05e+06,1.42e+06] (1.42e+06,1.8e+06]
## 0.2781818 0.3072727 0.3245455 0.0900000
hist(baohiem$Income, main = "Biểu đồ tần số thu nhập hàng năm của KH",xlab = "thu nhập hàng năm", ylab = "Count", col = "lightblue")
summary(baohiem$FamilyMembers)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.000 4.000 5.000 4.852 6.000 9.000
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ó số thành viên trong gia đình từ 2 người đến 9 người, trung bình (mean) là 4.852. 1st Qu.(first quartile) = 4 có nghĩa là 25% đối tượng nghiên cứu có số thành viên trong gia đình bằng hoặc nhỏ hơn 4 người. Tương tự, 3rd Qu.(Third quartile) = 6 có nghĩa là 75% đối tượng có số thành viên trong gia đình bằng hoặc thấp hơn 6 người. Số trung vị (median) 5 cũng có nghĩa là 50% đối tượng có số thành viên trong gia đình là 5 người trở xuống (hay 5 người trở lên).
table(baohiem$FamilyMembers)
##
## 2 3 4 5 6 7 8 9
## 42 195 279 241 166 104 34 39
table(baohiem$FamilyMembers)/sum(table(baohiem$FamilyMembers))
##
## 2 3 4 5 6 7 8
## 0.03818182 0.17727273 0.25363636 0.21909091 0.15090909 0.09454545 0.03090909
## 9
## 0.03545455
pie(table(baohiem$FamilyMembers), col = rainbow(8), main = "Biểu đồ số thành viên trong gia định của KH")
ggplot(baohiem, aes(Employment, fill =TravelInsurance )) + geom_bar(position = 'dodge')
bh <- table(baohiem$Employment, baohiem$TravelInsurance); bh
##
## No Yes
## Government Sector 241 70
## Private Sector 472 317
bh1 <- prop.table(bh); bh1
##
## No Yes
## Government Sector 0.21909091 0.06363636
## Private Sector 0.42909091 0.28818182
Dựa vào kết quả của bảng tần số và tần suất ta thấy: Có 70 khách hàng làm việc trong lĩnh vực công quốc gia mua bảo hiểm, chiếm 6,36%. Có 317 khách hàng làm việc trong lĩnh vực tư nhân mua bảo hiểm, chiếm 28,82%.
#Tần số biên
addmargins(bh)
##
## No Yes Sum
## Government Sector 241 70 311
## Private Sector 472 317 789
## Sum 713 387 1100
riskratio(bh)
## $data
##
## No Yes Total
## Government Sector 241 70 311
## Private Sector 472 317 789
## Total 713 387 1100
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Government Sector 1.000000 NA NA
## Private Sector 1.785026 1.428077 2.231195
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Government Sector NA NA NA
## Private Sector 1.710001e-08 1.815312e-08 3.270033e-08
##
## $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 có mua bảo hiểm du lịch theo lĩnh vực làm việc là 1.785 tức tỷ lệ khách hàng có mua bảo hiểm du lịch là thuộc lĩnh vực tư nhân gấp 1.785 lần tỷ lệ khách hàng có mua bảo hiểm du lịch là thuộc lĩnh vực công quốc gia.
epitab(bh, method = 'oddsratio', rev='c')
## $tab
##
## Yes p0 No p1 oddsratio lower upper
## Government Sector 70 0.1808786 241 0.3380084 1.0000000 NA NA
## Private Sector 317 0.8191214 472 0.6619916 0.4324777 0.3198158 0.5848271
##
## p.value
## Government Sector NA
## Private Sector 1.815312e-08
##
## $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à 0.4325 tức tỉ lệ những khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc lĩnh vực công quốc gia bằng 43,25% tỷ lệ khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc lĩnh vực tư nhân.
ggplot(baohiem, aes(Graduate, fill =TravelInsurance )) + geom_bar(position = 'dodge')
a <- table(baohiem$Graduate, baohiem$TravelInsurance); a
##
## No Yes
## No 109 53
## Yes 604 334
a1 <- prop.table(a); a1
##
## No Yes
## No 0.09909091 0.04818182
## Yes 0.54909091 0.30363636
Dựa vào kết quả của bảng tần số và tần suất ta thấy: Có 53 khách hàng chưa tốt nghiệp đại học có mua bảo hiểm du lịch, chiếm 4,82%. Có 334 khách hàng đã tốt nghiệp đại học có mua bảo hiểm, chiếm 30,36%.
#Tần số biên
addmargins(a)
##
## No Yes Sum
## No 109 53 162
## Yes 604 334 938
## Sum 713 387 1100
riskratio(a)
## $data
##
## No Yes Total
## No 109 53 162
## Yes 604 334 938
## Total 713 387 1100
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## No 1.000000 NA NA
## Yes 1.088386 0.8587183 1.379478
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## No NA NA NA
## Yes 0.4803885 0.5330121 0.4766503
##
## $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 có mua bảo hiểm du lịch theo trình độ học vấn là 1.088386 tức tỷ lệ khách hàng có mua bảo hiểm du lịch là khách hàng đã tốt nghiệp đại học gấp 1.088386 lần tỷ lệ khách hàng có mua bảo hiểm du lịch là khách hàng chưa tốt nghiệp đại học.
epitab(a, method = "oddsratio")
## $tab
##
## No p0 Yes p1 oddsratio lower upper p.value
## No 109 0.1528752 53 0.1369509 1.000000 NA NA NA
## Yes 604 0.8471248 334 0.8630491 1.137261 0.7979126 1.620933 0.5330121
##
## $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,1373 tức tỉ lệ những khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc khách hàng đã tốt nghiệp lớn hơn khoảng 13,73% so với tỷ lệ khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc khách hàng chưa tốt nghiệp.
ggplot(baohiem, aes(ChronicDiseases, fill =TravelInsurance )) + geom_bar(position = 'dodge')
b <- table(baohiem$ChronicDiseases, baohiem$TravelInsurance); b
##
## No Yes
## No 513 272
## Yes 200 115
b1 <- prop.table(b); b1
##
## No Yes
## No 0.4663636 0.2472727
## Yes 0.1818182 0.1045455
Dựa vào kết quả của bảng tần số và tần suất ta thấy: Có 272 khách hàng không mắc bệnh mãn tính có mua bảo hiểm du lịch, chiếm 24,73%%. Có 115 khách hàng có mắc bệnh mãn tính có mua bảo hiểm du lịch, chiếm 10,45%.
#Tần số biên
addmargins(b)
##
## No Yes Sum
## No 513 272 785
## Yes 200 115 315
## Sum 713 387 1100
riskratio(b, rev = "c")
## $data
##
## Yes No Total
## No 272 513 785
## Yes 115 200 315
## Total 387 713 1100
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## No 1.0000000 NA NA
## Yes 0.9715647 0.8808554 1.071615
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## No NA NA NA
## Yes 0.5592954 0.5766821 0.5596014
##
## $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 mua bảo hiểm du lịch theo tình trạng mắc bệnh mãn tính là 0,972 tức tỷ lệ khách hàng không mua bảo hiểm du lịch là khách hàng mắc ít hơn và xấp xỉ bằng tỷ lệ khách hàng không mua bảo hiểm du lịch là khách hàng không mắc bệnh mãn tính.
epitab(b, method = "oddsratio")
## $tab
##
## No p0 Yes p1 oddsratio lower upper p.value
## No 513 0.7194951 272 0.7028424 1.000000 NA NA NA
## Yes 200 0.2805049 115 0.2971576 1.084467 0.8258439 1.424081 0.5766821
##
## $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.0845 tức tỉ lệ những khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc khách hàng có mắc bệnh mãn tính khoảng 8,45% so với tỷ lệ khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc khách hàng không mắc bệnh mãn tính.
ggplot(baohiem, aes(FrequentFlyer , fill =TravelInsurance )) + geom_bar(position = 'dodge')
c <- table(baohiem$FrequentFlyer, baohiem$TravelInsurance); c
##
## No Yes
## No 613 252
## Yes 100 135
c1 <- prop.table(c); c1
##
## No Yes
## No 0.55727273 0.22909091
## Yes 0.09090909 0.12272727
Dựa vào kết quả của bảng tần số và tần suất ta thấy: Có 252 khách hàng không thường xuyên đặt vé máy bay trong 2 năm qua có mua bảo hiểm du lịch, chiếm 22,91%%. Có 135 khách hàng thường xuyên đặt vé máy bay trong 2 năm qua có mua bảo hiểm du lịch, chiếm 12,27%.
#Tần số biên
addmargins(c)
##
## No Yes Sum
## No 613 252 865
## Yes 100 135 235
## Sum 713 387 1100
epitab(c, method = "riskratio")
## $tab
##
## No p0 Yes p1 riskratio lower upper p.value
## No 613 0.7086705 252 0.2913295 1.000000 NA NA NA
## Yes 100 0.4255319 135 0.5744681 1.971884 1.694901 2.294133 2.945852e-15
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
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 có mua bảo hiểm du lịch theo tình trạng khách hàng thường xuyên đặt vé máy bay trong 2 năm qua là 1.972 tức tỷ lệ khách hàng có mua bảo hiểm du lịch thuộc thường xuyên đặt vé máy bay trong 2 năm gấp 1,972 lần so với tỷ lệ khách hàng có mua bảo hiểm du lịch thuộc khách hàng ít đặt vé máy bay trong 2 năm qua.
oddsratio(c, rev = 'c')
## $data
##
## Yes No Total
## No 252 613 865
## Yes 135 100 235
## Total 387 713 1100
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## No 1.0000000 NA NA
## Yes 0.3050071 0.2260771 0.4101714
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## No NA NA NA
## Yes 2.997602e-15 2.945852e-15 7.626982e-16
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Theo kết quả trên ta thấy tỉ lệ chênh là 0.305 tức tỉ lệ những khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc khách hàng ít đặt vé máy bay trong 2 năm qua thấp hơn 30,5% so với tỷ lệ khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc khách hàng thường xuyên đặt vé máy bay trong 2 năm qua.
ggplot(baohiem, aes(TravelledAbroad , fill =TravelInsurance )) + geom_bar(position = 'dodge')
d <- table(baohiem$TravelledAbroad, baohiem$TravelInsurance); d
##
## No Yes
## No 664 220
## Yes 49 167
d1 <- prop.table(d); d1
##
## No Yes
## No 0.60363636 0.20000000
## Yes 0.04454545 0.15181818
Dựa vào kết quả của bảng tần số và tần suất ta thấy: Có 220 khách hàng chưa từng đi du lịch nước ngoài có mua bảo hiểm du lịch, chiếm 20%. Có 167 khách hàng đã từng đi du lịch nước ngoài có mua bảo hiểm du lịch, chiếm 10,45%.
#Tần số biên
addmargins(d)
##
## No Yes Sum
## No 664 220 884
## Yes 49 167 216
## Sum 713 387 1100
epitab(d, method = "riskratio")
## $tab
##
## No p0 Yes p1 riskratio lower upper p.value
## No 664 0.7511312 220 0.2488688 1.00000 NA NA NA
## Yes 49 0.2268519 167 0.7731481 3.10665 2.713237 3.557107 5.840064e-46
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
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 có mua bảo hiểm du lịch theo tình trạng đã/chưa từng đi du lịch nước ngoài là 3.107 tức tỷ lệ khách hàng có mua bảo hiểm du lịch thuộc khách hàng đã từng đi du lịch nước ngoài gấp 3.107 lần so với tỷ lệ khách hàng có mua bảo hiểm du lịch thuộc khách hàng chưa từng đi du lịch nước ngoài.
epitab(d, method = "oddsratio")
## $tab
##
## No p0 Yes p1 oddsratio lower upper p.value
## No 664 0.9312763 220 0.5684755 1.00000 NA NA NA
## Yes 49 0.0687237 167 0.4315245 10.28646 7.226647 14.64181 5.840064e-46
##
## $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à 10.29 tức tỉ lệ những khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc khách hàng đã từng đi du lịch nước ngoài gấp 10.29 lần so với tỷ lệ khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc khách hàng chưa từng đi du lịch nước ngoài.
Mã hoá biến độ Age (độ tuổi) từ định lượng sang định tính
Với dữ liệu gốc, biến độ tuổi (age) là biến định lượng nhận các giá trị từ 25 đến 35 tuổi. Tác giả đặt quy ước về việc mã hoá biến (age) như sau: Tuổi nhóm dưới 30 tuổi (duoi30): độ tuổi từ trên 24 tuổi đến 30 tuổi. Tuổi nhóm trên 30 tuổi (tren30): độ tuổi từ trên 30 tuổi đến 35 tuổi.
age <- cut(baohiem$Age, breaks = c(24,30,35), labels=c("duoi30","tren30"))
table(age)
## age
## duoi30 tren30
## 661 439
ggplot(baohiem, aes(age , fill =TravelInsurance )) + geom_bar(position = 'dodge')
e <- table(age, baohiem$TravelInsurance); e
##
## age No Yes
## duoi30 460 201
## tren30 253 186
e1 <- prop.table(e); e1
##
## age No Yes
## duoi30 0.4181818 0.1827273
## tren30 0.2300000 0.1690909
Dựa vào kết quả của bảng tần số và tần suất ta thấy: Có 201 khách hàng dưới 30 tuổi có mua bảo hiểm du lịch, chiếm 16.91%. Có 186 khách hàng trên 30 tuổi có mua bảo hiểm du lịch, chiếm 18,27%.
#Tần số biên
addmargins(e)
##
## age No Yes Sum
## duoi30 460 201 661
## tren30 253 186 439
## Sum 713 387 1100
epitab(e, method = "riskratio")
## $tab
##
## age No p0 Yes p1 riskratio lower upper p.value
## duoi30 460 0.6959153 201 0.3040847 1.000000 NA NA NA
## tren30 253 0.5763098 186 0.4236902 1.393329 1.188798 1.63305 6.232459e-05
##
## $measure
## [1] "wald"
##
## $conf.level
## [1] 0.95
##
## $pvalue
## [1] "fisher.exact"
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 có mua bảo hiểm du lịch theo độ tuổi là 1.3933 tức tỷ lệ khách hàng có mua bảo hiểm du lịch thuộc khách hàng trên 30 tuổi gấp 3.107 lần so với tỷ lệ khách hàng có mua bảo hiểm du lịch thuộc khách hàng dưới 30 tuổi.
epitab(e, method = "oddsratio")
## $tab
##
## age No p0 Yes p1 oddsratio lower upper p.value
## duoi30 460 0.6451613 201 0.5193798 1.000000 NA NA NA
## tren30 253 0.3548387 186 0.4806202 1.682497 1.308243 2.163814 6.232459e-05
##
## $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.6825 tức tỉ lệ những khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc khách hàng trên 30 tuổi gấp 1.6825 lần so với tỷ lệ khách hàng có mua bảo hiểm du lịch/những khách hàng không mua bảo hiểm du dịch thuộc khách hàng dưới 30 tuổi.
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.
Bài nghiên cứu chọn biến TravelInsurance là biến phụ thuộc vì tác giả muốn xem xét quyết định mua bảo hiểm du lịch của khách hàng sẽ chịu ảnh hưởng bởi các yếu tố nào.
Đối với biến định lượng, tác giả chọn biến income làm biến phụ thuộc, đây là biến cho biết thu nhập hằng năm của khách hàng.
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.
Dữ liệu nghiên cứu về một công ty du lịch và lữ hành đang cung cấp gói bảo hiểm du lịch cho khách hàng của họ và gói bảo hiểm này cũng bao gồm bảo hiểm Covid. Mục đích là để tìm ra khách hàng nào có khả năng quan tâm đến việc mua gói bảo hiểm này, công ty sử dụng lịch sử dữ liệu của họ. Công ty đã cung cấp bảo hiểm cho một số khách hàng vào năm 2019 và đã trích xuất một số dữ liệu về hiệu suất và doanh số bán gói trong thời gian đó. Dữ liệu này bao gồm thông tin về 1100 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/travel-insurance-prediction-data.
Dữ liệu nghiên cứu gồm 1100 quan sát với 9 biến bao gồm 6 biến định tính và 3 biến định lượng.
trong đó:
Biến định tính
Employment: Lĩnh vực mà khách hàng đang làm việc (Government Sector: Lĩnh vực công quốc gia; Private Sector: Lĩnh vực tư nhân)
Graduate: Tình trạng tốt nghiệp đại học của khách hàng (Yes: Đã; No: Chưa)
ChronicDiseases: Tình trạng mắc bệnh mãn tính của khách hàng (Yes: Có; No: Không)
FrequentFlyer: Tình trạng khách hàng thường xuyên đặt vé máy bay trong 2 năm qua (Yes: Có; No: Không)
TravelledAbroad: Tình trạng khách hàng đã từng đi du lịch nước ngoài (Yes: Có; No: Không)
TravelInsurance: Tình trạng mua bảo hiểm du lịch của khách hàng (Yes: Có; No: Không)
Biến định lượng
Age: Số tuổi của khách hàng
Income: Thu nhập hàng năm của khách hàng tính bằng Rupee Ấn Độ.
FamilyMembers: Số thành viên trong gia đình khách hàng