BÀI TẬP TUẦN 02

Trần Thị Huỳnh Nga

2025-05-20

Phần 1. Đọc dữ liệu

data <- read.csv("D:/data/Supermarket Transactions.csv")

Cấu trúc dữ liệu được trình bày như sau.

str(data)

## 'data.frame':    14059 obs. of  16 variables:
##  $ ID               : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ PurchaseDate     : chr  "12/18/2007" "12/20/2007" "12/21/2007" "12/21/2007" ...
##  $ CustomerID       : int  7223 7841 8374 9619 1900 6696 9673 354 1293 7938 ...
##  $ Gender           : chr  "F" "M" "F" "M" ...
##  $ MaritalStatus    : chr  "S" "M" "M" "M" ...
##  $ Homeowner        : chr  "Y" "Y" "N" "Y" ...
##  $ Children         : int  2 5 2 3 3 3 2 2 3 1 ...
##  $ AnnualIncome     : chr  "$30K - $50K" "$70K - $90K" "$50K - $70K" "$30K - $50K" ...
##  $ City             : chr  "Los Angeles" "Los Angeles" "Bremerton" "Portland" ...
##  $ StateorProvince  : chr  "CA" "CA" "WA" "OR" ...
##  $ Country          : chr  "USA" "USA" "USA" "USA" ...
##  $ ProductFamily    : chr  "Food" "Food" "Food" "Food" ...
##  $ ProductDepartment: chr  "Snack Foods" "Produce" "Snack Foods" "Snacks" ...
##  $ ProductCategory  : chr  "Snack Foods" "Vegetables" "Snack Foods" "Candy" ...
##  $ UnitsSold        : int  5 5 3 4 4 3 4 6 1 2 ...
##  $ Revenue          : num  27.38 14.9 5.52 4.44 14 ...

head(data)

ID	PurchaseDate	CustomerID	Gender	MaritalStatus	Homeowner	Children	AnnualIncome	City	StateorProvince	Country	ProductFamily	ProductDepartment	ProductCategory	UnitsSold	Revenue
1	12/18/2007	7223	F	S	Y	2	$30K - $50K	Los Angeles	CA	USA	Food	Snack Foods	Snack Foods	5	27.38
2	12/20/2007	7841	M	M	Y	5	$70K - $90K	Los Angeles	CA	USA	Food	Produce	Vegetables	5	14.90
3	12/21/2007	8374	F	M	N	2	$50K - $70K	Bremerton	WA	USA	Food	Snack Foods	Snack Foods	3	5.52
4	12/21/2007	9619	M	M	Y	3	$30K - $50K	Portland	OR	USA	Food	Snacks	Candy	4	4.44
5	12/22/2007	1900	F	S	Y	3	$130K - $150K	Beverly Hills	CA	USA	Drink	Beverages	Carbonated Beverages	4	14.00
6	12/22/2007	6696	F	M	Y	3	$10K - $30K	Beverly Hills	CA	USA	Food	Deli	Side Dishes	3	4.37

tail(data)

	ID	PurchaseDate	CustomerID	Gender	MaritalStatus	Homeowner	Children	AnnualIncome	City	StateorProvince	Country	ProductFamily	ProductDepartment	ProductCategory	UnitsSold	Revenue
14054	14054	12/29/2009	2032	F	M	N	3	$10K - $30K	Yakima	WA	USA	Non-Consumable	Household	Paper Products	5	14.50
14055	14055	12/29/2009	9102	F	M	Y	2	$10K - $30K	Bremerton	WA	USA	Food	Baking Goods	Baking Goods	3	9.64
14056	14056	12/29/2009	4822	F	M	Y	3	$10K - $30K	Walla Walla	WA	USA	Food	Frozen Foods	Vegetables	3	7.45
14057	14057	12/31/2009	250	M	S	Y	1	$30K - $50K	Portland	OR	USA	Drink	Beverages	Pure Juice Beverages	4	3.24
14058	14058	12/31/2009	6153	F	S	N	4	$50K - $70K	Spokane	WA	USA	Drink	Dairy	Dairy	2	4.00
14059	14059	12/31/2009	3656	M	S	N	3	$50K - $70K	Portland	OR	USA	Non-Consumable	Household	Electrical	5	25.53

==> Dữ liệu bao gồm 14059 quan sát và có 16 biến kể cả biến định tính và định lượng.

Thực hiện kiểm tra dữ liệu bị thiếu trong toàn bộ các cột của data.

colSums(is.na(data))

##                ID      PurchaseDate        CustomerID            Gender 
##                 0                 0                 0                 0 
##     MaritalStatus         Homeowner          Children      AnnualIncome 
##                 0                 0                 0                 0 
##              City   StateorProvince           Country     ProductFamily 
##                 0                 0                 0                 0 
## ProductDepartment   ProductCategory         UnitsSold           Revenue 
##                 0                 0                 0                 0

==> Kết quả kiểm tra cho kết quả toàn bộ các cột của dữ liệu đều có tổng dữ liệu thiếu bằng 0.

Lựa chọn các biến định tính và chuyển đổi thành dạng factor

bdt <- c("MaritalStatus","City","Gender","ProductDepartment","StateorProvince","ProductCategory","Country","ProductFamily","AnnualIncome","Homeowner")
data[bdt] <- lapply(data[bdt], as.factor)
str(data)

## 'data.frame':    14059 obs. of  16 variables:
##  $ ID               : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ PurchaseDate     : chr  "12/18/2007" "12/20/2007" "12/21/2007" "12/21/2007" ...
##  $ CustomerID       : int  7223 7841 8374 9619 1900 6696 9673 354 1293 7938 ...
##  $ Gender           : Factor w/ 2 levels "F","M": 1 2 1 2 1 1 2 1 2 2 ...
##  $ MaritalStatus    : Factor w/ 2 levels "M","S": 2 1 1 1 2 1 2 1 1 2 ...
##  $ Homeowner        : Factor w/ 2 levels "N","Y": 2 2 1 2 2 2 2 2 2 1 ...
##  $ Children         : int  2 5 2 3 3 3 2 2 3 1 ...
##  $ AnnualIncome     : Factor w/ 8 levels "$10K - $30K",..: 5 7 6 5 3 1 5 4 1 6 ...
##  $ City             : Factor w/ 23 levels "Acapulco","Bellingham",..: 8 8 4 12 3 3 13 23 2 15 ...
##  $ StateorProvince  : Factor w/ 10 levels "BC","CA","DF",..: 2 2 8 6 2 2 6 8 8 2 ...
##  $ Country          : Factor w/ 3 levels "Canada","Mexico",..: 3 3 3 3 3 3 3 3 3 3 ...
##  $ ProductFamily    : Factor w/ 3 levels "Drink","Food",..: 2 2 2 2 1 2 2 2 3 3 ...
##  $ ProductDepartment: Factor w/ 22 levels "Alcoholic Beverages",..: 20 18 20 21 4 11 13 6 15 14 ...
##  $ ProductCategory  : Factor w/ 45 levels "Baking Goods",..: 42 45 42 7 15 41 5 13 16 35 ...
##  $ UnitsSold        : int  5 5 3 4 4 3 4 6 1 2 ...
##  $ Revenue          : num  27.38 14.9 5.52 4.44 14 ...

Phần 2. Phân tích Mô tả Một biến Định tính

2.1. Biến Gender

Biến Gender thể hiện số lượng khách hàng được phân loại dựa trên giới tính, nhằm đánh giá hành vi nhu cầu mua sắm giữa nam và nữ.

table_gender <- table(data$Gender)

kable(
  as.data.frame(table_gender),
  col.names = c("Giới tính", "Số lượng"),
  caption = "<center>**Bảng 1: Số lượng khách hàng theo giới tính**</center>"
)

Table: Bảng 1: Số lượng khách hàng theo giới tính

Giới tính	Số lượng
F	7170
M	6889

Gender_chart <- round(table(data$Gender)/sum(nrow(data))*100 ,1)

kable(
  as.data.frame(Gender_chart),
  col.names = c("Giới tính", "Tần suất"),
  caption = "<center>**Bảng 2: Tần suất khách hàng theo giới tính**</center>"
)

Table: Bảng 2: Tần suất khách hàng theo giới tính

Giới tính	Tần suất
F	51
M	49

label <- paste(Gender_chart, "%")
pie(Gender_chart, main ="BIỂU ĐỒ TRÒN GIỚI TÍNH", col = rainbow(length(Gender_chart))
,radius =1)
legend("topright",legend = label, fill = rainbow(length(Gender_chart)), title = "Giới tính", cex = 0.8)

