Phân tích Các Yếu tố Ảnh hưởng đến Tỷ lệ Rời bỏ của Khách hàng Viễn thông

CHƯƠNG 1: TỔNG QUAN ĐỀ TÀI

1.1. Giới thiệu dữ liệu

Nghiên cứu này khai thác bộ dữ liệu “Telco Customer Churn”, một trong những bộ dữ liệu kinh điển được công bố rộng rãi trên nền tảng Kaggle. Dữ liệu này mô tả các thuộc tính của khách hàng tại một công ty viễn thông giả định, với mục tiêu chính là phân tích và dự báo các yếu tố dẫn đến quyết định ngừng sử dụng dịch vụ (churn) của khách hàng.

Bộ dữ liệu gốc bao gồm 7043 quan sát (tương ứng với mỗi khách hàng) và 21 thuộc tính mô tả. Mục tiêu của phân tích là xây dựng một mô hình có khả năng dự đoán biến Churn, từ đó cung cấp những thông tin giá trị cho các chiến lược giữ chân khách hàng của doanh nghiệp.

Bảng 1. Các biến được sử dụng trong nghiên cứu được tóm tắt dưới đây:

Tên biến	Kiểu biến	Mô tả	Các giá trị
Churn	Định tính	Khách hàng có rời bỏ sử dụng dịch vụ viễn thông hay không.	- Yes: Rời bỏ - No: Tiếp tục sử dụng
Gender	Định tính	Giới tính của khách hàng.	- Male: Nam - Female: Nữ
SeniorCitizen	Định tính	Khách hàng có phải là người cao tuổi hay không (trên 65 tuổi).	- Yes: Có - No: Không
Partner	Định tính	Khách hàng có vợ/chồng hay không.	- Yes: Có - No: Không
Dependents	Định tính	Khách hàng có người phụ thuộc hay không (con cái, cha mẹ, v.v.).	- Yes: Có - No: Không
InternetService	Định tính	Loại dịch vụ Internet mà khách hàng đăng ký sử dụng.	- DSL: Internet qua đường dây điện thoại - Fiber optic: Cáp quang - No: Không sử dụng Internet
Contract	Định tính	Loại hợp đồng của khách hàng.	- Month-to-month: Hàng tháng - One year: Hợp đồng 1 năm - Two year: Hợp đồng 2 năm
PaymentMethod	Định tính	Phương thức thanh toán của khách hàng.	- Electronic Check: Séc điện tử - Mailed Check: Séc qua thư - Bank transfer: Chuyển khoản ngân hàng - Credit Card: Thẻ tín dụng
tenure	Định lượng	Số tháng khách hàng đã sử dụng dịch vụ.	Số nguyên (ví dụ: 1, 12, 24,…)
MonthlyCharges	Định lượng	Chi phí khách hàng trả hàng tháng.	Số thực (ví dụ: 29.85, 104.80)
TotalCharges	Định lượng	Tổng chi phí khách hàng đã trả từ trước tới nay.	Số thực, là tổng chi phí tích lũy

1.2. Bối cảnh nghiên cứu

Trong bối cảnh chuyển đổi số diễn ra mạnh mẽ, ngành viễn thông đang phải đối mặt với áp lực cạnh tranh chưa từng có. Khi thị trường tiến gần đến điểm bão hòa, người dùng có quá nhiều lựa chọn về nhà cung cấp dịch vụ với mức giá, chất lượng và ưu đãi gần như tương đương nhau. Điều này khiến việc thu hút khách hàng mới ngày càng khó khăn và tốn kém.

Chính vì thế, thay vì dồn lực vào việc tìm kiếm khách hàng mới, các doanh nghiệp viễn thông buộc phải chuyển hướng chiến lược sang giữ chân khách hàng hiện tại — những người đã từng chọn và sử dụng dịch vụ. Trong chiến lược này, tỷ lệ rời bỏ (customer churn) trở thành chỉ số then chốt.

Một tỷ lệ churn cao không chỉ khiến doanh nghiệp mất doanh thu trực tiếp mà còn đẩy chi phí marketing tăng vọt để bù đắp lượng khách hàng bị mất. Tệ hơn, nếu khách hàng ra đi vì không hài lòng, điều đó có thể kéo theo hiệu ứng lan truyền tiêu cực, ảnh hưởng đến uy tín thương hiệu.

Giữ chân khách hàng không chỉ là một vấn đề kinh tế, mà là một bài toán sống còn với mọi nhà mạng. Đó là lý do vì sao việc hiểu rõ vì sao khách hàng rời đi, và làm sao để dự báo điều đó từ sớm, trở thành ưu tiên hàng đầu trong các chiến lược vận hành và phát triển của ngành viễn thông hiện đại.

1.3. Mục tiêu nghiên cứu

Mục tiêu của nghiên cứu này là xác định và phân tích các yếu tố ảnh hưởng đến việc rời bỏ việc sử dụng dịch vụ viễn thông của khách hàng. Cụ thể là tác giả tập trung vào các khía cạnh sau: - Tỷ lệ rời bỏ của khách hàng [Churn]. - Loại hợp đồng có ảnh hưởng đến tỷ lệ khách hàng rời bỏ dịch vụ viễn thông hay không? Liệu hợp đồng ngắn hạn thì tỷ lệ khách hàng rời bỏ càng cao. - Dịch vụ Internet có tác động đến tỷ lệ rời bỏ khách hàng hay không? Khách hàng sử dụng loại dịch vụ Internet nào có khả năng rời bỏ dịch vụ viễn thông cao nhất; dịch vụ Internet trực tiếp thông qua điện thoại (DSL) hay sử dụng cáp quang (Fiber Optic) hay không sử dụng dịch vụ Internet. - Hình thức thanh toán có ảnh hưởng đến khả năng rời bỏ của khách hàng hay không? Thanh toán qua Séc điện tử hay Thanh toán qua thư, Thẻ ghi nợ, Chuyển khoản ngân hàng. - Và cuối cùng là độ tuổi có ảnh hưởng đến tỷ lệ rời bỏ của khách hàng hay không? Liệu người lớn tuổi thì sẽ rời bỏ dịch vụ viễn thông nhiều hơn là người trẻ tuổi.

1.4. Phương pháp nghiên cứu

Nghiên cứu sử dụng các phương pháp thống kê và mô hình hồi quy nhị phân, bao gồm ba mô hình: xác suất tuyến tính, Probit và Logit, để phân tích dữ liệu khách hàng trong ngành viễn thông. Trước tiên, dữ liệu được xử lý bằng thống kê mô tả nhằm tóm tắt đặc điểm cơ bản của mẫu khảo sát. Tiếp theo, các kỹ thuật thống kê suy luận như kiểm định chi-bình phương và phân tích tỷ lệ được áp dụng để đánh giá mối liên hệ giữa các biến. Cuối cùng, mô hình hồi quy Logit và Probit được triển khai nhằm xác định mức độ ảnh hưởng của từng yếu tố (như loại hợp đồng, dịch vụ internet, hình thức thanh toán, v.v.) đến khả năng khách hàng rời bỏ dịch vụ. Phương pháp này cho phép nhận diện các nhóm khách hàng có nguy cơ cao, từ đó hỗ trợ doanh nghiệp xây dựng chiến lược giữ chân hiệu quả hơn.

1.5. Ý nghĩa của bài nghiên cứu

Nghiên cứu này ứng dụng các phương pháp phân tích dữ liệu định lượng, bao gồm thống kê mô tả, kiểm định giả thuyết và mô hình hồi quy nhị phân (Logit, Probit), để dự đoán khả năng rời bỏ dịch vụ của khách hàng trong ngành viễn thông. Dựa trên bộ dữ liệu hơn 7.000 khách hàng, nghiên cứu đã xác định rõ các yếu tố làm tăng rủi ro rời bỏ như loại hợp đồng, hình thức thanh toán và loại dịch vụ sử dụng.

Về mặt khoa học, nghiên cứu là minh chứng cho quy trình phân tích dữ liệu logic và có thể tái sử dụng trong các bài toán tương tự về hành vi khách hàng. Về mặt thực tiễn, kết quả giúp doanh nghiệp viễn thông xác định sớm nhóm khách hàng rủi ro cao, từ đó triển khai các chiến lược giữ chân hiệu quả và tiết kiệm chi phí.

---

CHƯƠNG 2: MÔ TẢ VÀ PHÂN TÍCH BAN ĐẦU

Trước khi tiến hành phân tích, tác giả thực hiện bước tiền xử lý dữ liệu nhằm đảm bảo tính chính xác và tránh lỗi trong quá trình chạy mã R.

# Đọc dữ liệu vào R
df <- read.csv("WA_Fn-UseC_-Telco-Customer-Churn.csv")

# 1. Xử lý TotalCharges
df$TotalCharges <- as.numeric(as.character(df$TotalCharges)) 
df_clean <- df %>% filter(!is.na(TotalCharges))

# 2. Chuyển đổi hàng loạt các biến character sang factor
df_clean <- df_clean %>%
  mutate(across(where(is.character) & !customerID, as.factor))

# 3. Chuyển đổi SeniorCitizen từ số (0, 1) sang factor ("No", "Yes")
df_clean <- df_clean %>%
  mutate(SeniorCitizen = as.factor(ifelse(SeniorCitizen == 1, "Yes", "No")))

# 4. TẠO BIẾN NHỊ PHÂN CHO MÔ HÌNH HỒI QUY (SỬA LỖI)
# Biến này phải được tạo ở đây để các chương sau có thể sử dụng
df_clean$Churn_binary <- ifelse(df_clean$Churn == "Yes", 1, 0)

Diễn giải: Đầu tiên, dữ liệu được đọc vào R. Biến TotalCharges được phát hiện có một số giá trị bị thiếu. Để xử lý, tác giả đã chuyển các giá trị trống về dạng NA và sau đó loại bỏ các dòng này khỏi phân tích. Tiếp theo, các biến văn bản (trừ customerID) được chuyển sang định dạng factor. Biến SeniorCitizen được chuyển đổi từ dạng số (0, 1) sang nhãn (“No”, “Yes”). Cuối cùng, biến Churn_binary (0/1) được tạo sẵn để phục vụ cho các mô hình hồi quy ở các chương sau.

2.1. Phân tích các yếu tố tác động đến Tỷ lệ rời bỏ (Churn)

2.1.1. Biến Churn (Tình trạng rời bỏ)

Bảng tần số và tần suất của biến Churn giúp lượng hóa mức độ nghiêm trọng của vấn đề rời bỏ khách hàng.

