Nhiệm vụ tuần 4

PHẦN 1: CHUẨN BỊ VÀ TÌM HIỂU DỮ LIỆU

1.1 Đọc dữ liệu

library(readxl)

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

tcc <- read_excel("D:/THU 2/chieut2 nv4.xlsx")

1.2 Sơ lược về bộ 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" ...

Nội dung của bộ dữ liệu là khảo sát quyết định ngưng sử dụng dịch vụ Internet của khách hàng, bao gồm: 8 biến, 7.043 quan sát.

Tên biến	Mô tả	Loại biến	Giá trị/Đơn vị
CustomerID	Mã định danh duy nhất cho mỗi khách hàng	Định danh (ID)	Chuỗi ký tự/ số
Gender	Giới tính khách hàng	Danh mục	Male, Female
InternetService	Loại dịch vụ Internet đang sử dụng	Danh mục	Fiber optic (cáp quang), DSL (đường dây thuê bao số)
Contract	Hình thức hợp đồng	Danh mục	Month-to-month (hàng tháng), One year (1 năm), Two year (2 năm)
PaymentMethod	Phương thức thanh toán	Danh mục	Electronic check (séc điện tử), Mailed check (séc gửi qua bưu điện), Credit card (thẻ tín dụng), Bank transfer (chuyển khoản)
MonthlyCharges	Phí dịch vụ hàng tháng	Số liên tục	Đơn vị USD
Churn1	Cờ nhị phân thể hiện quyết định ngưng sử dụng dịch vụ	Nhị phân	1 = Yes (ngưng), 0 = No (không ngưng)
Churn	Tương tự Churn1 (có thể là bản sao hoặc tên cũ của biến)	Nhị phân	Yes / No (chuỗi ký tự)

PHẦN 2: PHÂN TÍCH VÀ MÔ TẢ CÁC BIẾN ĐỊNH TÍNH

2.1 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:

Tỷ lệ nam và nữ gần như cân bằng:

Nữ chiếm 49,52% (3.488/7.043)

Nam chiếm 50,48% (3.555/7.043)

Chênh lệch giữa hai nhóm chỉ khoảng 0,96 điểm phần trăm, tức là không đáng kể.

Do phân phối gần như đồng đều, biến Gender khó gây sai lệch lớn khi phân tích mối liên hệ với quyết định churn; tuy nhiên vẫn nên kiểm định tác động giới tính nếu cần mô hình hóa.

2.2 InternetService

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 1: Internet Service of Customers') +
  scale_fill_brewer(palette = "Set3") +
  theme(plot.title = element_text(hjust = 0.5, face = 'bold'))  

Nhận xét:

Fiber optic chiếm tỷ lệ cao nhất với 3.096 khách hàng, tương đương 43,96% tổng số.

DSL đứng thứ hai, có 2.421 khách hàng, chiếm 34,37%.

Đáng chú ý nhóm No (không sử dụng dịch vụ internet) vẫn còn tới 1.526 khách, chiếm 21,67%—tương đương hơn 1/5 cơ sở dữ liệu.

2.3 Contract

Tần số, tần suất

# Lập bảng tần số
contract_f <- table(tcc$Contract)

# Lập bảng tần suất
contract_p <- prop.table(contract_f)*100