==> Kết quả cung cấp dựa trên bộ dữ liệu thu thập được cho thấy có đến 51% khách hàng là nữ và 49% khách hàng là nam.

2.2. Biến MaritalStatus

Biến Biến MaritalStatus thể hiện tình trạng hôn nhân của bộ phận khách hàng nhằm đánh giá nhu cầu mua sắm giữa những người đã có gia đình và chưa có gia đình.

table_maria <- table(data$MaritalStatus)
kable(
  as.data.frame(table_maria),
  col.names = c("Tình trạng", "Số luọng"),
  caption = "<center>**Bảng 1: Số lượng khách hàng theo tình trạng hôn nhân**</center>"
)

Table: Bảng 1: Số lượng khách hàng theo tình trạng hôn nhân

Tình trạng	Số luọng
M	6866
S	7193

MaritalStatus_chart <- round((table(data$MaritalStatus)/sum(nrow(data)))*100 ,1)
kable(
  as.data.frame(MaritalStatus_chart),
  col.names = c("Tình trạng", "Tần suất"),
  caption = "<center>**Bảng 2: Tần suất khách hàng theo tình trạng hôn nhân**</center>"
)

Table: Bảng 2: Tần suất khách hàng theo tình trạng hôn nhân

Tình trạng	Tần suất
M	48.8
S	51.2

label_maria <- paste(MaritalStatus_chart, "%")
pie(MaritalStatus_chart, main = "BIỂU ĐỒ TÌNH TRẠNG HÔN NHÂN", radius = 1, col = c("violet", "lightcyan"))
legend("right",legend = label_maria, fill = c("violet", "lightcyan"), title = "Tình trạng", cex = 0.8, bty ="n")

==> Kết quả cung cấp dựa trên bộ dữ liệu thu thập được cho thấy có đến 48.8% khách hàng đã kết hôn và 51.2% khách hàng độc thân.

2.3. Biến Homeowner

Biến Homeowner thể hiện thông tin đã sở hữu nhà hoặc chưa của khách hàng.

table_homeowner <- table(data$Homeowner)
kable(
  as.data.frame(table_homeowner),
  col.names = c("Tình trạng", "Số lượng"),
  caption = "<center>**Bảng 1: Số lượng khách hàng đã sở hữu nhà**</center>"
)

Table: Bảng 1: Số lượng khách hàng đã sở hữu nhà

Tình trạng	Số lượng
N	5615
Y	8444

Homeowner_chart <- round((table(data$Homeowner)/sum(nrow(data)))*100 ,1)
kable(
  as.data.frame(Homeowner_chart),
  col.names = c("Tình trạng", "TTần suất"),
  caption = "<center>**Bảng 2: Tần suất khách hàng đã sở hữu nhà**</center>"
)

Table: Bảng 2: Tần suất khách hàng đã sở hữu nhà

Tình trạng	TTần suất
N	39.9
Y	60.1

label_Homeowner <- paste(Homeowner_chart, "%")
pie(Homeowner_chart, main = "BIỂU ĐỒ TÌNH TRẠNG KHÁCH HÀNG ĐÃ SỞ HỮU NHÀ", radius = 1, col = c("#66c2a5", "#fc8d62"))
legend("right",legend = label_maria, fill = c("#66c2a5", "#fc8d62"), title = "Tình trạng", cex = 0.8, bty ="n")

==> Kết quả cung cấp dựa trên bộ dữ liệu thu thập được cho thấy có đến 39.9% khách hàng đã sở hữu nhà và 60.1% khách hàng chưa sở hữu nhà. Điều này cũng phản ánh được khả nắng mua sắm và chi phối hành vi lựa chọn sản phẩm của khách hàng đã sở hữu nhà là cao hơn.

2.4 Biến Country

Biến Country cho biết số lượng khách hàng đến từ các quốc gia có được phân bổ đông đều hay không.

table_coutry <- table(data$Country)
kable(
  as.data.frame(table_coutry),
  col.names = c("Quốc gia", "Số lượng"),
  caption = "<center>**Bảng 1: Số lượng khách hàng đến từ các quốc gia**</center>"
)

Table: Bảng 1: Số lượng khách hàng đến từ các quốc gia

Quốc gia	Số lượng
Canada	809
Mexico	3688
USA	9562

Country_chart <- round((table(data$Country)/sum(nrow(data)))*100 ,1)
kable(
  as.data.frame(Country_chart),
  col.names = c("Quốc gia", "Tần suất"),
  caption = "<center>**Bảng 2: Tần suất khách hàng đến từ các quốc gia**</center>"
)

Table: Bảng 2: Tần suất khách hàng đến từ các quốc gia

Quốc gia	Tần suất
Canada	5.8
Mexico	26.2
USA	68.0

label_Country <- paste(Country_chart, "%")
barplot.default(Country_chart, main = "BIỂU ĐỒ PHÂN BỔ KHÁCH HÀNG TỪ CÁC QUỐC GIA", col = brewer.pal(3, "Set3"), xlab = "Quốc gia", ylab = "Tần suất)", cex.names = 0.8, width = 0.5)

==> Kết quả cung cấp dựa trên bộ dữ liệu thu thập được cho thấy có đến 5.8% khách hàng đến từ Canada, 26.2% khách hàng đến từ Mexico và 68% đến từ USA. Kết quả này phản ảnh sự chênh lệch khá lớn giữa 3 quốc gia. Số lượng khách hàng đến từ USA chiếm đông đảo so với Canada và Mexico, điều này cân nhắc chủ doanh nghiệp cần quan tâm nhiều hơn các đặc trưng của khách hàng Canada, Mexico và tập trung khai thác khách hàng USA.

2.5. Biến StateorProvince

2.5.1 Thống kê tần suất

table_StateorProvince <- table(data$StateorProvince)

kable(
  as.data.frame(table_StateorProvince),
  col.names = c("Tiểu bang", "Số lượng"),
  caption = "<center>**Bảng 1: Số lượng khách hàng đến từ các biểu bang**</center>"
)

Table: Bảng 1: Số lượng khách hàng đến từ các biểu bang

Tiểu bang	Số lượng
BC	809
CA	2733
DF	815
Guerrero	383
Jalisco	75
OR	2262
Veracruz	464
WA	4567
Yucatan	654
Zacatecas	1297

2.5.1 Trực quan hóa

StateorProvince_chart <- round((table(data$StateorProvince)/sum(nrow(data)))*100 ,1)
kable(
  as.data.frame(StateorProvince_chart),
  col.names = c("Tiểu bang", "Tần suất"),
  caption = "<center>**Bảng 2: Số lượng khách hàng đến từ các biểu bang**</center>"
)

Table: Bảng 2: Số lượng khách hàng đến từ các biểu bang

Tiểu bang	Tần suất
BC	5.8
CA	19.4
DF	5.8
Guerrero	2.7
Jalisco	0.5
OR	16.1
Veracruz	3.3
WA	32.5
Yucatan	4.7
Zacatecas	9.2

label_StateorProvince <- paste(StateorProvince_chart, "%")

max_val <- max(StateorProvince_chart)

bp <- barplot.default(StateorProvince_chart, main = "BIỂU ĐỒ PHÂN BỔ KHÁCH HÀNG ĐẾN TỪ CÁC TIỂU BANG", col = brewer.pal(10, "Spectral"), ylab = "Tần suất", cex.names = 0.8, width = 0.5, las = 2, ylim = c(0, max_val + 10), xaxt = "n")

text(
  x = bp,
  y = StateorProvince_chart + 1.5,        # Vị trí nhãn trên đầu cột
  labels = paste0(StateorProvince_chart, "%"),
  cex = 0.8                     
)
legend("topright",legend = names(StateorProvince_chart), fill = brewer.pal(10, "Spectral"), title = "Tiểu bang", cex = 0.8, bty ="n")

2.6. Biến City

table_City <- table(data$City)
kable(
  as.data.frame(table_City),
  col.names = c("Thành phố", "Số lượng"),
  caption = "<center>**Bảng 1: Số lượng khách hàng đến từ các thành phố**</center>"
)

Table: Bảng 1: Số lượng khách hàng đến từ các thành phố

Thành phố	Số lượng
Acapulco	383
Bellingham	143
Beverly Hills	811
Bremerton	834
Camacho	452
Guadalajara	75
Hidalgo	845
Los Angeles	926
Merida	654
Mexico City	194
Orizaba	464
Portland	876
Salem	1386
San Andres	621
San Diego	866
San Francisco	130
Seattle	922
Spokane	875
Tacoma	1257
Vancouver	633
Victoria	176
Walla Walla	160
Yakima	376