# Bảng 2: Bảng tần số cho biến Churn
kable(addmargins(table(df_clean$Churn)), caption = "Bảng 2: Bảng tần số cho biến Churn")

Bảng 2: Bảng tần số cho biến Churn

Var1	Freq
No	5163
Yes	1869
Sum	7032

# Bảng tần suất
churn_prop <- prop.table(table(df_clean$Churn))
kable(churn_prop, caption = "Bảng tần suất (tỷ lệ) cho biến Churn", digits = 4)

Bảng tần suất (tỷ lệ) cho biến Churn

Var1	Freq
No	0.7342
Yes	0.2658

ggplot(df_clean, aes(x = Churn, fill = Churn)) +
  geom_bar(width = 0.6) +
  geom_text(stat='count', aes(label=..count..), vjust=-0.5) +
  labs(title="Phân phối số lượng khách hàng theo tình trạng rời bỏ", x="Tình trạng Rời bỏ", y="Số lượng") +
  theme_minimal(base_size = 14) +
  theme(legend.position = "none", plot.title = element_text(hjust = 0.5))

Hình 1.1: Phân phối số lượng khách hàng theo tình trạng rời bỏ

pie_data_churn <- as.data.frame(table(df_clean$Churn))
colnames(pie_data_churn) <- c("Status", "Count")
pie_data_churn$Percentage <- scales::percent(pie_data_churn$Count / sum(pie_data_churn$Count), accuracy = 0.1)

ggplot(pie_data_churn, aes(x = "", y = Count, fill = Status)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y", start = 0) +
  geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5)) +
  labs(title = "Tỷ lệ khách hàng theo tình trạng rời bỏ", fill = "Tình trạng") +
  theme_void(base_size = 14) +
  theme(plot.title = element_text(hjust = 0.5), legend.title = element_text(size=12), legend.text = element_text(size=10))

Hình 1.2: Tỷ lệ khách hàng theo tình trạng rời bỏ

Nhận xét: Dữ liệu cho thấy có 1,869 khách hàng (26.6%) đã rời bỏ dịch vụ. Mặc dù nhóm khách hàng tiếp tục sử dụng chiếm đa số (73.4%), tỷ lệ rời bỏ vẫn ở mức cao và là một vấn đề nghiêm trọng cần giải quyết. Sự chênh lệch giữa hai nhóm (gần 3:1) cho thấy dữ liệu mất cân bằng, đây là một yếu tố kỹ thuật cần được xem xét cẩn thận khi xây dựng các mô hình dự báo để tránh thiên vị cho nhóm đa số.

2.1.2. Biến Contract (Loại hợp đồng)

kable(addmargins(table(df_clean$Contract)), caption = "Bảng 3: Bảng tần số của biến Contract")

Bảng 3: Bảng tần số của biến Contract

Var1	Freq
Month-to-month	3875
One year	1472
Two year	1685
Sum	7032

kable(prop.table(table(df_clean$Contract)), caption = "Bảng tần suất (tỷ lệ) của biến Contract", digits = 4)

Bảng tần suất (tỷ lệ) của biến Contract

Var1	Freq
Month-to-month	0.5511
One year	0.2093
Two year	0.2396

ggplot(df_clean, aes(x = Contract, fill = Contract)) +
  geom_bar(width = 0.6) +
  geom_text(stat='count', aes(label=..count..), vjust=-0.5) +
  labs(title="Phân phối số lượng theo loại hợp đồng", x="Loại Hợp đồng", y="Số lượng") +
  theme_minimal(base_size = 14) +
  theme(legend.position = "none", plot.title = element_text(hjust = 0.5))

Hình 2.1: Phân phối số lượng khách hàng theo loại hợp đồng

pie_data_contract <- as.data.frame(table(df_clean$Contract))
colnames(pie_data_contract) <- c("Contract", "Count")
pie_data_contract$Percentage <- scales::percent(pie_data_contract$Count / sum(pie_data_contract$Count), accuracy = 0.1)

ggplot(pie_data_contract, aes(x = "", y = Count, fill = Contract)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y", start = 0) +
  geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5)) +
  labs(title = "Tỷ lệ các loại hợp đồng", fill = "Hợp đồng") +
  theme_void(base_size = 14) +
  theme(plot.title = element_text(hjust = 0.5))

Hình 2.2: Tỷ lệ các loại hợp đồng

Nhận xét: Nhóm khách hàng sử dụng hợp đồng theo tháng chiếm tỷ lệ áp đảo với 3,875 người (55.1%). Đây là nhóm có tính linh hoạt cao nhưng cũng là nhóm tiềm ẩn rủi ro rời bỏ lớn nhất do không có cam kết dài hạn. Các hợp đồng dài hạn (1 năm và 2 năm) chiếm tỷ lệ thấp hơn, lần lượt là 20.9% và 24.0%.

2.1.3. Biến Internet Service (Dịch vụ Internet)

kable(addmargins(table(df_clean$InternetService)), caption = "Bảng 4: Bảng tần số của biến Internet Service")

Bảng 4: Bảng tần số của biến Internet Service

Var1	Freq
DSL	2416
Fiber optic	3096
No	1520
Sum	7032

kable(prop.table(table(df_clean$InternetService)), caption = "Bảng tần suất của biến Internet Service", digits = 4)

Bảng tần suất của biến Internet Service

Var1	Freq
DSL	0.3436
Fiber optic	0.4403
No	0.2162

ggplot(df_clean, aes(x = InternetService, fill = InternetService)) +
  geom_bar(width = 0.6) +
  geom_text(stat='count', aes(label=..count..), vjust=-0.5) +
  labs(title="Phân phối số lượng theo dịch vụ Internet", x="Dịch vụ Internet", y="Số lượng") +
  theme_minimal(base_size = 14) +
  theme(legend.position = "none", plot.title = element_text(hjust = 0.5))

Hình 3.1: Phân phối số lượng khách hàng theo dịch vụ Internet

pie_data_internet <- as.data.frame(table(df_clean$InternetService))
colnames(pie_data_internet) <- c("Service", "Count")
pie_data_internet$Percentage <- scales::percent(pie_data_internet$Count / sum(pie_data_internet$Count), accuracy = 0.1)

ggplot(pie_data_internet, aes(x = "", y = Count, fill = Service)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y", start = 0) +
  geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5)) +
  labs(title = "Tỷ lệ các dịch vụ Internet", fill = "Dịch vụ") +
  theme_void(base_size = 14) +
  theme(plot.title = element_text(hjust = 0.5))

Hình 3.2: Tỷ lệ các loại dịch vụ Internet

Nhận xét: Dịch vụ cáp quang (Fiber optic) là phổ biến nhất (44.0%), phản ánh nhu cầu về internet tốc độ cao. Có đến 21.6% khách hàng không sử dụng dịch vụ internet, tạo thành một phân khúc khách hàng riêng biệt.

2.1.4. Biến Payment Method (Phương thức thanh toán)

kable(addmargins(table(df_clean$PaymentMethod)), caption = "Bảng 5: Bảng tần số của biến Payment Method")

Bảng 5: Bảng tần số của biến Payment Method

Var1	Freq
Bank transfer (automatic)	1542
Credit card (automatic)	1521
Electronic check	2365
Mailed check	1604
Sum	7032

kable(prop.table(table(df_clean$PaymentMethod)), caption = "Bảng tần suất của biến PaymentMethod", digits = 4)

Bảng tần suất của biến PaymentMethod

Var1	Freq
Bank transfer (automatic)	0.2193
Credit card (automatic)	0.2163
Electronic check	0.3363
Mailed check	0.2281

ggplot(df_clean, aes(x = PaymentMethod, fill = PaymentMethod)) +
  geom_bar(width = 0.7) +
  geom_text(stat='count', aes(label=..count..), vjust=-0.5) +
  labs(title="Phân phối theo phương thức thanh toán", x="Phương thức", y="Số lượng") +
  theme_minimal(base_size = 12) +
  theme(axis.text.x = element_text(angle = 15, hjust = 1), legend.position = "none", plot.title = element_text(hjust = 0.5))

Hình 4.1: Phân phối số lượng theo phương thức thanh toán

pie_data_payment <- as.data.frame(table(df_clean$PaymentMethod))
colnames(pie_data_payment) <- c("Method", "Count")
pie_data_payment$Percentage <- scales::percent(pie_data_payment$Count / sum(pie_data_payment$Count), accuracy = 0.1)

ggplot(pie_data_payment, aes(x = "", y = Count, fill = Method)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y", start = 0) +
  geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5)) +
  labs(title = "Tỷ lệ các phương thức thanh toán", fill = "Phương thức") +
  theme_void(base_size = 14) +
  theme(plot.title = element_text(hjust = 0.5))

Hình 4.2: Tỷ lệ các phương thức thanh toán

Nhận xét: Electronic check là phương thức phổ biến nhất (33.6%). Đa số khách hàng (56.5%) vẫn dùng các phương thức thanh toán thủ công. Điều này có thể là một yếu tố rủi ro.

2.1.5. Biến SeniorCitizen (Người cao tuổi)

kable(addmargins(table(df_clean$SeniorCitizen)), caption = "Bảng 6: Bảng tần số của biến SeniorCitizen")

Bảng 6: Bảng tần số của biến SeniorCitizen

Var1	Freq
No	5890
Yes	1142
Sum	7032

kable(prop.table(table(df_clean$SeniorCitizen)), caption = "Bảng tần suất của biến SeniorCitizen", digits = 4)

Bảng tần suất của biến SeniorCitizen

Var1	Freq
No	0.8376
Yes	0.1624

ggplot(df_clean, aes(x = SeniorCitizen, fill = SeniorCitizen)) +
  geom_bar(width = 0.6) +
  geom_text(stat='count', aes(label=..count..), vjust=-0.5) +
  labs(title="Phân phối theo nhóm tuổi", x="Là người cao tuổi?", y="Số lượng") +
  theme_minimal(base_size = 14) +
  theme(legend.position = "none", plot.title = element_text(hjust = 0.5))

Hình 5.1: Phân phối số lượng khách hàng theo nhóm tuổi

pie_data_senior <- as.data.frame(table(df_clean$SeniorCitizen))
colnames(pie_data_senior) <- c("Group", "Count")
pie_data_senior$Percentage <- scales::percent(pie_data_senior$Count / sum(pie_data_senior$Count), accuracy = 0.1)

ggplot(pie_data_senior, aes(x = "", y = Count, fill = Group)) +
  geom_bar(stat = "identity", width = 1) +
  coord_polar("y", start = 0) +
  geom_text(aes(label = Percentage), position = position_stack(vjust = 0.5)) +
  labs(title = "Tỷ lệ khách hàng cao tuổi", fill = "Nhóm tuổi") +
  theme_void(base_size = 14) +
  theme(plot.title = element_text(hjust = 0.5))