# Kết hợp thành một bảng
contract <- data.frame(
  Category = names(contract_f),
  Frequency = as.vector(contract_f),
  Percentage = round(as.vector(contract_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 1: Contract of Customers') +
  scale_fill_brewer(palette = "Set3") +
  theme(plot.title = element_text(hjust = 0.5, face = 'bold'))  

Nhận xét:

Month-to-month chiếm áp đảo với 3.875 khách (55,02%).

Two year đứng thứ hai với 1.695 khách (24,07%).

One year ít nhất, 1.473 khách (20,91%).

2.4 PaymentMethod

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 1: Payment Method of Customers') +
  scale_fill_brewer(palette = "Set3") +
  theme(plot.title = element_text(hjust = 0.5, face = 'bold'))  

Nhận xét:

Electronic check chiếm tỷ lệ cao nhất với 2.365 khách (33,58%), cho thấy khách hàng thường ưu tiên phương thức thanh toán trực tuyến nhanh gọn.

Các phương thức tự động (“Bank transfer” và “Credit card”) tổng cộng gần 44% (21,92% + 21,61%), cho thấy khoảng một nửa khách hàng có hình thức thanh toán không cần can thiệp thủ công.

Mailed check vẫn chiếm hơn 22% (1.612 khách), tức còn khá nhiều khách hàng dùng phương thức truyền thống.

2.5 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 1: Churn of Customers') +
  scale_fill_brewer(palette = "Set3") +
  theme(plot.title = element_text(hjust = 0.5, face = 'bold'))  

Nhận xét:

Tỷ lệ khách hàng không ngưng sử dụng (No) chiếm 73,46% (5.174/7.043), còn lại 26,54% (1.869/7.043) đã ngưng sử dụng dịch vụ.

Mức churn ~26,5% khá cao, cho thấy hơn 1/4 khách hàng rời đi — đây là vấn đề quan trọng cần tập trung cải thiện.

PHẦN 3: ƯỚC LƯỢNG KHOẢNG VÀ KIỂM ĐỊNH GIẢ THUYẾT CHO TỶ LỆ

3.1 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

3.2 InternetService

# Số lượng DSL
dsl <- sum(tcc$InternetService == "DSL")
# Tổng số khách hàng
total <- length(tcc$gender)
# Kiểm định tỷ lệ
prop.test(dsl, total, p = 0.35, conf.level = 0.95)

## 
##  1-sample proportions test with continuity correction
## 
## data:  dsl out of total, null probability 0.35
## X-squared = 1.1837, df = 1, p-value = 0.2766
## alternative hypothesis: true p is not equal to 0.35
## 95 percent confidence interval:
##  0.3326707 0.3549919
## sample estimates:
##         p 
## 0.3437456

3.3 Contract

# Số lượng One year
one_yr <- sum(tcc$Contract == "Oneyear")
# Tổng số khách hàng
total <- length(tcc$gender)
# Kiểm định tỷ lệ
prop.test(one_yr, total, p = 0.21, conf.level = 0.95)

## 
##  1-sample proportions test with continuity correction
## 
## data:  one_yr out of total, null probability 0.21
## X-squared = 1870.9, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.21
## 95 percent confidence interval:
##  0.0000000000 0.0006796279
## sample estimates:
## p 
## 0

3.4 PaymentMethod

# Số lượng Credit card (automatic)
credit <- sum(tcc$PaymentMethod == "Credit card (automatic)")
# Tổng số khách hàng
total <- length(tcc$gender)
# Kiểm định tỷ lệ
prop.test(credit, total, p = 0.22, conf.level = 0.95)

## 
##  1-sample proportions test with continuity correction
## 
## data:  credit out of total, null probability 0.22
## X-squared = 0.6014, df = 1, p-value = 0.438
## alternative hypothesis: true p is not equal to 0.22
## 95 percent confidence interval:
##  0.2065751 0.2259389
## sample estimates:
##         p 
## 0.2161011

3.5 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

PHẦN 4: PHÂN TÍCH MỐI QUAN HỆ GIỮA CÁC BIẾN ĐỊNH TÍNH

4.1 InternetService và Contract

Bảng tần suất chéo

is_contract <- table(tcc$InternetService,tcc$Contract)
is_contract

##              
##               Month-to-month One year Two year
##   DSL                   1223      570      628
##   Fiber optic           2128      539      429
##   No                     524      364      638

4.2 InternetService và Churn

Bảng tần suất chéo

is_churn <- table(tcc$InternetService,tcc$Churn)
is_churn

##              
##                 No  Yes
##   DSL         1962  459
##   Fiber optic 1799 1297
##   No          1413  113

4.3 Contract và PaymentMethod

Bảng tần suất chéo

con_pm <- table(tcc$Contract,tcc$PaymentMethod)
con_pm 

##                 
##                  Bank transfer (automatic) Credit card (automatic)
##   Month-to-month                       589                     543
##   One year                             391                     398
##   Two year                             564                     581
##                 
##                  Electronic check Mailed check
##   Month-to-month             1850          893
##   One year                    347          337
##   Two year                    168          382