City_chart <- round((table(data$City)/sum(nrow(data)))*100 ,1)
kable(
  as.data.frame(City_chart),
  col.names = c("Thành phố", "Tần suất"),
  caption = "<center>**Bảng 2: Tần suất khách hàng đến từ các thành phố**</center>"
)

Table: Bảng 2: Tần suất khách hàng đến từ các thành phố

Thành phố	Tần suất
Acapulco	2.7
Bellingham	1.0
Beverly Hills	5.8
Bremerton	5.9
Camacho	3.2
Guadalajara	0.5
Hidalgo	6.0
Los Angeles	6.6
Merida	4.7
Mexico City	1.4
Orizaba	3.3
Portland	6.2
Salem	9.9
San Andres	4.4
San Diego	6.2
San Francisco	0.9
Seattle	6.6
Spokane	6.2
Tacoma	8.9
Vancouver	4.5
Victoria	1.3
Walla Walla	1.1
Yakima	2.7

ct <- as.data.frame(table(data$City))
ct$Perc <- round(100 * ct$Freq / sum(ct$Freq), 1)

ggplot(ct, aes(x = reorder(Var1, Perc), y = Perc)) +
  geom_col(fill = "lightgrey") +
  geom_text(aes(label = paste0(Perc, "%")), hjust = -0.1, size = 3) +
  coord_flip() +
  labs(title = "BIỂU ĐỒ PHÂN BỐ DỰA TRÊN THÀNH PHỐ", x = "Thành phố", y = "Tần suất") +
  theme_minimal() + theme(plot.title = element_text(hjust = 0.5))

2.7. Biến AnnualIncome

table_AnnualIncome <- table(data$AnnualIncome)
kable(
  as.data.frame(table_AnnualIncome),
  col.names = c("Khoảng thu nhập", "Số lượng"),
  caption = "<center>**Bảng 1: Số lượng khách hàng thuộc các khoảng thu nhập cá nhân**</center>"
)

Table: Bảng 1: Số lượng khách hàng thuộc các khoảng thu nhập cá nhân

Khoảng thu nhập	Số lượng
$10K - $30K	3090
$110K - $130K	643
$130K - $150K	760
$150K +	273
$30K - $50K	4601
$50K - $70K	2370
$70K - $90K	1709
$90K - $110K	613

AnnualIncome_chart <- round((table(data$AnnualIncome)/sum(nrow(data)))*100 ,1)
kable(
  as.data.frame(AnnualIncome_chart),
  col.names = c("Thu nhập cá nhân", "Tần suất"),
  caption = "<center>**Bảng 2: Tần suất khách hàng thuộc các khoảng thu nhập cá nhân**</center>"
)

Table: Bảng 2: Tần suất khách hàng thuộc các khoảng thu nhập cá nhân

Thu nhập cá nhân	Tần suất
$10K - $30K	22.0
$110K - $130K	4.6
$130K - $150K	5.4
$150K +	1.9
$30K - $50K	32.7
$50K - $70K	16.9
$70K - $90K	12.2
$90K - $110K	4.4

label_AnnualIncome<- paste(AnnualIncome_chart, "%")
max_val <- max(AnnualIncome_chart)

ai <- barplot.default(AnnualIncome_chart, main = "BIỂU ĐỒ PHÂN BỔ DỰA TRÊN KHOẢNG THU NHẬP CÁ NHÂN", col = brewer.pal(8, "Pastel1"), ylab = "Tần suất", cex.names = 0.5, width = 0.5, las = 2, ylim = c(0, max_val + 10), xaxt = "n")

text(
  x = ai,
  y = AnnualIncome_chart + 1.5,        # Vị trí nhãn trên đầu cột
  labels = paste0(AnnualIncome_chart, "%"),
  cex = 0.8                     
)

legend("topright",legend = names(AnnualIncome_chart), fill = brewer.pal(8, "Pastel1"), title = "Các khoản thu nhập cá nhân", cex = 0.8, bty ="n")

2.8. Biến ProductFamily

table_ProductFamily <- table(data$ProductFamily)
kable(
  as.data.frame(table_ProductFamily),
  col.names = c("Nhóm sản phẩm", "Số lượng"),
  caption = "<center>**Bảng 1: Số lượng thuộc các nhóm sản phẩm**</center>"
)

Table: Bảng 1: Số lượng thuộc các nhóm sản phẩm

Nhóm sản phẩm	Số lượng
Drink	1250
Food	10153
Non-Consumable	2656

ProductFamily_chart <- round((table(data$ProductFamily)/sum(nrow(data)))*100 ,1)
kable(
  as.data.frame(ProductFamily_chart),
  col.names = c("Nhóm sản phẩm", "Tỷ lệ (%)"),
  caption = "<center>**Bảng 2: Tần suất của các nhóm sản phẩm**</center>"
)

Table: Bảng 2: Tần suất của các nhóm sản phẩm

Nhóm sản phẩm	Tỷ lệ (%)
Drink	8.9
Food	72.2
Non-Consumable	18.9

label_ProductFamily<- paste(ProductFamily_chart, "%")
max_val <- max(ProductFamily_chart)

pf <- barplot.default(ProductFamily_chart, main = "BIỂU ĐỒ PHÂN BỔ DỰA TRÊN NHÓM SẢN PHẨM", col = brewer.pal(3, "Accent"), ylab = "Tỷ lệ (%)", cex.names = 0.5, width = 0.5, las = 2, ylim = c(0, max_val + 10), xaxt = "n")

text(
  x = pf,
  y = ProductFamily_chart + 3.5,        # Vị trí nhãn trên đầu cột
  labels = paste0(ProductFamily_chart, "%"),
  cex = 0.8                     # Kích cỡ nhãn
)

legend("topright",legend = names(ProductFamily_chart), fill = brewer.pal(3, "Accent"), title = "Nhóm sản phẩm", cex = 0.8, bty ="n")

2.9. Biến ProductDepartment

table_ProductDepartment <- table(data$ProductDepartment)
kable(
  as.data.frame(table_ProductDepartment),
  col.names = c("Bộ phận sản phẩm", "Số lượng"),
  caption = "<center>**Bảng 1: Số lượng thuộc các bộ phận sản phẩm**</center>"
)

Table: Bảng 1: Số lượng thuộc các bộ phận sản phẩm

Bộ phận sản phẩm	Số lượng
Alcoholic Beverages	356
Baked Goods	425
Baking Goods	1072
Beverages	680
Breakfast Foods	188
Canned Foods	977
Canned Products	109
Carousel	59
Checkout	82
Dairy	903
Deli	699
Eggs	198
Frozen Foods	1382
Health and Hygiene	893
Household	1420
Meat	89
Periodicals	202
Produce	1994
Seafood	102
Snack Foods	1600
Snacks	352
Starchy Foods	277

ProductDepartment_chart <- round((table(data$ProductDepartment)/sum(nrow(data)))*100 ,1)
kable(
  as.data.frame(ProductDepartment_chart),
  col.names = c("Bộ phận sản phẩm", "Tỷ lệ (%)"),
  caption = "<center>**Bảng 2: Tần suất của các bộ phận sản phẩm**</center>"
)

Table: Bảng 2: Tần suất của các bộ phận sản phẩm

Bộ phận sản phẩm	Tỷ lệ (%)
Alcoholic Beverages	2.5
Baked Goods	3.0
Baking Goods	7.6
Beverages	4.8
Breakfast Foods	1.3
Canned Foods	6.9
Canned Products	0.8
Carousel	0.4
Checkout	0.6
Dairy	6.4
Deli	5.0
Eggs	1.4
Frozen Foods	9.8
Health and Hygiene	6.4
Household	10.1
Meat	0.6
Periodicals	1.4
Produce	14.2
Seafood	0.7
Snack Foods	11.4
Snacks	2.5
Starchy Foods	2.0

df <- as.data.frame(table(data$ProductDepartment))
df$Perc <- round(100 * df$Freq / sum(df$Freq), 1)

ggplot(df, aes(x = reorder(Var1, Perc), y = Perc)) +
  geom_col(fill = "steelblue") +
  geom_text(aes(label = paste0(Perc, "%")), hjust = -0.1, size = 3) +
  coord_flip() +
  labs(title = "BIỂU ĐỒ PHÂN BỐ DỰA TRÊN BỘ PHẬN SẢN PHẨM", x = "Bộ phận", y = "Tần suất") +
  theme_minimal() + theme(plot.title = element_text(hjust = 0.5))