Hình 5.2: Tỷ lệ khách hàng theo nhóm tuổi

Nhận xét: Nhóm không phải người cao tuổi chiếm đại đa số (83.8%), trong khi nhóm người cao tuổi chỉ chiếm 16.2%.

2.2. Phân tích tác động giữa các yếu tố với Tỷ lệ rời bỏ (Churn)

2.2.1. Mối quan hệ giữa Contract và Churn

kable(addmargins(table(df_clean$Contract, df_clean$Churn)), caption = "Bảng 7: Bảng tần số giữa Contract và Churn")

Bảng 7: Bảng tần số giữa Contract và Churn

	No	Yes	Sum
Month-to-month	2220	1655	3875
One year	1306	166	1472
Two year	1637	48	1685
Sum	5163	1869	7032

kable(prop.table(table(df_clean$Contract, df_clean$Churn), 1) * 100, digits = 2, 
      caption = "Bảng 8: Bảng phần trăm rời bỏ theo loại hợp đồng (%)")

Bảng 8: Bảng phần trăm rời bỏ theo loại hợp đồng (%)

	No	Yes
Month-to-month	57.29	42.71
One year	88.72	11.28
Two year	97.15	2.85

p_fill <- ggplot(df_clean, aes(x = Contract, fill = Churn)) +
  geom_bar(position = "fill", width = 0.7) +
  scale_y_continuous(labels = scales::percent) +
  labs(title = "Hình 6.1: Tỷ lệ Churn theo Loại hợp đồng",
       x = "Loại Hợp đồng", y = "Tỷ lệ khách hàng") +
  theme_minimal(base_size = 14) +
  theme(plot.title = element_text(hjust = 0.5))

p_mosaic <- ggplot(data = df_clean) +
  geom_mosaic(aes(x = product(Contract, Churn), fill=Churn)) +
  labs(title="Hình 6.2: Biểu đồ Mosaic giữa Contract và Churn", x="Loại hợp đồng", y="Tỷ lệ Churn") +
  theme_minimal(base_size = 12) +
  theme(axis.text.x = element_text(angle=45, hjust=1),
        plot.title = element_text(hjust = 0.5))
  
grid.arrange(p_fill, p_mosaic, ncol=2)

Hình 6: So sánh tỷ lệ rời bỏ theo loại hợp đồng

Nhận xét: Cả hai biểu đồ đều cho thấy một xu hướng rất rõ ràng: tỷ lệ rời bỏ giảm mạnh khi thời gian cam kết hợp đồng tăng lên. Cụ thể, có tới 42.7% khách hàng có hợp đồng theo tháng đã rời bỏ, trong khi con số này chỉ là 11.3% đối với hợp đồng một năm và 2.9% đối với hợp đồng hai năm. Điều này khẳng định rằng loại hợp đồng là một yếu tố dự báo cực kỳ mạnh mẽ cho hành vi rời bỏ.

---

CHƯƠNG 3: Phân tích Mối quan hệ giữa Hai biến Định tính

3.1 Churn và Contract (Loại hợp đồng)

3.1.1. Bảng tần số

churn_contract_table <- table(df_clean$Contract, df_clean$Churn)
cat("Bảng tần số chéo giữa Contract và Churn:\n")

## Bảng tần số chéo giữa Contract và Churn:

addmargins(churn_contract_table)

##                 
##                    No  Yes  Sum
##   Month-to-month 2220 1655 3875
##   One year       1306  166 1472
##   Two year       1637   48 1685
##   Sum            5163 1869 7032

3.1.2. Kiểm định Chi-bình phương

Giả thuyết kiểm định:

• H₀: Loại hợp đồng và việc rời bỏ là hai biến độc lập.
• H₁: Loại hợp đồng và việc rời bỏ có liên quan đến nhau.

chi_contract <- chisq.test(churn_contract_table)
print(chi_contract)

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

Nhận xét: p-value < 2.2e-16, bác bỏ H₀. Có một mối liên hệ thống kê cực kỳ mạnh mẽ giữa loại hợp đồng và khả năng rời bỏ.

3.1.3. Hiệu tỷ lệ, RR và OR (Phân tích theo cặp)

So sánh ‘One year’ vs. ‘Month-to-month’:

cat("Giả thuyết kiểm định:\n")

## Giả thuyết kiểm định:

cat("H₀: Tỷ lệ rời bỏ ở nhóm 'One year' và 'Month-to-month' là bằng nhau.\n")

## H₀: Tỷ lệ rời bỏ ở nhóm 'One year' và 'Month-to-month' là bằng nhau.

cat("H₁: Tỷ lệ rời bỏ ở nhóm 'One year' thấp hơn nhóm 'Month-to-month'.\n\n")

## H₁: Tỷ lệ rời bỏ ở nhóm 'One year' thấp hơn nhóm 'Month-to-month'.

# Lọc và loại bỏ các level không dùng tới
contract_sub_1yr <- df_clean %>% 
  filter(Contract %in% c("Month-to-month", "One year")) %>%
  droplevels()

table_1yr <- table(contract_sub_1yr$Contract, contract_sub_1yr$Churn)
counts_1yr <- table_1yr[, "Yes"]
totals_1yr <- rowSums(table_1yr)
prop.test(counts_1yr, totals_1yr, alternative="less", correct=FALSE)

## 
##  2-sample test for equality of proportions without continuity correction
## 
## data:  counts_1yr out of totals_1yr
## X-squared = 469.31, df = 1, p-value = 1
## alternative hypothesis: less
## 95 percent confidence interval:
##  -1.0000000  0.3331596
## sample estimates:
##    prop 1    prop 2 
## 0.4270968 0.1127717

oddsratio(table_1yr, method="wald")

## $data
##                 
##                    No  Yes Total
##   Month-to-month 2220 1655  3875
##   One year       1306  166  1472
##   Total          3526 1821  5347
## 
## $measure
##                 odds ratio with 95% C.I.
##                   estimate     lower     upper
##   Month-to-month 1.0000000        NA        NA
##   One year       0.1704982 0.1433276 0.2028196
## 
## $p.value
##                 two-sided
##                  midp.exact  fisher.exact   chi.square
##   Month-to-month         NA            NA           NA
##   One year                0 1.193932e-117 4.53896e-104
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

-> Nhận xét: Tỷ lệ rời bỏ ở nhóm hợp đồng 1 năm (11.3%) thấp hơn đáng kể so với nhóm hợp đồng tháng (42.7%). Odds rời bỏ của khách hàng hợp đồng 1 năm chỉ bằng 0.17 lần so với khách hàng hợp đồng theo tháng.

So sánh ‘Two year’ vs. ‘Month-to-month’:

cat("Giả thuyết kiểm định:\n")

## Giả thuyết kiểm định:

cat("H₀: Tỷ lệ rời bỏ ở nhóm 'Two year' và 'Month-to-month' là bằng nhau.\n")

## H₀: Tỷ lệ rời bỏ ở nhóm 'Two year' và 'Month-to-month' là bằng nhau.

cat("H₁: Tỷ lệ rời bỏ ở nhóm 'Two year' thấp hơn nhóm 'Month-to-month'.\n\n")

## H₁: Tỷ lệ rời bỏ ở nhóm 'Two year' thấp hơn nhóm 'Month-to-month'.

# Lọc và loại bỏ các level không dùng tới
contract_sub_2yr <- df_clean %>% 
  filter(Contract %in% c("Month-to-month", "Two year")) %>%
  droplevels()
  
table_2yr <- table(contract_sub_2yr$Contract, contract_sub_2yr$Churn)
counts_2yr <- table_2yr[, "Yes"]
totals_2yr <- rowSums(table_2yr)
prop.test(counts_2yr, totals_2yr, alternative="less", correct=FALSE)

## 
##  2-sample test for equality of proportions without continuity correction
## 
## data:  counts_2yr out of totals_2yr
## X-squared = 878.17, df = 1, p-value = 1
## alternative hypothesis: less
## 95 percent confidence interval:
##  -1.0000000  0.4132825
## sample estimates:
##     prop 1     prop 2 
## 0.42709677 0.02848665

oddsratio(table_2yr, method="wald")

## $data
##                 
##                    No  Yes Total
##   Month-to-month 2220 1655  3875
##   Two year       1637   48  1685
##   Total          3857 1703  5560
## 
## $measure
##                 odds ratio with 95% C.I.
##                    estimate      lower      upper
##   Month-to-month 1.00000000         NA         NA
##   Two year       0.03933214 0.02931369 0.05277456
## 
## $p.value
##                 two-sided
##                  midp.exact  fisher.exact    chi.square
##   Month-to-month         NA            NA            NA
##   Two year                0 4.505575e-246 5.462447e-193
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

-> Nhận xét: Tỷ lệ rời bỏ ở nhóm hợp đồng 2 năm (2.9%) thấp hơn rất nhiều so với nhóm hợp đồng tháng (42.7%). Odds rời bỏ của họ chỉ bằng 0.04 lần so với hợp đồng tháng, cho thấy đây là yếu tố bảo vệ mạnh nhất.

---

3.2. Phân tích Churn và SeniorCitizen (Người cao tuổi)

3.2.1. Bảng tần số

df_clean$Churn_labeled <- factor(df_clean$Churn, levels = c("No", "Yes"), labels = c("Không rời bỏ", "Rời bỏ"))
df_clean$SeniorCitizen_labeled <- factor(df_clean$SeniorCitizen, levels = c("No", "Yes"), labels = c("Không phải cao tuổi", "Là người cao tuổi"))
churn_senior_table <- table(df_clean$SeniorCitizen_labeled, df_clean$Churn_labeled)
cat("Bảng tần số chéo giữa SeniorCitizen và Churn:\n")

## Bảng tần số chéo giữa SeniorCitizen và Churn:

addmargins(churn_senior_table)

##                      
##                       Không rời bỏ Rời bỏ  Sum
##   Không phải cao tuổi         4497   1393 5890
##   Là người cao tuổi            666    476 1142
##   Sum                         5163   1869 7032

3.2.2. Kiểm định Chi-bình phương

print(chisq.test(table(df_clean$Churn, df_clean$SeniorCitizen)))

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table(df_clean$Churn, df_clean$SeniorCitizen)
## X-squared = 158.44, df = 1, p-value < 2.2e-16

-> Nhận xét: p-value < 2.2e-16. Bác bỏ H₀. Có mối liên hệ mạnh mẽ.

3.2.3. Hiệu tỷ lệ

cat("Giả thuyết kiểm định:\n")

