TIỂU LUẬN CUỐI KỲ
Đỗ Nguyễn Nhật Minh & Đặng Thùy Dung; Giảng viên: ThS. Trần Mạnh Tường
2025-10
LỜI CẢM ƠN
1 CHƯƠNG 1: GIỚI THIỆU
1.1 Lý do chọn đề tài
1.2 Mục tiêu nghiên cứu
1.3 Đối tượng và phạm vi nghiên cứu
1.4 Phương pháp nghiên cứu
2 CHƯƠNG 2: PHƯƠNG PHÁP NGHIÊN CỨU VÀ XỬ LÝ DỮ LIỆU
2.1 Cơ sở lý thuyết
2.2 Giới thiệu bộ dữ liệu
2.2.1 Tổng quan bộ dữ liệu:
library(dplyr)## Warning: package 'dplyr' was built under R version 4.4.3##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyr)## Warning: package 'tidyr' was built under R version 4.4.3library(readxl)## Warning: package 'readxl' was built under R version 4.4.3library(rstudioapi)## Warning: package 'rstudioapi' was built under R version 4.4.3# Đặt thư mục làm việc về vị trí file .Rmd
setwd(dirname(rstudioapi::getSourceEditorContext()$path))
# Đọc dữ liệu Excel
data <- read_excel("C:/Users/PC/OneDrive - UFM/Documents/customers_data.xlsx")
# 2. Xem tổng quan kích thước dữ liệu ---------------------------------------
num_rows <- nrow(data) # số quan sát
num_cols <- ncol(data) # số biến
cat("Số quan sát:", num_rows, "\n")## Số quan sát: 100000cat("Số biến:", num_cols, "\n")## Số biến: 12# 3. Tên các biến trong bộ dữ liệu ------------------------------------------
names(data)## [1] "id" "age" "gender"
## [4] "income" "education" "region"
## [7] "loyalty_status" "purchase_frequency" "purchase_amount"
## [10] "product_category" "promotion_usage" "satisfaction_score"# 4. Kiểm tra kiểu dữ liệu của từng biến -----------------------------------
sapply(data, class)## id age gender income
## "numeric" "numeric" "character" "numeric"
## education region loyalty_status purchase_frequency
## "character" "character" "character" "character"
## purchase_amount product_category promotion_usage satisfaction_score
## "numeric" "character" "numeric" "numeric"# 5. Kiểm tra giá trị thiếu --------------------------------------------------
missing_total <- sum(is.na(data))
missing_by_var <- colSums(is.na(data))
cat("Tổng số giá trị thiếu:", missing_total, "\n")## Tổng số giá trị thiếu: 0missing_by_var## id age gender income
## 0 0 0 0
## education region loyalty_status purchase_frequency
## 0 0 0 0
## purchase_amount product_category promotion_usage satisfaction_score
## 0 0 0 0# 6. Kiểm tra các dòng bị trùng lặp -----------------------------------------
dup_total <- sum(duplicated(data))
cat("Số quan sát trùng lặp:", dup_total, "\n")## Số quan sát trùng lặp: 0Bộ dữ liệu được sử dụng trong nghiên cứu có tên là “Customer Purchases Behaviour Dataset”, được công bố trên nền tảng Kaggle bởi tác giả Sanyam Goyal. Đây là một bộ dữ liệu mô phỏng (simulated dataset) phản ánh hành vi mua sắm của khách hàng trong lĩnh vực thương mại điện tử, được thiết kế với mục tiêu phục vụ cho mục đích nghiên cứu, phân tích dữ liệu và xây dựng mô hình dự báo trong marketing.
Cụ thể, bộ dữ liệu gồm 100.000 quan sát (rows) và 12 biến (columns), mỗi quan sát tương ứng với một khách hàng giả định. Các biến bao phủ cả đặc điểm nhân khẩu học và hành vi mua hàng bao gồm: id, age, gender, income, education, region, loyalty_status, purchase_frequency, purchase_amount, product_category, promotion_usage, satisfaction_score.
2.2.2 Chuyển kiểu dữ liệu phù hợp
# 7. Xử lý dữ liệu
data$gender <- as.factor(data$gender)
data$region <- as.factor(data$region)
data$loyalty_status <- as.factor(data$loyalty_status)
data$promotion_usage <- as.factor(data$promotion_usage)
data$income <- as.numeric(data$income)
data$purchase_amount <- as.numeric(data$purchase_amount)
str(data)## tibble [100,000 × 12] (S3: tbl_df/tbl/data.frame)
## $ id : num [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
## $ age : num [1:100000] 27 29 37 30 31 38 32 24 27 28 ...
## $ gender : Factor w/ 2 levels "Female","Male": 2 2 2 2 1 2 1 1 2 1 ...
## $ income : num [1:100000] 40682 15317 38849 11568 46952 ...
## $ education : chr [1:100000] "Bachelor" "Masters" "Bachelor" "HighSchool" ...
## $ region : Factor w/ 4 levels "East","North",..: 1 4 4 3 2 3 3 2 1 2 ...
## $ loyalty_status : Factor w/ 3 levels "Gold","Regular",..: 1 2 3 2 2 3 3 2 2 2 ...
## $ purchase_frequency: chr [1:100000] "frequent" "rare" "rare" "frequent" ...
## $ purchase_amount : num [1:100000] 18249 4557 11822 4098 19685 ...
## $ product_category : chr [1:100000] "Books" "Clothing" "Clothing" "Food" ...
## $ promotion_usage : Factor w/ 2 levels "0","1": 1 2 1 1 2 1 1 1 1 1 ...
## $ satisfaction_score: num [1:100000] 6 6 6 7 5 5 7 5 5 6 ...Sau khi nhập dữ liệu, nhóm nghiên cứu tiến hành kiểm tra và chuyển đổi kiểu dữ liệu của các biến để đảm bảo tính phù hợp cho các bước phân tích thống kê và mô hình hóa. Kết quả cho thấy bộ dữ liệu bao gồm 100.000 quan sát và 12 biến, trong đó:
Các biến định danh và định lượng như id, age, income, purchase_amount, satisfaction_score được lưu dưới dạng integer hoặc numeric, thuận lợi cho việc tính toán thống kê và hồi quy.
Các biến phân loại như gender, region, loyalty_status và promotion_usage được chuyển sang kiểu factor, giúp mô hình nhận diện rõ các nhóm giá trị rời rạc.
Các biến mô tả như education, purchase_frequency và product_category giữ nguyên kiểu character, phù hợp cho các thao tác lọc, nhóm hoặc trực quan hóa sau này.
Xem 5 dòng đầu tiên
# Xem 5 dòng đầu tiên
head(data, 5)## # A tibble: 5 × 12
## id age gender income education region loyalty_status purchase_frequency
## <dbl> <dbl> <fct> <dbl> <chr> <fct> <fct> <chr>
## 1 1 27 Male 40682 Bachelor East Gold frequent
## 2 2 29 Male 15317 Masters West Regular rare
## 3 3 37 Male 38849 Bachelor West Silver rare
## 4 4 30 Male 11568 HighSchool South Regular frequent
## 5 5 31 Female 46952 College North Regular occasional
## # ℹ 4 more variables: purchase_amount <dbl>, product_category <chr>,
## # promotion_usage <fct>, satisfaction_score <dbl>2.2.3 Mô tả ý nghĩa các biến:
# Bảng mô tả ý nghĩa các biến trong bộ dữ liệu
# ============================================================
# BẢNG MÔ TẢ CÁC BIẾN TRONG BỘ DỮ LIỆU
# ============================================================
library(knitr)
library(kableExtra)## Warning: package 'kableExtra' was built under R version 4.4.3##
## Attaching package: 'kableExtra'## The following object is masked from 'package:dplyr':
##
## group_rows# Tạo bảng mô tả với 4 cột: Biến, Ý nghĩa, Kiểu dữ liệu, Loại biến
variable_description <- data.frame(
"Biến" = c("id", "age", "gender", "income", "education", "region",
"loyalty_status", "purchase_frequency", "purchase_amount",
"product_category", "promotion_usage", "satisfaction_score"),
"Ý nghĩa" = c(
"Mã định danh khách hàng",
"Tuổi của khách hàng",
"Giới tính của khách hàng (Nam/Nữ)",
"Thu nhập hằng năm (USD)",
"Trình độ học vấn (HighSchool/College/Bachelor/Masters)",
"Khu vực sinh sống",
"Mức độ trung thành (Bronze/Silver/Gold/Platinum)",
"Tần suất mua hàng trong kỳ",
"Số tiền chi tiêu trong một lần mua (USD)",
"Loại sản phẩm đã mua",
"Có sử dụng khuyến mãi hay không (Yes/No)",
"Mức độ hài lòng (1–10)"
),
"Kiểu dữ liệu" = c(
"integer", # id
"integer", # age
"character", # gender
"integer", # income
"character", # education
"character", # region
"character", # loyalty_status
"character", # purchase_frequency
"integer", # purchase_amount
"character", # product_category
"integer", # promotion_usage
"integer" # satisfaction_score
),
"Loại biến" = c(
"Định danh", # id
"Định lượng", # age
"Định tính", # gender
"Định lượng", # income
"Định tính", # education
"Định tính", # region
"Định tính", # loyalty_status
"Định tính", # purchase_frequency
"Định lượng", # purchase_amount
"Định tính", # product_category
"Định lượng", # promotion_usage
"Định lượng" # satisfaction_score
)
)
# Hiển thị bảng đẹp
variable_description %>%
kbl(caption = "Bảng 1. Mô tả các biến trong bộ dữ liệu") %>%
kable_styling(
full_width = FALSE,
position = "center",
bootstrap_options = c("striped", "hover", "condensed", "responsive")
)## Warning in attr(x, "align"): 'xfun::attr()' is deprecated.
## Use 'xfun::attr2()' instead.
## See help("Deprecated")| Biến | Ý.nghĩa | Kiểu.dữ.liệu | Loại.biến |
|---|---|---|---|
| id | Mã định danh khách hàng | integer | Định danh |
| age | Tuổi của khách hàng | integer | Định lượng |
| gender | Giới tính của khách hàng (Nam/Nữ) | character | Định tính |
| income | Thu nhập hằng năm (USD) | integer | Định lượng |
| education | Trình độ học vấn (HighSchool/College/Bachelor/Masters) | character | Định tính |
| region | Khu vực sinh sống | character | Định tính |
| loyalty_status | Mức độ trung thành (Bronze/Silver/Gold/Platinum) | character | Định tính |
| purchase_frequency | Tần suất mua hàng trong kỳ | character | Định tính |
| purchase_amount | Số tiền chi tiêu trong một lần mua (USD) | integer | Định lượng |
| product_category | Loại sản phẩm đã mua | character | Định tính |
| promotion_usage | Có sử dụng khuyến mãi hay không (Yes/No) | integer | Định lượng |
| satisfaction_score | Mức độ hài lòng (1–10) | integer | Định lượng |
Trong đó:
Biến định tính bao gồm 6 biến : gender, education, region, loyalty_status, product_category, promotion_usage, purchase_frequenc.
Biến định lượng bao gồm: age, income, purchase_amount, satisfaction_score
3 CHƯƠNG 3. PHÂN TÍCH DỮ LIỆU
3.1 Phân tích đơn biến
3.1.1 Biến Income (Thu nhập bình quân theo năm của khách hàng)
library(dplyr)
library(kableExtra)
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.4.3# Tạo nhóm thu nhập thủ công
data <- data %>%
mutate(income_group = case_when(
income >= 5000 & income < 16250 ~ "Thấp",
income >= 16250 & income < 27500 ~ "Trung bình",
income >= 27500 & income < 38750 ~ "Cao",
income >= 38750 & income <= 50000 ~ "Rất cao"
))
# Bảng tần suất và tỉ lệ
freq_income <- data %>%
group_by(income_group) %>%
summarise(Tanso = n()) %>%
mutate(Tyle = round(Tanso / sum(Tanso) * 100, 2))
# Hiển thị bảng
freq_income %>%
kbl(caption = "Bảng 2. Phân bố khách hàng theo nhóm thu nhập (4 tổ)") %>%
kable_styling(full_width = F, position = "center")## Warning in attr(x, "align"): 'xfun::attr()' is deprecated.
## Use 'xfun::attr2()' instead.
## See help("Deprecated")| income_group | Tanso | Tyle |
|---|---|---|
| Cao | 25194 | 25.19 |
| Rất cao | 24999 | 25.00 |
| Thấp | 24944 | 24.94 |
| Trung bình | 24863 | 24.86 |
# Biểu đồ
ggplot(freq_income, aes(x = income_group, y = Tanso, fill = income_group)) +
geom_bar(stat = "identity") +
labs(title = "Phân bố khách hàng theo nhóm thu nhập",
x = "Nhóm thu nhập (USD)", y = "Tần số") +
theme_minimal() +
theme(legend.position = "none")
summary_income <- data %>%
summarise(Min = min(income),
Max = max(income),
Mean = mean(income),
Median = median(income),
SD = sd(income))
summary_income %>%
kbl(caption = "Bảng 3. Thống kê mô tả biến Income") %>%
kable_styling(full_width = F, position = "center")## Warning in attr(x, "align"): 'xfun::attr()' is deprecated.
## Use 'xfun::attr2()' instead.
## See help("Deprecated")| Min | Max | Mean | Median | SD |
|---|---|---|---|---|
| 5000 | 50000 | 27516.27 | 27584.5 | 12996.78 |
Kết luận:
Kết quả thống kê mô tả cho biến Income (thu nhập bình quân năm của khách hàng) được trình bày trong Bảng 3 cho thấy: mức thu nhập của các khách hàng dao động trong khoảng từ 5.000 USD đến 50.000 USD, với giá trị trung bình (Mean) đạt 27.516,27 USD, trung vị (Median) là 27.584,5 USD, và độ lệch chuẩn (SD) đạt 12.996,78 USD. Sự chênh lệch tương đối lớn giữa giá trị cực tiểu và cực đại, cùng độ lệch chuẩn cao, phản ánh mức độ phân tán đáng kể trong thu nhập của các khách hàng, cho thấy dữ liệu bao quát nhiều nhóm đối tượng có khả năng chi tiêu khác nhau.
Phân tích tần suất theo nhóm thu nhập (Bảng 2) cho thấy mẫu dữ liệu được phân bố tương đối đồng đều giữa bốn nhóm thu nhập, bao gồm: nhóm Cao (25,19%), Rất cao (25,00%), Trung bình (24,86%) và Thấp (24,94%). Sự phân bố gần như đồng đều giữa bốn nhóm thu nhập (khoảng 25% mỗi nhóm) phản ánh đặc trưng của bộ dữ liệu mô phỏng, được thiết kế nhằm đảm bảo tính cân bằng trong phân tích.
3.1.2 Biến Region
# --- 2. Biến region (định tính) ---
region_summary <- data %>%
group_by(region) %>%
summarise(Tanso = n()) %>%
mutate(Tyle = round(Tanso / sum(Tanso) * 100, 2))
region_summary %>%
kbl(caption = "Bảng 4. Phân bố khách hàng theo khu vực") %>%
kable_styling(full_width = F, position = "center")## Warning in attr(x, "align"): 'xfun::attr()' is deprecated.
## Use 'xfun::attr2()' instead.
## See help("Deprecated")| region | Tanso | Tyle |
|---|---|---|
| East | 30074 | 30.07 |
| North | 19918 | 19.92 |
| South | 20073 | 20.07 |
| West | 29935 | 29.94 |
# Biểu đồ cột khu vực
ggplot(region_summary, aes(x = reorder(region, -Tanso), y = Tanso, fill = region)) +
geom_bar(stat = "identity") +
labs(title = "Phân bố khách hàng theo khu vực", x = "Khu vực", y = "Tần số") +
theme_minimal() +
theme(legend.position = "none")
Kết luận:
- Biến Region (khu vực sinh sống) bao gồm bốn nhóm: East, West, North và South. Kết quả cho thấy các quan sát được phân bố tương đối cân bằng giữa các khu vực, trong đó khu vực East và West chiếm tỷ trọng cao hơn một chút (khoảng 30%), trong khi North và South chiếm khoảng 20% mỗi nhóm. Phân bố này cho thấy dữ liệu được mô phỏng có chủ đích nhằm đảm bảo tính đa dạng và đại diện cho bốn vùng, giúp việc so sánh hành vi chi tiêu hoặc thu nhập giữa các khu vực trở nên đáng tin cậy.
3.1.3 Biến Purchase_amount
summary_purchase <- data %>%
summarise(
Min = min(purchase_amount, na.rm = TRUE),
Q1 = quantile(purchase_amount, 0.25, na.rm = TRUE),
Median = median(purchase_amount, na.rm = TRUE),
Mean = mean(purchase_amount, na.rm = TRUE),
Q3 = quantile(purchase_amount, 0.75, na.rm = TRUE),
Max = max(purchase_amount, na.rm = TRUE),
SD = sd(purchase_amount, na.rm = TRUE)
)
summary_purchase %>%
kbl(caption = "Bảng 5. Thống kê mô tả biến Purchase Amount") %>%
kable_styling(full_width = F, position = "center")## Warning in attr(x, "align"): 'xfun::attr()' is deprecated.
## Use 'xfun::attr2()' instead.
## See help("Deprecated")| Min | Q1 | Median | Mean | Q3 | Max | SD |
|---|---|---|---|---|---|---|
| 1118 | 5583 | 9452 | 9634.791 | 13350 | 26204 | 4799.339 |
# Biểu đồ phân phối chi tiêu
ggplot(data, aes(x = purchase_amount)) +
geom_histogram(fill = "#f9a825", color = "white", bins = 30) +
labs(title = "Biểu đồ phân phối số tiền chi tiêu", x = "Purchase Amount (USD)", y = "Tần suất") +
theme_minimal()
Kết luận: - Biến Purchase Amount thể hiện số tiền chi tiêu trung bình (USD) trong mỗi giao dịch của khách hàng. Kết quả thống kê mô tả (Bảng 5) cho thấy giá trị chi tiêu dao động từ 1.118 USD đến 26.204 USD, với giá trị trung bình (Mean) đạt 9.634,79 USD, trung vị (Median) là 9.452 USD, và độ lệch chuẩn (SD) ở mức 4.799,34 USD.
Sự chênh lệch giữa giá trị cực tiểu và cực đại khá lớn, tuy nhiên giá trị trung bình và trung vị gần tương đồng cho thấy phân phối của biến Purchase Amount có xu hướng gần đối xứng, không bị lệch mạnh về hai phía. Điều này được củng cố qua biểu đồ phân phối (Histogram) ở Hình …, trong đó mật độ quan sát tập trung chủ yếu trong khoảng 5.000 – 15.000 USD, và giảm dần về hai phía.
Phần lớn khách hàng có mức chi tiêu trong khoảng từ Q1 = 5.583 USD đến Q3 = 13.350 USD, cho thấy phân bố chi tiêu khá đồng đều giữa các nhóm khách hàng. Độ lệch chuẩn tương đối lớn (khoảng 4.800 USD) phản ánh sự đa dạng trong hành vi chi tiêu, tức là tồn tại cả những nhóm khách hàng chi tiêu thấp lẫn những nhóm chi tiêu cao hơn mức trung bình đáng kể.
3.2 Phân tích mối quan hệ giữa các biến
3.2.1 Phân tích mối quan hệ giữa Purchase Amount và Income
1.A. Thống kê Mô tả và Độ lệch
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.4.3## Warning: package 'readr' was built under R version 4.4.3## Warning: package 'purrr' was built under R version 4.4.3## Warning: package 'forcats' was built under R version 4.4.3## Warning: package 'lubridate' was built under R version 4.4.3## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ lubridate 1.9.4 ✔ stringr 1.5.1
## ✔ purrr 1.1.0 ✔ tibble 3.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ kableExtra::group_rows() masks dplyr::group_rows()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors# --- Gói cần thiết ---
library(tidyverse)
# --- 1. Đọc dữ liệu ---
df <- read_excel("C:/Users/PC/OneDrive - UFM/Documents/customers_data.xlsx")
# --- 2. Tạo nhóm thu nhập (Income group) theo tứ phân vị ---
income_breaks <- quantile(df$income, probs = c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE)
df <- df %>%
mutate(
income_group = cut(income,
breaks = income_breaks,
include.lowest = TRUE,
labels = c("Thấp", "Trung bình", "Cao", "Rất cao"))
)
# --- 3. Tạo nhóm chi tiêu (Purchase Amount group) theo tứ phân vị ---
purchase_breaks <- quantile(df$purchase_amount, probs = c(0, 0.25, 0.5, 0.75, 1), na.rm = TRUE)
df <- df %>%
mutate(
purchase_group = cut(purchase_amount,
breaks = purchase_breaks,
include.lowest = TRUE,
labels = c("Thấp", "Trung bình", "Cao", "Rất cao"))
)
# --- 4. BẢNG 1: TẦN SUẤT KHÁCH HÀNG ---
freq_table_n <- df %>%
count(income_group, purchase_group) %>%
pivot_wider(names_from = purchase_group, values_from = n, values_fill = 0) %>%
rename(
"Nhóm Thu nhập" = income_group,
"Chi tiêu Thấp" = Thấp,
"Chi tiêu Trung bình" = `Trung bình`,
"Chi tiêu Cao" = Cao,
"Chi tiêu Rất cao" = `Rất cao`
)
print(freq_table_n)## # A tibble: 4 × 5
## `Nhóm Thu nhập` `Chi tiêu Thấp` `Chi tiêu Trung bình` `Chi tiêu Cao`
## <fct> <int> <int> <int>
## 1 Thấp 22872 2128 0
## 2 Trung bình 2124 19322 3550
## 3 Cao 6 3431 16684
## 4 Rất cao 0 120 4764
## # ℹ 1 more variable: `Chi tiêu Rất cao` <int>prop.table(table(df$income_group, df$purchase_group), 1)##
## Thấp Trung bình Cao Rất cao
## Thấp 0.91488 0.08512 0.00000 0.00000
## Trung bình 0.08496 0.77288 0.14200 0.00016
## Cao 0.00024 0.13724 0.66736 0.19516
## Rất cao 0.00000 0.00480 0.19056 0.80464Kết luận: Kết quả thống kê mô tả thể hiện mối quan hệ phân bố giữa hai biến định tính Income Group (nhóm thu nhập) và Purchase Amount Group (nhóm chi tiêu). Phân bố tần suất cho thấy sự khác biệt đáng kể giữa các nhóm, phản ánh rõ xu hướng chi tiêu tăng theo thu nhập.Cụ thể:
So sánh giữa các nhóm thu nhập:
Khi thu nhập tăng từ thấp lên trung bình, tỷ lệ chi tiêu trung bình tăng mạnh từ 8,51% lên 77,29%, tức tăng hơn 9 lần, trong khi tỷ lệ chi tiêu thấp giảm từ 91,49% xuống chỉ còn 8,50%.
Khi tiếp tục tăng từ trung bình lên cao, cấu trúc chi tiêu thay đổi rõ rệt: tỷ lệ chi tiêu cao tăng từ 14,20% lên 66,74%, tức tăng gần 4,7 lần, còn chi tiêu rất cao tăng từ 0,02% lên 19,52%.
Từ nhóm cao sang rất cao, tỷ lệ chi tiêu rất cao tiếp tục tăng mạnh từ 19,52% lên 80,46%, tức cao gấp hơn 4 lần, trong khi tỷ lệ chi tiêu thấp và trung bình gần như triệt tiêu (chỉ còn dưới 0,5%).
So sánh chéo giữa các mức chi tiêu:
Ở mức chi tiêu thấp có tới 91,49% khách hàng thuộc nhóm thu nhập thấp nằm trong mức chi tiêu thấp, trong khi tỷ lệ này gần như bằng 0% ở các nhóm thu nhập cao và rất cao. Điều này cho thấy khi thu nhập tăng, hành vi chi tiêu thấp hầu như biến mất.
Ngược lại, ở mức chi tiêu rất cao, xu hướng hoàn toàn đảo ngược. Nếu ở nhóm thu nhập thấp và trung bình, gần như không có khách hàng nào chi tiêu ở mức này, thì tỷ lệ đó tăng lên 19,52% ở nhóm thu nhập cao và đạt 80,46% ở nhóm thu nhập rất cao. Nói cách khác, phần lớn khách hàng thu nhập cao đều chi tiêu ở mức cao hoặc rất cao.
=> Tổng hợp lại, sự chênh lệch tuyệt đối 80,46 điểm phần trăm giữa hai cực thu nhập thấp và rất cao tại mức chi tiêu rất cao thể hiện mức độ phân hóa tiêu dùng đặc biệt rõ rệt. Đây là bằng chứng cho thấy thu nhập có tác động mạnh mẽ và nhất quán đến hành vi chi tiêu của khách hàng.
1.B. Trực quan hóa Phân phối
# --- Thao tác 2.1: Biểu đồ Mật độ ---
library(ggplot2)
# Biểu đồ Mật độ cho Income
p_income_density <- ggplot(data, aes(x = income)) +
geom_density(fill = "#00BFC4", alpha = 0.6) +
labs(title = "Phân phối Mật độ Thu nhập (Income)", x = "Thu nhập") +
theme_minimal()
print(p_income_density)
#
# Biểu đồ Mật độ cho Purchase Amount
p_purchase_density <- ggplot(data, aes(x = purchase_amount)) +
geom_density(fill = "#F8766D", alpha = 0.6) +
labs(title = "Phân phối Mật độ Chi tiêu (Purchase Amount)", x = "Giá trị Chi tiêu") +
theme_minimal()
print(p_purchase_density)
#1.C. Biểu đồ Tương quan và Hồi quy
# ============================
# Node 3.4: Hồi quy Tuyến tính Đơn giản
# Mối quan hệ giữa Thu nhập (Income) và Chi tiêu (Purchase Amount)
# ============================
# --- Thao tác 3.1: Biểu đồ tương quan và đường hồi quy ---
library(ggplot2)
ggplot(data, aes(x = income, y = purchase_amount)) +
geom_point(alpha = 0.5, color = "#0072B2") + # Vẽ điểm dữ liệu
geom_smooth(method = "lm", color = "red", se = TRUE) + # Đường hồi quy + khoảng tin cậy
labs(
title = "Mối quan hệ giữa Thu nhập và Chi tiêu",
subtitle = "Đường hồi quy tuyến tính đơn giản",
x = "Thu nhập (Income)",
y = "Giá trị Chi tiêu (Purchase Amount)"
) +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
# --- Thao tác 3.2: Kiểm định Tương quan Pearson ---
cor_test <- cor.test(data$income, data$purchase_amount, method = "pearson")
# In kết quả tương quan
cat("\n--- Kết quả Kiểm định Tương quan Pearson ---\n")##
## --- Kết quả Kiểm định Tương quan Pearson ---cat(paste0("Hệ số tương quan (r): ", round(cor_test$estimate, 4), "\n"))## Hệ số tương quan (r): 0.9484cat(paste0("P-value: ", format.pval(cor_test$p.value, digits = 4), "\n"))## P-value: < 2.2e-16# --- Thao tác 3.3: Mô hình Hồi quy Tuyến tính Đơn giản ---
model_reg <- lm(purchase_amount ~ income, data = data)
# Tóm tắt hệ số ước lượng và ý nghĩa thống kê
reg_summary <- summary(model_reg)
reg_summary$coefficients[, c("Estimate", "Pr(>|t|)")]## Estimate Pr(>|t|)
## (Intercept) -2.2924034 0.8387218
## income 0.3502322 0.0000000# --- Thao tác 3.4: Diễn giải kết quả định lượng ---
cat("\n--- Phương trình Hồi quy Ước lượng ---\n")##
## --- Phương trình Hồi quy Ước lượng ---cat(paste0("Purchase_Amount = ",
round(reg_summary$coefficients[1, 1], 3), " + ",
round(reg_summary$coefficients[2, 1], 3), " * Income\n"))## Purchase_Amount = -2.292 + 0.35 * Incomecat("\n--- Độ phù hợp mô hình ---\n")##
## --- Độ phù hợp mô hình ---cat(paste0("Multiple R-squared: ", round(reg_summary$r.squared, 4), "\n"))## Multiple R-squared: 0.8995cat(paste0("Adjusted R-squared: ", round(reg_summary$adj.r.squared, 4), "\n"))## Adjusted R-squared: 0.8995summary(model_reg)##
## Call:
## lm(formula = purchase_amount ~ income, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -9571.4 -770.7 2.6 765.4 9133.7
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.2924034 11.2632649 -0.204 0.839
## income 0.3502322 0.0003701 946.262 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1521 on 99998 degrees of freedom
## Multiple R-squared: 0.8995, Adjusted R-squared: 0.8995
## F-statistic: 8.954e+05 on 1 and 99998 DF, p-value: < 2.2e-16Kết luận:
Biểu đồ tương quan giữa Income và Purchase Amount cho thấy các điểm dữ liệu phân bố dọc theo một đường xu hướng tăng, thể hiện mối quan hệ đồng biến rõ rệt giữa thu nhập và chi tiêu. Kết quả kiểm định Pearson cho hệ số tương quan r = 0.9484 (p < 0.001), chứng minh mối quan hệ tuyến tính này rất mạnh và có ý nghĩa thống kê cao.
Kết quả ước lượng mô hình hồi quy tuyến tính giữa Purchase Amount và Income được thể hiện qua phương trình: Purchase Amounti = −2.292 + 0.350×Incomei Trong đó, hệ số góc của biến Income = 0.350 (p < 0.001) mang ý nghĩa thống kê rất cao, cho thấy khi thu nhập tăng thêm 1 USD, chi tiêu trung bình của khách hàng tăng khoảng 0.35 USD. Giá trị R^2 = 0.8995 cho thấy mô hình giải thích được khoảng 90% sự biến thiên của chi tiêu, khẳng định thu nhập là yếu tố dự báo chính cho hành vi chi tiêu của khách hàng.
3.2.2 Phân tích Cặp biến: purchase_amount và region
2.A. Thống kê Mô tả theo
# --- Thao tác 1.1: Thống kê Mô tả Purchase Amount theo Region ---
library(dplyr)
purchase_by_region <- data %>%
group_by(region) %>%
summarise(
N = n(),
TB_Purchase_Amount = mean(purchase_amount, na.rm = TRUE),
Median_Purchase_Amount = median(purchase_amount, na.rm = TRUE),
SD_Purchase_Amount = sd(purchase_amount, na.rm = TRUE)
)
cat("--- Bảng Tóm tắt Giá trị Chi tiêu Trung bình theo Khu vực ---\n")## --- Bảng Tóm tắt Giá trị Chi tiêu Trung bình theo Khu vực ---print(purchase_by_region)## # A tibble: 4 × 5
## region N TB_Purchase_Amount Median_Purchase_Amount SD_Purchase_Amount
## <fct> <int> <dbl> <dbl> <dbl>
## 1 East 30074 9615. 9424. 4805.
## 2 North 19918 9673. 9478. 4775.
## 3 South 20073 9649. 9498 4798.
## 4 West 29935 9619. 9444 4811.Trực quan hóa Phân phối
# --- Thao tác 2.1: Biểu đồ Hộp (Box Plot) ---
library(ggplot2)
ggplot(data, aes(x = region, y = purchase_amount, fill = region)) +
geom_boxplot(outlier.colour = "red", outlier.shape = 1) +
labs(
title = "Phân phối Chi tiêu (Purchase Amount) theo Khu vực",
x = "Khu vực (Region)",
y = "Giá trị Chi tiêu (Purchase Amount)"
) +
theme_minimal() +
theme(legend.position = "none")
#Kết luận:
Bảng kết quả kết hợp biểu đồ tương quan giữa Giá trị chi tiêu theo vùng cho thấy số quan sát giữa các vùng tương đối cân đối. Giá trị chi tiêu trung bình (TB_Purchase_Amount) ở bốn khu vực khá tương đồng, nằm trong khoảng 9.615–9.673 USD, với trung vị khoảng 9.450–9.500 USD và độ lệch chuẩn xấp xỉ 4.800 USD.
Sự chênh lệch rất nhỏ giữa các giá trị trung bình và trung vị cho thấy phân phối chi tiêu ở từng vùng có tính đối xứng và ổn định, không xuất hiện ngoại lệ đáng kể. Ngoài ra, độ lệch chuẩn tương đương giữa các khu vực cho thấy mức độ biến động chi tiêu của khách hàng tương đối đồng nhất trên toàn thị trường.Điều đó cho thấy rằng không có sự khác biệt thống kê đáng kể về mức chi tiêu trung bình giữa các vùng địa lý. Tổng kết lại, khu vực cư trú không phải là yếu tố chính ảnh hưởng đến hành vi chi tiêu của khách hàng trong bộ dữ liệu này.
2.C Kiểm định Thống kê ANOVA
# --- Thao tác 3.1: Kiểm định Phương sai (ANOVA) ---
aov_purchase_region <- aov(purchase_amount ~ region, data = data)
cat("\n--- Kết quả Kiểm định ANOVA: Purchase Amount ~ Region ---\n")##
## --- Kết quả Kiểm định ANOVA: Purchase Amount ~ Region ---summary(aov_purchase_region)## Df Sum Sq Mean Sq F value Pr(>F)
## region 3 5.213e+07 17375239 0.754 0.52
## Residuals 99996 2.303e+12 23033829Kết luận:
Để đánh giá sự khác biệt về chi tiêu trung bình (Purchase Amount) giữa các khu vực địa lý (Region), nhóm tiến hành phân tích phương sai một nhân tố (One-way ANOVA). Kết quả kiểm định cho thấy: F(3,99996)=0.754,p=0.52. với tổng bình phương sai giữa nhóm (Sum Sq = 5.21×10⁷) nhỏ hơn nhiều so với sai số trong nhóm (2.30×10¹²).
Giá trị p = 0.52 > 0.05 cho thấy không có bằng chứng thống kê để bác bỏ giả thuyết không (H₀). Điều này nghĩa là mức chi tiêu trung bình giữa các khu vực không có sự khác biệt có ý nghĩa thống kê. Nói cách khác, hành vi chi tiêu của khách hàng tương đối đồng nhất trên toàn bộ các vùng địa lý, và yếu tố Region *không ảnh hưởng đáng kể đến mức chi tiêu trung bình.
Để xác nhận kết quả này, nhóm tiếp tục thực hiện kiểm định hậu kỳ Tukey’s HSD, nhằm xem xét chi tiết hơn các cặp vùng cụ thể có chênh lệch nhỏ nào có thể đạt ý nghĩa thống kê, mặc dù kiểm định ANOVA tổng thể chưa cho thấy khác biệt đáng kể.
2.D Kiểm định Hậu kỳ Tukey’s HSD (Tukey’s Honestly Significant Difference)
# --- Thao tác 2.1: Kiểm định Hậu kỳ Tukey's HSD ---
# Sử dụng đối tượng aov đã tạo ở bước trước
aov_purchase_region <- aov(purchase_amount ~ region, data = data)
# Tiến hành kiểm định Tukey's HSD
tukey_hsd_result <- TukeyHSD(aov_purchase_region)
cat("\n--- Kết quả Kiểm định Hậu kỳ Tukey's HSD (So sánh cặp Region) ---\n")##
## --- Kết quả Kiểm định Hậu kỳ Tukey's HSD (So sánh cặp Region) ---print(tukey_hsd_result$region)## diff lwr upr p adj
## North-East 57.951014 -54.68683 170.58886 0.5489893
## South-East 33.376257 -78.99967 145.75218 0.8710819
## West-East 3.800638 -96.86367 104.46495 0.9996734
## South-North -24.574756 -147.88657 98.73705 0.9562651
## West-North -54.150375 -166.89237 58.59162 0.6052033
## West-South -29.575619 -142.05593 82.90469 0.9064082Kết luận:
- Kết quả cho thấy tất cả các giá trị p điều chỉnh (p adj) đều lớn hơn 0.05 (dao động từ 0.55 đến 0.99), và các khoảng tin cậy 95% của hiệu số trung bình (lwr–upr) đều bao gồm giá trị 0. Điều này khẳng định rằng không có cặp vùng nào có sự chênh lệch chi tiêu trung bình có ý nghĩa thống kê.
=> Tổng hợp hai kiểm định, có thể kết luận rằng yếu tố khu vực địa lý (Region) không ảnh hưởng đáng kể đến mức chi tiêu của khách hàng, và hành vi chi tiêu được phân bố tương đối đồng nhất trên toàn thị trường. Kết quả này phù hợp với thống kê mô tả trước đó, khi các giá trị trung bình và độ lệch chuẩn của Purchase Amount giữa các vùng chỉ dao động trong biên độ rất nhỏ
3.2.3 Phân tích Cặp biến Income và Region
3.A Thống kê Mô tả Income theo Khu vực
# --- Thao tác 1.1: Thống kê Mô tả Income theo Region ---
library(dplyr)
income_by_region <- data %>%
group_by(region) %>%
summarise(
N = n(),
TB_Income = mean(income, na.rm = TRUE),
Median_Income = median(income, na.rm = TRUE),
SD_Income = sd(income, na.rm = TRUE)
)
cat("--- Bảng Tóm tắt Thu nhập Trung bình theo Khu vực ---\n")## --- Bảng Tóm tắt Thu nhập Trung bình theo Khu vực ---print(income_by_region)## # A tibble: 4 × 5
## region N TB_Income Median_Income SD_Income
## <fct> <int> <dbl> <dbl> <dbl>
## 1 East 30074 27468. 27534. 13003.
## 2 North 19918 27670. 27722. 12963.
## 3 South 20073 27592. 27715 13015.
## 4 West 29935 27412. 27477 13000.Trực quan hóa Phân phối
# --- Thao tác 2.1: Biểu đồ Hộp (Box Plot) cho Income ---
library(ggplot2)
ggplot(data, aes(x = region, y = income, fill = region)) +
geom_boxplot(outlier.colour = "blue", outlier.shape = 1) +
labs(
title = "Phân phối Thu nhập (Income) theo Khu vực",
x = "Khu vực (Region)",
y = "Thu nhập (Income)"
) +
theme_minimal() +
theme(legend.position = "none")
#Kết luận:
- Bảng kết quả kết hợp biểu đồ tương quan trên trình bày các chỉ tiêu thống kê mô tả của biến Income theo từng khu vực địa lý (Region). Kết quả cho thấy mức thu nhập trung bình giữa các vùng tương đối đồng đều, dao động quanh 27.400–27.700 USD, với độ lệch chuẩn khoảng 13.000 USD. Giá trị trung bình và trung vị gần tương đương nhau trong tất cả các nhóm, cho thấy phân phối thu nhập trong từng khu vực khá cân đối, không bị lệch. Sự khác biệt nhỏ giữa các khu vực cho thấy thu nhập khách hàng không biến động đáng kể theo vùng địa lý, phản ánh đặc điểm kinh tế tương đối đồng nhất của tập khách hàng trong bộ dữ liệu.
3.B Kiểm định Thống kê (Node 3.3: ANOVA & Tukey’s HSD)
# --- Thao tác 3.1: Kiểm định Phương sai (ANOVA) ---
aov_income_region <- aov(income ~ region, data = data)
cat("\n--- Kết quả Kiểm định ANOVA: Income ~ Region ---\n")##
## --- Kết quả Kiểm định ANOVA: Income ~ Region ---summary(aov_income_region)## Df Sum Sq Mean Sq F value Pr(>F)
## region 3 9.843e+08 328109221 1.942 0.12
## Residuals 99996 1.689e+13 168911582Kết luận:
Phân tích phương sai một nhân tố (One-way ANOVA) được thực hiện nhằm đánh giá xem mức thu nhập trung bình (Income) có khác biệt đáng kể giữa bốn khu vực địa lý (Region) hay không. Kết quả cho thấy:F(3,99996)=1.942,p=0.12 với tổng bình phương sai giữa nhóm (Sum Sq = 9.84×10⁸) nhỏ hơn rất nhiều so với sai số trong nhóm (1.69×10¹³).
Giá trị p = 0.12 > 0.05 cho thấy không có đủ bằng chứng thống kê để bác bỏ giả thuyết không (H₀).Nói cách khác, mức thu nhập trung bình của khách hàng giữa các khu vực không có sự khác biệt có ý nghĩa thống kê.
Kết quả này củng cố nhận định từ thống kê mô tả trước đó, khi thu nhập trung bình giữa các vùng dao động trong biên độ rất hẹp (≈ ±150 USD), với độ lệch chuẩn gần như tương đồng (≈ 13.000 USD).
Điều này cho thấy thu nhập của khách hàng có xu hướng ổn định và đồng nhất trên toàn bộ khu vực địa lý, và yếu tố Region không đóng vai trò quan trọng trong việc phân hóa thu nhập trong tập dữ liệu này.
Kiểm định Hậu kỳ Tukey’s HSD
# --- Thao tác 3.2: Kiểm định Hậu kỳ Tukey's HSD cho Income ---
# Sử dụng đối tượng aov_income_region đã tạo ở bước trước
aov_income_region <- aov(income ~ region, data = data)
cat("\n--- Kết quả Kiểm định ANOVA: Income ~ Region ---\n")##
## --- Kết quả Kiểm định ANOVA: Income ~ Region ---print(summary(aov_income_region))## Df Sum Sq Mean Sq F value Pr(>F)
## region 3 9.843e+08 328109221 1.942 0.12
## Residuals 99996 1.689e+13 168911582cat("\n--- Kết quả Kiểm định Hậu kỳ Tukey's HSD (So sánh cặp Region về Income) ---\n")##
## --- Kết quả Kiểm định Hậu kỳ Tukey's HSD (So sánh cặp Region về Income) ---tukey_hsd_income <- TukeyHSD(aov_income_region)
print(tukey_hsd_income$region)## diff lwr upr p adj
## North-East 202.40400 -102.6179 507.42587 0.3211191
## South-East 124.13961 -180.1730 428.45220 0.7211165
## West-East -56.00917 -328.6068 216.58851 0.9523616
## South-North -78.26439 -412.1912 255.66244 0.9314243
## West-North -258.41316 -563.7171 46.89073 0.1303528
## West-South -180.14877 -484.7440 124.44650 0.4257519Kết luận
Để kiểm chứng chi tiết, nhóm tiếp tục thực hiện kiểm định hậu kỳ Tukey’s HSD nhằm xác định cặp vùng cụ thể có sự chênh lệch thu nhập nếu có.
Kết quả cho thấy tất cả các giá trị p điều chỉnh (p adj) đều lớn hơn 0.05, dao động từ 0.13 đến 0.95, và các khoảng tin cậy 95% của hiệu số trung bình đều bao gồm giá trị 0. Điều này khẳng định rằng không có cặp khu vực nào có sự chênh lệch thu nhập trung bình có ý nghĩa thống kê.
=> Tổng hợp hai kiểm định cho thấy thu nhập trung bình của khách hàng phân bố tương đối đồng đều giữa các vùng địa lý. Điều này một lần nữa củng cố kết luận từ thống kê mô tả trước đó rằng yếu tố khu vực (Region) không ảnh hưởng đáng kể đến mức thu nhập của khách hàng, và thu nhập có xu hướng ổn định trên toàn thị trường.
3.3 Mô hình Hồi quy
3.3.1 Ước lượng Mô hình Hồi quy
# --- Thao tác 1.1: Ước lượng Mô hình Hồi quy Tương tác ---
# purchase_amount ~ income * region
model_interaction <- lm(purchase_amount ~ income * region, data = data)
cat("--- Bảng Hệ số Ước lượng (Beta) và P-value Cốt lõi ---\n")## --- Bảng Hệ số Ước lượng (Beta) và P-value Cốt lõi ---# Lấy bảng hệ số từ summary và format
coefficients_table <- summary(model_interaction)$coefficients[, c("Estimate", "Std. Error", "t value", "Pr(>|t|)")]
coefficients_table <- round(coefficients_table, 4) # Làm tròn để dễ đọc
print(coefficients_table)## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -15.2105 20.5001 -0.7420 0.4581
## income 0.3506 0.0007 519.7615 0.0000
## regionNorth 27.3414 32.6452 0.8375 0.4023
## regionSouth 31.3240 32.4593 0.9650 0.3345
## regionWest 3.6302 29.0037 0.1252 0.9004
## income:regionNorth -0.0015 0.0011 -1.3622 0.1731
## income:regionSouth -0.0015 0.0011 -1.4105 0.1584
## income:regionWest 0.0007 0.0010 0.7565 0.4493cat("\n--- R-squared điều chỉnh của Mô hình ---\n")##
## --- R-squared điều chỉnh của Mô hình ---cat("Adjusted R-squared:", round(summary(model_interaction)$adj.r.squared, 4), "\n")## Adjusted R-squared: 0.8995Kết luận: Mô hình hồi quy được xây dựng nhằm phân tích tác động của thu nhập (Income) và khu vực địa lý (Region) đến mức chi tiêu của khách hàng (Purchase Amount), đồng thời xem xét hiệu ứng tương tác giữa hai yếu tố này. Kết quả ước lượng cho thấy:
Biến Income có hệ số hồi quy β1 = 0.3506 (p < 0.001), có ý nghĩa thống kê cao, cho thấy thu nhập là yếu tố dự báo chính cho chi tiêu. Khi thu nhập tăng thêm 1 USD, chi tiêu trung bình tăng khoảng 0.35 USD.
Các biến khu vực (regionNorth, regionSouth, regionWest) đều có p-value > 0.05, chứng tỏ sự khác biệt chi tiêu trung bình giữa các vùng không có ý nghĩa thống kê.
Các hệ số tương tác (income:region) cũng có p-value lớn (từ 0.15 đến 0.45), cho thấy mối quan hệ giữa thu nhập và chi tiêu không thay đổi đáng kể theo vùng địa lý — tức là tác động của thu nhập lên chi tiêu là nhất quán trên toàn bộ các khu vực.
Giá trị R² điều chỉnh = 0.8995 cho thấy mô hình giải thích được khoảng 89,95% biến thiên trong chi tiêu, thể hiện độ phù hợp rất cao. Điều này cho thấy việc bổ sung yếu tố khu vực và tương tác không cải thiện đáng kể mô hình, vì phần lớn biến động chi tiêu vẫn được giải thích chủ yếu bởi thu nhập cá nhân.
3.3.2 Trực quan hóa Tác động
# --- Thao tác 2.1: Biểu đồ Trực quan hóa Tác động Tương tác ---
library(ggplot2)
ggplot(data, aes(x = income, y = purchase_amount, color = region)) +
geom_point(alpha = 0.3) +
geom_smooth(method = "lm", se = FALSE, linewidth = 1.2) + # Vẽ đường hồi quy riêng cho từng Region
labs(
title = "Tác động Tương tác: Income và Region lên Purchase Amount",
subtitle = "Các đường hồi quy gần như trùng nhau, không có tác động tương tác.",
x = "Thu nhập (Income)",
y = "Giá trị Chi tiêu (Purchase Amount)",
color = "Khu vực"
) +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
#Kết luận:
Quan sát cho thấy các đường hồi quy của bốn khu vực gần như trùng nhau, thể hiện mối quan hệ giữa thu nhập và chi tiêu là nhất quán trên toàn bộ các vùng. Điều này phù hợp với kết quả hồi quy trước đó, khi các hệ số tương tác giữa Income và Region đều không có ý nghĩa thống kê (p > 0.1).
Tóm lại, thu nhập cá nhân đóng vai trò quyết định trực tiếp đến khả năng và hành vi chi tiêu, trong khi khác biệt khu vực (East, North, South, West) chỉ phản ánh sự phân bố dân cư mà không ảnh hưởng mạnh đến sức mua trong bộ dữ liệu này. Điều này cũng cho thấy mức độ hội nhập và đồng nhất hóa hành vi tiêu dùng của khách hàng giữa các vùng, đặc biệt trong bối cảnh thị trường bán lẻ mô phỏng mang tính toàn quốc.
3. Kiểm định Giả định Mô hình (Model Diagnostics)
# Sử dụng mô hình đã ước lượng: model_interaction
# Đặt layout để tránh lỗi margins
par(mfrow = c(2, 2))
# Vẽ 4 đồ thị kiểm định
plot(model_interaction)
# Trả lại layout mặc định
par(mfrow = c(1, 1))Kết luận:
Mô hình này thỏa mãn rất tốt hai giả định quan trọng: Thứ nhất, biểu đồ Normal Q-Q Plot cho thấy các phần dư (residuals) phân bố gần như hoàn toàn trên đường chéo 45 độ, xác nhận rằng giả định Phân phối Chuẩn của Phần dư được thỏa mãn. Thứ hai, biểu đồ Residuals vs Leverage không có bất kỳ điểm dữ liệu nào vượt qua giới hạn Cook’s Distance, chứng tỏ không có điểm ngoại lai (outliers) hoặc điểm ảnh hưởng lớn làm sai lệch nghiêm trọng các hệ số hồi quy.
Tuy nhiên, mô hình đã vi phạm rõ ràng giả định về Phương sai Đồng nhất (Homoscedasticity). Điều này được chứng minh qua biểu đồ Residuals vs Fitted và Scale-Location Plot, nơi các phần dư không phân tán ngẫu nhiên mà tạo thành một hình dạng phễu (funnel shape). Cụ thể, khi giá trị Chi tiêu dự đoán (Fitted Values) tăng lên, độ phân tán (biến động) của phần dư cũng tăng lên đáng kể.
4. Kiểm tra Đa cộng tuyến (VIF)
# --- Kiểm tra Đa cộng tuyến (VIF) ---
library(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:purrr':
##
## some## The following object is masked from 'package:dplyr':
##
## recodecat("\n--- Kết quả Kiểm tra Đa cộng tuyến (VIF) ---\n")##
## --- Kết quả Kiểm tra Đa cộng tuyến (VIF) ---# Kiểm tra VIF chi tiết trên từng predictor (bao gồm dummies và interactions)
vif_result_detailed <- vif(model_interaction, type = "predictor")## GVIFs computed for predictorsprint(vif_result_detailed)## GVIF Df GVIF^(1/(2*Df)) Interacts With Other Predictors
## income 1 7 1 region --
## region 1 7 1 income --# Tùy chọn: Lọc và in chỉ các VIF > 5 để dễ theo dõi
high_vif <- vif_result_detailed[vif_result_detailed > 5]
if (length(high_vif) > 0) {
cat("\n--- Các VIF Cao (>5) Cần Theo Dõi ---\n")
print(high_vif)
} else {
cat("\n--- Không Có VIF Nào >5: Mô Hình Ổn Định ---\n")
}##
## --- Các VIF Cao (>5) Cần Theo Dõi ---
## [1] "7" "7" "region" "income"Kết luận Bộ biểu đồ chẩn đoán mô hình hồi quy tuyến tính được trình bày trong hình gồm bốn kiểm định đồ họa chính.
Biểu đồ Residuals vs Fitted cho thấy các điểm phân bố ngẫu nhiên quanh trục 0, không xuất hiện dạng hình parabol hoặc xu hướng rõ rệt, cho thấy mối quan hệ giữa thu nhập và chi tiêu có tính tuyến tính hợp lý.
Biểu đồ Q–Q Residuals cho thấy các điểm phần dư bám khá sát theo đường chéo, chỉ lệch nhẹ ở hai đầu phân phối, chứng tỏ phần dư tuân theo phân phối chuẩn xấp xỉ, thỏa mãn giả định về tính chuẩn của sai số.
Biểu đồ Scale–Location thể hiện các giá trị chuẩn hóa có xu hướng ổn định, không cho thấy hiện tượng lan tỏa rõ rệt, cho thấy giả định phương sai đồng nhất (homoscedasticity) được duy trì tương đối tốt.
Biểu đồ Residuals vs Leverage cho thấy hầu hết các quan sát nằm trong phạm vi an toàn của Cook’s Distance, không có điểm dữ liệu nào có ảnh hưởng quá lớn đến mô hình, chứng tỏ mô hình ổn định và không bị chi phối bởi các giá trị ngoại lai có ảnh hưởng mạnh.
Tổng hợp bốn biểu đồ, có thể kết luận rằng các giả định cơ bản của mô hình hồi quy tuyến tính đều được thỏa mãn ở mức chấp nhận được, và mô hình đạt độ phù hợp tốt cho dữ liệu.
3.4 Ước lượng Mô hình tối ưu
# --- Bước Tiếp Theo: Ước Lượng Mô Hình Tối Ưu (Robust Standard Errors) ---
library(sandwich) # Cho vcovHC## Warning: package 'sandwich' was built under R version 4.4.3library(lmtest) # Cho coeftest## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric# Fit lại model nếu cần (từ trước)
model_interaction <- lm(purchase_amount ~ income * region, data = data)
# Tính Robust SE (HC1: Phù hợp cho heteroscedasticity)
robust_vcov <- vcovHC(model_interaction, type = "HC1")
# Bảng coefficients với robust SE, t-value, p-value
robust_summary <- coeftest(model_interaction, vcov = robust_vcov)
cat("--- Bảng Hệ Số Mô Hình Tối Ưu (Robust SE) ---\n")## --- Bảng Hệ Số Mô Hình Tối Ưu (Robust SE) ---print(round(robust_summary[, c("Estimate", "Std. Error", "t value", "Pr(>|t|)"), drop=FALSE], 4))## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -15.2105 14.7527 -1.0310 0.3025
## income 0.3506 0.0007 486.0888 0.0000
## regionNorth 27.3414 23.6152 1.1578 0.2470
## regionSouth 31.3240 23.6754 1.3231 0.1858
## regionWest 3.6302 20.8091 0.1745 0.8615
## income:regionNorth -0.0015 0.0011 -1.2741 0.2026
## income:regionSouth -0.0015 0.0012 -1.3042 0.1922
## income:regionWest 0.0007 0.0010 0.7095 0.4780# So sánh với OLS gốc (SỬA: Dùng names() thay rownames())
cat("\n--- So Sánh P-value: OLS vs Robust ---\n")##
## --- So Sánh P-value: OLS vs Robust ---ols_summary <- summary(model_interaction)$coefficients[, "Pr(>|t|)", drop = FALSE] # Giữ drop=FALSE để là matrix 1 cột
robust_p <- robust_summary[, "Pr(>|t|)", drop = FALSE]
if (nrow(data) > 0) {
data$gender <- as.factor(data$gender)
}
# Tạo comparison với names() (hoặc rownames nếu matrix)
comparison <- data.frame(
Term = rownames(ols_summary), # Bây giờ OK vì là matrix
OLS_p = round(as.numeric(ols_summary), 4),
Robust_p = round(as.numeric(robust_p), 4),
Change = ifelse(as.numeric(robust_p) > as.numeric(ols_summary), "Tăng (ít ý nghĩa hơn)", "Giảm")
)
# Adjusted R² vẫn giữ nguyên
cat("\n--- Adjusted R-squared (Vẫn Giữ Nguyên) ---\n")##
## --- Adjusted R-squared (Vẫn Giữ Nguyên) ---cat("Adj R²:", round(summary(model_interaction)$adj.r.squared, 4), "\n")## Adj R²: 0.8995# ... (phần trên giữ nguyên)
library(knitr)
cat("\n--- So Sánh P-value: OLS vs Robust ---\n")##
## --- So Sánh P-value: OLS vs Robust ---kable(comparison, col.names = c("Term", "OLS p-value", "Robust p-value", "Thay đổi"),
digits = 4, align = "lccc") # Bảng đẹp, align trái cho Term## Warning in attr(x, "align"): 'xfun::attr()' is deprecated.
## Use 'xfun::attr2()' instead.
## See help("Deprecated")## Warning in attr(x, "format"): 'xfun::attr()' is deprecated.
## Use 'xfun::attr2()' instead.
## See help("Deprecated")| Term | OLS p-value | Robust p-value | Thay đổi |
|---|---|---|---|
| (Intercept) | 0.4581 | 0.3025 | Giảm |
| income | 0.0000 | 0.0000 | Giảm |
| regionNorth | 0.4023 | 0.2470 | Giảm |
| regionSouth | 0.3345 | 0.1858 | Giảm |
| regionWest | 0.9004 | 0.8615 | Giảm |
| income:regionNorth | 0.1731 | 0.2026 | Tăng (ít ý nghĩa hơn) |
| income:regionSouth | 0.1584 | 0.1922 | Tăng (ít ý nghĩa hơn) |
| income:regionWest | 0.4493 | 0.4780 | Tăng (ít ý nghĩa hơn) |
# Thêm diễn giải tự động
significant_terms <- comparison$Term[as.numeric(comparison$Robust_p) < 0.05]
if (length(significant_terms) > 0) {
cat("\n--- Kết Luận Chính (Robust): Các Term Ý Nghĩa (p<0.05) ---\n")
cat(paste(significant_terms, collapse = ", "), "\n") # E.g., "income"
} else {
cat("\n--- Không Có Term Nào Ý Nghĩa Mới ---\n")
}##
## --- Kết Luận Chính (Robust): Các Term Ý Nghĩa (p<0.05) ---
## incomeKết luận:
Mô hình hồi quy tuyến tính tương tác, với biến phụ thuộc là số tiền mua hàng (purchase_amount) và các biến độc lập bao gồm thu nhập (income), khu vực địa lý (region) cùng với tương tác giữa chúng, đã được ước lượng bằng phương pháp bình phương nhỏ nhất thông thường (OLS) và điều chỉnh bằng sai số chuẩn mạnh mẽ (robust standard errors) để khắc phục vi phạm giả định phương sai đồng nhất. Kết quả cho thấy mô hình giải thích được khoảng 90% biến thiên của dữ liệu (Adjusted R-squared = 0.8995), chứng tỏ khả năng dự đoán cao và phù hợp tốt với dữ liệu quan sát.
Về các hệ số ước lượng, thu nhập (income) là yếu tố dự đoán mạnh mẽ và có ý nghĩa thống kê cao nhất (β = 0.3506, p < 0.001 theo robust SE), ngụ ý rằng cứ tăng thêm một đơn vị thu nhập, số tiền mua hàng dự kiến tăng khoảng 0.351 đơn vị, giữ nguyên các yếu tố khác. Điều này phản ánh mối quan hệ tuyến tính dương rõ rệt giữa mức thu nhập và hành vi chi tiêu. Ngược lại, các hệ số của biến region (so với mức tham chiếu, giả sử là East) không đạt ý nghĩa thống kê (p > 0.18 cho North và South; p = 0.862 cho West), cho thấy sự khác biệt về mức chi tiêu cơ bản giữa các khu vực không đáng kể. Tương tự, các hệ số tương tác (income:region) cũng không ý nghĩa (p > 0.19), chứng tỏ tác động của thu nhập đến số tiền mua hàng không thay đổi đáng kể theo khu vực địa lý.
So sánh giữa OLS và robust SE cho thấy hầu hết các giá trị p-value giảm nhẹ (tăng tính ý nghĩa thống kê), ngoại trừ các tương tác (p-value tăng, giảm tính ý nghĩa), điều này củng cố rằng việc điều chỉnh heteroscedasticity giúp ước lượng ổn định hơn mà không thay đổi bản chất kết quả. Tổng thể, mô hình nhấn mạnh vai trò thống trị của thu nhập như một động lực chính thúc đẩy chi tiêu, trong khi yếu tố khu vực không đóng góp đáng kể độc lập hoặc điều tiết. Khuyến nghị: Tập trung chiến lược tiếp thị vào phân khúc khách hàng có thu nhập cao để tối ưu hóa doanh thu, và xem xét mô hình đơn giản hóa (bỏ tương tác) để tăng tính diễn giải mà không mất độ chính xác.
3.5 Dự báo
# --- Dự Báo Chi Tiêu: Tạo Kịch Bản Và Ước Lượng (SỬA LỖI ROUND) ---
library(sandwich)
library(lmtest)
# Fit mô hình tối ưu (từ trước)
model_interaction <- lm(purchase_amount ~ income * region, data = data)
# Tạo newdata cho dự báo (4 vùng x 3 mức income)
newdata_forecast <- expand.grid(
income = c(50000, 75000, 100000), # USD, giả định đơn vị
region = levels(data$region) # Levels thực tế từ data, e.g., c("East", "North", "South", "West")
)
# Dự báo điểm với khoảng tin cậy 95% (sử dụng OLS predict; robust SE không ảnh hưởng trực tiếp đến predict, nhưng ổn định CI)
predictions <- predict(model_interaction, newdata = newdata_forecast, interval = "confidence", level = 0.95)
# Kết hợp với newdata
forecast_df <- cbind(newdata_forecast, predictions)
# SỬA: Chỉ round các cột numeric
numeric_cols <- c("income", "fit", "lwr", "upr")
forecast_df[, numeric_cols] <- round(forecast_df[, numeric_cols], 2)
cat("--- Bảng Dự Báo Chi Tiêu (USD) Với Khoảng Tin Cậy 95% ---\n")## --- Bảng Dự Báo Chi Tiêu (USD) Với Khoảng Tin Cậy 95% ---print(forecast_df)## income region fit lwr upr
## 1 50000 East 17515.54 17481.14 17549.93
## 2 75000 East 26280.91 26215.75 26346.06
## 3 100000 East 35046.28 34948.85 35143.71
## 4 50000 North 17469.95 17427.88 17512.03
## 5 75000 North 26198.86 26118.89 26278.83
## 6 100000 North 34927.77 34808.03 35047.52
## 7 50000 South 17471.71 17429.81 17513.60
## 8 75000 South 26199.50 26120.01 26278.99
## 9 100000 South 34927.30 34808.35 35046.25
## 10 50000 West 17555.30 17520.75 17589.84
## 11 75000 West 26338.73 26273.34 26404.12
## 12 100000 West 35122.17 35024.42 35219.92# Visualize: Plot dự báo theo income và region (giữ nguyên)
library(ggplot2)
p <- ggplot(forecast_df, aes(x = income, y = fit, color = region)) +
geom_line(size = 1) +
geom_ribbon(aes(ymin = lwr, ymax = upr, fill = region), alpha = 0.2) +
labs(title = "Dự Báo Chi Tiêu Theo Thu Nhập Và Khu Vực",
x = "Thu Nhập (USD)", y = "Số Tiền Mua Hàng Dự Báo (USD)",
color = "Khu Vực", fill = "Khu Vực") +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.print(p)
Kết luận:
Dựa trên mô hình hồi quy tương tác đã được tối ưu hóa với sai số chuẩn mạnh mẽ, nhóm em đã thực hiện dự báo số tiền chi tiêu (purchase_amount) cho các kịch bản thu nhập điển hình (50.000 USD, 75.000 USD và 100.000 USD) tại từng khu vực địa lý (East làm mức tham chiếu). Kết quả dự báo, kèm theo khoảng tin cậy 95% (CI), được trình bày trong bảng trên và minh họa qua biểu đồ đường. Các ước lượng cho thấy mối quan hệ tuyến tính dương mạnh mẽ giữa thu nhập và chi tiêu, với mức tăng trung bình khoảng 17.500 USD cho mỗi 25.000 USD tăng thêm thu nhập, bất kể khu vực. Sự khác biệt giữa các khu vực rất nhỏ (dưới 50 USD ở mức thu nhập thấp và dưới 200 USD ở mức cao), nằm trong khoảng tin cậy chồng chéo, phù hợp với phân tích hệ số trước đó (region và tương tác không ý nghĩa thống kê).
Biểu đồ đường minh họa rõ ràng xu hướng: Các đường dự báo cho từng khu vực (màu đỏ cho East, xanh lá cho North, xanh dương cho South, tím cho West) tăng đều đặn theo thu nhập, gần như song song với nhau, xác nhận rằng thu nhập là động lực chính thúc đẩy chi tiêu mà không bị ảnh hưởng đáng kể bởi yếu tố khu vực. Khoảng tin cậy (vùng tô mờ) hẹp và chồng chéo giữa các khu vực, phản ánh độ chính xác cao của mô hình (Adjusted R² = 0.90) và độ không chắc chắn thấp ở các mức thu nhập trung bình đến cao.
=>Tổng thể, kết quả dự báo nhấn mạnh tiềm năng tăng trưởng doanh thu từ phân khúc khách hàng thu nhập cao: Tại mức 100.000 USD, chi tiêu dự kiến đạt khoảng 35.000 USD – gấp đôi so với mức 50.000 USD – với biên độ an toàn dưới 200 USD giữa các khu vực. Doanh nghiệp có thể áp dụng các chiến lược như chương trình khách hàng thân thiết hoặc ưu đãi cá nhân hóa cho nhóm này để tối ưu hóa doanh số, mà không cần điều chỉnh riêng theo địa lý.