2.10. Biến ProductCategory

table_ProductCategory <- table(data$ProductCategory)
kable(
  as.data.frame(table_ProductCategory),
  col.names = c("Loại sản phẩm", "Số lượng"),
  caption = "<center>**Bảng 1: Số lượng thuộc các loại sản phẩm**</center>"
)

Table: Bảng 1: Số lượng thuộc các loại sản phẩm

Loại sản phẩm	Số lượng
Baking Goods	484
Bathroom Products	365
Beer and Wine	356
Bread	425
Breakfast Foods	417
Candles	45
Candy	352
Canned Anchovies	44
Canned Clams	53
Canned Oysters	35
Canned Sardines	40
Canned Shrimp	38
Canned Soup	404
Canned Tuna	87
Carbonated Beverages	154
Cleaning Supplies	189
Cold Remedies	93
Dairy	903
Decongestants	85
Drinks	135
Eggs	198
Electrical	355
Frozen Desserts	323
Frozen Entrees	118
Fruit	765
Hardware	129
Hot Beverages	226
Hygiene	197
Jams and Jellies	588
Kitchen Products	217
Magazines	202
Meat	761
Miscellaneous	42
Packaged Vegetables	48
Pain Relievers	192
Paper Products	345
Pizza	194
Plastic Products	141
Pure Juice Beverages	165
Seafood	102
Side Dishes	153
Snack Foods	1600
Specialty	289
Starchy Foods	277
Vegetables	1728

ProductCategory_chart <- round((table(data$ProductCategory)/sum(nrow(data)))*100 ,1)
kable(
  as.data.frame(ProductCategory_chart),
  col.names = c("Loại sản phẩm", "Tần suất"),
  caption = "<center>**Bảng 2: Tần suất của các loại sản phẩm**</center>"
)

Table: Bảng 2: Tần suất của các loại sản phẩm

Loại sản phẩm	Tần suất
Baking Goods	3.4
Bathroom Products	2.6
Beer and Wine	2.5
Bread	3.0
Breakfast Foods	3.0
Candles	0.3
Candy	2.5
Canned Anchovies	0.3
Canned Clams	0.4
Canned Oysters	0.2
Canned Sardines	0.3
Canned Shrimp	0.3
Canned Soup	2.9
Canned Tuna	0.6
Carbonated Beverages	1.1
Cleaning Supplies	1.3
Cold Remedies	0.7
Dairy	6.4
Decongestants	0.6
Drinks	1.0
Eggs	1.4
Electrical	2.5
Frozen Desserts	2.3
Frozen Entrees	0.8
Fruit	5.4
Hardware	0.9
Hot Beverages	1.6
Hygiene	1.4
Jams and Jellies	4.2
Kitchen Products	1.5
Magazines	1.4
Meat	5.4
Miscellaneous	0.3
Packaged Vegetables	0.3
Pain Relievers	1.4
Paper Products	2.5
Pizza	1.4
Plastic Products	1.0
Pure Juice Beverages	1.2
Seafood	0.7
Side Dishes	1.1
Snack Foods	11.4
Specialty	2.1
Starchy Foods	2.0
Vegetables	12.3

pc <- as.data.frame(table(data$ProductDepartment))
pc$Perc <- round(100 * pc$Freq / sum(pc$Freq), 1)

ggplot(pc, aes(x = reorder(Var1, Perc), y = Perc)) +
  geom_col(fill = "lightgreen") +
  geom_text(aes(label = paste0(Perc, "%")), hjust = -0.1, size = 3) +
  coord_flip() +
  labs(title = "BIỂU ĐỒ PHÂN BỐ DỰA TRÊN LOẠI SẢN PHẨM", x = "Loại sản phẩm", y = "Tần suất") +
  theme_minimal() + theme(plot.title = element_text(hjust = 0.5))

Phần 3. Ước lượng Khoảng và Kiểm định Giả thuyết cho Tỷ lệ (1 biến)

3.1. Biến Country với hạng mục USA

3.1.1. Ước lượng khoảng tin cậy

n <- nrow(data)
n_usa <- sum(data$Country == "USA")
x_usa <- n_usa / n
z <- qnorm(0.975)
se_usa <- sqrt(x_usa * (1 - x_usa) / n)
lower <- x_usa - z * se_usa
upper <- x_usa + z * se_usa
cat("Khoảng tin cậy 95% cho tỷ lệ khách hàng đến từ USA là:", round(lower, 4), "-", round(upper, 4), "\n")

## Khoảng tin cậy 95% cho tỷ lệ khách hàng đến từ USA là: 0.6724 - 0.6878

Ước lượng khoảng với độ tin cậy 95% cho thấy rằng nếu lặp lại quá trình lấy mẫu và tính khoảng tin cậy nhiều lần, thì khoảng 95% các khoảng tin cậy 0.6724 - 0.6878 sẽ chứa đúng tỷ lệ thực tế của tỷ lệ khách hàng đến từ USA.

3.1.2. Kiểm định giả thuyết

Thực hiện kiểm định giả thuyết cho rằng tỷ lệ khách hàng đến từ USA là 60%, ta có:

Bài toán kiểm định:

$H_0$: Tỷ lệ khách hàng đến từ $USA = 0.6$
$H_1$: Tỷ lệ khách hàng đến từ $USA \ne 0.6$

prop.test(x = n_usa, n = n, p = 0.6, alternative = "two.sided", conf.level = 0.95)

## 
##  1-sample proportions test with continuity correction
## 
## data:  n_usa out of n, null probability 0.6
## X-squared = 375.83, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.6
## 95 percent confidence interval:
##  0.6723397 0.6878289
## sample estimates:
##         p 
## 0.6801337

Kết quả cho thấy:

Giá trị P- value = 0.6801337
Với độ tin cậy 95%, p-value = 0.6801337 > 0.05. Không có cơ sở bác bỏ giả thuyết $H_0$, tức không thể nói rằng tỷ lệ kháng hàng đến từ USA là khác 60%.

3.2. Biến StateorProvince với hạng mục WA

3.2.1. Ước lượng khoảng tin cậy

n <- nrow(data)
n_wa <- sum(data$StateorProvince == "WA")
x_wa <- n_wa / n
z <- qnorm(0.975)
se_wa <- sqrt(x_wa * (1 - x_wa) / n)
lower <- x_wa - z * se_wa
upper <- x_wa + z * se_wa
cat("Khoảng tin cậy 95% cho tỷ lệ khách hàng đến từ bang WA là:", round(lower, 4), "-", round(upper, 4), "\n")

## Khoảng tin cậy 95% cho tỷ lệ khách hàng đến từ bang WA là: 0.3171 - 0.3326

Ước lượng khoảng với độ tin cậy 95% cho thấy rằng nếu lặp lại quá trình lấy mẫu và tính khoảng tin cậy nhiều lần, thì khoảng 95% các khoảng tin cậy 0.3171 - 0.3326 sẽ chứa đúng tỷ lệ thực tế của tỷ lệ khách hàng đến từ bang WA.

3.2.2. Kiểm định giả thuyết

Thực hiện kiểm định giả thuyết cho rằng tỷ lệ khách hàng đến từ bang WA là có thể hơn 80%, ta có:

Bài toán kiểm định:

$H_0$: Tỷ lệ khách hàng đến từ bang $WA \geq 0.8$
$H_1$: Tỷ lệ khách hàng đến từ bang $WA < 0.8$

prop.test(x = n_wa, n = n, p = 0.8, alternative = "greater", conf.level = 0.95)

## 
##  1-sample proportions test with continuity correction
## 
## data:  n_wa out of n, null probability 0.8
## X-squared = 19835, df = 1, p-value = 1
## alternative hypothesis: true p is greater than 0.8
## 95 percent confidence interval:
##  0.3183475 1.0000000
## sample estimates:
##         p 
## 0.3248453

Kết quả cho thấy:

Giá trị P- value = 0.3248453
Với độ tin cậy 95%, p-value = 0.3248453 > 0.05. Không có cơ sở bác bỏ giả thuyết $H_0$, tức không thể nói rằng tỷ lệ kháng hàng đến từ bang WA là ít hơn 80%.

3.3. Biến ProductFamily với hạng mục Drink

3.3.1. Ước lượng khoảng tin cậy

n <- nrow(data)
n_Drink <- sum(data$ProductFamilly == "Drink")
x_Drink <- n_Drink / n
z <- qnorm(0.975)
se_Drink <- sqrt(x_Drink * (1 - x_Drink) / n)
lower <- x_Drink - z * se_Drink
upper <- x_Drink + z * se_Drink
cat("Ước lượng khoảng tin cậy 95% cho tỷ lệ tiêu thụ sản phẩm về đồ uống là:", round(lower, 4), "-", round(upper, 4), "\n")