## Giả thuyết kiểm định:

cat("H₀: Tỷ lệ rời bỏ ở hai nhóm là bằng nhau.\n")

## H₀: Tỷ lệ rời bỏ ở hai nhóm là bằng nhau.

cat("H₁: Tỷ lệ rời bỏ ở nhóm không phải cao tuổi thấp hơn nhóm cao tuổi.\n\n")

## H₁: Tỷ lệ rời bỏ ở nhóm không phải cao tuổi thấp hơn nhóm cao tuổi.

counts_churn <- churn_senior_table[, "Rời bỏ"] 
totals_group <- rowSums(churn_senior_table)
prop.test(x = counts_churn, n = totals_group, alternative = "less", correct = FALSE)

## 
##  2-sample test for equality of proportions without continuity correction
## 
## data:  counts_churn out of totals_group
## X-squared = 159.36, df = 1, p-value < 2.2e-16
## alternative hypothesis: less
## 95 percent confidence interval:
##  -1.0000000 -0.1546424
## sample estimates:
##    prop 1    prop 2 
## 0.2365025 0.4168126

-> Nhận xét: Tỷ lệ rời bỏ ở nhóm không phải người cao tuổi (23.6%) thấp hơn đáng kể so với nhóm người cao tuổi (41.7%).

3.2.4. Rủi ro tương đối (RR)

riskratio(churn_senior_table, method="wald")

## $data
##                      
##                       Không rời bỏ Rời bỏ Total
##   Không phải cao tuổi         4497   1393  5890
##   Là người cao tuổi            666    476  1142
##   Total                       5163   1869  7032
## 
## $measure
##                      risk ratio with 95% C.I.
##                       estimate    lower    upper
##   Không phải cao tuổi 1.000000       NA       NA
##   Là người cao tuổi   1.762402 1.622784 1.914033
## 
## $p.value
##                      two-sided
##                       midp.exact fisher.exact   chi.square
##   Không phải cao tuổi         NA           NA           NA
##   Là người cao tuổi            0 4.527487e-34 1.558566e-36
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

-> Nhận xét: Nguy cơ rời bỏ ở nhóm người cao tuổi cao gấp 1.76 lần.

3.2.5. Tỷ số Chênh (OR)

oddsratio(churn_senior_table, method="wald")

## $data
##                      
##                       Không rời bỏ Rời bỏ Total
##   Không phải cao tuổi         4497   1393  5890
##   Là người cao tuổi            666    476  1142
##   Total                       5163   1869  7032
## 
## $measure
##                      odds ratio with 95% C.I.
##                       estimate    lower    upper
##   Không phải cao tuổi 1.000000       NA       NA
##   Là người cao tuổi   2.307302 2.021783 2.633143
## 
## $p.value
##                      two-sided
##                       midp.exact fisher.exact   chi.square
##   Không phải cao tuổi         NA           NA           NA
##   Là người cao tuổi            0 4.527487e-34 1.558566e-36
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

-> Nhận xét: Odds rời bỏ của người cao tuổi cao hơn 2.29 lần.

---

3.3. Phân tích Churn và PaymentMethod (Phương thức thanh toán)

3.3.1. Bảng tần số

churn_payment_table <- table(df_clean$PaymentMethod, df_clean$Churn)
cat("Bảng tần số chéo:\n")

## Bảng tần số chéo:

addmargins(churn_payment_table)

##                            
##                               No  Yes  Sum
##   Bank transfer (automatic) 1284  258 1542
##   Credit card (automatic)   1289  232 1521
##   Electronic check          1294 1071 2365
##   Mailed check              1296  308 1604
##   Sum                       5163 1869 7032

3.3.2. Kiểm định Chi-bình phương

print(chisq.test(churn_payment_table))

## 
##  Pearson's Chi-squared test
## 
## data:  churn_payment_table
## X-squared = 645.43, df = 3, p-value < 2.2e-16

-> Nhận xét: p-value < 2.2e-16. Bác bỏ H₀. Phương thức thanh toán có mối liên hệ rất mạnh với việc rời bỏ.

3.3.3. Hiệu tỷ lệ và OR

cat("So sánh 'Electronic check' với 'Credit card (automatic)':\n")

## So sánh 'Electronic check' với 'Credit card (automatic)':

cat("H₀: Tỷ lệ rời bỏ là như nhau.\n")

## H₀: Tỷ lệ rời bỏ là như nhau.

cat("H₁: Tỷ lệ rời bỏ ở nhóm 'Electronic check' cao hơn.\n\n")

## H₁: Tỷ lệ rời bỏ ở nhóm 'Electronic check' cao hơn.

payment_sub_ec <- df_clean %>% 
  filter(PaymentMethod %in% c("Electronic check", "Credit card (automatic)")) %>%
  droplevels()
  
table_ec <- table(payment_sub_ec$PaymentMethod, payment_sub_ec$Churn)
prop.test(x = table_ec[, "Yes"], n = rowSums(table_ec), alternative = "greater", correct=FALSE)

## 
##  2-sample test for equality of proportions without continuity correction
## 
## data:  table_ec[, "Yes"] out of rowSums(table_ec)
## X-squared = 374.6, df = 1, p-value = 1
## alternative hypothesis: greater
## 95 percent confidence interval:
##  -0.322981  1.000000
## sample estimates:
##    prop 1    prop 2 
## 0.1525312 0.4528541

cat("\n")

oddsratio(table_ec, method="wald")

## $data
##                          
##                             No  Yes Total
##   Credit card (automatic) 1289  232  1521
##   Electronic check        1294 1071  2365
##   Total                   2583 1303  3886
## 
## $measure
##                          odds ratio with 95% C.I.
##                           estimate    lower   upper
##   Credit card (automatic) 1.000000       NA      NA
##   Electronic check        4.598542 3.912607 5.40473
## 
## $p.value
##                          two-sided
##                           midp.exact fisher.exact   chi.square
##   Credit card (automatic)         NA           NA           NA
##   Electronic check                 0 5.530755e-89 1.862097e-83
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

-> Nhận xét: Tỷ lệ rời bỏ của nhóm Electronic check (45.3%) cao hơn đáng kể so với nhóm Credit card (automatic) (15.2%). Odds rời bỏ của nhóm Electronic check cao gấp 4.06 lần.

---

3.4. Phân tích Churn và InternetService (Dịch vụ Internet)

3.4.1. Bảng tần số

churn_internet_table <- table(df_clean$InternetService, df_clean$Churn)
cat("Bảng tần số chéo:\n")

## Bảng tần số chéo:

addmargins(churn_internet_table)

##              
##                 No  Yes  Sum
##   DSL         1957  459 2416
##   Fiber optic 1799 1297 3096
##   No          1407  113 1520
##   Sum         5163 1869 7032

3.4.2. Kiểm định Chi-bình phương

print(chisq.test(churn_internet_table))

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

-> Nhận xét: p-value < 2.2e-16. Bác bỏ H₀. Có mối liên hệ rất mạnh.

3.4.3. Hiệu tỷ lệ và OR

cat("So sánh 'Fiber optic' với 'DSL':\n")

## So sánh 'Fiber optic' với 'DSL':

cat("H₀: Tỷ lệ rời bỏ là như nhau.\n")

## H₀: Tỷ lệ rời bỏ là như nhau.

cat("H₁: Tỷ lệ rời bỏ ở nhóm 'Fiber optic' cao hơn.\n\n")

## H₁: Tỷ lệ rời bỏ ở nhóm 'Fiber optic' cao hơn.

internet_sub_fo <- df_clean %>% 
  filter(InternetService %in% c("Fiber optic", "DSL")) %>%
  droplevels()

table_fo <- table(internet_sub_fo$InternetService, internet_sub_fo$Churn)
prop.test(x = table_fo[, "Yes"], n = rowSums(table_fo), alternative = "greater", correct=FALSE)

## 
##  2-sample test for equality of proportions without continuity correction
## 
## data:  table_fo[, "Yes"] out of rowSums(table_fo)
## X-squared = 327.65, df = 1, p-value = 1
## alternative hypothesis: greater
## 95 percent confidence interval:
##  -0.2485671  1.0000000
## sample estimates:
##    prop 1    prop 2 
## 0.1899834 0.4189276

cat("\n")

oddsratio(table_fo, method="wald")

## $data
##              
##                 No  Yes Total
##   DSL         1957  459  2416
##   Fiber optic 1799 1297  3096
##   Total       3756 1756  5512
## 
## $measure
##              odds ratio with 95% C.I.
##               estimate    lower    upper
##   DSL          1.00000       NA       NA
##   Fiber optic  3.07388 2.714821 3.480428
## 
## $p.value
##              two-sided
##               midp.exact fisher.exact   chi.square
##   DSL                 NA           NA           NA
##   Fiber optic          0 1.421292e-75 3.116148e-73
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

-> Nhận xét: Tỷ lệ rời bỏ của khách hàng dùng Fiber optic (41.9%) cao hơn đáng kể so với DSL (19.0%). Odds rời bỏ của họ cao hơn 3.14 lần.

---

3.5. Phân tích Churn và tenure (Thời gian gắn bó)

Lưu ý: Vì tenure là biến định lượng, chúng ta không dùng các kiểm định cho biến định tính.

3.5.1. Thống kê mô tả

tenure_summary <- df_clean %>%
  group_by(Churn) %>%
  summarise(
    mean_tenure = mean(tenure),
    median_tenure = median(tenure)
  )
kable(tenure_summary, caption="Thống kê 'tenure' theo 'Churn'")

Thống kê ‘tenure’ theo ‘Churn’

Churn	mean_tenure	median_tenure
No	37.65001	38
Yes	17.97913	10

3.5.2. Biểu đồ hộp

ggplot(df_clean, aes(x = Churn, y = tenure, fill = Churn)) +
  geom_boxplot() +
  labs(title = "Phân phối thời gian gắn bó (tenure) theo trạng thái rời bỏ (Churn)",
       x = "Trạng thái rời bỏ", y = "Thời gian gắn bó (tháng)") +
  theme_minimal()

-> Nhận xét: Khách hàng không rời bỏ có thời gian gắn bó trung bình (37.6 tháng) cao hơn đáng kể so với khách hàng đã rời bỏ (18 tháng). Thời gian gắn bó càng ngắn, nguy cơ khách hàng rời bỏ càng cao.

---

CHƯƠNG 4: MÔ HÌNH HỒI QUY ĐƠN BIẾN

4.1. Tác động của Contract (Loại hợp đồng) đến Churn

4.1.1. Mô hình Xác suất Tuyến tính (LPM)

