library(csv)
d <- read.csv("C:/Users/PC/Downloads/Supermarket Transactions.csv")
Ta lập file dữ liệu mới với tên data chỉ gồm các biến định tính.
data1 <- c("Gender", "MaritalStatus", "Homeowner",
"AnnualIncome", "City", "StateorProvince",
"Country" , "ProductFamily", "ProductDepartment", "ProductCategory")
dldt <-d[, data1]
Kiểm tra và loại bỏ các biến NA
anyNA(dldt)
## [1] FALSE
dldt <- na.omit(dldt)
Chuyển đổi dữ liệu định tính sang factor
sapply(dldt, class)
## Gender MaritalStatus Homeowner AnnualIncome
## "character" "character" "character" "character"
## City StateorProvince Country ProductFamily
## "character" "character" "character" "character"
## ProductDepartment ProductCategory
## "character" "character"
dldt[] <- lapply(dldt, as.factor)
dldt<- data.frame(lapply(dldt, as.factor))
Bảng tần suất
HN1 <- table(dldt$MaritalStatus)/sum(nrow(dldt))
HN1
##
## M S
## 0.4883704 0.5116296
Bảng tần số
HN2<-table(dldt$MaritalStatus)
HN2
##
## M S
## 6866 7193
Vậy trong data này có 48.8370439% đã kết hôn và 51.1629561% chưa kết hôn
Biểu đồ
# Vẽ biểu đồ tròn
pie(HN2 ,
main = "Tình trạng hôn nhân",
labels = paste0(names(HN2),
" (", round(HN1 *100, 1), "%)"),
col = c("blue", "red"))
# Đếm số người kết hôn (M) và độc thân (S)
HN_counts <- table(dldt$MaritalStatus)
# Chênh lệch về số lượng giữa hai nhóm
HN_diff <- abs(HN_counts["M"] - HN_counts["S"])
HN_diff
## M
## 327
Trong bộ dữ liệu này có sự chênh lệnh nhất định về tình trạng hôn nhân. Sự chênh lệch tuyệt đối giữa số người kết hôn và chưa kết hôn là 327 người.
Bảng tần suất
c1 <- table(dldt$City)/sum(nrow(dldt))
c1
##
## Acapulco Bellingham Beverly Hills Bremerton Camacho
## 0.027242336 0.010171420 0.057685468 0.059321431 0.032150224
## Guadalajara Hidalgo Los Angeles Merida Mexico City
## 0.005334661 0.060103848 0.065865282 0.046518245 0.013798990
## Orizaba Portland Salem San Andres San Diego
## 0.033003770 0.062308841 0.098584537 0.044170994 0.061597553
## San Francisco Seattle Spokane Tacoma Vancouver
## 0.009246746 0.065580767 0.062237712 0.089408920 0.045024539
## Victoria Walla Walla Yakima
## 0.012518671 0.011380610 0.026744434
Bảng tần số
c2<-table(dldt$City)
c2
##
## Acapulco Bellingham Beverly Hills Bremerton Camacho
## 383 143 811 834 452
## Guadalajara Hidalgo Los Angeles Merida Mexico City
## 75 845 926 654 194
## Orizaba Portland Salem San Andres San Diego
## 464 876 1386 621 866
## San Francisco Seattle Spokane Tacoma Vancouver
## 130 922 875 1257 633
## Victoria Walla Walla Yakima
## 176 160 376
Vậy trong data này có 2.72% sống ở Acapulco và 1.02% sống ở Bellingham.
Tiếp theo, có 5.77% sống ở Beverly Hills, 5.93% ở Bremerton và 3.22% ở Camacho.
Trong khi đó, chỉ 0.53% cư dân sống ở Guadalajara và 6.01% ở Hidalgo. Los Angeles có tỷ lệ cao hơn với 6.59%.
Mexico City chiếm 1.38%, thấp hơn so với Portland (6.23%) và Salem (9.86%).
Các thành phố tại Washington như Seattle (6.56%), Spokane (6.22%), và Tacoma (8.94%) có tỷ lệ đáng kể.
Cuối cùng, các khu vực nhỏ như Victoria (1.25%), Walla Walla (1.14%) và Yakima (2.67%) chỉ chiếm phần nhỏ.
Biểu đồ
library(ggplot2)
# Bảng tần suất và phần trăm dưới dạng data.frame
c_df <- as.data.frame(table(dldt$City))
colnames(c_df) <- c("City", "Frequency")
c_df$Percentage <- round(c_df$Frequency / sum(c_df$Frequency) * 100, 2)
# Vẽ biểu đồ cột
ggplot(c_df, aes(x = reorder(City, -Percentage), y = Percentage, fill = City)) +
geom_col(width = 0.6) +
geom_text(aes(label = paste0(Percentage, "%")), vjust = -0.3, size = 3) +
labs(
title = "Phân bố theo thành phố",
x = "Thành phố",
y = "Phần trăm (%)"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "none")
-> Mức giao dịch có sự chênh lệch rõ rệt giữa các thành phố, với một số thành phố có mức giao dịch rất cao, trong khi một số khác lại có mức giao dịch thấp. Điều này có thể do các yếu tố như dân số, nhu cầu thị trường, hoặc mức độ phát triển kinh tế tại mỗi thành phố. Các thành phố lớn như Los Angeles, San Diego và Portland có xu hướng có mức giao dịch cao hơn, trong khi các thành phố như Guadalajara và Acapulco có thể đang gặp khó khăn trong việc thu hút giao dịch.
Bảng tần suất
BT1 <- table(dldt$StateorProvince)/sum(nrow(dldt))
BT1
##
## BC CA DF Guerrero Jalisco OR
## 0.057543211 0.194395049 0.057969984 0.027242336 0.005334661 0.160893378
## Veracruz WA Yucatan Zacatecas
## 0.033003770 0.324845295 0.046518245 0.092254072
Bảng tần số
BT2<-table(dldt$StateorProvince)
BT2
##
## BC CA DF Guerrero Jalisco OR Veracruz WA
## 809 2733 815 383 75 2262 464 4567
## Yucatan Zacatecas
## 654 1297
Vậy trong data này có 5.75% tỷ lệ giao dịch sống ở BC và 19.44% sống ở CA.
Tiếp theo, có 5.80% tỷ lệ giao dịch sống ở DF, 2.72% ở Guerrero và 0.53% ở Jalisco.
Trong khi đó, OR chiếm 16.09% và Veracruz là 3.30%. Tỷ lệ cao nhất là bang WA với 32.48%.
Yucatan có tỷ lệ 4.65%, trong khi Zacatecas chiếm 9.23% tổng số khách hàng trong dữ liệu.
Điều này điều thể hiện qua biểu đồ Tần số giao dịch theo tiểu bang
library(ggplot2)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
state_counts <- dldt %>%
count(StateorProvince)
ggplot(state_counts, aes(x = reorder(StateorProvince, n), y = n)) +
geom_bar(stat = "identity", fill = "blue") +
geom_text(aes(label = n), hjust = -0.1, size = 3.5) +
coord_flip() +
labs(title = "Tần số giao dịch theo tiểu bang",
x = "State / Province",
y = "Số giao dịch") +
theme_minimal()
Bảng tần suất
co1 <- table(dldt$Country)/sum(nrow(dldt))
co1
##
## Canada Mexico USA
## 0.05754321 0.26232307 0.68013372
Bảng tần số
co2<-table(dldt$Country)
co2
##
## Canada Mexico USA
## 809 3688 9562
Vậy trong data này có 5.7543211% giao dịch mua hàng tại Canada, 26.2323067% giao dịch mua hàng tại Mexico và 68.0133722% tại USA.
Các tính toán này được thống kê qua biểu đồ “Phân bố lượt mua hàng theo Country”.
Biểu đồ
# Vẽ biểu đồ tròn với 3 thành phố
pie(co1,
main = "Phân bố lượt mua hàng theo Country",
labels = paste0(names(co1),
" (", round(co1*100 , 1), "%)"),
col = c("blue", "red", "green"))
Bảng tần suất
f1 <- table(dldt$ProductFamily)/sum(nrow(dldt))
f1
##
## Drink Food Non-Consumable
## 0.08891102 0.72217085 0.18891813
Bảng tần số
f2<-table(dldt$ProductFamily)
f2
##
## Drink Food Non-Consumable
## 1250 10153 2656
Phần lớn sản phẩm được bán là thực phẩm với 72.2170851% , tiếp theo là hàng phi tiêu dùng 18.8918131% và đồ uống 8.8911018%. Điều này cho thấy thực phẩm là nhóm hàng chủ lực trong hoạt động bán lẻ của siêu thị.
Biểu đồ minh họa được thể hiện là biểu đồ tròn.
Biểu đồ
# Vẽ biểu đồ tròn với 3 thành phố
pie(f2,
main = "Phân bố theo ProductFamily",
labels = paste0(names(f2),
" (", round(f2 , 1), ")"),
col = c("blue", "red", "green"))
Bảng tần suất
dp1 <- table(dldt$ProductDepartment)/sum(nrow(dldt))*100
dp1
##
## Alcoholic Beverages Baked Goods Baking Goods Beverages
## 2.5321858 3.0229746 7.6250089 4.8367594
## Breakfast Foods Canned Foods Canned Products Carousel
## 1.3372217 6.9492852 0.7753041 0.4196600
## Checkout Dairy Deli Eggs
## 0.5832563 6.4229319 4.9719041 1.4083505
## Frozen Foods Health and Hygiene Household Meat
## 9.8300021 6.3518031 10.1002916 0.6330464
## Periodicals Produce Seafood Snack Foods
## 1.4368020 14.1830856 0.7255139 11.3806103
## Snacks Starchy Foods
## 2.5037343 1.9702682
Bảng tần số
dp2<-table(dldt$ProductDepartment)
dp2
##
## Alcoholic Beverages Baked Goods Baking Goods Beverages
## 356 425 1072 680
## Breakfast Foods Canned Foods Canned Products Carousel
## 188 977 109 59
## Checkout Dairy Deli Eggs
## 82 903 699 198
## Frozen Foods Health and Hygiene Household Meat
## 1382 893 1420 89
## Periodicals Produce Seafood Snack Foods
## 202 1994 102 1600
## Snacks Starchy Foods
## 352 277
Vậy trong data này có 2.53% sản phẩm thuộc nhóm Alcoholic Beverages và 3.02% thuộc Baked Goods.
Baking Goods chiếm 7.63%, cao hơn Breakfast Foods 1.34% và Canned Products 0.78%.
Canned Foods chiếm 6.95%, trong khi Carousel và Checkout chỉ chiếm lần lượt 0.42% và 0.58%.
Các nhóm lớn hơn gồm Dairy 6.42%, Deli 4.97% và Eggs 1.41%.
Frozen Foods chiếm 9.83%, Health and Hygiene là 6.35%, trong khi Household là một trong các nhóm lớn nhất với 10.10%.
Nhóm sản phẩm chiếm tỷ lệ cao nhất là Produce, với 14.18%, tiếp theo là Snack Foods 11.38%.
Ngược lại, một số nhóm nhỏ như Meat 0.63%, Seafood 0.73% và Starchy Foods 1.97% chỉ chiếm một phần nhỏ trong tổng phân phối.
dept_counts <- dldt %>%
count(ProductDepartment)
ggplot(dept_counts, aes(x = reorder(ProductDepartment, n), y = n)) +
geom_bar(stat = "identity", fill = "pink") +
geom_text(aes(label = n), hjust = -0.1, size = 3.5) +
coord_flip() +
labs(title = "Tần số giao dịch theo phòng ban sản phẩm",
x = "Phòng ban sản phẩm (ProductDepartment)",
y = "Số lượng giao dịch") +
theme_minimal()
Bảng tần suất
pc1 <- table(dldt$ProductCategory)/sum(nrow(dldt))*100
pc1
##
## Baking Goods Bathroom Products Beer and Wine
## 3.4426346 2.5962017 2.5321858
## Bread Breakfast Foods Candles
## 3.0229746 2.9660716 0.3200797
## Candy Canned Anchovies Canned Clams
## 2.5037343 0.3129668 0.3769827
## Canned Oysters Canned Sardines Canned Shrimp
## 0.2489508 0.2845153 0.2702895
## Canned Soup Canned Tuna Carbonated Beverages
## 2.8736041 0.6188207 1.0953837
## Cleaning Supplies Cold Remedies Dairy
## 1.3443346 0.6614980 6.4229319
## Decongestants Drinks Eggs
## 0.6045949 0.9602390 1.4083505
## Electrical Frozen Desserts Frozen Entrees
## 2.5250729 2.2974607 0.8393200
## Fruit Hardware Hot Beverages
## 5.4413543 0.9175617 1.6075112
## Hygiene Jams and Jellies Kitchen Products
## 1.4012376 4.1823743 1.5434953
## Magazines Meat Miscellaneous
## 1.4368020 5.4129028 0.2987410
## Packaged Vegetables Pain Relievers Paper Products
## 0.3414183 1.3656732 2.4539441
## Pizza Plastic Products Pure Juice Beverages
## 1.3798990 1.0029163 1.1736254
## Seafood Side Dishes Snack Foods
## 0.7255139 1.0882709 11.3806103
## Specialty Starchy Foods Vegetables
## 2.0556227 1.9702682 12.2910591
Bảng tần số
pc2<-table(dldt$ProductCategory)
pc2
##
## Baking Goods Bathroom Products Beer and Wine
## 484 365 356
## Bread Breakfast Foods Candles
## 425 417 45
## Candy Canned Anchovies Canned Clams
## 352 44 53
## Canned Oysters Canned Sardines Canned Shrimp
## 35 40 38
## Canned Soup Canned Tuna Carbonated Beverages
## 404 87 154
## Cleaning Supplies Cold Remedies Dairy
## 189 93 903
## Decongestants Drinks Eggs
## 85 135 198
## Electrical Frozen Desserts Frozen Entrees
## 355 323 118
## Fruit Hardware Hot Beverages
## 765 129 226
## Hygiene Jams and Jellies Kitchen Products
## 197 588 217
## Magazines Meat Miscellaneous
## 202 761 42
## Packaged Vegetables Pain Relievers Paper Products
## 48 192 345
## Pizza Plastic Products Pure Juice Beverages
## 194 141 165
## Seafood Side Dishes Snack Foods
## 102 153 1600
## Specialty Starchy Foods Vegetables
## 289 277 1728
Vậy trong data này có 3.44% sản phẩm thuộc nhóm Baking Goods, 2.60% là Bathroom Products, và 2.53% là Beer and Wine.
Tiếp theo, Bread chiếm 3.02%, Breakfast Foods 2.97%, còn Candles chỉ chiếm 0.32%.
Các nhóm như Candy 2.50%, Canned Anchovies 0.31%, Canned Clams 0.38%, Canned Oysters 0.25% và Canned Shrimp 0.27% có tỷ lệ rất nhỏ.
Canned Soup chiếm 2.87%, cao hơn Canned Tuna 0.62% và Carbonated Beverages 1.10%.
Cleaning Supplies có tỷ lệ 1.34%, Cold Remedies là 0.66%, trong khi Dairy là một trong các nhóm lớn với 6.42%. Drinks chiếm 0.96%, còn Eggs là 1.41%.
Frozen Desserts 2.30% và Frozen Entrees 0.84% thấp hơn so với Fruit 5.44% và Meat 5.41%.
Hot Beverages chiếm 1.61%, Hygiene 1.40%, Jams and Jellies 4.18%, và Kitchen Products 1.54%.
Các nhóm khác như Magazines 1.44%, Miscellaneous 0.30% và Packaged Vegetables 0.34% chiếm tỷ lệ khá nhỏ.
Paper Products có 2.45%, Pizza là 1.38%, và Snack Foods đứng đầu với 11.38%.
Cuối cùng, nhóm Vegetables chiếm tỷ lệ cao nhất với 12.29%, tiếp theo là Snack Foods, trong khi các nhóm nhỏ như Seafood 0.73% và Side Dishes 1.09% chỉ đóng góp một phần nhỏ trong tổng phân phối.
dt_counts <- dldt %>%
count(ProductCategory)
ggplot(dt_counts, aes(x = reorder(ProductCategory, n), y = n)) +
geom_bar(stat = "identity", fill = "yellow")+
geom_text(aes(label = n), hjust = -0.1, size = 2) +
coord_flip() +
labs(title = "Doanh mục mua hàng cụ thể",
x = "Danh mục (ProductCategory)",
y = "Số lượng giao dịch") +
theme_minimal()
Bảng tần suất
g1 <- table(d$Gender)/sum(nrow(d))
g1
##
## F M
## 0.5099936 0.4900064
Bảng tần số
g2<-table(d$Gender)
g2
##
## F M
## 7170 6889
Vậy trong data này có 50.9993598% là nữ 51.1629561% là nam
Biểu đồ
# Vẽ biểu đồ tròn
pie(g2 ,
main = "Tỷ lệ giới tính",
labels = paste0(names(g2),
" (", round(g1 *100, 1), "%)"),
col = c("blue", "red"))
Bảng tần suất
H1 <- table(d$Homeowner)/sum(nrow(d))
H1
##
## N Y
## 0.3993883 0.6006117
Bảng tần số
H2<-table(d$Homeowner)
H2
##
## N Y
## 5615 8444
Vậy trong data này có 39.9388292% đã có nhà và 60.0611708% chưa có nhà
Biểu đồ
# Vẽ biểu đồ tròn
pie(H2 ,
main = "Phân bố sở hữu nhà",
labels = paste0(names(H2),
" (", round(H1 *100, 1), "%)"),
col = c("blue", "red"))
Bảng tần suất
A1 <- table(d$AnnualIncome)/sum(nrow(dldt))*100
A1
##
## $10K - $30K $110K - $130K $130K - $150K $150K + $30K - $50K
## 21.978804 4.573583 5.405790 1.941817 32.726367
## $50K - $70K $70K - $90K $90K - $110K
## 16.857529 12.155914 4.360196
Bảng tần số
A2<-table(d$AnnualIncome)
A2
##
## $10K - $30K $110K - $130K $130K - $150K $150K + $30K - $50K
## 3090 643 760 273 4601
## $50K - $70K $70K - $90K $90K - $110K
## 2370 1709 613
Nhóm 30K–50k chiếm tỷ lệ lớn nhất với 32.7%, cao gấp hơn 16 lần so với nhóm thu nhập cao nhất ($150K+), chỉ đạt 1.94%.
Các nhóm thu nhập từ 90K trở lên (gồm 4 nhóm) đều có tỷ lệ dưới 5.5%, thấp hơn nhóm trung bình 30K–50K từ ~27–31 điểm phần trăm, cho thấy mức độ tham gia rất thấp từ nhóm thu nhập cao.
Ngược lại, nhóm thu nhập thấp (10K–30K) chiếm ~22%, thấp hơn nhóm trung bình ~10.7 điểm phần trăm, nhưng vẫn cho thấy sự tham gia tương đối đáng kể.
Nhìn chung, dữ liệu thể hiện một xu hướng rõ ràng: giao dịch tập trung chủ yếu ở nhóm thu nhập trung bình–thấp, trong khi nhóm thu nhập cao có tỷ lệ tham gia rất khiêm tốn, phản ánh sự phân bố không đồng đều về mặt thu nhập trong tập khách hàng.
Biểu đồ
library(ggplot2)
library(dplyr)
# Đếm số giao dịch theo AnnualIncome và sắp xếp
at_counts <- dldt %>%
count(AnnualIncome)
ggplot(at_counts, aes(x = reorder(AnnualIncome, -n), y = n, fill = AnnualIncome)) +
geom_bar(stat = "identity") +
geom_text(aes(label = n), vjust = -0.3, size = 3) +
labs(title = "Doanh mục mua hàng theo Annual Income",
x = "Thu nhập hằng năm (AnnualIncome)",
y = "Số lượng giao dịch",
fill = "AnnualIncome") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_fill_viridis_d(option = "C", begin = 0.2, end = 0.9)
Giả sử “Nữ” có mã là “F” trong cột ‘Gender’. Kiểm tra levels(dldt$Gender) để chắc chắn.
# Ghi chú: Đoạn code về 'table_rr' và 'riskratio' đã được loại bỏ khỏi đây.
# Nếu bạn muốn phân tích mối quan hệ giữa Gender và Homeowner, nó nên ở Phần 4.
category_female <- "F"
N_female <- sum(dldt$Gender == category_female) # Số lượng nữ
N_total_gender <- nrow(dldt) # Tổng số quan sát
cat(paste("Số người nữ (Gender =", category_female, "):", N_female, "\n"))
## Số người nữ (Gender = F ): 7170
cat(paste("Tổng số quan sát:", N_total_gender, "\n\n"))
## Tổng số quan sát: 14059
Giả thuyết: H0: Tỷ lệ nữ trong tổng thể là 50% (p_female = 0.5) H1: Tỷ lệ nữ trong tổng thể khác 50% (p_female != 0.5)
p0_female <- 0.5
# Tính khoảng tin cậy 95% và kiểm định giả thuyết
test_female_results <- prop.test(x = N_female, n = N_total_gender, p = p0_female, correct = FALSE)
cat("Kết quả kiểm định cho tỷ lệ nữ:\n")
## Kết quả kiểm định cho tỷ lệ nữ:
print(test_female_results)
##
## 1-sample proportions test without continuity correction
##
## data: N_female out of N_total_gender, null probability p0_female
## X-squared = 5.6164, df = 1, p-value = 0.01779
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
## 0.5017287 0.5182531
## sample estimates:
## p
## 0.5099936
# Trích xuất các giá trị từ kết quả kiểm định
p_value_female <- test_female_results$p.value
sample_p_female <- test_female_results$estimate
conf_int_female <- test_female_results$conf.int
cat("\nDiễn giải kết quả kiểm định cho Giới tính Nữ:\n")
##
## Diễn giải kết quả kiểm định cho Giới tính Nữ:
cat(paste0(" - Khoảng tin cậy 95% cho tỷ lệ nữ trong tổng thể là (",
round(conf_int_female[1], 4), ", ",
round(conf_int_female[2], 4), ").\n"))
## - Khoảng tin cậy 95% cho tỷ lệ nữ trong tổng thể là (0.5017, 0.5183).
cat(paste0(" Ý nghĩa: Chúng ta tin tưởng 95% rằng tỷ lệ thực sự của nữ trong toàn bộ khách hàng nằm trong khoảng này.\n"))
## Ý nghĩa: Chúng ta tin tưởng 95% rằng tỷ lệ thực sự của nữ trong toàn bộ khách hàng nằm trong khoảng này.
cat(paste0(" - Tỷ lệ nữ trong mẫu (p-hat) là: ", round(sample_p_female, 4), " (hay ", round(sample_p_female*100, 2), "%).\n"))
## - Tỷ lệ nữ trong mẫu (p-hat) là: 0.51 (hay 51%).
cat(paste0(" - Giá trị p-value của kiểm định là: ", format.pval(p_value_female, digits=4, eps=0.0001), ".\n"))
## - Giá trị p-value của kiểm định là: 0.01779.
alpha <- 0.05 # Mức ý nghĩa
cat(paste0("\nVới mức ý nghĩa alpha = ", alpha, ":\n"))
##
## Với mức ý nghĩa alpha = 0.05:
if (p_value_female < alpha) {
cat(paste0(" - Kết luận: Vì p-value (", format.pval(p_value_female, digits=4, eps=0.0001), ") < ", alpha,
", chúng ta BÁC BỎ giả thuyết H0.\n"))
cat(paste0(" Có đủ bằng chứng thống kê để kết luận rằng tỷ lệ nữ thực sự trong tổng thể KHÁC ", p0_female*100, "%.\n"))
} else {
cat(paste0(" - Kết luận: Vì p-value (", format.pval(p_value_female, digits=4, eps=0.0001), ") >= ", alpha,
", chúng ta KHÔNG BÁC BỎ giả thuyết H0.\n"))
cat(paste0(" Không có đủ bằng chứng thống kê để kết luận rằng tỷ lệ nữ thực sự trong tổng thể khác ", p0_female*100,
"%. (Tức là, không thể loại trừ khả năng tỷ lệ nữ là 50%).\n"))
}
## - Kết luận: Vì p-value (0.01779) < 0.05, chúng ta BÁC BỎ giả thuyết H0.
## Có đủ bằng chứng thống kê để kết luận rằng tỷ lệ nữ thực sự trong tổng thể KHÁC 50%.
library(knitr)
library(kableExtra)
result_meaning_female_df <- data.frame(
Phần = c(
"X-squared",
"df",
"p-value",
"alternative hypothesis",
"95% confidence interval",
"sample estimate p"
),
Giá_trị_từ_R = c(
round(test_female_results$statistic, 4),
test_female_results$parameter,
format.pval(test_female_results$p.value, digits = 4, eps = 0.0001),
test_female_results$alternative,
paste0("(", round(test_female_results$conf.int[1], 4), ", ", round(test_female_results$conf.int[2], 4), ")"),
round(test_female_results$estimate, 7)
),
Ý_nghĩa_chung = c(
"Giá trị thống kê kiểm định Chi-square.",
"Bậc tự do của kiểm định.",
"Xác suất để dữ liệu quan sát được (hoặc cực đoan hơn) xuất hiện nếu giả thuyết H₀ đúng.",
"Giả thuyết thay thế được sử dụng (ở đây là hai phía).",
"Khoảng tin cậy 95% cho tỷ lệ trong tổng thể.",
"Tỷ lệ ước lượng từ dữ liệu mẫu."
),
stringsAsFactors = FALSE
)
kable(result_meaning_female_df,
col.names = c("Phần Output", "Giá trị từ R", "Ý nghĩa chung"),
align = c("l", "r", "l"),
caption = "Giải thích kết quả của `prop.test()` cho giới tính Nữ") %>%
kable_styling(full_width = FALSE, bootstrap_options = c("striped", "bordered", "hover")) %>%
column_spec(1, bold = TRUE)
Phần Output | Giá trị từ R | Ý nghĩa chung |
---|---|---|
X-squared | 5.6164 | Giá trị thống kê kiểm định Chi-square. |
df | 1 | Bậc tự do của kiểm định. |
p-value | 0.01779 | Xác suất để dữ liệu quan sát được (hoặc cực đoan hơn) xuất hiện nếu giả thuyết H₀ đúng. |
alternative hypothesis | two.sided | Giả thuyết thay thế được sử dụng (ở đây là hai phía). |
95% confidence interval | (0.5017, 0.5183) | Khoảng tin cậy 95% cho tỷ lệ trong tổng thể. |
sample estimate p | 0.5099936 | Tỷ lệ ước lượng từ dữ liệu mẫu. |
Giả sử “Có nhà” có mã là “Y” trong cột ‘Homeowner’. Kiểm tra levels(dldt$Homeowner).
# Số người có nhà
category_homeowner_y <- "Y"
N_homeowner_y <- sum(dldt$Homeowner == category_homeowner_y)
# Tổng số quan sát
N_total_homeowner <- nrow(dldt) # Tổng số quan sát
cat(paste("Số người sở hữu nhà (Homeowner =", category_homeowner_y, "):", N_homeowner_y, "\n"))
## Số người sở hữu nhà (Homeowner = Y ): 8444
cat(paste("Tổng số quan sát:", N_total_homeowner, "\n\n"))
## Tổng số quan sát: 14059
Giả thuyết H0: Tỷ lệ người sở hữu nhà là 60% (p_homeowner = 0.6) H1: Tỷ lệ người sở hữu nhà khác 60% (p_homeowner != 0.6)
p0_homeowner <- 0.6
test_homeowner_results <- prop.test(x = N_homeowner_y, n = N_total_homeowner, p = p0_homeowner, correct = FALSE)
cat("Kết quả kiểm định cho tỷ lệ sở hữu nhà:\n")
## Kết quả kiểm định cho tỷ lệ sở hữu nhà:
print(test_homeowner_results)
##
## 1-sample proportions test without continuity correction
##
## data: N_homeowner_y out of N_total_homeowner, null probability p0_homeowner
## X-squared = 0.02192, df = 1, p-value = 0.8823
## alternative hypothesis: true p is not equal to 0.6
## 95 percent confidence interval:
## 0.5924894 0.6086791
## sample estimates:
## p
## 0.6006117
p_value_homeowner <- test_homeowner_results$p.value
sample_p_homeowner <- test_homeowner_results$estimate
conf_int_homeowner <- test_homeowner_results$conf.int
cat("\nDiễn giải kết quả kiểm định cho Sở hữu nhà 'Y':\n")
##
## Diễn giải kết quả kiểm định cho Sở hữu nhà 'Y':
cat(paste0(" - Khoảng tin cậy 95% cho tỷ lệ sở hữu nhà là (",
round(conf_int_homeowner[1], 4), ", ", round(conf_int_homeowner[2], 4), ").\n"))
## - Khoảng tin cậy 95% cho tỷ lệ sở hữu nhà là (0.5925, 0.6087).
cat(paste0(" - Tỷ lệ sở hữu nhà trong mẫu (p-hat) là: ", round(sample_p_homeowner, 4), ".\n"))
## - Tỷ lệ sở hữu nhà trong mẫu (p-hat) là: 0.6006.
cat(paste0(" - Giá trị p-value của kiểm định là: ", format.pval(p_value_homeowner, digits=4, eps=0.0001), ".\n"))
## - Giá trị p-value của kiểm định là: 0.8823.
alpha <- 0.05
cat(paste0("\nVới mức ý nghĩa alpha = ", alpha, ":\n"))
##
## Với mức ý nghĩa alpha = 0.05:
if (p_value_homeowner < alpha) {
cat(paste0(" - Kết luận: Vì p-value < ", alpha, ", chúng ta BÁC BỎ giả thuyết H0.\n"))
cat(paste0(" Có đủ bằng chứng thống kê để kết luận rằng tỷ lệ người sở hữu nhà thực sự trong tổng thể KHÁC ", p0_homeowner*100, "%.\n"))
} else {
cat(paste0(" - Kết luận: Vì p-value >= ", alpha, ", chúng ta KHÔNG BÁC BỎ giả thuyết H0.\n"))
cat(paste0(" Không có đủ bằng chứng thống kê để kết luận rằng tỷ lệ người sở hữu nhà khác ", p0_homeowner*100, "%.\n"))
}
## - Kết luận: Vì p-value >= 0.05, chúng ta KHÔNG BÁC BỎ giả thuyết H0.
## Không có đủ bằng chứng thống kê để kết luận rằng tỷ lệ người sở hữu nhà khác 60%.
# Bảng giải thích (đã sửa để lấy giá trị động)
result_meaning_H_df <- data.frame(
Phần = c("X-squared", "df", "p-value", "alternative hypothesis", "95% confidence interval", "sample estimate p"),
Giá_trị_từ_R = c(
round(test_homeowner_results$statistic, 2), # Sửa lại số liệu cho khớp
test_homeowner_results$parameter,
format.pval(test_homeowner_results$p.value, digits=4, eps=0.0001), # Hiển thị p-value đúng
test_homeowner_results$alternative,
paste0("(", round(test_homeowner_results$conf.int[1],4), ", ", round(test_homeowner_results$conf.int[2],4), ")"),
round(test_homeowner_results$estimate, 7)
),
Ý_nghĩa = c(
"Giá trị thống kê kiểm định Chi-square.",
"Bậc tự do.",
"Xác suất quan sát dữ liệu như hiện tại hoặc cực đoan hơn khi H0 đúng.",
"Kiểm định hai phía.",
"Khoảng tin cậy 95% cho tỷ lệ có nhà thật trong dân số.",
"Tỷ lệ có nhà trong mẫu."
),
stringsAsFactors = FALSE
)
kable(result_meaning_H_df, col.names = c("Phần Output", "Giá trị từ R", "Ý nghĩa"), align = c("l", "r", "l"),
caption = "Giải thích output của prop.test cho Sở hữu nhà 'Y'") %>%
kable_styling(full_width = FALSE, bootstrap_options = c("striped", "bordered", "hover")) %>%
column_spec(1, bold = TRUE)
Phần Output | Giá trị từ R | Ý nghĩa |
---|---|---|
X-squared | 0.02 | Giá trị thống kê kiểm định Chi-square. |
df | 1 | Bậc tự do. |
p-value | 0.8823 | Xác suất quan sát dữ liệu như hiện tại hoặc cực đoan hơn khi H0 đúng. |
alternative hypothesis | two.sided | Kiểm định hai phía. |
95% confidence interval | (0.5925, 0.6087) | Khoảng tin cậy 95% cho tỷ lệ có nhà thật trong dân số. |
sample estimate p | 0.6006117 | Tỷ lệ có nhà trong mẫu. |
# Số sản phẩm (ProductFamily = "Food") và tổng số quan sát
category_food <- "Food"
N_food <- sum(dldt$ProductFamily == category_food)
# Tổng số sản phẩm
N_total_productfamily <- nrow(dldt)
cat(paste("Số sản phẩm 'Food' (ProductFamily =", category_food, "):", N_food, "\n"))
## Số sản phẩm 'Food' (ProductFamily = Food ): 10153
cat(paste("Tổng số sản phẩm quan sát:", N_total_productfamily, "\n\n"))
## Tổng số sản phẩm quan sát: 14059
Giả thuyết H0: p_food >= 0.7
p0_food <- 0.7
alternative_hyp_food <- "two.sided"
test_food_results <- prop.test(x = N_food, n = N_total_productfamily, p = p0_food,
alternative = alternative_hyp_food, correct = FALSE)
cat("Kết quả kiểm định cho tỷ lệ sản phẩm 'Food':\n")
## Kết quả kiểm định cho tỷ lệ sản phẩm 'Food':
print(test_food_results)
##
## 1-sample proportions test without continuity correction
##
## data: N_food out of N_total_productfamily, null probability p0_food
## X-squared = 32.908, df = 1, p-value = 9.663e-09
## alternative hypothesis: true p is not equal to 0.7
## 95 percent confidence interval:
## 0.7147067 0.7295136
## sample estimates:
## p
## 0.7221709
p_value_food <- test_food_results$p.value
sample_p_food <- test_food_results$estimate
conf_int_food <- test_food_results$conf.int
cat("\nDiễn giải kết quả kiểm định cho ProductFamily 'Food':\n")
##
## Diễn giải kết quả kiểm định cho ProductFamily 'Food':
cat(paste0(" - Khoảng tin cậy 95% cho tỷ lệ 'Food' là (",
round(conf_int_food[1], 4), ", ", round(conf_int_food[2], 4), ").\n"))
## - Khoảng tin cậy 95% cho tỷ lệ 'Food' là (0.7147, 0.7295).
cat(paste0(" - Tỷ lệ 'Food' trong mẫu (p-hat) là: ", round(sample_p_food, 4), ".\n"))
## - Tỷ lệ 'Food' trong mẫu (p-hat) là: 0.7222.
cat(paste0(" - Giá trị p-value của kiểm định là: ", format.pval(p_value_food, digits=4, eps=0.0001), ".\n"))
## - Giá trị p-value của kiểm định là: < 1e-04.
alpha <- 0.05
cat(paste0("\nVới mức ý nghĩa alpha = ", alpha, ":\n"))
##
## Với mức ý nghĩa alpha = 0.05:
if (p_value_food < alpha) {
cat(paste0(" - Kết luận: Vì p-value < ", alpha, ", chúng ta BÁC BỎ giả thuyết H0.\n"))
if (alternative_hyp_food == "two.sided") {
cat(paste0(" Có đủ bằng chứng thống kê để kết luận rằng tỷ lệ sản phẩm 'Food' thực sự trong tổng thể KHÁC ", p0_food*100, "%.\n"))
} else if (alternative_hyp_food == "less") {
cat(paste0(" Có đủ bằng chứng thống kê để kết luận rằng tỷ lệ sản phẩm 'Food' thực sự trong tổng thể NHỎ HƠN ", p0_food*100, "%.\n"))
} else { # greater
cat(paste0(" Có đủ bằng chứng thống kê để kết luận rằng tỷ lệ sản phẩm 'Food' thực sự trong tổng thể LỚN HƠN ", p0_food*100, "%.\n"))
}
} else {
cat(paste0(" - Kết luận: Vì p-value >= ", alpha, ", chúng ta KHÔNG BÁC BỎ giả thuyết H0.\n"))
if (alternative_hyp_food == "two.sided") {
cat(paste0(" Không có đủ bằng chứng thống kê để kết luận rằng tỷ lệ sản phẩm 'Food' khác ", p0_food*100, "%.\n"))
} else if (alternative_hyp_food == "less") {
cat(paste0(" Không có đủ bằng chứng thống kê để kết luận rằng tỷ lệ sản phẩm 'Food' nhỏ hơn ", p0_food*100, "% (tức là không thể bác bỏ H0: p >= ", p0_food*100,"%).\n"))
} else { # greater
cat(paste0(" Không có đủ bằng chứng thống kê để kết luận rằng tỷ lệ sản phẩm 'Food' lớn hơn ", p0_food*100, "% (tức là không thể bác bỏ H0: p <= ", p0_food*100,"%).\n"))
}
}
## - Kết luận: Vì p-value < 0.05, chúng ta BÁC BỎ giả thuyết H0.
## Có đủ bằng chứng thống kê để kết luận rằng tỷ lệ sản phẩm 'Food' thực sự trong tổng thể KHÁC 70%.
# Bảng giải thích
result_meaning_P_df <- data.frame(
Phần = c("X-squared", "df", "p-value", "alternative hypothesis", "95% confidence interval", "sample estimate p"),
Giá_trị_từ_R = c(
round(test_food_results$statistic, 1),
test_food_results$parameter,
format.pval(test_food_results$p.value, digits=4, eps=0.0001),
test_food_results$alternative,
paste0("(", round(test_food_results$conf.int[1],4), ", ", round(test_food_results$conf.int[2],4), ")"),
round(test_food_results$estimate, 7)
),
Ý_nghĩa = c(
"Giá trị thống kê Chi-square.",
"Bậc tự do.",
"Giá trị p.",
"Kiểm định (hai phía, nhỏ hơn, hoặc lớn hơn).",
"Khoảng tin cậy 95% cho tỷ lệ sản phẩm 'Food' thực tế.",
"Tỷ lệ sản phẩm 'Food' ước lượng từ mẫu."
),
stringsAsFactors = FALSE
)
kable(result_meaning_P_df, col.names = c("Phần Output", "Giá trị từ R", "Ý nghĩa"), align = c("l", "r", "l"),
caption = "Giải thích output của prop.test cho ProductFamily 'Food'") %>%
kable_styling(full_width = FALSE, bootstrap_options = c("striped", "bordered", "hover")) %>%
column_spec(1, bold = TRUE)
Phần Output | Giá trị từ R | Ý nghĩa |
---|---|---|
X-squared | 32.9 | Giá trị thống kê Chi-square. |
df | 1 | Bậc tự do. |
p-value | < 1e-04 | Giá trị p. |
alternative hypothesis | two.sided | Kiểm định (hai phía, nhỏ hơn, hoặc lớn hơn). |
95% confidence interval | (0.7147, 0.7295) | Khoảng tin cậy 95% cho tỷ lệ sản phẩm ‘Food’ thực tế. |
sample estimate p | 0.7221709 | Tỷ lệ sản phẩm ‘Food’ ước lượng từ mẫu. |
gp <- table(Gender = dldt$Gender, ProductFamily = dldt$ProductFamily)
cat("Bảng tần suất chéo giữa Gender và ProductFamily (Số lượng):\n")
## Bảng tần suất chéo giữa Gender và ProductFamily (Số lượng):
print(gp)
## ProductFamily
## Gender Drink Food Non-Consumable
## F 669 5149 1352
## M 581 5004 1304
# Bảng tỷ lệ phần trăm theo hàng (trong mỗi Gender, tỷ lệ mua các ProductFamily)
# margin = 1: tính tỷ lệ theo hàng. Giúp so sánh xu hướng chọn ProductFamily giữa các nhóm Gender.
gp1 <- round(prop.table(gp, margin = 1) * 100, 1)
cat("\nBảng tỷ lệ % theo hàng (trong mỗi Gender, phân phối ProductFamily):\n")
##
## Bảng tỷ lệ % theo hàng (trong mỗi Gender, phân phối ProductFamily):
print(gp1)
## ProductFamily
## Gender Drink Food Non-Consumable
## F 9.3 71.8 18.9
## M 8.4 72.6 18.9
# Chuyển bảng sang dataframe để ggplot
gpf<- as.data.frame(gp)
colnames(gpf) <- c("Gender", "ProductFamily", "Freq")
ggplot(gpf, aes(x = Gender, y = Freq, fill = ProductFamily)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
# scale_fill_manual của bạn dùng được vì ProductFamily ít mức
scale_fill_manual(
name = "Nhóm sản phẩm",
values = c("Drink" = "skyblue", "Food" = "lightgreen", "Non-Consumable" = "salmon"),
labels = c("Đồ uống", "Thực phẩm", "Phi tiêu dùng") # Nhãn cho chú thích
) +
labs(
title = "Số giao dịch theo Nhóm sản phẩm & Giới tính",
x = "Giới tính",
y = "Số lượng giao dịch"
) +
theme_minimal()
cat("\n\n**Kiểm định Chi-bình phương cho Gender và ProductFamily:**\n")
##
##
## **Kiểm định Chi-bình phương cho Gender và ProductFamily:**
cat("H0: Giới tính (Gender) và Nhóm sản phẩm (ProductFamily) là độc lập (không có mối quan hệ).\n")
## H0: Giới tính (Gender) và Nhóm sản phẩm (ProductFamily) là độc lập (không có mối quan hệ).
cat("H1: Giới tính (Gender) và Nhóm sản phẩm (ProductFamily) có liên quan.\n\n")
## H1: Giới tính (Gender) và Nhóm sản phẩm (ProductFamily) có liên quan.
chisq_gp <- chisq.test(gp)
print(chisq_gp)
##
## Pearson's Chi-squared test
##
## data: gp
## X-squared = 3.5185, df = 2, p-value = 0.1722
alpha_chi <- 0.05
cat(paste0("\nVới mức ý nghĩa alpha = ", alpha_chi, ":\n"))
##
## Với mức ý nghĩa alpha = 0.05:
if (chisq_gp$p.value < alpha_chi) {
cat(paste0(" - Kết luận: Vì p-value (", format.pval(chisq_gp$p.value, digits=4, eps=0.0001), ") < ", alpha_chi,
", chúng ta BÁC BỎ giả thuyết H0.\n"))
cat(" Có bằng chứng thống kê về mối quan hệ ý nghĩa giữa Giới tính và Nhóm sản phẩm.\n")
cat(" Để hiểu rõ hơn về bản chất mối quan hệ, hãy xem xét bảng tỷ lệ phần trăm và biểu đồ.\n")
} else {
cat(paste0(" - Kết luận: Vì p-value (", format.pval(chisq_gp$p.value, digits=4, eps=0.0001), ") >= ", alpha_chi,
", chúng ta KHÔNG BÁC BỎ giả thuyết H0.\n"))
cat(" Không có đủ bằng chứng thống kê để kết luận có mối quan hệ ý nghĩa giữa Giới tính và Nhóm sản phẩm.\n")
}
## - Kết luận: Vì p-value (0.1722) >= 0.05, chúng ta KHÔNG BÁC BỎ giả thuyết H0.
## Không có đủ bằng chứng thống kê để kết luận có mối quan hệ ý nghĩa giữa Giới tính và Nhóm sản phẩm.
# Kiểm tra điều kiện tần số kỳ vọng
if(any(chisq_gp$expected < 5)){
cat("\nCẢNH BÁO: Có một số ô trong bảng có tần suất kỳ vọng nhỏ hơn 5. Kết quả của kiểm định Chi-bình phương có thể không hoàn toàn chính xác.\n")
# print("Tần suất kỳ vọng:")
# print(round(chisq_test_gp$expected, 2))
}
mh <- table(MaritalStatus = dldt$MaritalStatus, Homeowner = dldt$Homeowner)
cat("Bảng tần suất chéo giữa Tình trạng hôn nhân và Sở hữu nhà (Số lượng):\n")
## Bảng tần suất chéo giữa Tình trạng hôn nhân và Sở hữu nhà (Số lượng):
print(mh)
## Homeowner
## MaritalStatus N Y
## M 1719 5147
## S 3896 3297
mh1 <- round(prop.table(mh, margin = 1) * 100, 1)
cat("\nBảng tỷ lệ % theo hàng (trong mỗi Tình trạng hôn nhân, phân phối Sở hữu nhà):\n")
##
## Bảng tỷ lệ % theo hàng (trong mỗi Tình trạng hôn nhân, phân phối Sở hữu nhà):
print(mh1)
## Homeowner
## MaritalStatus N Y
## M 25.0 75.0
## S 54.2 45.8
mhdf <- as.data.frame(mh)
colnames(mhdf) <- c("Marital", "Owner", "Freq")
ggplot(mhdf, aes(x = Marital, y = Freq, fill = Owner)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
scale_fill_manual(
name = "Sở hữu nhà",
values = c("Y" = "steelblue", "N" = "pink"), # Đảm bảo "Y", "N" là các mức của Homeowner
labels = c("Có nhà", "Không có nhà")
) +
labs(
title = "Số khách có/không sở hữu nhà theo Tình trạng hôn nhân",
x = "Tình trạng hôn nhân",
y = "Số khách hàng"
) +
theme_minimal()
cat("\n\n**Kiểm định Chi-bình phương cho MaritalStatus và Homeowner:**\n")
##
##
## **Kiểm định Chi-bình phương cho MaritalStatus và Homeowner:**
cat("H0: Tình trạng hôn nhân (MaritalStatus) và Sở hữu nhà (Homeowner) là độc lập.\n")
## H0: Tình trạng hôn nhân (MaritalStatus) và Sở hữu nhà (Homeowner) là độc lập.
cat("H1: Tình trạng hôn nhân (MaritalStatus) và Sở hữu nhà (Homeowner) có liên quan.\n\n")
## H1: Tình trạng hôn nhân (MaritalStatus) và Sở hữu nhà (Homeowner) có liên quan.
chisq_mh <- chisq.test(mh)
print(chisq_mh)
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: mh
## X-squared = 1241.2, df = 1, p-value < 2.2e-16
alpha_chi <- 0.05
cat(paste0("\nVới mức ý nghĩa alpha = ", alpha_chi, ":\n"))
##
## Với mức ý nghĩa alpha = 0.05:
if (chisq_mh$p.value < alpha_chi) {
cat(paste0(" - Kết luận: Vì p-value (", format.pval(chisq_mh$p.value, digits=4, eps=0.0001), ") < ", alpha_chi,
", chúng ta BÁC BỎ giả thuyết H0.\n"))
cat(" Có bằng chứng thống kê về mối quan hệ ý nghĩa giữa Tình trạng hôn nhân và Sở hữu nhà.\n")
} else {
cat(paste0(" - Kết luận: Vì p-value (", format.pval(chisq_mh$p.value, digits=4, eps=0.0001), ") >= ", alpha_chi,
", chúng ta KHÔNG BÁC BỎ giả thuyết H0.\n"))
cat(" Không có đủ bằng chứng thống kê để kết luận có mối quan hệ ý nghĩa giữa Tình trạng hôn nhân và Sở hữu nhà.\n")
}
## - Kết luận: Vì p-value (< 1e-04) < 0.05, chúng ta BÁC BỎ giả thuyết H0.
## Có bằng chứng thống kê về mối quan hệ ý nghĩa giữa Tình trạng hôn nhân và Sở hữu nhà.
if(any(chisq_mh$expected < 5)){
cat("\nCẢNH BÁO: Có một số ô có tần suất kỳ vọng < 5. Kết quả Chi-bình phương có thể không chính xác.\n")
}
ap <- table(AnnualIncome = dldt$AnnualIncome, ProductCategory = dldt$ProductCategory)
cat("Bảng tần suất chéo giữa Thu nhập hàng năm và Danh mục sản phẩm (Số lượng) - Hiển thị một phần do có thể rất lớn:\n")
## Bảng tần suất chéo giữa Thu nhập hàng năm và Danh mục sản phẩm (Số lượng) - Hiển thị một phần do có thể rất lớn:
# Do bảng có thể rất lớn, chỉ in một phần hoặc tóm tắt
if (ncol(ap) > 10) {
print(ap[, 1:10]) # In 10 cột đầu tiên
cat("... và các cột khác ...\n")
} else {
print(ap)
}
## ProductCategory
## AnnualIncome Baking Goods Bathroom Products Beer and Wine Bread
## $10K - $30K 119 85 80 108
## $110K - $130K 18 16 14 23
## $130K - $150K 22 19 15 24
## $150K + 11 8 3 10
## $30K - $50K 151 116 121 134
## $50K - $70K 86 50 61 63
## $70K - $90K 59 51 39 50
## $90K - $110K 18 20 23 13
## ProductCategory
## AnnualIncome Breakfast Foods Candles Candy Canned Anchovies Canned Clams
## $10K - $30K 111 6 76 10 12
## $110K - $130K 7 1 16 2 1
## $130K - $150K 28 2 19 1 3
## $150K + 7 1 8 1 1
## $30K - $50K 143 21 127 14 20
## $50K - $70K 62 7 60 8 6
## $70K - $90K 42 7 29 6 7
## $90K - $110K 17 0 17 2 3
## ProductCategory
## AnnualIncome Canned Oysters
## $10K - $30K 5
## $110K - $130K 4
## $130K - $150K 3
## $150K + 1
## $30K - $50K 10
## $50K - $70K 5
## $70K - $90K 5
## $90K - $110K 2
## ... và các cột khác ...
ap1 <- round(prop.table(ap, margin = 1) * 100, 1)
cat("\nBảng tỷ lệ % theo hàng (trong mỗi mức Thu nhập, phân phối Danh mục sản phẩm) - Hiển thị một phần:\n")
##
## Bảng tỷ lệ % theo hàng (trong mỗi mức Thu nhập, phân phối Danh mục sản phẩm) - Hiển thị một phần:
if (ncol(ap1) > 10) {
print(ap1[, 1:10])
cat("... và các cột khác ...\n")
} else {
print(ap1)
}
## ProductCategory
## AnnualIncome Baking Goods Bathroom Products Beer and Wine Bread
## $10K - $30K 3.9 2.8 2.6 3.5
## $110K - $130K 2.8 2.5 2.2 3.6
## $130K - $150K 2.9 2.5 2.0 3.2
## $150K + 4.0 2.9 1.1 3.7
## $30K - $50K 3.3 2.5 2.6 2.9
## $50K - $70K 3.6 2.1 2.6 2.7
## $70K - $90K 3.5 3.0 2.3 2.9
## $90K - $110K 2.9 3.3 3.8 2.1
## ProductCategory
## AnnualIncome Breakfast Foods Candles Candy Canned Anchovies Canned Clams
## $10K - $30K 3.6 0.2 2.5 0.3 0.4
## $110K - $130K 1.1 0.2 2.5 0.3 0.2
## $130K - $150K 3.7 0.3 2.5 0.1 0.4
## $150K + 2.6 0.4 2.9 0.4 0.4
## $30K - $50K 3.1 0.5 2.8 0.3 0.4
## $50K - $70K 2.6 0.3 2.5 0.3 0.3
## $70K - $90K 2.5 0.4 1.7 0.4 0.4
## $90K - $110K 2.8 0.0 2.8 0.3 0.5
## ProductCategory
## AnnualIncome Canned Oysters
## $10K - $30K 0.2
## $110K - $130K 0.6
## $130K - $150K 0.4
## $150K + 0.4
## $30K - $50K 0.2
## $50K - $70K 0.2
## $70K - $90K 0.3
## $90K - $110K 0.3
## ... và các cột khác ...
apdf<- as.data.frame(ap)
colnames(apdf) <- c("AnnualIncome", "ProductCategory", "Freq")
ggplot(apdf, aes(x = AnnualIncome, y = Freq, fill = ProductCategory)) +
geom_col(position = position_dodge(width = 0.9), width = 0.8) + # position_dodge để các cột nằm cạnh nhau
labs(
title = "Sản lượng theo Thu nhập và Danh mục sản phẩm",
subtitle = "Lưu ý: Biểu đồ có thể phức tạp do nhiều Danh mục sản phẩm",
x = "Thu nhập hàng năm",
y = "Số lượng giao dịch"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1), # Xoay nhãn trục x
legend.position = if(nlevels(apdf$ProductCategory) > 10) "none" else "right") # Ẩn legend nếu quá nhiều
cat("\n\n**Kiểm định Chi-bình phương cho AnnualIncome và ProductCategory:**\n")
##
##
## **Kiểm định Chi-bình phương cho AnnualIncome và ProductCategory:**
cat("H0: Thu nhập hàng năm (AnnualIncome) và Danh mục sản phẩm (ProductCategory) là độc lập.\n")
## H0: Thu nhập hàng năm (AnnualIncome) và Danh mục sản phẩm (ProductCategory) là độc lập.
cat("H1: Thu nhập hàng năm (AnnualIncome) và Danh mục sản phẩm (ProductCategory) có liên quan.\n\n")
## H1: Thu nhập hàng năm (AnnualIncome) và Danh mục sản phẩm (ProductCategory) có liên quan.
# Do số lượng levels của ProductCategory lớn, tần số kỳ vọng có thể rất thấp nhiều ô. Do đó có thể gí trị chi bình phương sẽ không quá đúng
chisq_ap <- chisq.test(ap)
## Warning in chisq.test(ap): Chi-squared approximation may be incorrect
print(chisq_ap)
##
## Pearson's Chi-squared test
##
## data: ap
## X-squared = 295.23, df = 308, p-value = 0.6897
alpha_chi <- 0.05
cat(paste0("\nVới mức ý nghĩa alpha = ", alpha_chi, ":\n"))
##
## Với mức ý nghĩa alpha = 0.05:
if (chisq_ap$p.value < alpha_chi) {
cat(paste0(" - Kết luận: Vì p-value (", format.pval(chisq_ap$p.value, digits=4, eps=0.0001), ") < ", alpha_chi,
", chúng ta BÁC BỎ giả thuyết H0.\n"))
cat(" Có bằng chứng thống kê về mối quan hệ ý nghĩa giữa Thu nhập hàng năm và Danh mục sản phẩm.\n")
} else {
cat(paste0(" - Kết luận: Vì p-value (", format.pval(chisq_ap$p.value, digits=4, eps=0.0001), ") >= ", alpha_chi,
", chúng ta KHÔNG BÁC BỎ giả thuyết H0.\n"))
cat(" Không có đủ bằng chứng thống kê để kết luận có mối quan hệ ý nghĩa giữa Thu nhập hàng năm và Danh mục sản phẩm.\n")
}
## - Kết luận: Vì p-value (0.6897) >= 0.05, chúng ta KHÔNG BÁC BỎ giả thuyết H0.
## Không có đủ bằng chứng thống kê để kết luận có mối quan hệ ý nghĩa giữa Thu nhập hàng năm và Danh mục sản phẩm.
if(any(chisq_ap$expected < 1)){ # Điều kiện chặt hơn: tần số kỳ vọng < 1
cat("\nCẢNH BÁO NGHIÊM TRỌNG: Có nhiều ô có tần suất kỳ vọng RẤT THẤP (có thể < 1).\n")
cat("Kết quả của kiểm định Chi-bình phương cho cặp biến này RẤT KHÔNG ĐÁNG TIN CẬY.\n")
cat("Nên xem xét nhóm các mức của 'ProductCategory' lại trước khi kiểm định.\n")
} else if(any(chisq_ap$expected < 5)){
cat("\nCẢNH BÁO: Có một số ô có tần suất kỳ vọng < 5. Kết quả Chi-bình phương có thể không chính xác.\n")
}
##
## CẢNH BÁO NGHIÊM TRỌNG: Có nhiều ô có tần suất kỳ vọng RẤT THẤP (có thể < 1).
## Kết quả của kiểm định Chi-bình phương cho cặp biến này RẤT KHÔNG ĐÁNG TIN CẬY.
## Nên xem xét nhóm các mức của 'ProductCategory' lại trước khi kiểm định.
Trong phân tích thống kê định lượng, bảng ngẫu nhiên (contingency table) là một công cụ cơ bản để khảo sát mối liên hệ giữa hai biến phân loại. Trong trường hợp đơn giản nhất, bảng ngẫu nhiên 2x2 biểu diễn sự phân bố của hai biến nhị phân, giúp xác định và đo lường mối liên hệ giữa chúng. Các chỉ số như hiệu tỷ lệ (risk difference), tỷ số nguy cơ (Relative Risk - RR) và tỷ số chênh (Odds Ratio - OR) đóng vai trò quan trọng trong việc lượng hóa mối quan hệ đó. Bài viết này sẽ trình bày chi tiết cấu trúc xác suất sinh ra bảng ngẫu nhiên, phương pháp so sánh hai tỷ lệ, cách xây dựng khoảng tin cậy cho Odds Ratio, và kết thúc bằng một ví dụ thực tiễn trong lĩnh vực kinh doanh.
Một bảng ngẫu nhiên 2x2 là bảng tần suất đếm số quan sát thuộc vào từng tổ hợp của hai biến nhị phân:
\[ \begin{array}{|c|c|c|c|} \hline & \text{Kết quả (+)} & \text{Kết quả (–)} & \text{Tổng} \\ \hline \text{Phơi nhiễm (Yes)} & a & b & a + b \\ \hline \text{Không phơi nhiễm (No)} & c & d & c + d \\ \hline \text{Tổng cộng} & a + c & b + d & n = a + b + c + d \\ \hline \end{array} \]
Để hiểu được sự hình thành của bảng này, cần xác định mô hình xác suất sinh ra dữ liệu — trong đó phổ biến nhất là phân phối Poisson và Multinomial.
Phân phối Poisson thường được sử dụng để mô hình hóa số lượng sự kiện xảy ra trong một khoảng thời gian, không gian hoặc đơn vị cụ thể. Giả sử các sự kiện xảy ra độc lập và với một tỷ lệ trung bình không đổi, mỗi ô trong bảng có thể xem là biến ngẫu nhiên Poisson:
\[ X_{ij} \sim \text{Poisson}(\lambda_{ij}) \]
Ưu điểm:
Phù hợp khi tổng số quan sát không cố định.
Áp dụng trong phân tích số sự kiện như: số lượt truy cập, số đơn hàng lỗi, v.v.
Hạn chế:
Trong trường hợp tổng số quan sát \(n\) là cố định, và mỗi quan sát rơi vào một trong bốn ô với xác suất \(p_1, p_2, p_3, p_4\), thì bảng ngẫu nhiên 2x2 có thể được mô hình hóa theo phân phối đa thức Multinomial như sau:
\[ (a, b, c, d) \sim \text{Multinomial}(n; p_1, p_2, p_3, p_4) \]
Phân phối này thường được sử dụng trong các tình huống mà dữ liệu được thu thập từ khảo sát hoặc nghiên cứu xã hội học với kích thước mẫu cố định. Khi đó, các xác suất \(p_1, p_2, p_3, p_4\) biểu diễn xác suất mà một cá thể rơi vào từng ô trong bảng 2x2.
Ưu điểm của mô hình Multinomial:
Kiểm soát được tổng số mẫu.
Phù hợp cho dữ liệu khảo sát, thử nghiệm.
So sánh giữa phân phối Poisson và Multinomial
Tiêu chí | Poisson | Multinomial |
---|---|---|
Tổng số mẫu | Không cố định | Cố định |
Ứng dụng chính | Số sự kiện | Tần suất khảo sát |
Dữ liệu phù hợp | Giao dịch, lỗi, tai nạn | Trả lời khảo sát, phân nhóm |
\[ RD = \frac{a}{a + b} - \frac{c}{c + d} \]
Ý nghĩa:
Đo lường chênh lệch tuyệt đối giữa xác suất xảy ra kết quả ở nhóm phơi nhiễm và nhóm không phơi nhiễm.
Thường được sử dụng trong đánh giá tác động của chính sách, can thiệp hoặc chương trình thí điểm, khi sự khác biệt về xác suất là quan trọng hơn so với tỷ số.
Khoảng tin cậy 95% (CI) cho RD có thể được ước lượng bằng:
\[ CI_{RD} = RD \pm Z_{1 - \alpha/2} \cdot SE_{RD} \]
Trong đó: - \(Z_{1 - \alpha/2}\) là giá trị tới hạn (thường ≈ 1.96 với 95% CI),
\[ RR = \frac{a / (a + b)}{c / (c + d)} \]
Ý nghĩa:
\(RR > 1\): nguy cơ xảy ra kết quả cao hơn ở nhóm phơi nhiễm.
\(RR < 1\): nguy cơ xảy ra kết quả thấp hơn ở nhóm phơi nhiễm.
\(RR = 1\): không có mối liên hệ giữa phơi nhiễm và kết quả.
Ta thường lấy log của RR để tính khoảng tin cậy:
\[ CI_{RR} = \exp \left[ \ln(RR) \pm Z_{1 - \alpha/2} \cdot SE_{\ln(RR)} \right] \]
Trong đó:
\[ SE_{\ln(RR)} = \sqrt{ \frac{1}{a} - \frac{1}{a + b} + \frac{1}{c} - \frac{1}{c + d} } \]
Ví dụ trong kinh doanh:
Tỷ lệ khách mua hàng khi có khuyến mãi: \(80/100 = 0.8\)
Khi không có khuyến mãi: \(40/100 = 0.4\)
\(RR = 0.8 / 0.4 = 2\)
⇒ Khuyến mãi làm tăng gấp đôi khả năng khách mua hàng.
Hạn chế:
Không sử dụng được trong nghiên cứu bệnh chứng (case-control) vì ta không biết nguy cơ tuyệt đối.
Dễ gây hiểu nhầm nếu không đi kèm nguy cơ tuyệt đối. Ví dụ: RR = 2 có vẻ cao, nhưng nếu nguy cơ ban đầu là 1%, thì tăng lên 2% vẫn là rất thấp.
Không đối xứng: Nếu đổi nhóm tham chiếu thì giá trị RR thay đổi, khác với OR.
\[ OR = \frac{a / b}{c / d} = \frac{ad}{bc} \]
Hay
\[ \text{OR} = \frac{\text{Odds ở nhóm 1}}{\text{Odds ở nhóm 2}} \] OR thường dùng để đo lường mối liên hệ giữa một yếu tố và một kết quả trong bảng 2x2.
OR = 1: Không có sự khác biệt về odds giữa hai nhóm.
OR > 1: Nhóm 1 có odds xảy ra kết quả cao hơn nhóm 2.
OR < 1: Nhóm 1 có odds xảy ra kết quả thấp hơn nhóm 2.
Ví dụ: OR = 2 nghĩa là odds xảy ra kết quả ở nhóm 1 cao gấp 2 lần nhóm 2.
Ý nghĩa:
OR cho biết tỷ lệ odds (tức là “xác suất chia cho 1 trừ xác suất”) giữa hai nhóm.
Thường được sử dụng phổ biến trong mô hình logistic regression.
Trong các nghiên cứu bệnh hiếm (rare disease assumption), OR xấp xỉ với RR.
Ưu điểm của Odds Ratio:
Dễ tính và dễ diễn giải.
Ổn định về mặt toán học khi sử dụng trong các mô hình hồi quy.
Không phụ thuộc vào tỷ lệ hiện diện trong mẫu (đặc biệt trong các thiết kế bệnh – chứng: case-control study).
Để xác định xem OR có ý nghĩa thống kê hay không, cần xây dựng khoảng tin cậy.
Logarithm tự nhiên của Odds Ratio:
\[ \log(OR) = \log\left( \frac{a \cdot d}{b \cdot c} \right) \]
Sai số chuẩn (Standard Error):
\[ SE = \sqrt{ \frac{1}{a} + \frac{1}{b} + \frac{1}{c} + \frac{1}{d} } \]
Khoảng tin cậy 95% cho \(\log(OR)\):
\[ \log(OR) \pm 1.96 \cdot SE \]
Lấy mũ để có khoảng tin cậy 95% cho OR:
\[ CI_{95\%} = \left[ e^{\log(OR) - 1.96 \cdot SE},\quad e^{\log(OR) + 1.96 \cdot SE} \right] \]
Một công ty thương mại điện tử thử nghiệm chiến dịch khuyến mãi để kiểm tra xem liệu có ảnh hưởng đến hành vi mua hàng không. Họ lấy mẫu 200 khách hàng ngẫu nhiên và thu được bảng sau:
Mua hàng | Không mua | Tổng | |
---|---|---|---|
Có khuyến mãi | 80 | 20 | 100 |
Không khuyến mãi | 40 | 60 | 100 |
\[ OR = \frac{80 \cdot 60}{20 \cdot 40} = \frac{4800}{800} = 6 \]
→ Odds mua hàng khi có khuyến mãi cao gấp 6 lần so với khi không có khuyến mãi.
\[ \log(OR) = \log(6) \approx 1.79 \]
\[ SE = \sqrt{ \frac{1}{80} + \frac{1}{20} + \frac{1}{40} + \frac{1}{60} } \approx 0.35 \]
\[ CI = \left[ e^{1.79 - 1.96 \cdot 0.35},\quad e^{1.79 + 1.96 \cdot 0.35} \right] \approx \left[ e^{1.11},\quad e^{2.47} \right] = [3.03,\ 11.81] \]
Vì khoảng tin cậy không chứa 1, có thể kết luận rằng khuyến mãi có ảnh hưởng có ý nghĩa thống kê đến hành vi mua hàng.
Với \(OR = 6\) và \(CI = (3.03,\ 11.81)\), doanh nghiệp có thể tự tin triển khai chiến lược khuyến mãi quy mô lớn hơn.
Tạo bảng chéo cho Gender và một biến nhị phân cho việc có mua ‘Food’ hay khôn
dldt$BuysFood <- ifelse(dldt$ProductFamily == "Food", "Mua", "Không")
dldt$BuysFood <- as.factor(dldt$BuysFood) # Chuyển thành factor
gender_ordered <- c("F", "M") # Giả sử Nữ là nhóm quan tâm, Nam là tham chiếu
buys_ordered <- c("Yes_Buys_Food", "No_Buys_Food") # "Yes" là outcome tích cực
table_gender_food <- table(Gender = dldt$Gender, BuysFood = dldt$BuysFood)
Kiểm tra bảng:
cat("\nBảng chéo Gender vs. Mua Sản phẩm 'Food':\n")
##
## Bảng chéo Gender vs. Mua Sản phẩm 'Food':
print(table_gender_food)
## BuysFood
## Gender Không Mua
## F 2021 5149
## M 1885 5004
if ("No_Buys_Food" %in% colnames(table_gender_food) && "Yes_Buys_Food" %in% colnames(table_gender_food)) {
if (match("No_Buys_Food", colnames(table_gender_food)) < match("Yes_Buys_Food", colnames(table_gender_food))) {
table_gender_food <- table_gender_food[, c("Yes_Buys_Food", "No_Buys_Food")]
cat("\nĐã sắp xếp lại cột của bảng cho riskratio.\n")
print(table_gender_food)
}
}
# Tương tự, nếu cần đảo hàng (F ra trước)
if ("M" %in% rownames(table_gender_food) && "F" %in% rownames(table_gender_food)) {
if (match("M", rownames(table_gender_food)) < match("F", rownames(table_gender_food))) {
table_gender_food <- table_gender_food[c("F", "M"), ]
cat("\nĐã sắp xếp lại hàng của bảng cho riskratio.\n")
print(table_gender_food)
}
}
cat("\nPhân tích Relative Risk (Nữ so với Nam cho việc mua 'Food'):\n")
##
## Phân tích Relative Risk (Nữ so với Nam cho việc mua 'Food'):
table_gender_food <- table(Gender = dldt$Gender, BuysFood = dldt$BuysFood)
cat("\nKiểm tra bảng table_gender_food trước khi tính RR:\n")
##
## Kiểm tra bảng table_gender_food trước khi tính RR:
print(table_gender_food)
## BuysFood
## Gender Không Mua
## F 2021 5149
## M 1885 5004
print(paste("Kích thước bảng:", paste(dim(table_gender_food), collapse="x")))
## [1] "Kích thước bảng: 2x2"
cat("\nLevels của Gender:", paste(levels(dldt$Gender), collapse=", "), "\n")
##
## Levels của Gender: F, M
cat("Levels của BuysFood:", paste(levels(dldt$BuysFood), collapse=", "), "\n")
## Levels của BuysFood: Không, Mua
library(epitools)
rr_gender_food_obj <- riskratio(table_gender_food, rev = "columns")
# rev = "columns" để coi cột đầu là "Yes" (Mua) cho RR
cat("\nKết quả tính Relative Risk:\n")
##
## Kết quả tính Relative Risk:
print(rr_gender_food_obj)
## $data
## BuysFood
## Gender Mua Không Total
## F 5149 2021 7170
## M 5004 1885 6889
## Total 10153 3906 14059
##
## $measure
## risk ratio with 95% C.I.
## Gender estimate lower upper
## F 1.0000000 NA NA
## M 0.9707514 0.9203271 1.023938
##
## $p.value
## two-sided
## Gender midp.exact fisher.exact chi.square
## F NA NA NA
## M 0.2753749 0.2830759 0.2752955
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
str(rr_gender_food_obj)
## List of 4
## $ data : int [1:3, 1:3] 5149 5004 10153 2021 1885 3906 7170 6889 14059
## ..- attr(*, "dimnames")=List of 2
## .. ..$ Gender : chr [1:3] "F" "M" "Total"
## .. ..$ BuysFood: chr [1:3] "Mua" "Không" "Total"
## $ measure : num [1:2, 1:3] 1 0.971 NA 0.92 NA ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ Gender : chr [1:2] "F" "M"
## .. ..$ risk ratio with 95% C.I.: chr [1:3] "estimate" "lower" "upper"
## $ p.value : num [1:2, 1:3] NA 0.275 NA 0.283 NA ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ Gender : chr [1:2] "F" "M"
## .. ..$ two-sided: chr [1:3] "midp.exact" "fisher.exact" "chi.square"
## $ correction: logi FALSE
## - attr(*, "method")= chr "Unconditional MLE & normal approximation (Wald) CI"
measure <- rr_gender_food_obj$measure
measure_row <- measure["F", ]
if (any(is.na(measure_row[c("estimate", "lower", "upper")]))) {
cat("\n❗ Giá trị RR hoặc KTC có NA, không thể đánh giá ý nghĩa thống kê.\n")
} else {
rr_estimate_gf <- measure_row["estimate"]
rr_lower_gf <- measure_row["lower"]
rr_upper_gf <- measure_row["upper"]
cat(sprintf("\nRR = %.3f, 95%% CI: (%.3f, %.3f)\n", rr_estimate_gf, rr_lower_gf, rr_upper_gf))
if (is.infinite(rr_estimate_gf) || is.infinite(rr_lower_gf) || is.infinite(rr_upper_gf)) {
cat(" - Cảnh báo: RR hoặc KTC là vô cực (Inf). Có thể có ô = 0 trong bảng.\n")
} else if (rr_lower_gf > 1) {
cat(sprintf(" - Nữ giới có khả năng mua 'Food' CAO HƠN có ý nghĩa thống kê (cao hơn khoảng %.1f%%).\n",
(rr_estimate_gf - 1) * 100))
} else if (rr_upper_gf < 1) {
cat(sprintf(" - Nữ giới có khả năng mua 'Food' THẤP HƠN có ý nghĩa thống kê (thấp hơn khoảng %.1f%%).\n",
(1 - rr_estimate_gf) * 100))
} else {
cat(" - Không có sự khác biệt có ý nghĩa thống kê (KTC chứa 1).\n")
}
}
##
## ❗ Giá trị RR hoặc KTC có NA, không thể đánh giá ý nghĩa thống kê.
# Dựa trên cấu trúc thực tế của measure
measure <- rr_gender_food_obj$measure
# Kiểm tra xem dòng "F" có tồn tại và các cột cần thiết có trong measure
if ("F" %in% rownames(measure) &&
all(c("estimate", "lower", "upper") %in% colnames(measure))) {
rr_estimate_gf <- measure["F", "estimate"]
rr_lower_gf <- measure["F", "lower"]
rr_upper_gf <- measure["F", "upper"]
# Kiểm tra NA trước khi xử lý
if (any(is.na(c(rr_estimate_gf, rr_lower_gf, rr_upper_gf)))) {
cat("\n❗ Giá trị RR hoặc khoảng tin cậy có NA. Không thể đánh giá ý nghĩa thống kê.\n")
} else {
cat(paste0("\nRR = ", round(rr_estimate_gf, 3),
", 95% CI: (", round(rr_lower_gf, 3), ", ", round(rr_upper_gf, 3), ")\n"))
# Diễn giải kết quả
if (is.infinite(rr_estimate_gf) || is.infinite(rr_lower_gf) || is.infinite(rr_upper_gf)) {
cat(" - Cảnh báo: RR hoặc KTC là vô cực (Inf). Có thể có ô = 0 trong bảng.\n")
} else if (rr_lower_gf > 1) {
cat(paste0(" - Nữ giới có khả năng mua 'Food' CAO HƠN có ý nghĩa thống kê (cao hơn khoảng ",
round((rr_estimate_gf - 1) * 100, 1), "%).\n"))
} else if (rr_upper_gf < 1) {
cat(paste0(" - Nữ giới có khả năng mua 'Food' THẤP HƠN có ý nghĩa thống kê (thấp hơn khoảng ",
round((1 - rr_estimate_gf) * 100, 1), "%).\n"))
} else {
cat(" - Không có sự khác biệt có ý nghĩa thống kê (KTC chứa 1).\n")
}
}
} else {
cat("\n❗ Không thể trích xuất RR từ dòng 'F'. Kiểm tra lại output $measure.\n")
}
##
## ❗ Giá trị RR hoặc khoảng tin cậy có NA. Không thể đánh giá ý nghĩa thống kê.
# Tạo biến nhị phân BuysFood
dldt$BuysFood <- factor(ifelse(dldt$ProductFamily == "Food", "Mua", "Không"),
levels = c("Mua", "Không"))
# Tạo bảng chéo Gender vs BuysFood
table_gender_food <- table(Gender = dldt$Gender, BuysFood = dldt$BuysFood)
cat("\nBảng chéo Gender vs. Mua Sản phẩm 'Food':\n")
##
## Bảng chéo Gender vs. Mua Sản phẩm 'Food':
print(table_gender_food)
## BuysFood
## Gender Mua Không
## F 5149 2021
## M 5004 1885
# Sắp xếp cột (Mua trước Không)
if ("Không" %in% colnames(table_gender_food) && "Mua" %in% colnames(table_gender_food)) {
if (match("Không", colnames(table_gender_food)) < match("Mua", colnames(table_gender_food))) {
table_gender_food <- table_gender_food[, c("Mua", "Không")]
cat("\nĐã sắp xếp lại cột của bảng cho riskratio.\n")
print(table_gender_food)
}
}
# Sắp xếp hàng (F trước M)
if ("M" %in% rownames(table_gender_food) && "F" %in% rownames(table_gender_food)) {
if (match("M", rownames(table_gender_food)) < match("F", rownames(table_gender_food))) {
table_gender_food <- table_gender_food[c("F", "M"), ]
cat("\nĐã sắp xếp lại hàng của bảng cho riskratio.\n")
print(table_gender_food)
}
}
cat("\nPhân tích Relative Risk (Nữ so với Nam cho việc mua 'Food'):\n")
##
## Phân tích Relative Risk (Nữ so với Nam cho việc mua 'Food'):
Kết quả từ phân tích Risk Ratio (RR): RR = 1.03 → Tỷ lệ nữ mua sản phẩm Food cao hơn 3% so với nam giới.
Khoảng tin cậy 95% (KTC): (0.977, 1.087) → KTC chứa giá trị 1, nghĩa là ta không thể bác bỏ giả thuyết rằng RR = 1 (không có sự khác biệt).
Không có ý nghĩa thống kê:
Vì KTC 95% của RR chứa giá trị 1, nên không có đủ bằng chứng thống kê để kết luận rằng giới tính ảnh hưởng đến hành vi mua Food.
Nói cách khác: sự khác biệt 3% có thể là do ngẫu nhiên.
Ý nghĩa thực tế (nếu có):
Mặc dù RR > 1 (tức là nữ có vẻ mua nhiều hơn), nhưng chênh lệch này nhỏ và không đáng kể, và không đáng tin cậy về mặt thống kê.
Trong các phân tích thực tiễn, nếu RR nằm trong khoảng (0.95 - 1.05) và KTC chứa 1 thì thường không có ảnh hưởng rõ ràng.
or_gender_food_obj <- oddsratio(table_gender_food , method = "wald")
print(or_gender_food_obj$measure)
## odds ratio with 95% C.I.
## Gender estimate lower upper
## F 1.0000000 NA NA
## M 0.9597335 0.8914195 1.033283
library(ggplot2)
library(dplyr)
# Tạo data frame từ kết quả bạn cung cấp
or_df <- data.frame(
Gender = c("Male vs Female"),
OR = c(0.9597335),
lower = c(0.8914195),
upper = c(1.03328)
)
# Vẽ biểu đồ
ggplot(or_df, aes(x = Gender, y = OR)) +
geom_point(size = 4, color = "dodgerblue4", shape = 18) + # Điểm OR
geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.1, color = "dodgerblue4", linewidth = 1) +
geom_hline(yintercept = 1, linetype = "dashed", color = "grey60") + # Đường OR = 1
geom_text(aes(label = sprintf("%.2f", OR)), vjust = -1.5, fontface = "bold") +
geom_text(aes(y = lower, label = sprintf("%.2f", lower)), vjust = -0.3, hjust = 1.2, size = 3) +
geom_text(aes(y = upper, label = sprintf("%.2f", upper)), vjust = -0.3, hjust = -0.2, size = 3) +
labs(
title = "Odds Ratio và Khoảng tin cậy 95%",
subtitle = "So sánh khả năng mua 'Food': Nam so với Nữ (tham chiếu)",
y = "Odds Ratio (OR)",
x = NULL
) +
theme_minimal(base_size = 14) +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
plot.subtitle = element_text(hjust = 0.5),
axis.text.x = element_text(face = "bold")
)
library(ggplot2)
library(dplyr)
library(scales)
# Đếm số lượng mỗi tổ hợp Giới tính và Trạng thái mua
gender_food_counts <- dldt %>%
count(Gender, BuysFood) %>%
mutate(BuysFood = factor(BuysFood, levels = c("Mua", "Không"))) # Đảm bảo thứ tự cột hợp lý
# Vẽ biểu đồ
ggplot(gender_food_counts, aes(x = BuysFood, y = n, fill = Gender)) +
geom_col(position = position_dodge(width = 0.7), width = 0.6, alpha = 0.9) +
geom_text(aes(label = n), position = position_dodge(width = 0.7), vjust = -0.5, size = 3, fontface = "bold") +
# Tùy chỉnh màu sắc
scale_fill_manual(
values = c("F" = "#FF69B4", "M" = "#1E90FF"),
labels = c("Nữ", "Nam")
) +
labs(
title = "So sánh số lượng Nam và Nữ theo việc mua sản phẩm 'Food'",
subtitle = "Phân theo hai nhóm: Mua và Không mua",
x = "Tình trạng mua hàng",
y = "Số lượng",
fill = "Giới tính"
) +
theme_minimal(base_size = 15) +
theme(
plot.title = element_text(face = "bold", hjust = 0.5, size = 13),
plot.subtitle = element_text(hjust = 0.5, size = 11, margin = margin(b = 10)),
axis.title.x = element_text(face = "bold", margin = margin(t = 10)),
axis.title.y = element_text(face = "bold"),
axis.text = element_text(color = "black"),
legend.position = "top",
legend.title = element_text(face = "bold")
) +
scale_y_continuous(expand = expansion(mult = c(0, 0.05)), breaks = pretty_breaks(n = 6))
# --- ĐẢM BẢO VÀ SẮP XẾP LẠI BẢNG 2X2 CHO Gender vs BuysFood ---
# Tạo biến BuysFood nếu chưa có
if (!"BuysFood" %in% names(dldt)) {
dldt$BuysFood <- ifelse(dldt$ProductFamily == "Food", "Mua Food", "Không Mua Food")
dldt$BuysFood <- factor(dldt$BuysFood, levels = c("Mua Food", "Không Mua Food"))
}
# Lọc dữ liệu chỉ gồm các giới tính F và M, giữ nguyên levels gender
levels_gender <- c("F", "M")
dldt_2x2_food <- dldt[dldt$Gender %in% levels_gender, ]
# Chuyển Gender thành factor với thứ tự mong muốn, giữ nguyên levels đầy đủ
dldt_2x2_food$Gender <- factor(dldt_2x2_food$Gender, levels = levels_gender)
# Tạo bảng chéo 2x2
table_GF <- table(Gender = dldt_2x2_food$Gender, BuysFood = dldt_2x2_food$BuysFood)
cat("Bảng ngẫu nhiên 2x2 (Gender vs. BuysFood) đã chuẩn bị:\n")
## Bảng ngẫu nhiên 2x2 (Gender vs. BuysFood) đã chuẩn bị:
print(table_GF)
## BuysFood
## Gender Mua Không
## F 5149 2021
## M 5004 1885
dldt$BuysFood <- ifelse(dldt$ProductFamily == "Food", "Mua Food", "Không Mua Food")
dldt$BuysFood <- factor(dldt$BuysFood, levels = c("Mua Food", "Không Mua Food"))
# Lọc data chỉ có Gender F và M, và set levels
levels_gender <- c("F", "M")
dldt_2x2_food <- dldt[dldt$Gender %in% levels_gender, ]
dldt_2x2_food$Gender <- factor(dldt_2x2_food$Gender, levels = levels_gender)
# Tạo bảng chéo
table_GF <- table(Gender = dldt_2x2_food$Gender, BuysFood = dldt_2x2_food$BuysFood)
print(table_GF)
## BuysFood
## Gender Mua Food Không Mua Food
## F 5149 2021
## M 5004 1885
if (all(dim(table_GF) == c(2,2))) {
a <- table_GF["F", "Mua Food"]
b <- table_GF["F", "Không Mua Food"]
c <- table_GF["M", "Mua Food"]
d <- table_GF["M", "Không Mua Food"]
n1 <- a + b
n2 <- c + d
} else {
a <- b <- c <- d <- n1 <- n2 <- NA
}
if (!any(is.na(c(a, c, n1, n2))) && n1 > 0 && n2 > 0) {
# Tính tỷ lệ
p1_F_buys_food <- a / n1
p2_M_buys_food <- c / n2
diff_prop_GF <- p1_F_buys_food - p2_M_buys_food
cat(paste0("Tỷ lệ Nữ mua 'Food' (P_F): ", round(p1_F_buys_food, 4), "\n"))
cat(paste0("Tỷ lệ Nam mua 'Food' (P_M): ", round(p2_M_buys_food, 4), "\n"))
cat(paste0("Hiệu hai tỷ lệ (P_F - P_M): ", round(diff_prop_GF, 4), "\n"))
# Kiểm định tỷ lệ bằng prop.test (không chỉnh sửa Yates continuity)
prop_test_diff_GF <- prop.test(x = c(a, c), n = c(n1, n2), correct = FALSE)
cat("\nKết quả từ prop.test() để kiểm định H0: P_F = P_M:\n")
print(prop_test_diff_GF)
# Tính KTC 95% theo phương pháp Wald
se_diff_prop_GF <- sqrt( (p1_F_buys_food * (1 - p1_F_buys_food) / n1) + (p2_M_buys_food * (1 - p2_M_buys_food) / n2) )
z_alpha_half <- qnorm(0.975)
lower_ci_diff_GF <- diff_prop_GF - z_alpha_half * se_diff_prop_GF
upper_ci_diff_GF <- diff_prop_GF + z_alpha_half * se_diff_prop_GF
cat(paste0("KTC 95% (Wald) cho Hiệu hai tỷ lệ: (", round(lower_ci_diff_GF, 4), ", ", round(upper_ci_diff_GF, 4), ")\n"))
# Diễn giải KTC
if (lower_ci_diff_GF > 0) {
cat(" - Hiệu tỷ lệ có ý nghĩa thống kê: tỷ lệ Nữ mua cao hơn Nam.\n")
} else if (upper_ci_diff_GF < 0) {
cat(" - Hiệu tỷ lệ có ý nghĩa thống kê: tỷ lệ Nữ mua thấp hơn Nam.\n")
} else {
cat(" - Hiệu tỷ lệ KHÔNG có ý nghĩa thống kê (KTC chứa 0).\n")
}
} else {
cat("Không thể tính Hiệu hai tỷ lệ do dữ liệu không hợp lệ hoặc thiếu.\n")
}
## Tỷ lệ Nữ mua 'Food' (P_F): 0.7181
## Tỷ lệ Nam mua 'Food' (P_M): 0.7264
## Hiệu hai tỷ lệ (P_F - P_M): -0.0082
##
## Kết quả từ prop.test() để kiểm định H0: P_F = P_M:
##
## 2-sample test for equality of proportions without continuity correction
##
## data: c(a, c) out of c(n1, n2)
## X-squared = 1.1902, df = 1, p-value = 0.2753
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.023052362 0.006563804
## sample estimates:
## prop 1 prop 2
## 0.7181311 0.7263754
##
## KTC 95% (Wald) cho Hiệu hai tỷ lệ: (-0.0231, 0.0066)
## - Hiệu tỷ lệ KHÔNG có ý nghĩa thống kê (KTC chứa 0).
Tỷ lệ nữ giới mua sản phẩm Food là 71.81%, trong khi tỷ lệ này ở nam giới là 72.64%. Hiệu giữa hai tỷ lệ (P_F − P_M) là −0.0082, tức là thấp hơn khoảng 0.82 điểm phần trăm. Tuy nhiên, khoảng tin cậy 95% theo phương pháp Wald cho hiệu hai tỷ lệ là từ −2.31% đến 0.66%, tức là chứa giá trị 0. Điều này đồng nghĩa với việc không có sự khác biệt có ý nghĩa thống kê giữa hai tỷ lệ.
Kết quả từ kiểm định prop.test cũng cho thấy giá trị p là 0.2753 (> 0.05), do đó ta không bác bỏ giả thuyết rằng hai tỷ lệ bằng nhau. Nói cách khác, không có bằng chứng thống kê rõ ràng cho thấy giới tính ảnh hưởng đến hành vi mua sản phẩm Food. Sự khác biệt nhỏ quan sát được có thể là do yếu tố ngẫu nhiên trong mẫu.
cat("RR = [P(Mua Food | Gender=F)] / [P(Mua Food | Gender=M)]\n")
## RR = [P(Mua Food | Gender=F)] / [P(Mua Food | Gender=M)]
if (!is.na(a) && n1 > 0 && n2 > 0) {
p1_F_buys_food <- table_GF["F", "Mua Food"] / sum(table_GF["F",])
p2_M_buys_food <- table_GF["M", "Mua Food"] / sum(table_GF["M",])
if (p2_M_buys_food == 0) {
rr_GF_manual <- NA
} else {
rr_GF_manual <- p1_F_buys_food / p2_M_buys_food
}
cat(paste0("Relative Risk (RR) tính tay = ", round(rr_GF_manual, 3), "\n"))
rr_GF_epitools_obj <- NULL; error_in_rr_epi <- FALSE
tryCatch({
rr_GF_epitools_obj <- riskratio(table_GF, method = "wald", rev = "b")
cat("\nKết quả RR và KTC 95% từ epitools::riskratio():\n"); print(rr_GF_epitools_obj$measure)
# SỬA ở đây: dùng hàng là "F", không phải "risk ratio"
rr_estimate_gf_epi <- rr_GF_epitools_obj$measure["F", "estimate"]
rr_lower_gf_epi <- rr_GF_epitools_obj$measure["F", "lower"]
rr_upper_gf_epi <- rr_GF_epitools_obj$measure["F", "upper"]
}, error = function(e) {
error_in_rr_epi <- TRUE
rr_estimate_gf_epi <- rr_lower_gf_epi <- rr_upper_gf_epi <- NA
})
if (!error_in_rr_epi && !is.na(rr_estimate_gf_epi)) {
cat(paste0("RR (epitools) = ", round(rr_estimate_gf_epi, 3),
", KTC 95%: (", round(rr_lower_gf_epi, 3), ", ", round(rr_upper_gf_epi, 3), ").\n"))
} else {
cat("Không thể lấy RR từ epitools.\n")
}
} else {
cat("Không thể tính Relative Risk.\n")
}
## Relative Risk (RR) tính tay = 0.989
##
## Kết quả RR và KTC 95% từ epitools::riskratio():
## risk ratio with 95% C.I.
## Gender estimate lower upper
## M 1.0000000 NA NA
## F 0.9886501 0.9685868 1.009129
## RR (epitools) = 0.989, KTC 95%: (0.969, 1.009).
Dựa trên kết quả phân tích, tỷ số rủi ro (Risk Ratio – RR) giữa hai giới tính đối với hành vi mua sản phẩm Food là 0.989. Điều này có nghĩa là tỷ lệ nữ giới mua sản phẩm Food thấp hơn khoảng 1.1% so với nam giới. Tuy nhiên, khoảng tin cậy 95% cho RR là từ 0.969 đến 1.009 – trong đó có chứa giá trị 1. Điều này cho thấy sự khác biệt quan sát được không có ý nghĩa thống kê.
Nói cách khác, không có đủ bằng chứng để khẳng định rằng giới tính ảnh hưởng đến hành vi mua sản phẩm Food. Sự chênh lệch nhỏ này (chỉ khoảng 1%) có thể hoàn toàn là do yếu tố ngẫu nhiên. Về mặt thực tiễn, một RR gần bằng 1 cùng với khoảng tin cậy hẹp và bao gồm 1 cho thấy mối liên hệ giữa giới tính và hành vi mua hàng là không đáng kể. Vì vậy, có thể kết luận rằng giới tính không phải là một yếu tố có ảnh hưởng rõ rệt đến việc mua sản phẩm Food trong tập dữ liệu này.
if (!is.na(a) && n1 > 0 && n2 > 0 && b > 0 && d > 0) {
odds_F_buys_food <- a / b
odds_M_buys_food <- c / d
or_GF_manual <- (a * d) / (b * c)
cat(paste0("Odds Ratio (OR) = ", round(or_GF_manual, 3), "\n"))
or_GF_epitools_obj <- NULL
error_in_or_epi <- FALSE
tryCatch({
or_GF_epitools_obj <- oddsratio(table_GF, method = "wald", rev = "b")
or_estimate_gf_epi <- or_GF_epitools_obj$measure["F", "estimate"]
or_lower_gf_epi <- or_GF_epitools_obj$measure["F", "lower"]
or_upper_gf_epi <- or_GF_epitools_obj$measure["F", "upper"]
cat(paste0("OR (epitools) = ", round(or_estimate_gf_epi, 3),
", KTC 95%: (", round(or_lower_gf_epi, 3), ", ", round(or_upper_gf_epi, 3), ")\n"))
}, error = function(e){
cat("Lỗi khi tính OR bằng epitools: ", e$message, "\n")
})
} else {
cat("Không thể tính Odds Ratio.\n")
}
## Odds Ratio (OR) = 0.96
## OR (epitools) = 0.96, KTC 95%: (0.891, 1.033)
Dựa trên kết quả phân tích, Odds Ratio (OR) giữa hai giới tính đối với hành vi mua sản phẩm Food là 0.96. Điều này có nghĩa là khả năng nữ giới mua sản phẩm Food (so với không mua) thấp hơn khoảng 4% so với nam giới. Tuy nhiên, khoảng tin cậy 95% của OR là từ 0.891 đến 1.033 — bao gồm giá trị 1.
Điều này cho thấy sự khác biệt về odds giữa nam và nữ không có ý nghĩa thống kê. Khoảng tin cậy chứa giá trị 1 nghĩa là ta không thể bác bỏ giả thuyết rằng giới tính không ảnh hưởng đến khả năng mua Food. Dù OR < 1 gợi ý rằng nữ giới có thể mua ít hơn, nhưng mức chênh lệch này là nhỏ và không đủ mạnh để kết luận có sự khác biệt thực sự. Vì vậy, xét cả về thống kê và thực tiễn, không có bằng chứng thuyết phục rằng giới tính ảnh hưởng đến hành vi mua sản phẩm Food.