## Ước lượng khoảng tin cậy 95% cho tỷ lệ tiêu thụ sản phẩm về đồ uống là: 0 - 0

Ước lượng khoảng với độ tin cậy 95% cho thấy rằng nếu lặp lại quá trình lấy mẫu và tính khoảng tin cậy nhiều lần, thì khoảng 95% các khoảng tin cậy 0 - 0 sẽ chứa đúng tỷ lệ thực tế của tỷ lệ tiêu thụ sản phẩm về đồ uống.

3.3.2. Kiểm định giả thuyết

Thực hiện kiểm định giả thuyết cho rằng tỷ lệ tiêu thụ sản phẩm về đồ uống trong nhóm sản phẩm là 30%, ta có:

Bài toán kiểm định:

$H_0$: Tỷ lệ $Drink = 0.3$
$H_1$: Tỷ lệ $Drink \ne 0.3$

prop.test(x = n_Drink, n = n, p = 0.3, alternative = "two.sided", conf.level = 0.95)

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

Kết quả cho thấy:

Giá trị P- value = 0
Với độ tin cậy 95%, p-value = 0 < 0.05. Bác bỏ giả thuyết $H_0$, tức có cơ sở để nói rằng tỷ lệ tiêu thụ sản phẩm về đồ uống trong nhóm sản phẩm gia đình là 30%.

Phần 4. Phân tích mối quan hệ giữa hai biến định tính

4.1. Cặp biến Gender và ProductFamily

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

table_pct <- data %>%
  tabyl(Gender, ProductFamily) %>%
  adorn_totals(where = c("row", "col")) %>%
  adorn_percentages("row") %>%
  adorn_pct_formatting()

kable(table_pct,
      caption = "<center>**Bảng Tần suất chéo: Gender và ProductFamily**</center>",
      align = "c")

Table: Bảng Tần suất chéo: Gender và ProductFamily

Gender	Drink	Food	Non-Consumable	Total
F	9.3%	71.8%	18.9%	100.0%
M	8.4%	72.6%	18.9%	100.0%
Total	8.9%	72.2%	18.9%	100.0%

Tỷ lệ phần trăm của bảng tần suất chéo giữa Gender và ProductFamily được tính toán theo hàng, nhằm cho biết trong từng nhóm của biến hàng là nam và nữ thì sẽ có bao nhiêu phần trăm nam và bao nhiêu phần trăm nữ mua Drink, Food,…

Kết quả thống kê tần suất ghi nhận:

Không có sự khác biệt lớn giữa nam và nữ về phân bổ loại sản phẩm.
Food là nhóm sản được ưu tiên trong giỏ hàng ở cả hai giới (trên 70%).
Nữ có xu hướng chọn Drink nhiều hơn một chút so với nam, lần lượt với tần suất là 9.3% và 8.4%.

Dòng total cuối bảng thể hiện tỷ lệ phân phối của Nhóm sản phẩm trên toàn bộ khách hàng. Kết quả cho thấy nhóm nữ có 9.3% chọn Drink trong khi toàn bộ chỉ có 8.9%, tức nhiều hơn mức trung bình chung.

4.1.2 Trực quan hóa

tb1 <- table(data$Gender, data$ProductFamily)
prop_tb1 <- prop.table(tb1, margin = 1) * 100
print(round(prop_tb1, 1))

##    
##     Drink Food Non-Consumable
##   F   9.3 71.8           18.9
##   M   8.4 72.6           18.9

bar_values <- barplot(prop_tb1, beside = TRUE, legend = TRUE,
        col = c("skyblue", "pink"),
        main = "Giới tính và Nhóm sản phẩm",
        xlab = "Nhóm sản phẩm", ylab = "Tần suất", ylim = c(0, max(prop_tb1) + 10), args.legend = list(title = "Giới tính",
                                         x = "topright",   # Vị trí
                                         cex = 0.8))

text(x = bar_values,
     y = prop_tb1,
     labels = paste0(round(prop_tb1, 1), "%"),
     pos = 3, cex = 0.8, col = "black")

Dữ liệu không cho thấy mối liên hệ mạnh giữa giới tính và nhóm sản phẩm. Sự khác biệt là rất nhỏ, không có xu hướng rõ ràng cho thấy một giới tính nào đó ưa chuộng một nhóm sản phẩm cụ thể hơn.

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

Thực hiện kiểm định Chi-squared nhằm xác định mối liên hệ giữa hai biến Giới tính và Nhóm sản phẩm có ý nghĩa thống kê hay không.

Bài toán kiểm định:

$H_0$: Hai biến Giới tính và Nhóm sản phẩm độc lập với nhau (không có mối liên hệ).
$H_1$: Hai biến Giới tính và Nhóm sản phẩm có mối liên hệ với nhau.

chisq_test1 <- chisq.test(tb1)
print(chisq_test1)

## 
##  Pearson's Chi-squared test
## 
## data:  tb1
## X-squared = 3.5185, df = 2, p-value = 0.1722

Kết quả của bài toán có:

Giá trị Chi-bình phương là 3.5185
Bậc tự do df = 2
Giá trị P- value = 0.1722

Với mức ý nghĩa 5%, p - value = 0.1721748 > 0.05. Không có cơ sở bác bỏ giả thuyết $H_0$. Tức không có mối liên hệ rõ ràng giữa hai biến Gender và ProductFamily.

4.2 Cặp biến MaritalStatus và Homeowner

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

table2 <- data %>%
  tabyl(MaritalStatus, Homeowner) %>%
  adorn_totals(where = c("row", "col")) %>%
  adorn_percentages("col") %>%
  adorn_pct_formatting()

kable(table2,
      caption = "<center>**Bảng Tần suất chéo: MaritalStatus và Homeowner**</center>",
      align = "c")

Table: Bảng Tần suất chéo: MaritalStatus và Homeowner

MaritalStatus	N	Y	Total
M	30.6%	61.0%	48.8%
S	69.4%	39.0%	51.2%
Total	100.0%	100.0%	100.0%

Tỷ lệ phần trăm của bảng tần suất chéo giữa MaritalStatus và Homeowner được tính toán theo cột, nhằm cho biết trong từng nhóm đối tượng khách hàng đã kết hơn và đối tượng khách hàng độc thân thì sẽ có bao nhiêu phần trăm khách hàng đã kết hôn sở hữu nhà và không.

Kết quả thống kê tần suất ghi nhận:

Có sự khác biệt lớn giữa hai đối tượng khách hàng về tình trạng sở hữu nhà.
Trong số các đối tượng khách hàng không sở hữu nhà, có đến 69.4% là người độc thân.
Trong số các đối tượng khách hàng đã sở hữu nhà, có đến 61% là người đã kết hôn.

4.2.2 Trực quan hóa

tb2 <- table(data$MaritalStatus, data$Homeowner)
prop_tb2 <- prop.table(tb2, margin = 2) * 100
print(round(prop_tb2, 1))

##    
##        N    Y
##   M 30.6 61.0
##   S 69.4 39.0

bar_values2 <- barplot(prop_tb2, beside = TRUE, legend = TRUE,
        col = c("peachpuff", "darkseagreen"),
        main = "Tình trạng hôn nhân và Sở hữu nhà",
        xlab = "Homeowner", ylab = "Tần suất (%)", ylim = c(0, max(prop_tb2) + 10), args.legend = list(title = "Tình trạng hôn nhân",
                                         x = "topright",   
                                         cex = 0.8))

text(x = bar_values2,
     y = prop_tb2,
     labels = paste0(round(prop_tb2, 1), "%"),
     pos = 3, cex = 0.8, col = "black")

Dữ liệu cho thấy có mối liên hệ mạnh giữa tình trạng hôn nhân và sở hữu nhà. Sự khác biệt là tương đối đồng đều khi tỷ lệ nhóm người đã kết hôn nhưng chưa có nhà là khá thấp và ngược lại, nhóm người độc thân nhưng có sở hữu nhà cũng không chênh lệch là bao.

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

Thực hiện kiểm định Chi-squared nhằm xác định mối liên hệ giữa hai MaritalStatus và Homeowner có ý nghĩa thống kê hay không.

Bài toán kiểm định:

$H_0$: Hai biến MaritalStatus và Homeowner độc lập với nhau (không có mối liên hệ).
$H_1$: Hai biến MaritalStatus và Homeowner có mối liên hệ với nhau.