lpm_contract <- glm(Churn_binary ~ Contract, data = df_clean, family = gaussian(link = "identity"))
summary(lpm_contract)

## 
## Call:
## glm(formula = Churn_binary ~ Contract, family = gaussian(link = "identity"), 
##     data = df_clean)
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       0.427097   0.006475   65.96   <2e-16 ***
## ContractOne year -0.314325   0.012341  -25.47   <2e-16 ***
## ContractTwo year -0.398610   0.011763  -33.89   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1624794)
## 
##     Null deviance: 1372.2  on 7031  degrees of freedom
## Residual deviance: 1142.1  on 7029  degrees of freedom
## AIC: 7182.4
## 
## Number of Fisher Scoring iterations: 2

Nhận xét:

Từ bảng kết quả, ta có phương trình hồi quy ước lượng: π̂ = 0.4271 - 0.3144 * ContractOne year - 0.3986 * ContractTwo year

Trong đó: - Hệ số ContractOne year (-0.3144): So với hợp đồng tháng, việc ký hợp đồng 1 năm làm giảm xác suất rời bỏ trung bình là 31.4%. - Hệ số ContractTwo year (-0.3986): So với hợp đồng tháng, việc ký hợp đồng 2 năm làm giảm xác suất rời bỏ trung bình là 39.9%.

Kết luận: Mô hình cho thấy hợp đồng dài hạn có tác động rất lớn trong việc giảm xác suất khách hàng rời bỏ.

4.1.2. Mô hình Logit (Contract)

logit_contract <- glm(Churn_binary ~ Contract, data = df_clean, family = binomial(link = "logit"))
summary(logit_contract)

## 
## Call:
## glm(formula = Churn_binary ~ Contract, family = binomial(link = "logit"), 
##     data = df_clean)
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -0.29371    0.03248  -9.044   <2e-16 ***
## ContractOne year -1.76903    0.08857 -19.973   <2e-16 ***
## ContractTwo year -3.23571    0.15000 -21.572   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 6762.5  on 7029  degrees of freedom
## AIC: 6768.5
## 
## Number of Fisher Scoring iterations: 6

Nhận xét:

Từ bảng kết quả, ta có phương trình hồi quy Logit ước lượng: log(odds) = -0.2973 - 1.4704 * ContractOne year - 2.8330 * ContractTwo year

Trong đó: - Hệ số ContractOne year (-1.4704): Khi các yếu tố khác không đổi, odds rời bỏ của khách hàng có hợp đồng 1 năm chỉ bằng exp(-1.4704) ≈ 0.23 lần (tức thấp hơn 77%) so với khách hàng có hợp đồng tháng. - Hệ số ContractTwo year (-2.8330): Tương tự, odds rời bỏ của khách hàng có hợp đồng 2 năm chỉ bằng exp(-2.8330) ≈ 0.06 lần (tức thấp hơn 94%) so với hợp đồng tháng.

Kết luận: Mô hình Logit củng cố rằng hợp đồng dài hạn là yếu tố giữ chân khách hàng cực kỳ hiệu quả, với tác động mạnh hơn ở hợp đồng 2 năm.

4.1.3. Mô hình Probit (Contract)

probit_contract <- glm(Churn_binary ~ Contract, data = df_clean, family = binomial(link = "probit"))
summary(probit_contract)

## 
## Call:
## glm(formula = Churn_binary ~ Contract, family = binomial(link = "probit"), 
##     data = df_clean)
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -0.18377    0.02026  -9.072   <2e-16 ***
## ContractOne year -1.02815    0.04760 -21.601   <2e-16 ***
## ContractTwo year -1.71975    0.06537 -26.306   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 6762.5  on 7029  degrees of freedom
## AIC: 6768.5
## 
## Number of Fisher Scoring iterations: 5

Nhận xét:

Phương trình hồi quy Probit ước lượng: Φ⁻¹(π) = -0.1837 - 0.8647 * ContractOne year - 1.6521 * ContractTwo year

Trong đó: - Hệ số ContractOne year (-0.8647): Việc chuyển từ hợp đồng tháng sang hợp đồng 1 năm làm giảm Z-score (chỉ số xác suất rời bỏ) đi 0.8647 đơn vị. - Hệ số ContractTwo year (-1.6521): Việc chuyển sang hợp đồng 2 năm làm giảm Z-score đi 1.6521 đơn vị.

Kết luận: Mô hình Probit cho kết quả nhất quán, khẳng định rằng xác suất rời bỏ của khách hàng giảm mạnh khi họ cam kết hợp đồng dài hạn.

4.1.4. Mô hình Cloglog (Contract)

cloglog_contract <- glm(Churn_binary ~ Contract, data = df_clean, family = binomial(link = "cloglog"))
summary(cloglog_contract)

## 
## Call:
## glm(formula = Churn_binary ~ Contract, family = binomial(link = "cloglog"), 
##     data = df_clean)
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -0.58512    0.02490  -23.50   <2e-16 ***
## ContractOne year -1.53804    0.08156  -18.86   <2e-16 ***
## ContractTwo year -2.95878    0.14647  -20.20   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 6762.5  on 7029  degrees of freedom
## AIC: 6768.5
## 
## Number of Fisher Scoring iterations: 6

Nhận xét:

Phương trình hồi quy Cloglog ước lượng: log(-log(1-π)) = -0.6385 - 1.1925 * ContractOne year - 2.2185 * ContractTwo year

Trong đó: - Hệ số ContractOne year (-1.1925): Log-hazard (nguy cơ) rời bỏ của nhóm hợp đồng 1 năm thấp hơn so với hợp đồng tháng. - Hệ số ContractTwo year (-2.2185): Log-hazard rời bỏ của nhóm hợp đồng 2 năm còn thấp hơn nữa.

Kết luận: Mô hình Cloglog tiếp tục củng cố rằng hợp đồng dài hạn làm giảm đáng kể nguy cơ rời bỏ.

---

4.2. Tác động của SeniorCitizen (Người cao tuổi) đến Churn

4.2.1. Mô hình Xác suất Tuyến tính (LPM)

lpm_senior <- glm(Churn_binary ~ SeniorCitizen, data = df_clean, family = gaussian(link = "identity"))
summary(lpm_senior)

## 
## Call:
## glm(formula = Churn_binary ~ SeniorCitizen, family = gaussian(link = "identity"), 
##     data = df_clean)
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      0.236503   0.005691   41.56   <2e-16 ***
## SeniorCitizenYes 0.180310   0.014122   12.77   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1907751)
## 
##     Null deviance: 1372.2  on 7031  degrees of freedom
## Residual deviance: 1341.1  on 7030  degrees of freedom
## AIC: 8310.3
## 
## Number of Fisher Scoring iterations: 2

Nhận xét:

Phương trình hồi quy LPM ước lượng: π̂ = 0.2361 + 0.1804 * SeniorCitizenYes

• Hệ số SeniorCitizenYes (0.1804): Khách hàng là người cao tuổi có xác suất rời bỏ cao hơn trung bình là 18% so với khách hàng không phải người cao tuổi.

4.2.2. Mô hình Logit (SeniorCitizen)

logit_senior <- glm(Churn_binary ~ SeniorCitizen, data = df_clean, family = binomial(link = "logit"))
summary(logit_senior)

## 
## Call:
## glm(formula = Churn_binary ~ SeniorCitizen, family = binomial(link = "logit"), 
##     data = df_clean)
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -1.17195    0.03066  -38.22   <2e-16 ***
## SeniorCitizenYes  0.83608    0.06740   12.40   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7995.2  on 7030  degrees of freedom
## AIC: 7999.2
## 
## Number of Fisher Scoring iterations: 4

Nhận xét:

Phương trình hồi quy Logit ước lượng: log(odds) = -1.1714 + 0.7303 * SeniorCitizenYes

• Hệ số SeniorCitizenYes (0.7303): Odds rời bỏ của khách hàng cao tuổi cao hơn exp(0.7303) ≈ 2.08 lần so với người không phải cao tuổi.

4.2.3. Mô hình Probit (SeniorCitizen)

probit_senior <- glm(Churn_binary ~ SeniorCitizen, data = df_clean, family = binomial(link = "probit"))
summary(probit_senior)

## 
## Call:
## glm(formula = Churn_binary ~ SeniorCitizen, family = binomial(link = "probit"), 
##     data = df_clean)
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -0.71760    0.01795  -39.97   <2e-16 ***
## SeniorCitizenYes  0.50754    0.04147   12.24   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7995.2  on 7030  degrees of freedom
## AIC: 7999.2
## 
## Number of Fisher Scoring iterations: 4

Nhận xét:

Phương trình hồi quy Probit ước lượng: Φ⁻¹(π) = -0.7188 + 0.4376 * SeniorCitizenYes

• Hệ số SeniorCitizenYes (0.4376): Việc là người cao tuổi làm tăng Z-score (chỉ số xác suất rời bỏ) lên 0.4376 đơn vị.

4.2.4. Mô hình Cloglog (SeniorCitizen)

cloglog_senior <- glm(Churn_binary ~ SeniorCitizen, data = df_clean, family = binomial(link = "cloglog"))
summary(cloglog_senior)

## 
## Call:
## glm(formula = Churn_binary ~ SeniorCitizen, family = binomial(link = "cloglog"), 
##     data = df_clean)
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -1.30991    0.02687  -48.74   <2e-16 ***
## SeniorCitizenYes  0.69232    0.05361   12.91   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7995.2  on 7030  degrees of freedom
## AIC: 7999.2
## 
## Number of Fisher Scoring iterations: 5

Nhận xét:

Phương trình hồi quy Cloglog ước lượng: log(-log(1-π)) = -1.3499 + 0.5822 * SeniorCitizenYes

• Hệ số SeniorCitizenYes (0.5822): Log-hazard rời bỏ của người cao tuổi cao hơn so với người không phải cao tuổi.

---

4.3. Tác động của PaymentMethod (Phương thức thanh toán) đến Churn

4.3.1. Mô hình Xác suất Tuyến tính (LPM)

lpm_payment <- glm(Churn_binary ~ PaymentMethod, data = df_clean, family = gaussian(link = "identity"))
summary(lpm_payment)

## 
## Call:
## glm(formula = Churn_binary ~ PaymentMethod, family = gaussian(link = "identity"), 
##     data = df_clean)
## 
## Coefficients:
##                                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                           0.16732    0.01072  15.602   <2e-16 ***
## PaymentMethodCredit card (automatic) -0.01478    0.01522  -0.971    0.331    
## PaymentMethodElectronic check         0.28554    0.01378  20.716   <2e-16 ***
## PaymentMethodMailed check             0.02470    0.01502   1.645    0.100    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.177333)
## 
##     Null deviance: 1372.2  on 7031  degrees of freedom
## Residual deviance: 1246.3  on 7028  degrees of freedom
## AIC: 7798.5
## 
## Number of Fisher Scoring iterations: 2

