library(readxl)
tcc <- read_excel("D:/BAI TAP/PTDLDT/tcc.xlsx")
tcc.xlsx
là một bộ dữ liệu liên quan đến việc khảo sát
nhu cầu tiếp tục hay dừng không tiếp tục sử dụng dịch vụ của một công ty
chuyên cung cấp dịch vụ về bưu chính viễn thông. Bên dưới là thông tin
cơ bản của bộ dữ liệu:
CustomerID: Mã khách hàng
Gender: Giới tính
InternetService: Dịch vụ Internet đang sử dụng (Bao gồm Internet cáp quang - Fiber optic và Đường dây thuê bao số - DSL)
Contract: Loại hợp đồng (Bao gồm hàng tháng, hàng năm và 2 năm)
PaymentMethod: Phương thức thanh toán (Bao gồm bill điện tử, bill qua thư, thẻ tín dụng và chuyển khoản)
MonthlyCharges: Phí hàng tháng (Tính bằng USD)
Churn1, Churn: Quyết định ngưng sử dụng dịch vụ. (1 là Yes - Ngừng sử dụng, 0 là No - Tiếp tục sử dụng)
Kiểm tra dữ liệu bị thiếu:
na <- is.na(tcc)
sum(na)
## [1] 0
Kết quả cho thấy không có giá trị nào bị trống trong bộ dữ liệu này.
Cấu trúc của dữ liệu:
str(tcc)
## tibble [7,043 × 8] (S3: tbl_df/tbl/data.frame)
## $ customerID : chr [1:7043] "7590-VHVEG" "5575-GNVDE" "3668-QPYBK" "7795-CFOCW" ...
## $ gender : chr [1:7043] "Female" "Male" "Male" "Male" ...
## $ InternetService: chr [1:7043] "DSL" "DSL" "DSL" "DSL" ...
## $ Contract : chr [1:7043] "Month-to-month" "One year" "Month-to-month" "One year" ...
## $ PaymentMethod : chr [1:7043] "Electronic check" "Mailed check" "Mailed check" "Bank transfer (automatic)" ...
## $ MonthlyCharges : num [1:7043] 29.9 57 53.9 42.3 70.7 ...
## $ Churn1 : num [1:7043] 0 0 1 0 1 1 0 0 1 0 ...
## $ Churn : chr [1:7043] "No" "No" "Yes" "No" ...
Dữ liệu này có 8 biến, dựa theo bảng cấu trúc này, ta có thể dễ dàng
thấy được nó hiện đang có 6 biến định tính bao gồm gender
,
InternetService
, Contract
,
PaymentMethod
, Churn1
và Churn
có
thể gộp làm một. Ở đây, ta chọn biến Churn
làm biến phụ
thuộc để có thể xem xét được những yếu tố nào ảnh hưởng đến quyết định
dừng sử dụng dịch vụ của khách hàng.
gender
Tần số, tần suất
# Lập bảng tần số
gender_f <- table(tcc$gender)
# Lập bảng tần suất
gender_p <- prop.table(gender_f)*100
# Kết hợp thành một bảng
gender <- data.frame(
Category = names(gender_f),
Frequency = as.vector(gender_f),
Percentage = round(as.vector(gender_p), 2)
)
gender
## Category Frequency Percentage
## 1 Female 3488 49.52
## 2 Male 3555 50.48
Biểu đồ
ggplot(data = gender, aes(x = '', y = Frequency, fill = Category)) +
geom_col() +
coord_polar('y') +
geom_text(aes(label = percent(Frequency/length(tcc$gender))), position = position_stack(vjust = 0.5)) +
labs(title = 'Figure 1: Gender of Customers') +
scale_fill_brewer(palette = "Set3") +
theme(plot.title = element_text(hjust = 0.5, face = 'bold'))
Nhận xét: Số lượng khách hàng là nam chiếm khoảng 50.48% và số lượng khách hàng nữ là 49.52% cho thấy rằng số lượng khách hàng nam đang có tỷ lệ cao hơn số khách hàng nữ nhưng sự chênh lệch đó là không đáng kể, chỉ khoảng chưa tới 1%.
InternetService
Bảng tần số, tần suất
# Lập bảng tần số
is_f <- table(tcc$InternetService)
# Lập bảng tần suất
is_p <- prop.table(is_f)*100
# Kết hợp thành một bảng
is <- data.frame(
Category = names(is_f),
Frequency = as.vector(is_f),
Percentage = round(as.vector(is_p), 2)
)
is
## Category Frequency Percentage
## 1 DSL 2421 34.37
## 2 Fiber optic 3096 43.96
## 3 No 1526 21.67
Biểu đồ
ggplot(data = is, aes(x = '', y = Frequency, fill = Category)) +
geom_col() +
coord_polar('y') +
geom_text(aes(label = percent(Frequency/length(tcc$gender))), position = position_stack(vjust = 0.5)) +
labs(title = 'Figure 2: Internet Service of Customers') +
scale_fill_brewer(palette = "Set3") +
theme(plot.title = element_text(hjust = 0.5, face = 'bold'))
Nhận xét: Đa số khách hàng chọn sử dụng cáp quang (Fiber optic) với tỷ lệ chiếm gần nửa (~40%), DSL chiếm tỷ lệ cao thứ hai với 34.4% và không sử dụng internet là 21.7%.
Contract
Bảng tần số, tần suất
# Lập bảng tần số
co_f <- table(tcc$Contract)
# Lập bảng tần suất
co_p <- prop.table(co_f)*100
# Kết hợp thành một bảng
contract <- data.frame(
Category = names(co_f),
Frequency = as.vector(co_f),
Percentage = round(as.vector(co_p), 2)
)
contract
## Category Frequency Percentage
## 1 Month-to-month 3875 55.02
## 2 One year 1473 20.91
## 3 Two year 1695 24.07
Biểu đồ
ggplot(data = contract, aes(x = '', y = Frequency, fill = Category)) +
geom_col() +
coord_polar('y') +
geom_text(aes(label = percent(Frequency/length(tcc$gender))), position = position_stack(vjust = 0.5)) +
labs(title = 'Figure 3: Contract of Customers') +
scale_fill_brewer(palette = "Set3") +
theme(plot.title = element_text(hjust = 0.5, face = 'bold'))
Nhận xét: Đa số khách hàng sử dụng loại hợp
đồng hàng tháng (Month-to-month)với tỷ lệ rất cao là 55%. Số còn lại sử
dụng hợp đồng 2 năm với 24.1% và 1 năm với 20.9%.
PaymentMethod
Bảng tần số, tần suất
# Lập bảng tần số
pm_f <- table(tcc$PaymentMethod)
# Lập bảng tần suất
pm_p <- prop.table(pm_f)*100
# Kết hợp thành một bảng
pm <- data.frame(
Category = names(pm_f),
Frequency = as.vector(pm_f),
Percentage = round(as.vector(pm_p), 2)
)
pm
## Category Frequency Percentage
## 1 Bank transfer (automatic) 1544 21.92
## 2 Credit card (automatic) 1522 21.61
## 3 Electronic check 2365 33.58
## 4 Mailed check 1612 22.89
Biểu đồ
ggplot(data = pm, aes(x = '', y = Frequency, fill = Category)) +
geom_col() +
coord_polar('y') +
geom_text(aes(label = percent(Frequency/length(tcc$gender))), position = position_stack(vjust = 0.5)) +
labs(title = 'Figure 4: Payment Method of Customers') +
scale_fill_brewer(palette = "Set3") +
theme(plot.title = element_text(hjust = 0.5, face = 'bold'))
Nhận xét: Các phương thức thanh toán đa phần là không có quá nhiều sự chênh lệch, Electronic check chiếm tỷ lệ cao nhất với 33.58%, Mailed check đứng thứ hai với 22.89%, Bank transfer đứng thứ 3 với 21.92% và Credit card đứng cuối với 21.61%. Thật ngạc nhiên khi các phương thức thanh toán dạng tự động trừ tiền (automatic)lại ít được ưa chuộng hơn so với các phương thức truyền thống như bill qua mail hay bill điện tử.
Churn
Tần số, tần suất
# Lập bảng tần số
ch_f <- table(tcc$Churn)
# Lập bảng tần suất
ch_p <- prop.table(ch_f)*100
# Kết hợp thành một bảng
churn <- data.frame(
Category = names(ch_f),
Frequency = as.vector(ch_f),
Percentage = round(as.vector(ch_p), 2)
)
churn
## Category Frequency Percentage
## 1 No 5174 73.46
## 2 Yes 1869 26.54
Biểu đồ
ggplot(data = churn, aes(x = '', y = Frequency, fill = Category)) +
geom_col() +
coord_polar('y') +
geom_text(aes(label = percent(Frequency/length(tcc$gender))), position = position_stack(vjust = 0.5)) +
labs(title = 'Figure 5: Churn of Customers') +
scale_fill_brewer(palette = "Set3") +
theme(plot.title = element_text(hjust = 0.5, face = 'bold'))
Nhận xét: Đa số khách hàng chọn tiếp tục sử dụng dịch vụ (73%) và chỉ có 27% khách hàng quyết định ngừng sử dụng dịch vụ.
Trong thống kê suy diễn, việc ước lượng khoảng và kiểm định giả thuyết cho tỷ lệ là một bước quan trọng, đặc biệt là trong trường hợp muốn đưa ra kết luận về quần thể dựa trên mẫu. Khi khảo sát, ta chỉ lấy một mẫu nhỏ từ quần thể lớn, mà mẫu đại diện cho quần thể nên ta cần ước lượng được khoảng tin cậy cho tỷ lệ thật sự bên ngoài quần thể. Ngoài ra ước lượng khoảng còn đưa ra được một khoảng tin cậy thể hiện độ chính xác của tỷ lệ.
gender
# Số lượng khách hàng nữ
fm <- sum(tcc$gender == "Female")
# Tổng số khách hàng
total <- length(tcc$gender)
# Kiểm định tỷ lệ
prop.test(fm, total, p = 0.495, conf.level = 0.95)
##
## 1-sample proportions test with continuity correction
##
## data: fm out of total, null probability 0.495
## X-squared = 0.00083849, df = 1, p-value = 0.9769
## alternative hypothesis: true p is not equal to 0.495
## 95 percent confidence interval:
## 0.4835017 0.5069906
## sample estimates:
## p
## 0.4952435
Đặt giả thuyết: \[ \left\{ \begin{array}{ll} H_0: & \text{Tỷ lệ thực số khách hàng là nữ } = 0.495 \\ H_1: & \text{Tỷ lệ thực số khách hàng là nữ } \ne 0.495 \end{array} \right. \]
Ta thấy rằng p_value = 0.9769 > 5%, nghĩa là không có đủ cơ sở để bác bỏ H0. Nghĩa là thực tế tỷ lệ số khách hàng nữ là 49.5%, ngoài ra, tỷ lệ khách hàng nữ còn được ước lượng là nằm trong khoảng 48.35-50.7% với độ tin cậy 95%.
Churn
# Số lượng No
continue <- sum(tcc$Churn == "No")
# Tổng số khách hàng
total <- length(tcc$gender)
# Kiểm định tỷ lệ
prop.test(continue, total, p = 0.73, conf.level = 0.95)
##
## 1-sample proportions test with continuity correction
##
## data: continue out of total, null probability 0.73
## X-squared = 0.74274, df = 1, p-value = 0.3888
## alternative hypothesis: true p is not equal to 0.73
## 95 percent confidence interval:
## 0.7241207 0.7448820
## sample estimates:
## p
## 0.7346301
Đặt giả thuyết: \[ \left\{ \begin{array}{ll} H_0: & \text{Tỷ lệ thực số khách hàng tiếp tục sử dụng dịch vụ } = 0.73 \\ H_1: & \text{Tỷ lệ thực số khách hàng tiếp tục sử dụng dịch vụ } \ne 0.73 \end{array} \right. \]
Ta thấy rằng p_value = 0.3888 > 5%, nghĩa là không có đủ cơ sở để bác bỏ H0. Nghĩa là thực tế tỷ lệ số khách hàng chọn tiếp tục sử dụng dịch vụ là 73%, ngoài ra, tỷ lệ khách hàng tiếp tục sử dụng dịch vụ còn được ước lượng là nằm trong khoảng 72.41-74.48% với độ tin cậy 95%.
Churn
gender
và
Churn
Bảng tần số chéo
gender_churn <- table(tcc$gender,tcc$Churn)
gender_churn
##
## No Yes
## Female 2549 939
## Male 2625 930
Biểu đồ
df_gender_churn <- as.data.frame(gender_churn)
colnames(df_gender_churn) <- c("Gender","Churn","Freq")
ggplot(df_gender_churn, aes(x = Churn, y = Freq, fill = Gender)) +
geom_col(position = position_dodge()) +
labs(title = 'Figure 6: Gender and Churn', x = 'Churn', y = 'Frequency') +
scale_fill_brewer(palette = "Set2") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, hjust = 1),
plot.title = element_text(hjust = 0.5, face = "bold"))
Kiểm định Chi-bình phương
chisq.test(gender_churn)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: gender_churn
## X-squared = 0.48408, df = 1, p-value = 0.4866
Nhận xét: Nhìn sơ qua biểu đồ và bảng tần số chéo, ta có thể thấy được tỷ lệ khách hàng nam, nữ trong nhóm rời bỏ và tiếp tục không quá chênh lệch nhau. Ở nhóm tiếp tục sử dụng, số lượng nữ, nam lần lượt là 2549 và 2625 còn nhóm rời bỏ lần lượt là 939 và 930.
Đặt giả thuyết: \[ \left\{ \begin{array}{ll} H_0: & \text{Không có mối quan hệ giữa giới tính và quyết định rời bỏ } \\ H_1: & \text{Có tồn tại mối quan hệ giữa giới tính và quyết định rời bỏ } \end{array} \right. \]
Ta thấy giá trị p_value = 0.4866 > 5%, nghĩa là không đủ cơ sở để
bác bỏ H0. Vậy không có mối quan hệ nào giữa gender
và
Churn
.
Relative Risk - RR
library(epitools)
riskratio(gender_churn)
## $data
##
## No Yes Total
## Female 2549 939 3488
## Male 2625 930 3555
## Total 5174 1869 7043
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Female 1.0000000 NA NA
## Male 0.9717493 0.8990893 1.050281
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Female NA NA NA
## Male 0.4699892 0.4828768 0.4698339
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
Tỷ lệ khách hàng dừng sử dụng dịch vụ của giới tính nam và giới tính nữ không quá chênh lệch. Cụ thể ta thấy so với nữ, tỷ lệ dừng sử dụng dịch vụ của khách nam chỉ bằng 0.97 trong khoảng 0.89-1.05 với độ tin cậy 95% cho thấy số khách nam dừng sử dụng dịch vụ thấp hơn số khách nữ là 3% và thấp hơn 0.97 lần.
Odds Ratio - OR
oddsratio(gender_churn)
## $data
##
## No Yes Total
## Female 2549 939 3488
## Male 2625 930 3555
## Total 5174 1869 7043
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## Female 1.0000000 NA NA
## Male 0.9617495 0.8652007 1.069076
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Female NA NA NA
## Male 0.4699892 0.4828768 0.4698339
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Tương tự, ta thấy tỷ số chênh của khách hàng nam quyết định dừng sử dụng dịch vụ so với số khách hàng nữ là 0.96 và nằm trong khoảng 0.86-1.07 với độ tin cậy 95%. Nghĩa là tỷ số chênh của khách hàng nam dừng sử dụng dịch vụ bằng 0.96 lần tỷ số chênh của khách hàng là nữ.
InternetService
và
Churn
Bảng tần số chéo
is_churn <- table(tcc$InternetService,tcc$Churn)
is_churn
##
## No Yes
## DSL 1962 459
## Fiber optic 1799 1297
## No 1413 113
Biểu đồ
df_is_churn <- as.data.frame(is_churn)
colnames(df_is_churn) <- c("Internet Service","Churn","Freq")
ggplot(df_is_churn, aes(x = Churn, y = Freq, fill = `Internet Service`)) +
geom_col(position = position_dodge()) +
labs(title = 'Figure 7: Internet Service and Churn', x = 'Churn', y = 'Frequency') +
scale_fill_brewer(palette = "Set2") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, hjust = 1),
plot.title = element_text(hjust = 0.5, face = "bold"))
Kiểm định Chi-bình phương
chisq.test(is_churn)
##
## Pearson's Chi-squared test
##
## data: is_churn
## X-squared = 732.31, df = 2, p-value < 2.2e-16
Nhận xét: Từ biểu đồ đã thể hiện rõ ràng
được sự khác biệt của hai yếu tố. Cụ thể là ở nhóm tiếp tục sử dụng thì
số dịch vụ Fiber optic, DSL và No lần lượt là 1962, 1799 và 1413, đây là
một tỷ lệ khá chênh lệch và ở nhóm rời bỏ thì số dịch vụ đó lần lượt là
459, 1297 và 113. Ta có thể thấy nhóm chọn dừng sử dụng dịch vụ có tỷ lệ
sử dụng Fiber optic rất cao, do đó InternetService
có khả
năng là có ảnh hưởng lên Churn
Ta tiến hành kiểm định
Chi-bình phương.
Đặt giả thuyết: \[ \left\{ \begin{array}{ll} H_0: & \text{Không có mối quan hệ giữa loại dịch vụ Internet và quyết định rời bỏ } \\ H_1: & \text{Có tồn tại mối quan hệ giữa loại dịch vụ Internet và quyết định rời bỏ } \end{array} \right. \]
Ta thấy giá trị p_value = 0.0000 < 5%, nghĩa là bác bỏ H0. Vậy có
tồn tại mối quan hệ giữa InternetService
và
Churn
. Vì thế ta tiến hành tính toán Relative Risk và Odds
Ratio.
Relative Risk - RR
riskratio(is_churn)
## $data
##
## No Yes Total
## DSL 1962 459 2421
## Fiber optic 1799 1297 3096
## No 1413 113 1526
## Total 5174 1869 7043
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## DSL 1.0000000 NA NA
## Fiber optic 2.2096380 2.0149902 2.4230887
## No 0.3905764 0.3211862 0.4749579
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## DSL NA NA NA
## Fiber optic 0 5.462658e-76 1.352046e-73
## No 0 1.775062e-25 9.986103e-24
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
Với nhóm Fiber optic so với DSL, ta có giá trị RR = 2.21 và nằm trong khoảng 2.02-2.42 với độ tin cậy 95%, nghĩa là tỷ lệ khách hàng sử dụng dịch vụ Fiber optic có tỷ lệ ngưng sử dụng dịch vụ cao hơn hẳn so với các khách hàng dùng DSL. Cụ thể, nhóm sử dụng Fiber optic có tỷ lệ dừng sử dụng cao hơn 121% so với nhóm DSL hay tỷ lệ dừng sử dụng dịch vụ của Fiber optic gấp 2.2 lần so với DSL.
Với nhóm không dùng so với DSL, ta có giá trị RR = 0.39 và nằm trong khoảng 0.32-0.47 với độ tin cậy 95%, nghĩa là tỷ lệ khách hàng không dùng dịch vụ có tỷ lệ ngưng sử dụng dịch vụ thấp hơn so với các khách hàng dùng DSL. Cụ thể, nhóm không dùng internet có tỷ lệ dừng sử dụng thấp hơn so với nhóm DSL là 61% hay tỷ lệ dừng sử dụng dịch vụ của nhóm không dùng internet chỉ bằng 0.39 lần so với DSL.
Odds-Ratio - OR
oddsratio(is_churn)
## $data
##
## No Yes Total
## DSL 1962 459 2421
## Fiber optic 1799 1297 3096
## No 1413 113 1526
## Total 5174 1869 7043
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## DSL 1.0000000 NA NA
## Fiber optic 3.0805710 2.7224910 3.4904113
## No 0.3422587 0.2743666 0.4236615
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## DSL NA NA NA
## Fiber optic 0 5.462658e-76 1.352046e-73
## No 0 1.775062e-25 9.986103e-24
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Ở nhóm Fiber optic, giá trị OR = 3.08 và nằm trong khoảng 2.72-3.49 với độ tin cậy 95% cho thấy việc tỷ lệ việc khách hàng sử dụng Fiber optic rời bỏ so với không rời bỏ cao hơn gấp 3 lần so với tỷ lệ mà khách hàng sử dụng DSL. Còn ở nhóm không sử dụng dịch vụ, giá trị OR = 0.34 và nằm trong khoảng 0.27-0.42 với độ tin cậy 95% cho thấy tỷ lệ mà khách hàng không sử dụng dịch vụ rời bỏ so với không rời bỏ ít hơn 0.34 lần so với tỷ lệ mà khách hàng dùng DSL rời bỏ.
Contract
và
Churn
Bảng tần số chéo
contract_churn <- table(tcc$Contract,tcc$Churn)
contract_churn
##
## No Yes
## Month-to-month 2220 1655
## One year 1307 166
## Two year 1647 48
Biểu đồ
df_contract_churn <- as.data.frame(contract_churn)
colnames(df_contract_churn) <- c("Contract","Churn","Freq")
ggplot(df_contract_churn, aes(x = Churn, y = Freq, fill = Contract)) +
geom_col(position = position_dodge()) +
labs(title = 'Figure 8: Contract and Churn', x = 'Churn', y = 'Frequency') +
scale_fill_brewer(palette = "Set2") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, hjust = 1),
plot.title = element_text(hjust = 0.5, face = "bold"))
Kiểm định Chi-bình phương
chisq.test(contract_churn)
##
## Pearson's Chi-squared test
##
## data: contract_churn
## X-squared = 1184.6, df = 2, p-value < 2.2e-16
Nhận xét: Từ biểu đồ, ta có thể thấy được hai yếu tố có sự khác biệt rõ rệt. Cụ thể những người chọn dừng sử dụng dịch vụ thường có xu hướng là hợp đồng hàng tháng trong khi nhóm tiếp tục sử dụng dịch vụ thì phân bố đều các hạn hợp đồng. Ở nhóm tiếp tục sử dụng, các hạn hợp đồng hàng tháng, hàng năm và 2 năm lần lượt là 2220, 1307 và 1647 trong khi đó ở nhóm không sử dụng nữa thì là 1655, 166, 48.
Đặt giả thuyết: \[ \left\{ \begin{array}{ll} H_0: & \text{Không có mối quan hệ giữa hạn hợp đồng và quyết định rời bỏ } \\ H_1: & \text{Có tồn tại mối quan hệ giữa hạn hợp đồng và quyết định rời bỏ } \end{array} \right. \]
Ta thấy giá trị p_value = 0.0000 < 5%, nghĩa là bác bỏ H0. Vậy có
mối quan hệ giữa Contract
và Churn
. Vì thế ta
tiến hành tính toán Relative Risk và Odds Ratio.
Relative Risk - RR
riskratio(contract_churn)
## $data
##
## No Yes Total
## Month-to-month 2220 1655 3875
## One year 1307 166 1473
## Two year 1647 48 1695
## Total 5174 1869 7043
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Month-to-month 1.00000000 NA NA
## One year 0.26386334 0.22759535 0.30591073
## Two year 0.06630484 0.05005021 0.08783844
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Month-to-month NA NA NA
## One year 0 1.189415e-117 3.529090e-104
## Two year 0 1.102868e-247 3.932491e-194
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
RR của one year so với month-to-month có giá trị là 0.26 và nằm trong khoảng 0.23 - 0.31 với độ tin cậy 95%, điều này cho thấy tỷ lệ dừng sử dụng dịch vụ của khách hàng có hạn hợp đồng là 1 năm thấp hơn 74% so với hàng tháng hay tỷ lệ dừng sử dụng dịch vụ của khách hàng có hạn hợp đồng 1 năm chỉ bằng 0.26 lần so với hàng tháng. RR của two year so với month-to-month có giá trị là 0.06 và nằm trong khoảng 0.05 - 0.08 với độ tin cậy 95%, là một tỷ lệ rất thấp cho thấy rằng việc dừng sử dụng dịch vụ của những khách hàng có hạn hợp đồng 2 năm thấp hơn đến 94% so với những khách hàng hàng tháng hay việc dừng sử dụng dịch vụ của các khách hàng có hạn hợp đồng 2 năm chỉ bằng 0.06 lần so với những khách hàng có hạn hợp đồng hàng tháng.
Odds-Ratio - OR
oddsratio(contract_churn)
## $data
##
## No Yes Total
## Month-to-month 2220 1655 3875
## One year 1307 166 1473
## Two year 1647 48 1695
## Total 5174 1869 7043
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## Month-to-month 1.00000000 NA NA
## One year 0.17052367 0.14292010 0.20231701
## Two year 0.03923438 0.02887594 0.05203486
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Month-to-month NA NA NA
## One year 0 1.189415e-117 3.529090e-104
## Two year 0 1.102868e-247 3.932491e-194
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
So với nhóm hàng tháng, OR = 0.17 và nằm trong khoảng 0.14 - 0.2 với độ tin cậy 95% cho thấy tỷ lệ rời bỏ của nhóm hàng năm thấp hơn 0.17 so với hàng tháng. Còn đối với nhóm 2 năm, khi OR = 0.03 và nằm trong khoảng 0.02 - 0.05 với độ tin cậy 95% cho thấy tỷ số lệ rời bỏ của nhóm 2 năm càng thấp hơn khi chỉ bằng 0.03 lần so với nhóm hàng tháng.
PaymentMethod
và
Churn
Bảng tần số chéo
pm_churn <- table(tcc$PaymentMethod,tcc$Churn)
pm_churn
##
## No Yes
## Bank transfer (automatic) 1286 258
## Credit card (automatic) 1290 232
## Electronic check 1294 1071
## Mailed check 1304 308
Biểu đồ
df_pm_churn <- as.data.frame(pm_churn)
colnames(df_pm_churn) <- c("Payment Method","Churn","Freq")
ggplot(df_pm_churn, aes(x = Churn, y = Freq, fill = `Payment Method`)) +
geom_col(position = position_dodge()) +
labs(title = 'Figure 9: Payment Method and Churn', x = 'Churn', y = 'Frequency') +
scale_fill_brewer(palette = "Set2") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, hjust = 1),
plot.title = element_text(hjust = 0.5, face = "bold"))
Kiểm định Chi-bình phương
chisq.test(pm_churn)
##
## Pearson's Chi-squared test
##
## data: pm_churn
## X-squared = 648.14, df = 3, p-value < 2.2e-16
Nhận xét: PaymentMethod
cho ra kết quả rằng ở phía chọn
tiếp tục sử dụng dịch vụ thì các loại phương thức thanh toán đều không
quá chênh lệch, nhưng ở bên rời bỏ, ta thấy phương thức electronic check
- bill điện tử là phương thức cao nhất trong nhóm rời bỏ. Cụ thể ở nhóm
chọn ở lại, các phương thức thanh toán đều không có quá nhiều chênh lệch
với số lượng chuyển khoản, thẻ tín dụng, bill điện tử và bill qua thư
lần lượt là 1286, 1290, 1294 và 1304. Trong khi đó ở nhóm rời bỏ thì lần
lượt là 258, 232, 1071, 308 cho thấy séc điện tử là phương thức có tỷ lệ
rời bỏ cao nhất.
Đặt giả thuyết:
\[ \left\{ \begin{array}{ll} H_0: & \text{Không có mối quan hệ giữa hai biến phân loại } \\ H_1: & \text{Có tồn tại mối quan hệ giữa hai biến phân loại } \end{array} \right. \]
Ta thấy p_value = 0.0000 < 5% nên bác bỏ H0, khi đó hai biến phân loại có tồn tại mối quan hệ. Ta tiến hành tình giá trị RR và OR của hai biến này như sau.
Relative Risk - RR
riskratio(pm_churn)
## $data
##
## No Yes Total
## Bank transfer (automatic) 1286 258 1544
## Credit card (automatic) 1290 232 1522
## Electronic check 1294 1071 2365
## Mailed check 1304 308 1612
## Total 5174 1869 7043
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Bank transfer (automatic) 1.0000000 NA NA
## Credit card (automatic) 0.9122228 0.7753344 1.073279
## Electronic check 2.7101037 2.4040084 3.055173
## Mailed check 1.1434397 0.9841985 1.328446
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Bank transfer (automatic) NA NA NA
## Credit card (automatic) 0.2683554 2.783795e-01 2.677952e-01
## Electronic check 0.0000000 3.445894e-80 6.609560e-76
## Mailed check 0.0795265 8.589995e-02 7.934142e-02
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
So với nhóm chuyển khoản ngân hàng, nhóm thanh toán bằng thẻ tín dụng có RR = 0.9 và nằm trong khoảng 0.75 - 1.07 với độ tin cậy 95% cho thấy tỷ lệ mà khách hàng rời bỏ sử dụng thẻ tín dụng chỉ bằng 0.9 lần so với chuyển khoản và ít hơn 10%. Đối với nhóm bill điện tử với RR = 2.71 và nằm trong khoảng 2.4 - 3.05 với độ tin cậy 95% cho thấy tỷ lệ rời bỏ mà khách hàng sử dụng séc điện tử cao hơn rất nhiều, cao hơn 171% và gấp 2.71 lần so với nhóm tham chiếu là chuyển khoản ngân hàng. Cuối cùng là nhóm bill qua thư, với RR = 1.14 và nằm trong khoảng 0.98 - 1.33 với độ tin cậy 95% cho thấy được đối với nhóm chuyển khoản ngân hàng thì nhóm bill qua thư có tỷ lệ rời bỏ cao hơn 1.14 lần và 14%.
Odds-Ratio - OR
oddsratio(pm_churn)
## $data
##
## No Yes Total
## Bank transfer (automatic) 1286 258 1544
## Credit card (automatic) 1290 232 1522
## Electronic check 1294 1071 2365
## Mailed check 1304 308 1612
## Total 5174 1869 7043
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## Bank transfer (automatic) 1.000000 NA NA
## Credit card (automatic) 0.896523 0.738563 1.087777
## Electronic check 4.122501 3.530664 4.827030
## Mailed check 1.177159 0.980964 1.413431
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Bank transfer (automatic) NA NA NA
## Credit card (automatic) 0.2683554 2.783795e-01 2.677952e-01
## Electronic check 0.0000000 3.445894e-80 6.609560e-76
## Mailed check 0.0795265 8.589995e-02 7.934142e-02
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Với giá trị OR là 0.89 và nằm trong khoảng 0.73 - 1.09 ở độ tin cậy 95% so với chuyển khoản ngân hàng, ta thấy được tỷ lệ mà khách hàng sử dụng phương thức thẻ tín dụng rời bỏ so với ở lại bằng 0.89 lần so với chuyển khoản ngân hàng. Còn về bill điện tử, với OR = 4.12 và nằm trong khoảng 3.5 - 4.82 ở độ tin cậy 95% cho thấy được nhóm sử dụng bill điện tử có tỷ lệ rời bỏ so với ở lại cao gấp 4.12 lần so với chuyển khoản. Cuối cùng là bill qua thư với OR = 1.17 và nằm trong khoảng 0.98 - 1.41 cho thấy được nhóm sử dụng bill qua thư có tỷ lệ rời bỏ so với không rời bỏ cao gấp 1.17 lần so với chuyển khoản ngân hàng.
Các yếu tố ảnh hưởng đến quyết định dừng sử dụng dịch vụ của khách hàng bao gồm yếu tố loại dịch vụ Internet mà khách hàng sử dụng, hợp đồng mà khách hàng đăng ký và phương thức thanh toán của khách hàng. Đầu tiên, về mặt dịch vụ Internet, ta có thể thấy tỷ lệ khách hàng rời bỏ công ty thường là những khách hàng đăng ký dịch vụ Fiber Optic. Do đó, có thể do công ty này đang có vấn đề với dịch vụ này, vì thế Fiber Optic là dịch vụ internet cần phải được cải thiện để giảm thiểu tỷ lệ rời khỏi của khách hàng. Tiếp đến, với thời hạn hợp đồng, tỷ lệ rời bỏ thường tập trung vào hạn hợp đồng hàng tháng, khi đó để giảm thiểu tỷ lệ rời bỏ, ta có thể tập trung vào việc phục vụ các gói có thời hạn 2 năm, 1 năm và cải thiện thêm các ưu đãi đối với gói hàng tháng. Cuối cùng là phương thức thanh toán, ta có thể thấy đa số khách hàng chọn dừng dịch vụ đa số đều dùng phương thức thanh toán là electric check. Vì thế để giảm thiểu được tỷ lệ rời bỏ, cần xem xét thêm về phương thức thanh toán này hoặc có thể thêm những ưu đãi khi thanh toán cho phương thức electric check để níu giữ chân của khách hàng.
Phân tích này có những hạn chế như chưa có đủ đa dạng loại yếu tố ảnh hưởng đến quyết định rời bỏ của khách hàng. Điều này khiến phân tích chưa đủ mức tổng quát và chỉ phụ thuộc một vài yếu tố cơ bản. Vì thế, có thể kết hợp thêm nhiều yếu tố khác để làm phân tích trở nên tổng quát hơn.