chisq_test2 <- chisq.test(tb2)
print(chisq_test2)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tb2
## X-squared = 1241.2, df = 1, p-value < 2.2e-16

Kết quả của bài toán có:

Giá trị Chi-bình phương là 1241.2
Bậc tự do df = 1
Giá trị P- value = 2.2e-16

Với mức ý nghĩa 5%, p - value = 6.7245065^{-272} < 0.05. Bác bỏ giả thuyết $H_0$. Tức có mối liên hệ giữa hai biến MaritalStatus và Homeowner.

Mối quan hệ tương quan này có thể được giải thích ở một số khía cạnh như xã hội , kinh tế. Thông thường, người đã kết hôn thường có nhu cầu ổn định hơn về chỗ ở, do lập gia đình, có con. Họ cũng có thể có khả năng tài chính tốt hơn, vì có thể kết hợp thu nhập từ hai người. Ngược lại, người độc thân thường ưu tiên linh hoạt, hoặc chưa đạt đến mức tài chính cần thiết để mua nhà.Mối quan hệ này có ý nghĩa về mặt thống kê và mang tính thực tiễn.

4.3 Cặp biến StateorProvince và ProductFamily

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

table3 <- data %>%
  tabyl(StateorProvince, ProductFamily) %>%
  adorn_totals(where = c("row", "col")) %>%
  adorn_percentages("col") %>%
  adorn_pct_formatting()

kable(table3,
      caption = "<center>**Bảng Tần suất chéo: StateorProvince và ProductFamily**</center>",
      align = "c")

Table: Bảng Tần suất chéo: StateorProvince và ProductFamily

StateorProvince	Drink	Food	Non-Consumable	Total
BC	5.5%	5.7%	6.0%	5.8%
CA	20.6%	19.4%	18.9%	19.4%
DF	5.2%	5.9%	5.7%	5.8%
Guerrero	3.3%	2.7%	2.6%	2.7%
Jalisco	0.4%	0.6%	0.5%	0.5%
OR	15.9%	16.0%	16.3%	16.1%
Veracruz	3.5%	3.2%	3.7%	3.3%
WA	31.9%	32.4%	33.2%	32.5%
Yucatan	3.8%	4.9%	4.2%	4.7%
Zacatecas	9.8%	9.3%	8.8%	9.2%
Total	100.0%	100.0%	100.0%	100.0%

Tỷ lệ phần trăm của bảng tần suất chéo giữa StateorProvince và ProductFamily được tính toán theo cột, nhằm cho biết trong từng nhóm sản phẩm, khách hàng đến từ các tiêu bang chiếm bao nhiêu tỷ lệ tiêu thụ sản phẩm Drnk, Food,..

Kết quả thống kê tần suất ghi nhận:

Trong hầu hết các nhóm sản phẩm, khách hàng đến từ bang WA đều có lượng tiêu thụ nhiều nhất với lần lượt là Drink 31.9%, Food 32.4% và Non-Consumable 33.2%. Trong khi đó, Jalisco tiêu thụ ít nhất với lần lượt là 0.4%, 0.6% và 0.5%.

4.1.2 Trực quan hóa

tbl_stack <- table(data$StateorProvince, data$ProductFamily)
prop_stack <- prop.table(tbl_stack, margin = 2) * 100
print(round(prop_stack, 1))

##            
##             Drink Food Non-Consumable
##   BC          5.5  5.7            6.0
##   CA         20.6 19.4           18.9
##   DF          5.2  5.9            5.7
##   Guerrero    3.3  2.7            2.6
##   Jalisco     0.4  0.6            0.5
##   OR         15.9 16.0           16.3
##   Veracruz    3.5  3.2            3.7
##   WA         31.9 32.4           33.2
##   Yucatan     3.8  4.9            4.2
##   Zacatecas   9.8  9.3            8.8

par(mar = c(5, 5, 4, 10), xpd = TRUE)

barplot(prop_stack,
        col = rainbow(nrow(tbl_stack)),  # mỗi loại sản phẩm một màu
        main = "Nhóm sản phẩm theo Tiểu bang",
        ylab = "Tần suất (%)",
        las = 1)
legend("topright", inset = c(-0.3, 0), 
       legend = rownames(tbl_stack),
       fill = rainbow(nrow(tbl_stack)),
       title = "Tiểu bang", bty = "n", cex = 0.8)

Dữ liệu được trực quan phản ánh WA là tiểu bang nổi bật nhất trong cả 3 nhóm sản phẩm, có thị trường khách hàng tiêu thụ lớn so với các khách hàng đến từ các tiểu bang khác. Điều này có thể phản ánh sự khác nhau về nhu cầu tiêu dùng, dân số hoặc phân phối hàng hóa giữa các vùng miền.

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

Thực hiện kiểm định Chi-squared nhằm xác định mối liên hệ giữa hai biến StateorProvince và ProductFamily có ý nghĩa thống kê hay không.

Bài toán kiểm định:

$H_0$: Hai biến StateorProvince và ProductFamily độc lập với nhau (không có mối liên hệ).
$H_1$: Hai biến StateorProvince và ProductFamily có mối liên hệ với nhau.

tb3 <- table(data$StateorProvince, data$ProductFamily)
chisq_test3 <- chisq.test(tb3)
print(chisq_test3)

## 
##  Pearson's Chi-squared test
## 
## data:  tb3
## X-squared = 12.3, df = 18, p-value = 0.8314

Kết quả của bài toán có:

Giá trị Chi-bình phương là 12.33
Bậc tự do df = 18
Giá trị P- value = 0.8314

Với mức ý nghĩa 5%, p - value = 0.8313894 > 0.05. Không có cơ sở bác bỏ giả thuyết $H_0$. Tức không có mối liên hệ rõ ràng giữa hai biến StateorProvince và ProductFamily.

Phần 5. Tổng kết và Thảo luận

5.1. Tóm tắt những phát hiện chính

Mối quan hệ giữa tình trạng hôn nhân và sở hữu nhà: Có mối liên hệ đáng kể giữa Marital Status và Homeowner, Khách hàng đã kết hôn có xu hướng sở hữu nhà cao hơn so với khách hàng độc thân hoặc khác.

Phân bố giới tính theo nhóm sản phẩm: Một số nhóm sản phẩm có tỷ lệ mua bởi nữ và nam đều không có chênh lệch quá lớn, thể hiện nhu cầu mua sắm ở một số nhóm sản phẩm đều cần thiết với cả hai giới tính.

Phân bố sản phẩm theo bang: Một số bang như WA chiếm tỷ trọng cao về tiêu thụ sản phẩm.Các nhóm sản phẩm có sự khác biệt về mức độ phổ biến theo từng khu vực địa lý và phần đông khách hàng cũng đến từ bang WA.

5.2. Hạn chế của phân tích

Phân tích chỉ sử dụng các biến định tính, kkhông bao gồm các yếu tố định lượng như thu nhập, độ tuổi, số lượng sản phẩm đã mua. Điều đó gây nên hạn chế độ sâu của phân tích hành vi tiêu dùng.

Chất lượng của dữ liệu chưa đảm bảo về sự phân bố không đồng đều, ảnh hưởng đến độ tin cậy của kiểm định thống kê.

5.3. Đề xuất

Phân khúc khách hàng theo địa lý và tình trạng hôn nhân: Nhắm quảng cáo hoặc ưu đãi sở hữu nhà cho khách hàng đã kết hôn tại các bang có tỷ trọng cao.

Tùy biến sản phẩm theo giới tính và bang: Phát triển chiến lược phân phối hoặc tiếp thị theo nhu cầu tiêu dùng phân biệt theo giới và khu vực.

Tận dụng insights để phát triển các sản phẩm/thông điệp phù hợp hơn với từng phân khúc khách hàng và sản phâm tiêu dùng phổ biến. Ví dụ như nhóm khách hàng chưa sở hữu nhà, tài chính thấp.

5.4. Hướng nghiên cứu tiếp theo

Thực hiện các phân tích chuyên sâu với đầy đủ các yếu tố trực quan từ nhiều biến định tinh và biến định lượng khác nhằm phân loại phân khúc khách hàng cũng như hành vi tiêu thụ các loại sản phẩm tiêu dùng của đa dạng tệp khách hàng.

Thông qua phân tích sợ bộ có thể tìm thấy các insights quan trọng trả lời cho các câu hỏi như: Có mối liên hệ nào giữa tần suất mua sắm và loại sản phẩm? hay Tác động của độ tuổi và thu nhập đến hành vi mua hàng?,… nhằm đưa ra chiến lược hỗ trợ phù hợp trong hoạt động kinh doanh.