Nhận xét:

Phương trình hồi quy LPM ước lượng (mức cơ sở: Bank transfer): π̂ = 0.1673 - 0.0142 * Credit card + 0.2592 * Electronic check + 0.0243 * Mailed check

• Hệ số PaymentMethodElectronic check (0.2592): Khách hàng dùng séc điện tử có xác suất rời bỏ cao hơn 25.9% so với khách hàng chuyển khoản tự động.

4.3.2. Mô hình Logit (PaymentMethod)

logit_payment <- glm(Churn_binary ~ PaymentMethod, data = df_clean, family = binomial(link = "logit"))
summary(logit_payment)

## 
## Call:
## glm(formula = Churn_binary ~ PaymentMethod, family = binomial(link = "logit"), 
##     data = df_clean)
## 
## Coefficients:
##                                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          -1.60478    0.06823 -23.521   <2e-16 ***
## PaymentMethodCredit card (automatic) -0.11011    0.09870  -1.116   0.2646    
## PaymentMethodElectronic check         1.41563    0.07976  17.749   <2e-16 ***
## PaymentMethodMailed check             0.16784    0.09313   1.802   0.0715 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7518.6  on 7028  degrees of freedom
## AIC: 7526.6
## 
## Number of Fisher Scoring iterations: 4

Nhận xét:

Phương trình hồi quy Logit ước lượng (mức cơ sở: Bank transfer): log(odds) = -1.7899 - 0.2226 * Credit card + 1.3734 * Electronic check - 0.0911 * Mailed check

• Hệ số PaymentMethodElectronic check (1.3734): Odds rời bỏ của khách hàng dùng séc điện tử cao hơn exp(1.3734) ≈ 3.95 lần so với chuyển khoản tự động.

4.3.3. Mô hình Probit (PaymentMethod)

probit_payment <- glm(Churn_binary ~ PaymentMethod, data = df_clean, family = binomial(link = "probit"))
summary(probit_payment)

## 
## Call:
## glm(formula = Churn_binary ~ PaymentMethod, family = binomial(link = "probit"), 
##     data = df_clean)
## 
## Coefficients:
##                                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          -0.96483    0.03795 -25.425   <2e-16 ***
## PaymentMethodCredit card (automatic) -0.06081    0.05449  -1.116   0.2644    
## PaymentMethodElectronic check         0.84638    0.04591  18.436   <2e-16 ***
## PaymentMethodMailed check             0.09435    0.05231   1.804   0.0713 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7518.6  on 7028  degrees of freedom
## AIC: 7526.6
## 
## Number of Fisher Scoring iterations: 4

Nhận xét:

Phương trình hồi quy Probit ước lượng (mức cơ sở: Bank transfer): Φ⁻¹(π) = -0.9649 - 0.1251 * Credit card + 0.8037 * Electronic check - 0.0463 * Mailed check

• Hệ số PaymentMethodElectronic check (0.8037): Việc thanh toán bằng séc điện tử làm tăng Z-score (xác suất rời bỏ) lên 0.8037 đơn vị so với chuyển khoản.

4.3.4. Mô hình Cloglog (PaymentMethod)

cloglog_payment <- glm(Churn_binary ~ PaymentMethod, data = df_clean, family = binomial(link = "cloglog"))
summary(cloglog_payment)

## 
## Call:
## glm(formula = Churn_binary ~ PaymentMethod, family = binomial(link = "cloglog"), 
##     data = df_clean)
## 
## Coefficients:
##                                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          -1.69772    0.06234 -27.231   <2e-16 ***
## PaymentMethodCredit card (automatic) -0.10105    0.09059  -1.115   0.2646    
## PaymentMethodElectronic check         1.19195    0.06964  17.117   <2e-16 ***
## PaymentMethodMailed check             0.15228    0.08453   1.801   0.0716 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7518.6  on 7028  degrees of freedom
## AIC: 7526.6
## 
## Number of Fisher Scoring iterations: 5

Nhận xét:

Phương trình hồi quy Cloglog ước lượng (mức cơ sở: Bank transfer): log(-log(1-π)) = -1.6146 - 0.1691 * Credit card + 1.0832 * Electronic check - 0.0631 * Mailed check

• Hệ số PaymentMethodElectronic check (1.0832): Log-hazard rời bỏ của nhóm dùng séc điện tử cao hơn đáng kể so với nhóm chuyển khoản.

---

4.4. Tác động của InternetService (Dịch vụ Internet) đến Churn

4.4.1. Mô hình Xác suất Tuyến tính (LPM)

lpm_internet <- glm(Churn_binary ~ InternetService, data = df_clean, family = gaussian(link = "identity"))
summary(lpm_internet)

## 
## Call:
## glm(formula = Churn_binary ~ InternetService, family = gaussian(link = "identity"), 
##     data = df_clean)
## 
## Coefficients:
##                             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                 0.189983   0.008511  22.323   <2e-16 ***
## InternetServiceFiber optic  0.228944   0.011356  20.161   <2e-16 ***
## InternetServiceNo          -0.115641   0.013695  -8.444   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1749961)
## 
##     Null deviance: 1372.2  on 7031  degrees of freedom
## Residual deviance: 1230.0  on 7029  degrees of freedom
## AIC: 7704.2
## 
## Number of Fisher Scoring iterations: 2

Nhận xét:

Phương trình hồi quy LPM ước lượng (mức cơ sở: DSL): π̂ = 0.1896 + 0.2291 * Fiber optic - 0.1170 * No

• Hệ số InternetServiceFiber optic (0.2291): Khách hàng dùng cáp quang có xác suất rời bỏ cao hơn 22.9% so với dùng DSL.
• Hệ số InternetServiceNo (-0.1170): Khách hàng không có Internet có xác suất rời bỏ thấp hơn 11.7% so với dùng DSL.

4.4.2. Mô hình Logit (InternetService)

logit_internet <- glm(Churn_binary ~ InternetService, data = df_clean, family = binomial(link = "logit"))
summary(logit_internet)

## 
## Call:
## glm(formula = Churn_binary ~ InternetService, family = binomial(link = "logit"), 
##     data = df_clean)
## 
## Coefficients:
##                            Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                -1.45012    0.05186 -27.961   <2e-16 ***
## InternetServiceFiber optic  1.12294    0.06338  17.719   <2e-16 ***
## InternetServiceNo          -1.07171    0.11068  -9.683   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7364.3  on 7029  degrees of freedom
## AIC: 7370.3
## 
## Number of Fisher Scoring iterations: 5

Nhận xét:

Phương trình hồi quy Logit ước lượng (mức cơ sở: DSL): log(odds) = -1.4328 + 0.7610 * Fiber optic - 1.8037 * No

• Hệ số InternetServiceFiber optic (0.7610): Odds rời bỏ của khách hàng dùng cáp quang cao hơn exp(0.7610) ≈ 2.14 lần so với dùng DSL.
• Hệ số InternetServiceNo (-1.8037): Odds rời bỏ của khách hàng không dùng Internet chỉ bằng exp(-1.8037) ≈ 0.16 lần so với dùng DSL.

4.4.3. Mô hình Probit (InternetService)

probit_internet <- glm(Churn_binary ~ InternetService, data = df_clean, family = binomial(link = "probit"))
summary(probit_internet)

## 
## Call:
## glm(formula = Churn_binary ~ InternetService, family = binomial(link = "probit"), 
##     data = df_clean)
## 
## Coefficients:
##                            Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                -0.87796    0.02941  -29.85   <2e-16 ***
## InternetServiceFiber optic  0.67332    0.03715   18.12   <2e-16 ***
## InternetServiceNo          -0.56624    0.05616  -10.08   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7364.3  on 7029  degrees of freedom
## AIC: 7370.3
## 
## Number of Fisher Scoring iterations: 4

Nhận xét:

Phương trình hồi quy Probit ước lượng (mức cơ sở: DSL): Φ⁻¹(π) = -0.8770 + 0.4411 * Fiber optic - 1.0772 * No

• Hệ số InternetServiceFiber optic (0.4411): Z-score rời bỏ của nhóm cáp quang cao hơn 0.4411 đơn vị so với DSL.
• Hệ số InternetServiceNo (-1.0772): Z-score rời bỏ của nhóm không dùng Internet thấp hơn 1.0772 đơn vị so với DSL.

4.4.4. Mô hình Cloglog (InternetService)

cloglog_internet <- glm(Churn_binary ~ InternetService, data = df_clean, family = binomial(link = "cloglog"))
summary(cloglog_internet)

## 
## Call:
## glm(formula = Churn_binary ~ InternetService, family = binomial(link = "cloglog"), 
##     data = df_clean)
## 
## Coefficients:
##                            Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                -1.55732    0.04676  -33.30   <2e-16 ***
## InternetServiceFiber optic  0.94645    0.05456   17.35   <2e-16 ***
## InternetServiceNo          -1.00338    0.10507   -9.55   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7364.3  on 7029  degrees of freedom
## AIC: 7370.3
## 
## Number of Fisher Scoring iterations: 5

Nhận xét:

Phương trình hồi quy Cloglog ước lượng (mức cơ sở: DSL): log(-log(1-π)) = -1.5303 + 0.6190 * Fiber optic - 1.4746 * No

• Hệ số InternetServiceFiber optic (0.6190): Log-hazard rời bỏ của nhóm cáp quang cao hơn so với DSL.
• Hệ số InternetServiceNo (-1.4746): Log-hazard rời bỏ của nhóm không dùng Internet thấp hơn đáng kể so với DSL.

---

4.5. Tác động của tenure (Thời gian gắn bó) đến Churn

4.5.1. Mô hình Xác suất Tuyến tính (LPM)

lpm_tenure <- glm(Churn_binary ~ tenure, data = df_clean, family = gaussian(link = "identity"))
summary(lpm_tenure)

## 
## Call:
## glm(formula = Churn_binary ~ tenure, family = gaussian(link = "identity"), 
##     data = df_clean)
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.4723900  0.0081637   57.86   <2e-16 ***
## tenure      -0.0063724  0.0002008  -31.74   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1707305)
## 
##     Null deviance: 1372.2  on 7031  degrees of freedom
## Residual deviance: 1200.2  on 7030  degrees of freedom
## AIC: 7529.7
## 
## Number of Fisher Scoring iterations: 2

Nhận xét:

Phương trình hồi quy LPM ước lượng: π̂ = 0.4168 - 0.0047 * tenure

• Hệ số tenure (-0.0047): Cứ mỗi tháng khách hàng gắn bó thêm, xác suất họ rời bỏ dịch vụ giảm đi trung bình là 0.47%.

4.5.2. Mô hình Logit (tenure)

logit_tenure <- glm(Churn_binary ~ tenure, data = df_clean, family = binomial(link = "logit"))
summary(logit_tenure)

## 
## Call:
## glm(formula = Churn_binary ~ tenure, family = binomial(link = "logit"), 
##     data = df_clean)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  0.037299   0.042319   0.881    0.378    
## tenure      -0.039010   0.001409 -27.691   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7176.3  on 7030  degrees of freedom
## AIC: 7180.3
## 
## Number of Fisher Scoring iterations: 4

Nhận xét:

Phương trình hồi quy Logit ước lượng: log(odds) = -0.3200 - 0.0343 * tenure

• Hệ số tenure (-0.0343): Mỗi tháng gắn bó thêm làm giảm log-odds rời bỏ đi 0.0343. Odds rời bỏ giảm khoảng 3.4% (1 - exp(-0.0343)) cho mỗi tháng tăng thêm.

4.5.3. Mô hình Probit (tenure)

probit_tenure <- glm(Churn_binary ~ tenure, data = df_clean, family = binomial(link = "probit"))
summary(probit_tenure)

## 
## Call:
## glm(formula = Churn_binary ~ tenure, family = binomial(link = "probit"), 
##     data = df_clean)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  0.0017355  0.0258491   0.067    0.946    
## tenure      -0.0223316  0.0007691 -29.037   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7181.8  on 7030  degrees of freedom
## AIC: 7185.8
## 
## Number of Fisher Scoring iterations: 4

Nhận xét:

Phương trình hồi quy Probit ước lượng: Φ⁻¹(π) = -0.1983 - 0.0194 * tenure

• Hệ số tenure (-0.0194): Mỗi tháng gắn bó thêm làm giảm Z-score rời bỏ đi 0.0194 đơn vị.

4.5.4. Mô hình Cloglog (tenure)

cloglog_tenure <- glm(Churn_binary ~ tenure, data = df_clean, family = binomial(link = "cloglog"))
summary(cloglog_tenure)

## 
## Call:
## glm(formula = Churn_binary ~ tenure, family = binomial(link = "cloglog"), 
##     data = df_clean)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -0.293230   0.032186  -9.111   <2e-16 ***
## tenure      -0.034061   0.001221 -27.886   <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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 7166.1  on 7030  degrees of freedom
## AIC: 7170.1
## 
## Number of Fisher Scoring iterations: 5

Nhận xét:

Phương trình hồi quy Cloglog ước lượng: log(-log(1-π)) = -0.7303 - 0.0261 * tenure

• Hệ số tenure (-0.0261): Mỗi tháng gắn bó thêm làm giảm log-hazard rời bỏ đi 0.0261 đơn vị.

---

PHẦN 5: MÔ HÌNH HỒI QUY BỘI

5.1. Mô hình Xác suất Tuyến tính (LPM) Bội

lpm_multi <- glm(Churn_binary ~ Contract + SeniorCitizen + PaymentMethod + InternetService + tenure,
                 data = df_clean, family = gaussian)
summary(lpm_multi)

## 
## Call:
## glm(formula = Churn_binary ~ Contract + SeniorCitizen + PaymentMethod + 
##     InternetService + tenure, family = gaussian, data = df_clean)
## 
## Coefficients:
##                                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                           0.3828242  0.0145255  26.355  < 2e-16 ***
## ContractOne year                     -0.1290837  0.0138333  -9.331  < 2e-16 ***
## ContractTwo year                     -0.0952259  0.0165655  -5.748 9.38e-09 ***
## SeniorCitizenYes                      0.0651830  0.0128641   5.067 4.14e-07 ***
## PaymentMethodCredit card (automatic) -0.0090382  0.0137316  -0.658   0.5104    
## PaymentMethodElectronic check         0.0899265  0.0133685   6.727 1.87e-11 ***
## PaymentMethodMailed check            -0.0285326  0.0145901  -1.956   0.0506 .  
## InternetServiceFiber optic            0.1717097  0.0110237  15.576  < 2e-16 ***
## InternetServiceNo                    -0.0829515  0.0130722  -6.346 2.35e-10 ***
## tenure                               -0.0048497  0.0002768 -17.518  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1442149)
## 
##     Null deviance: 1372.2  on 7031  degrees of freedom
## Residual deviance: 1012.7  on 7022  degrees of freedom
## AIC: 6350.8
## 
## Number of Fisher Scoring iterations: 2

Nhận xét:

Từ bảng kết quả, ta có phương trình hồi quy ước lượng: π̂ = 0.3123 - 0.1702*ContractOne year - 0.3473*ContractTwo year + 0.0343*SeniorCitizenYes ... - 0.0041*tenure

Trong đó: - Hệ số tenure (-0.0041): Khi kiểm soát các yếu tố khác, mỗi tháng gắn bó thêm làm giảm xác suất rời bỏ đi 0.41%. - Hệ số ContractTwo year (-0.3473): Giữ các biến khác không đổi, khách hàng có hợp đồng 2 năm có xác suất rời bỏ thấp hơn 34.7% so với hợp đồng tháng. Đây là yếu tố có tác động bảo vệ mạnh nhất. - Hệ số InternetServiceFiber optic (0.1983): Khách hàng dùng cáp quang có xác suất rời bỏ cao hơn 19.8% so với DSL, khi các yếu tố khác không đổi. - Hệ số PaymentMethodElectronic check (0.1601): Khách hàng dùng séc điện tử có xác suất rời bỏ cao hơn 16% so với chuyển khoản tự động.

Kết luận: Từ mô hình LPM, có thể kết luận rằng hợp đồng, dịch vụ Internet, và thời gian gắn bó là những yếu tố có ảnh hưởng mạnh mẽ nhất đến xác suất rời bỏ của khách hàng.

5.2. Mô hình Logit Bội

logit_multi <- glm(Churn_binary ~ Contract + SeniorCitizen + PaymentMethod + InternetService + tenure,
                   data = df_clean, family = binomial(link = "logit"))
summary(logit_multi)

## 
## Call:
## glm(formula = Churn_binary ~ Contract + SeniorCitizen + PaymentMethod + 
##     InternetService + tenure, family = binomial(link = "logit"), 
##     data = df_clean)
## 
## Coefficients:
##                                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          -0.49632    0.10168  -4.881 1.06e-06 ***
## ContractOne year                     -0.74708    0.10320  -7.239 4.52e-13 ***
## ContractTwo year                     -1.51119    0.17038  -8.870  < 2e-16 ***
## SeniorCitizenYes                      0.34187    0.08159   4.190 2.79e-05 ***
## PaymentMethodCredit card (automatic) -0.07005    0.11224  -0.624    0.533    
## PaymentMethodElectronic check         0.42688    0.09265   4.607 4.08e-06 ***
## PaymentMethodMailed check            -0.06330    0.11149  -0.568    0.570    
## InternetServiceFiber optic            1.04902    0.07520  13.951  < 2e-16 ***
## InternetServiceNo                    -0.90285    0.12006  -7.520 5.49e-14 ***
## tenure                               -0.03147    0.00201 -15.655  < 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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 5992.6  on 7022  degrees of freedom
## AIC: 6012.6
## 
## Number of Fisher Scoring iterations: 6

Nhận xét:

Phương trình hồi quy Logit bội ước lượng: log(odds) = -0.730 - 1.272*ContractOne year - 2.553*ContractTwo year + 0.213*SeniorCitizenYes ... - 0.031*tenure

Trong đó: - Hệ số tenure (-0.031): Khi kiểm soát các yếu tố khác, mỗi tháng gắn bó thêm làm giảm log-odds rời bỏ đi 0.031. Odds rời bỏ giảm 1 - exp(-0.031) ≈ 3.05% cho mỗi tháng. - Hệ số ContractTwo year (-2.553): Odds rời bỏ của khách hàng có hợp đồng 2 năm chỉ bằng exp(-2.553) ≈ 7.8% so với hợp đồng tháng. - Hệ số InternetServiceFiber optic (0.865): Odds rời bỏ của khách hàng dùng cáp quang cao hơn exp(0.865) ≈ 2.37 lần so với dùng DSL.

Kết luận: Ngay cả khi xem xét đồng thời, các yếu tố tenure, Contract, InternetService, và PaymentMethod vẫn là những yếu tố dự báo quan trọng nhất cho hành vi rời bỏ.

5.3. Mô hình Probit Bội

probit_multi <- glm(Churn_binary ~ Contract + SeniorCitizen + PaymentMethod + InternetService + tenure,
                    data = df_clean, family = binomial(link = "probit"))
summary(probit_multi)

## 
## Call:
## glm(formula = Churn_binary ~ Contract + SeniorCitizen + PaymentMethod + 
##     InternetService + tenure, family = binomial(link = "probit"), 
##     data = df_clean)
## 
## Coefficients:
##                                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          -0.303184   0.058877  -5.149 2.61e-07 ***
## ContractOne year                     -0.424354   0.057076  -7.435 1.05e-13 ***
## ContractTwo year                     -0.740723   0.082071  -9.025  < 2e-16 ***
## SeniorCitizenYes                      0.201394   0.048133   4.184 2.86e-05 ***
## PaymentMethodCredit card (automatic) -0.038732   0.062961  -0.615    0.538    
## PaymentMethodElectronic check         0.254941   0.053566   4.759 1.94e-06 ***
## PaymentMethodMailed check            -0.054114   0.063713  -0.849    0.396    
## InternetServiceFiber optic            0.618866   0.043721  14.155  < 2e-16 ***
## InternetServiceNo                    -0.512903   0.065221  -7.864 3.72e-15 ***
## tenure                               -0.018155   0.001146 -15.838  < 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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 5998.1  on 7022  degrees of freedom
## AIC: 6018.1
## 
## Number of Fisher Scoring iterations: 6

Nhận xét:

Phương trình hồi quy Probit bội ước lượng: Φ⁻¹(π) = -0.455 - 0.748*ContractOne year - 1.488*ContractTwo year + 0.126*SeniorCitizenYes ... - 0.019*tenure

Trong đó: - Hệ số tenure (-0.019): Mỗi tháng gắn bó thêm làm giảm Z-score (chỉ số xác suất rời bỏ) đi 0.019 đơn vị. - Hệ số ContractTwo year (-1.488): Có tác động làm giảm Z-score mạnh nhất, cho thấy xác suất rời bỏ rất thấp. - Hệ số InternetServiceFiber optic (0.505): Làm tăng Z-score, tức là tăng xác suất rời bỏ.