Phần 6. Suy diễn trong thống kê

6.1. Tổng quan lý thuyết

6.1.1 Hiệu hai tỷ lệ (Risk Difference - RD)

a. Định nghĩa

Hiệu hai tỷ lệ là sự khác biệt tuyệt đối về nguy cơ (tỷ lệ) xảy ra kết cục giữa nhóm phơi nhiễm và nhóm không phơi nhiễm.Nó cho biết việc phơi nhiễm làm tăng hoặc giảm bao nhiêu phần trăm điểm (percentage points) nguy cơ xảy ra kết cục. Đây là một thước đo tác động tuyệt đối (absolute effect).

b. Công thức

Công thức tính:

\[ RD = R_E - R_{NE} \] Trong đó:

Nguy cơ ở nhóm phơi nhiễm (Risk in Exposed):

\[ R_E = \frac{a}{a + b} \]

Nguy cơ ở nhóm không phơi nhiễm (Risk in Unexposed):

\[ R_{NE} = \frac{c}{c + d} \]

c. Diễn giải

RD > 0: Phơi nhiễm làm tăng nguy cơ.
RD < 0: Phơi nhiễm làm giảm nguy cơ (tác dụng bảo vệ).
RD = 0: Phơi nhiễm không ảnh hưởng đến nguy cơ.

d. Khoảng tin cậy cho RD

Khoảng tin cậy cho biết khoảng giá trị hợp lý của RD trong quần thể.

Tính phương sai (Variance) của RD:

\[ Var(RD) = \frac{R_E(1 - R_E)}{a + b} + \frac{R_{NE}(1 - R_{NE})}{c + d} \]

Tính sai số chuẩn (Standard Error):

\[ SE(RD) = \sqrt{Var(RD)} \]

Tính 95% CI:

\[ RD \pm 1.96 \times SE(RD) \]

Diễn giải CL: Nếu khoảng tin cậy chứa số 0, sự khác biệt không có ý nghĩa thống kê (ở mức ý nghĩa 5%).

6.2.1 Nguy cơ tương đối (Relative Risk - RR)

a. Định nghĩa

Nguy cơ tương đối là tỷ số của nguy cơ ở nhóm phơi nhiễm so với nguy cơ ở nhóm không phơi nhiễm. Nó cho biết những người phơi nhiễm có nguy cơ xảy ra kết cục cao gấp bao nhiêu lần so với những người không phơi nhiễm. Đây là một thước đo tác động tương đối (relative effect). B. Cách tính

b. Công thức

\[ RR = \frac{R_E}{R_{NE}} = \frac{a / (a + b)}{c / (c + d)} \]

c. Diễn giải

RR = 1: Phơi nhiễm không ảnh hưởng đến nguy cơ..
RR < 1: Phơi nhiễm làm giảm nguy cơ.
RR > 1: Phơi nhiễm làm tăng nguy cơ.

d. Khoảng tin cậy cho RR

Vì phân phối của RR bị lệch nên khoảng tin cậy của nó phải được tính trên thang logarit.

Tính log(RR)

\[ \ln(RR) \] 2. Tính sai số chuẩn của log(RR)

\[ SE(\ln(RR)) = \sqrt{\frac{1 - R_E}{a} + \frac{1 - R_{NE}}{c}} = \sqrt{\frac{b}{a(a + b)} + \frac{d}{c(c + d)}} \] 3. Tính khoảng tin cậy 95% trên thang log

\[ \ln(RR) \pm 1.96 \times SE(\ln(RR)) \] 4. Đổi về thang đo ban đầu (RR)

\[ CI = e^{\ln(RR) \pm 1.96 \times SE(\ln(RR))} \] Diễn giải CI: Nếu khoảng tin cậy chứa số 1, kết quả không có ý nghĩa thống kê.

6.3.1 Tỷ số chênh (Odds Ratio - OR)

a. Định nghĩa

Odds

Tỷ số chênh (Odds) là tỷ lệ giữa xác suất xảy ra một biến cố và xác suất không xảy ra biến cố đó.

Nếu Odds < 1 → Sự kiện xảy ra kém khả năng hơn không xảy ra.
Nếu Odds = 1 → Cân bằng giữa xảy ra và không xảy ra.
Nếu Odds > 1 → Sự kiện xảy ra nhiều khả năng hơn.

Odds = P / (1-P).

Odds Ratio

OR là tỷ số của odds xảy ra kết cục ở nhóm phơi nhiễm so với odds xảy ra kết cục ở nhóm không phơi nhiễm. Nhằm so sánh tỷ số chênh của việc có kết cục giữa hai nhóm.

b. Công thức

Odds ở nhóm phơi nhiễm:

\[ Odds_E = \frac{a / (a + b)}{b / (a + b)} = \frac{a}{b} \]

Odds ở nhóm không phơi nhiễm:

\[ Odds_{NE} = \frac{c}{d} \]

Công thức OR từ bảng 2x2:

\[ OR = \frac{Odds_E}{Odds_{NE}} = \frac{a / b}{c / d} = \frac{a \times d}{b \times c} \]

c. Diễn giải

OR > 1: Tỷ số chênh của kết cục cao hơn ở nhóm phơi nhiễm.
OR < 1: Tỷ số chênh của kết cục thấp hơn ở nhóm phơi nhiễm.
OR = 1: Không có mối liên hệ.

Đặc biệt:

Nếu OR = 2, có thể hiểu rằng nhóm phơi nhiễm có nguy cơ xảy ra kết cục cao gấp 2 lần so với nhóm không phơi nhiễm.
OR xấp xỉ RR khi kết quả là hiếm trong quần thể nghiên cứu. Dựa trên công thức toán học của OR và RR có thể được diễn giải cho sự khác biệt này là cốt lõi nằm ở mẫu số của các tỷ lệ bên trong: RR dùng a+b (tổng số người phơi nhiễm) và c+d (tổng số người không phơi nhiễm), trong khi OR chỉ dùng b (số người phơi nhiễm không có kết cục) và d (số người không phơi nhiễm không có kết cục).
OR có những đặc tính toán học, đặc biệt trong Hồi quy Logistic (Logistic Regression). Hồi quy logistic là một trong những mô hình thống kê mạnh mẽ và phổ biến nhất để phân tích các kết cục dạng nhị phân (có/không, bệnh/khỏe, đậu/rớt) và đầu ra trực tiếp của mô hình hồi quy logistic chính là log của Odds Ratio (log-odds).

d. Khoảng tin cậy cho RO

Tương tự như RR, tỷ số này cũng được tính trên thang logarit.

Tính log(OR):
\[ \ln(OR) \]
Sai số chuẩn của log(OR):
\[ SE(\ln(OR)) = \sqrt{ \frac{1}{a} + \frac{1}{b} + \frac{1}{c} + \frac{1}{d} } \]
Khoảng tin cậy 95% trên thang log:
\[ \ln(OR) \pm 1.96 \times SE(\ln(OR)) \]
Đổi về thang đo ban đầu:
\[ CI = e^{\ln(OR) \pm 1.96 \times SE(\ln(OR))} \]

Diễn giải CI: Nếu khoảng tin cậy chứa số 1, kết quả không có ý nghĩa thống kê.

6.2. THỰC HÀNH TRÊN R

Với cặp biến nhị phân Homeowner và MaritalStatus, ta có bảng ngẫu nhiên 2x2 như sau:

# đưa Y (phơi nhiễm) lên trên.
data$Homeowner <- factor(data$Homeowner, levels = c("Y", "N"))  
bnn <- table(data$Homeowner, data$MaritalStatus)
kable(bnn,
      caption = "<center>**Bảng Tần suất chéo: Homeowner và MaritalStatus**</center>",
      align = "c")

Table: Bảng Tần suất chéo: Homeowner và MaritalStatus

	M	S
Y	5147	3297
N	1719	3896

a. Hiệu hai tỷ lệ (Risk Difference - RD)

re <- round((5147/8444),3)
cat("Tỷ lệ có nhà ở nhóm đã kết hôn là", re * 100, "%", "\n")

## Tỷ lệ có nhà ở nhóm đã kết hôn là 61 %

r_ne <- round((1719/3896),3)
cat("Tỷ lệ không có nhà ở nhóm đã kết hôn là", r_ne * 100, "%", "\n")

## Tỷ lệ không có nhà ở nhóm đã kết hôn là 44.1 %

kq_RD <- round((re - r_ne),3)  
cat("Risk Difference", kq_RD, "\n")

## Risk Difference 0.169

Nhận xét:

Kết quả RD = 0.169 cho biết rằng nhóm người đã kết hôn có khả năng tăng 16.9% cơ hội sở hữu nhà so với nhóm người độc thân.

b. Tỷ lệ tương đối (Relative Risk - RR)

ppb <- addmargins(bnn)
kable(ppb,
      caption = "<center>**Bảng phân phối biên: Homeowner và MaritalStatus**</center>",
      align = "c")

Table: Bảng phân phối biên: Homeowner và MaritalStatus

	M	S	Sum
Y	5147	3297	8444
N	1719	3896	5615
Sum	6866	7193	14059

kq_RelRisk <- round(RelRisk(bnn), 3)
cat("Relative Risk:", kq_RelRisk, "\n")

## Relative Risk: 1.991

Nhận xét:

Kết quả RR = 1.991 cho biết rằng người đã kết hôn có khả năng sở hữu nhà cao gấp 1.991 lần so với người độc thân.

c. Tỷ lệ chênh (Odds Ratio - OR)

Odds_e <- round(((5147/3297)*100) ,1)
cat("Odds nhóm người đã kết hôn có sở hữu nhà là", Odds_e, "%", "\n")

## Odds nhóm người đã kết hôn có sở hữu nhà là 156.1 %

Odds_ne <- round(((1719/3896)*100) ,1)
cat("Odds nhóm người đã kết hôn không sở hữu nhà là", Odds_ne, "%", "\n")

## Odds nhóm người đã kết hôn không sở hữu nhà là 44.1 %

kq_OR <- OddsRatio(bnn)
cat("Odds Ratio:", kq_OR, "\n")

## Odds Ratio: 3.538167

Nhận xét:

Với Odds nhóm người đã kết hôn có sở hữu nhà cho biết trong số những người đã kết hôn, tỷ lệ giữa người sở hữu nhà và không sở hữu nhà là 156.1. Hay với mỗi 1 người đã kết hôn không sở hữu nhà, thì có khoảng 156.1 người đã kết hôn sở hữu nhà.
Với Odds nhóm người chưa kết hôn có sở hữu nhà cho biết trong số những người chưa kết hôn, tỷ lệ giữa người sở hữu nhà và không sở hữu nhà là 44.1. Tức, với mỗi 1 người chưa kết hôn không sở hữu nhà, chỉ có 44.1 người (ít hơn 1) sở hữu nhà. Điều này phản ánh mức độ sở hữu nhà của nhóm chưa kết hôn là khá thấp.
Kết quả OR = 3.5 cho thấy khả năng sở hữu nhà của người đã kết hôn cao hơn gấp 3.5 lần so với người chưa kết hôn.”

d. Khoảng tin cậy 95% cho Odds Ratio

ktc <- OddsRatio(bnn,conf.level = .95)

kable(ktc,
      caption = "<center>**Bảng ước lượng KTC Odds Ratio**</center>",
      align = "c")

Table: Bảng ước lượng KTC Odds Ratio

	x
odds ratio	3.538167
lwr.ci	3.293561
upr.ci	3.800939

cat("Khoảng tin cậy 95% cho Odds Ratio là:", 3.293561, "-", 3.800939, "\n")

## Khoảng tin cậy 95% cho Odds Ratio là: 3.293561 - 3.800939

Nhận xét:

Kết quả với OR = 3.54, (CL 95%: 3.29 - 3.8) cho thấy rằng người đã kết hôn có khả năng sở hữu nhà cao hơn khoảng 3.54 lần so với người chưa kết hôn. Vì toàn bộ khoảng tin cậy đều lớn hơn 1, điều này cho thấy mối liên hệ có ý nghĩa thống kê, tức là không do ngẫu nhiên.

6.3 VÍ DỤ THỰC TIỄN

Tình huống:

Một cửa hàng kinh doanh thức uống gửi phiếu đánh dấu nhận quà kèm với đơn hàng đầu tiên. Mục tiêu là kiểm tra xem việc nhận phiếu đánh dấu có tác động đến hành vi mua lại của khách hàng hay không.

a. Tạo bảng dữ liệu 2x2:

data <- matrix(c(240, 160, 180, 320),
               nrow = 2, byrow = TRUE,
               dimnames = list(
                 GiftClaimed = c("Đã nhận phiếu", "Không nhận phiếu"),
                 RepeatPurchase = c("Mua lại", "Không mua lại")))
d <- addmargins(data)

kable(d, format = "html", caption = "<center><b>Bảng tần suất chéo: Phiếu nhận quà và hành vi mua lại</b></center>") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),
                full_width = T,
                position = "center")

**Bảng tần suất chéo: Phiếu nhận quà và hành vi mua lại**
	Mua lại	Không mua lại	Sum
Đã nhận phiếu	240	160	400
Không nhận phiếu	180	320	500
Sum	420	480	900

b. Tính RD, RR, OR và khoảng tin cậy của OR:

re_th <- round((240/400),3)
cat("Tỷ lệ mua lại của nhóm nhận phiếu là", re_th * 100, "%", "\n")

## Tỷ lệ mua lại của nhóm nhận phiếu là 60 %

ne_th <- round((180/500),3)
cat("Tỷ lệ mua lại của nhóm không nhận phiếu là", ne_th * 100, "%", "\n")

## Tỷ lệ mua lại của nhóm không nhận phiếu là 36 %

th_RD <- round((re_th - ne_th),3)  
cat("Risk Difference", th_RD, "\n")

## Risk Difference 0.24

th_RelRisk <- round(RelRisk(data), 3)
cat("Relative Risk:", th_RelRisk, "\n")

## Relative Risk: 1.667

Odds_e_th <- round((240/160) ,1)
cat("Tỷ lệ mua lại/không mua lại khi đã nhận phiếu là ", Odds_e_th, "%", "\n")

## Tỷ lệ mua lại/không mua lại khi đã nhận phiếu là  1.5 %

Odds_ne_th <- round((180/320) ,1)
cat("Tỷ lệ mua lại/không mua lại khi không nhận phiếu là", Odds_ne_th, "%", "\n")

## Tỷ lệ mua lại/không mua lại khi không nhận phiếu là 0.6 %

th_OR <- OddsRatio(bnn)
cat("Odds Ratio:", th_OR, "\n")

## Odds Ratio: 3.538167

ktc_th <- OddsRatio(data,conf.level = .95)

kable(ktc_th,
      caption = "<center>**Bảng ước lượng KTC Odds Ratio**</center>",
      align = "c")

Table: Bảng ước lượng KTC Odds Ratio

	x
odds ratio	2.666667
lwr.ci	2.033943
upr.ci	3.496218

cat("Khoảng tin cậy 95% cho Odds Ratio là:", 2.033943, "-", 3.496218, "\n")

## Khoảng tin cậy 95% cho Odds Ratio là: 2.033943 - 3.496218

Kết quả ghi nhận

Tỷ lệ mua lại của nhóm khách hàng đã nhận phiếu cao hơn so với nhóm khách hàng không nhận phiếu với lần lượt là 60% và 36%.
Hiệu hai tỷ lệ RD = 0.24 cho biết hành vi mua lại khi đã nhận phiếu điểm có khả năng tăng 24% so với không nhận phiếu quà.
Tỷ lệ tương đối RR = 1.667 cho biết khả năng mua lại của nhóm đã nhận phiếu cao gấp 1.667 lần so với nhóm không nhận được phiếu.
Tỷ lệ mua lại/không mua lại khi đã nhận phiếu đạt 1.5. Tức, trong nhóm những người đã nhận phiếu, xác suất xảy ra hành vi mua lại cao hơn xác suất không mua lại là 0.15 lần. Với 400 người nhận phiếu có 240 người mua lại và 160 không mua lại.
Tỷ lệ mua lại/không mua lại khi không nhận phiếu đạt 0.56. Tức, trong nhóm những người không nhận phiếu, xác suất xảy ra hành vi mua lại (odds) là 0.56 thấp hơn khả năng không mua lại. Cụ thể, cứ 1 người không mua lại thì chỉ có khoảng 0.56 người mua lại.
Tỷ lệ chênh OR = 2.667 (CL 95%: 2.033943 - 3.496218) cho thấy những người nhận phiếu điểm có khả năng mua lại cao gấp 2.667 lần so với những người không nhận phiếu điểm. Vì toàn bộ khoảng tin cậy đều lớn hơn 1, điều này cho thấy mối liên hệ giữa hành vi mua lại hàng và phiếu điểm có ý nghĩa thống kê, tức là không do ngẫu nhiên.