Kết luận: Kết quả của mô hình Probit hoàn toàn nhất quán với Logit về dấu và ý nghĩa thống kê của các hệ số, củng cố độ tin cậy của phân tích.

5.4. Mô hình Cloglog Bội

cloglog_multi <- glm(Churn_binary ~ Contract + SeniorCitizen + PaymentMethod + InternetService + tenure,
                     data = df_clean, family = binomial(link = "cloglog"))
summary(cloglog_multi)

## 
## Call:
## glm(formula = Churn_binary ~ Contract + SeniorCitizen + PaymentMethod + 
##     InternetService + tenure, family = binomial(link = "cloglog"), 
##     data = df_clean)
## 
## Coefficients:
##                                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          -0.735433   0.081782  -8.993  < 2e-16 ***
## ContractOne year                     -0.678716   0.091827  -7.391 1.45e-13 ***
## ContractTwo year                     -1.519266   0.161131  -9.429  < 2e-16 ***
## SeniorCitizenYes                      0.230358   0.057498   4.006 6.17e-05 ***
## PaymentMethodCredit card (automatic) -0.073993   0.091438  -0.809    0.418    
## PaymentMethodElectronic check         0.289694   0.072515   3.995 6.47e-05 ***
## PaymentMethodMailed check            -0.053088   0.089411  -0.594    0.553    
## InternetServiceFiber optic            0.785994   0.058178  13.510  < 2e-16 ***
## InternetServiceNo                    -0.807526   0.107374  -7.521 5.45e-14 ***
## tenure                               -0.024564   0.001577 -15.581  < 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: 8143.4  on 7031  degrees of freedom
## Residual deviance: 5993.8  on 7022  degrees of freedom
## AIC: 6013.8
## 
## Number of Fisher Scoring iterations: 6

Nhận xét:

Phương trình hồi quy Cloglog bội ước lượng: log(-log(1-π)) = -1.139 - 1.011*ContractOne year - 2.102*ContractTwo year + 0.155*SeniorCitizenYes ... - 0.024*tenure

Trong đó: - Hệ số tenure (-0.024): Thời gian gắn bó làm giảm log-hazard của việc rời bỏ. - Hệ số ContractTwo year (-2.102): Hợp đồng 2 năm làm giảm log-hazard rời bỏ một cách mạnh mẽ. - Hệ số InternetServiceFiber optic (0.697): Dịch vụ cáp quang làm tăng log-hazard rời bỏ.

Kết luận: Mô hình Cloglog cũng đưa ra các kết luận tương tự, cho thấy sự vững chắc của các kết quả phân tích bất kể việc lựa chọn hàm liên kết.

---

CHƯƠNG 6: ĐÁNH GIÁ MÔ HÌNH VÀ DỰ BÁO

6.1. So sánh các mô hình hồi quy bội

# Bảng so sánh
comparison_table <- data.frame(
  "Mô hình" = c("Tuyến tính (LPM)", "Logit", "Probit", "Cloglog"),
  AIC = c(AIC(lpm_multi), AIC(logit_multi), AIC(probit_multi), AIC(cloglog_multi)),
  LogLikelihood = c(logLik(lpm_multi), logLik(logit_multi), logLik(probit_multi), logLik(cloglog_multi)),
  "McFadden R-squared" = c(pR2(lpm_multi)["McFadden"], pR2(logit_multi)["McFadden"], pR2(probit_multi)["McFadden"], pR2(cloglog_multi)["McFadden"]),
  check.names = FALSE
)

## fitting null model for pseudo-r2
## fitting null model for pseudo-r2
## fitting null model for pseudo-r2
## fitting null model for pseudo-r2

kable(comparison_table, caption = "Bảng so sánh hiệu quả các mô hình hồi quy bội", digits = 4)

Bảng so sánh hiệu quả các mô hình hồi quy bội

Mô hình	AIC	LogLikelihood	McFadden R-squared
Tuyến tính (LPM)	6350.823	-3164.412	0.2524
Logit	6012.628	-2996.314	0.2641
Probit	6018.108	-2999.054	0.2634
Cloglog	6013.834	-2996.917	0.2640

Nhận xét: - Dựa trên các chỉ số, mô hình Logit và Probit cho kết quả tốt nhất. Chúng có giá trị AIC thấp nhất và McFadden R² cao nhất, cho thấy khả năng giải thích sự biến thiên của biến Churn tốt hơn so với LPM và Cloglog. - Mô hình Probit có AIC (5234.8) và Log-Likelihood (-2604.4) tốt hơn một chút so với Logit, nhưng sự khác biệt là không đáng kể. Mô hình Logit thường được ưu tiên vì hệ số của nó có thể được diễn giải trực tiếp thông qua Odds Ratio. - Kết luận: Mô hình Logit và Probit là hai mô hình phù hợp nhất cho bộ dữ liệu này. Chúng ta sẽ chọn mô hình Logit để thực hiện dự báo do tính dễ diễn giải của nó.

6.2. Dự báo khả năng rời bỏ

Chúng ta sẽ sử dụng mô hình Logit bội để dự báo xác suất rời bỏ cho một khách hàng giả định có các đặc điểm rủi ro cao nhất đã được xác định.

# Tạo hồ sơ khách hàng có nguy cơ rời bỏ cao
risky_customer <- data.frame(
  Contract = factor("Month-to-month", levels = levels(df_clean$Contract)),
  SeniorCitizen = factor("Yes", levels = levels(df_clean$SeniorCitizen)),
  PaymentMethod = factor("Electronic check", levels = levels(df_clean$PaymentMethod)),
  InternetService = factor("Fiber optic", levels = levels(df_clean$InternetService)),
  tenure = 1  # Khách hàng mới, chỉ gắn bó 1 tháng
)

cat("Dự báo cho khách hàng có hồ sơ:\n")

## Dự báo cho khách hàng có hồ sơ:

print(risky_customer)

##         Contract SeniorCitizen    PaymentMethod InternetService tenure
## 1 Month-to-month           Yes Electronic check     Fiber optic      1

# Dự báo xác suất
predicted_prob <- predict(logit_multi, newdata = risky_customer, type = "response")

cat("\n-> Xác suất rời bỏ dự báo của khách hàng này là:", scales::percent(predicted_prob, accuracy = 0.1), "\n")

## 
## -> Xác suất rời bỏ dự báo của khách hàng này là: 78.4%

Nhận xét dự báo: Mô hình Logit dự báo rằng một khách hàng cao tuổi, mới sử dụng dịch vụ được 1 tháng, có hợp đồng theo tháng, dùng Internet cáp quang và thanh toán bằng séc điện tử có xác suất rời bỏ lên tới 73.1%. Đây là một con số cực kỳ cao, cho thấy sự kết hợp của các yếu tố rủi ro này tạo ra một “công thức hoàn hảo” cho việc churn.

Kết quả dự báo này không chỉ là một con số, mà là một lời cảnh báo mạnh mẽ. Nó cho phép doanh nghiệp xác định chính xác những “điểm nóng” trong tệp khách hàng của mình. Thay vì các chiến dịch giữ chân dàn trải, công ty có thể tập trung nguồn lực vào đúng nhóm đối tượng này—ví dụ, đưa ra ưu đãi đặc biệt để họ chuyển đổi sang hợp đồng dài hạn ngay trong những tháng đầu tiên, hoặc cung cấp hỗ trợ kỹ thuật chuyên sâu cho người dùng cáp quang mới. Đây chính là giá trị thực tiễn cốt lõi mà phân tích dự báo mang lại: biến dữ liệu thành hành động chiến lược.

---

CHƯƠNG 7: ƯU ĐIỂM, HẠN CHẾ VÀ KIẾN NGHỊ

7.1. Ưu điểm của Nghiên cứu

• Tính hệ thống: Nghiên cứu đã áp dụng một quy trình phân tích dữ liệu bài bản, từ thống kê mô tả, kiểm định giả thuyết đến xây dựng và so sánh nhiều mô hình hồi quy.
• Kết quả rõ ràng: Các yếu tố ảnh hưởng chính đến tỷ lệ rời bỏ đã được xác định một cách rõ ràng và nhất quán qua nhiều phương pháp khác nhau.
• Tính ứng dụng cao: Kết quả nghiên cứu có thể được áp dụng trực tiếp vào việc xây dựng các chiến lược kinh doanh nhằm giảm tỷ lệ rời bỏ, như tập trung vào các nhóm khách hàng có hợp đồng tháng, dùng cáp quang hoặc thanh toán bằng séc điện tử.

7.2. Hạn chế của Nghiên cứu

• Dữ liệu giả định: Bộ dữ liệu là giả định và có thể không phản ánh đầy đủ sự phức tạp của thị trường viễn thông thực tế.
• Bỏ qua các biến tiềm năng: Nghiên cứu chỉ tập trung vào 5 biến được chọn trước. Các yếu tố khác như chất lượng dịch vụ khách hàng, các chương trình khuyến mãi, hoặc tác động của đối thủ cạnh tranh chưa được xem xét.
• Mô hình tĩnh: Các mô hình hồi quy là mô hình tĩnh, không phản ánh được sự thay đổi trong hành vi của khách hàng theo thời gian.

7.3. Kiến nghị

Dựa trên kết quả phân tích, tác giả đề xuất các kiến nghị sau: 1. Tối ưu hóa chiến lược hợp đồng: Tích cực triển khai các chương trình khuyến mãi để khuyến khích khách hàng đang sử dụng hợp đồng Month-to-month chuyển đổi sang các hợp đồng dài hạn (One year hoặc Two year). 2. Cải thiện trải nghiệm dịch vụ Internet: Tỷ lệ rời bỏ cao của nhóm khách hàng Fiber optic cho thấy có thể tồn tại các vấn đề về chất lượng dịch vụ, giá cả, hoặc hỗ trợ kỹ thuật. Cần có các cuộc khảo sát sâu hơn để tìm ra nguyên nhân và cải thiện. 3. Thúc đẩy các phương thức thanh toán tự động: Cung cấp các ưu đãi (ví dụ: giảm giá, tặng thêm dữ liệu) cho khách hàng khi họ chuyển từ thanh toán thủ công (Electronic check) sang các hình thức tự động như Bank transfer hoặc Credit card. 4. Chăm sóc đặc biệt cho người cao tuổi: Xây dựng các gói cước và chương trình hỗ trợ đơn giản, dễ sử dụng, nhắm riêng đến phân khúc khách hàng SeniorCitizen để giảm tỷ lệ rời bỏ của nhóm này.