1 Bài tập tuần 5

library(epitools)
library(tidyverse)
library(questionr)
library(psych)
library(moments)
library(readr)
df <- read_csv("bank-full.csv")

2 Hồi quy Poisson

Hồi quy Poisson là một phương pháp hồi quy dùng cho dữ liệu rời rạc dạng đếm, tức là biến ngẫu nhiên nhận giá trị thuộc tập hợp số tự nhiên. Mô hình được sử dụng khi muốn đo lường trung bình số sự kiện xảy ra như: số người có thể bị tai nạn xe, số người ra vào siêu thị, số sản phẩm bị lỗi … Mô hình có các giả định như sau: \[ Y_i \sim Poisson(\lambda_i), \quad với \lambda_i>0\] \[ log(\lambda_i)=\beta_0 + \beta_1x_{i1} + ...+\beta_px_{ip}\] \[ Var(Y_i)\approx \mathbb{E} (Y_i)\] Tiếp đến là hàm hợp lý của hồi quy Poisson:

Biến \(y_i\sim Poisson(\lambda_i)\) thì có hàm mật độ xác suất như sau: \[ P(Y_i=y_i)=\frac{e^{-\lambda_i}\lambda_i^{y_i}}{y_i!}\] Với hồi quy Poisson thì \[\lambda_i = exp(\beta_0 + \beta_1x_{i1} + ...+\beta_px_{ip}) = exp(x_i^T\beta)\] Hàm Log Likelihood có dạng như sau

\[log\mathcal{L}(\beta)=\Sigma_{i=1}^n[y_ix_i^T\beta-exp(x_i^T\beta)-log(y_i!)]\] Trong đó thì các hệ số hồi quy được diễn giải như sau: Khi biến độc lập tăng lên 1 đơn vị thì kỳ vọng của số sự kiện xảy ra sẽ thay đổi một lượng \(exp(\beta)\), khi các biến độc lập khác không thay đổi.

Đánh giá sự phù hợp của mô hình

Hồi quy Poisson có một giả định quan trọng là \(Var(Y_i)\approx \mathbb{E} (Y_i)\). Nhưng trong thực tế thì thường phương sai sẽ lớn hơn so với kỳ vọng \(Var(Y_i)>\mathbb{E} (Y_i)\) đây gọi là hiện tượng phân tán. Vì thế mà ta cần đưa ra một chỉ số đánh giá được sự phân tán đó là: \[ \frac{Residual.Deviance}{Residual.df}\]

Residual Deviance là thước đo mức độ không phù hợp giữa mô hình Poisson và dữ liệu thực tế, được tính bằng hai lần chênh lệch log-likelihood giữa mô hình hiện tại và mô hình saturated (mô hình khớp hoàn hảo với dữ liệu). Residual degrees of freedom (Residual df) là số bậc tự do còn lại, bằng số quan sát trừ số tham số ước lượng. Chỉ số này cho biết mức độ phức tạp của mô hình và được dùng để chuẩn hoá residual deviance nhằm đánh giá mức độ phù hợp.

Tỷ số giữa Residual Deviance và Residual df xấp xỉ kỳ vọng của phân phối chi bình phương nếu mô hình phù hợp. Khi chỉ số này xấp xỉ 1, mô hình được xem là tương đối phù hợp với dữ liệu. Nếu lớn hơn đáng kể 1, điều đó cho thấy hiện tượng quá phân tán (overdispersion), còn nếu nhỏ hơn nhiều, có thể xảy ra underdispersion hoặc overfitting. Đây là cách kiểm tra tổng thể mô hình đơn giản nhưng hiệu quả trong phân tích định lượng.

2.1 Thực hành hồi quy Poisson

Để thực hành hồi quy Poisson thì cần một dữ liệu có biến thuộc là biến đếm. Trong R thì có bộ dữ liệu warpbreaks là dữ liệu về số lần đứt sợi, được phân loại theo loại len(wool) và độ căng của len(tension).

data(warpbreaks)
str(warpbreaks)
## 'data.frame':    54 obs. of  3 variables:
##  $ breaks : num  26 30 54 25 70 52 51 26 67 18 ...
##  $ wool   : Factor w/ 2 levels "A","B": 1 1 1 1 1 1 1 1 1 1 ...
##  $ tension: Factor w/ 3 levels "L","M","H": 1 1 1 1 1 1 1 1 1 2 ...

Bộ dữ liệu này có 3 biến trong đó biến breaks là biến số lần đứt sợi trên mỗi khung dệt. wool và tension là biến định tính trong đó wool được phân thành 2 loại là A và B, tension được chia thành 3 độ căng là “Low”, “Medium”,“High”.Sau đây sẽ ước lượng mô hình hồi quy Poisson với biến phụ thuộc breaks

model_Poisson <-  glm(breaks ~ wool + tension, family = poisson, data = warpbreaks)
summary(model_Poisson)
## 
## Call:
## glm(formula = breaks ~ wool + tension, family = poisson, data = warpbreaks)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  3.69196    0.04541  81.302  < 2e-16 ***
## woolB       -0.20599    0.05157  -3.994 6.49e-05 ***
## tensionM    -0.32132    0.06027  -5.332 9.73e-08 ***
## tensionH    -0.51849    0.06396  -8.107 5.21e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 297.37  on 53  degrees of freedom
## Residual deviance: 210.39  on 50  degrees of freedom
## AIC: 493.06
## 
## Number of Fisher Scoring iterations: 4

Dựa vào kết quả trên thì cho biết số lần trung bình mà sợi dây đứt trên một khung khi sợi len là A và Low thì là 40.0849118 lần. Với mức căng là L nhưng loại len là B thì số lần đứt sợi giảm trung bình 18.6%. Nếu mức căng là M giữ nguyên loại len thì số lần đứt sợi giảm trung bình 27.5% so với độ căng là L.Nếu mức căng là H giữ nguyên loại len thì số lần đứt sợi giảm trung bình 40.4% so với độ căng là L. Vậy cho thấy rằng loại len B tốt hơn len A vì số lần đứt ít hơn, loại len nào có độ căng càng cao thì càng tốt.

Về độ phù hợp của mô hình thì cho thấy rằng Residual deviance là 210.39 còn residual df là 50 cho thấy rằng Residual deviance gấp 4 lần df cho thấy rằng mô hình có hiện tượng phân tán cao. Để chắc chắn hơn thì ta đến với kiểm định bằng hàm dispersiontest với các giả thiết như sau:

Giả thuyết gốc: Mô hình không có hiện tượng quá phân tán \[H_0: \phi=1\]

Giả thuyết đối: Mô hình có hiện tượng quá phân tán \[ H_1: \phi \neq 1\]

AER::dispersiontest(model_Poisson)
## 
##  Overdispersion test
## 
## data:  model_Poisson
## z = 4.5797, p-value = 2.329e-06
## alternative hypothesis: true dispersion is greater than 1
## sample estimates:
## dispersion 
##   3.944448

Dựa trên p-value = 2.329e-06 < 0.05 vậy cho thấy rằng giả thuyết gốc bị bác bỏ và chấp nhận rằng mô hình có hiện tượng quá phân tán với tham số phân tán được ước lượng 3.9444.

2.2 Kiểm tra dữ liệu

str(df)
## spc_tbl_ [45,211 × 17] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ age      : num [1:45211] 58 44 33 47 33 35 28 42 58 43 ...
##  $ job      : chr [1:45211] "management" "technician" "entrepreneur" "blue-collar" ...
##  $ marital  : chr [1:45211] "married" "single" "married" "married" ...
##  $ education: chr [1:45211] "tertiary" "secondary" "secondary" "unknown" ...
##  $ default  : chr [1:45211] "no" "no" "no" "no" ...
##  $ balance  : num [1:45211] 2143 29 2 1506 1 ...
##  $ housing  : chr [1:45211] "yes" "yes" "yes" "yes" ...
##  $ loan     : chr [1:45211] "no" "no" "yes" "no" ...
##  $ contact  : chr [1:45211] "unknown" "unknown" "unknown" "unknown" ...
##  $ day      : num [1:45211] 5 5 5 5 5 5 5 5 5 5 ...
##  $ month    : chr [1:45211] "may" "may" "may" "may" ...
##  $ duration : num [1:45211] 261 151 76 92 198 139 217 380 50 55 ...
##  $ campaign : num [1:45211] 1 1 1 1 1 1 1 1 1 1 ...
##  $ pdays    : num [1:45211] -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
##  $ previous : num [1:45211] 0 0 0 0 0 0 0 0 0 0 ...
##  $ poutcome : chr [1:45211] "unknown" "unknown" "unknown" "unknown" ...
##  $ Target   : chr [1:45211] "no" "no" "no" "no" ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   age = col_double(),
##   ..   job = col_character(),
##   ..   marital = col_character(),
##   ..   education = col_character(),
##   ..   default = col_character(),
##   ..   balance = col_double(),
##   ..   housing = col_character(),
##   ..   loan = col_character(),
##   ..   contact = col_character(),
##   ..   day = col_double(),
##   ..   month = col_character(),
##   ..   duration = col_double(),
##   ..   campaign = col_double(),
##   ..   pdays = col_double(),
##   ..   previous = col_double(),
##   ..   poutcome = col_character(),
##   ..   Target = col_character()
##   .. )
##  - attr(*, "problems")=<externalptr>

Bộ dữ liệu có 45211 quan sát bao gồm 17 biến trong đó có 8 biến định tính và 9 biến định lượng.Đây là tập dữ liệu thu thập từ các chiến dịch qua điện thoại của một ngân hàng tại Bồ Đào Nha, nhằm mời khách hàng đăng ký sản phẩm tiền gửi có kỳ hạn. Với mục đích là nhận dạng đặc điểm của khách hàng có khả năng đăng ký sản phẩm của ngân hàng.Chi tiết các biến trong bộ dữ liệu

  • age: Tuổi của khách hàng
  • job: Nghề nghiệp
  • marital: Tình trạng hôn nhân
  • education: Trình độ học vấn
  • default: Tình trạng nợ xấu của khách hàng
  • balance: Số dư trung bình hàng năm
  • housing: Tình trạng vay thế chấp nhà ở
  • loan: Tình trạng khoản vay cá nhân
  • contact: Phương thức liên lạc tới khách hàng
  • day: Ngày gọi cuối cùng trong tháng
  • month: Tháng gọi cuối cùng
  • duration: Thời lượng cuộc gọi cuối
  • campaign: Số lần liên hệ trong chiến dịch hiện tại
  • pdays: Số ngày kể từ lần gọi gần nhất từ chiến dịch trước
  • previous: Số lần liên hệ trong các chiến dịch trước
  • poutcome: Kết quả của chiến dịch trước
  • target: Khách có đăng ký tiền gửi kỳ hạn không

Sau đó là kiểm tra xem bộ dữ liệu có giá trị Na:

sum(is.na(df))
## [1] 0

Vậy bộ dữ liệu không có giá trị Na nào. Tiếp tục là chuyển các biến về dạng factor

char_vars_raw <- names(df)[sapply(df,is.character)]
char_vars <- char_vars_raw[-8]
for (col in char_vars) {
    if (!is.factor(df[[col]])) {
        df[[col]] <- factor(df[[col]])
    }
}
for(col in char_vars) {
         cat("Biến",col,":",is.factor(df[[col]]),"\n")
}
## Biến job : TRUE 
## Biến marital : TRUE 
## Biến education : TRUE 
## Biến default : TRUE 
## Biến housing : TRUE 
## Biến loan : TRUE 
## Biến contact : TRUE 
## Biến poutcome : TRUE 
## Biến Target : TRUE

2.3 Ước lượng mô hình logistic

Ở đây ta sẽ quan tâm đến biến Target xem rằng những khách hàng có đặc điểm như nào thì sẽ đồng ý với việc đăng ký tiền gửi có kỳ hạn. Với trực giác nhận thấy rằng những biến như poutcome, default, housing, age, marital là có sự tác động đến biến Target. Sau đây sẽ ước lượng mô hình để đánh giá sự tác dộng của các biến trên lên biến Target.Mô hình dùng để ước lượng là mô hình logistic với hàm liên kết là \(ln(\frac{p}{1-p})\). Trong đó thì p là xác suất mà khách hàng đồng ý đăng ký tiền gửi kỳ hạn (nhãn “yes”).

# Chỉnh lại nhãn để "no" làm gốc
df$Target <- factor(df$Target,levels = c("no","yes"))
# Chỉnh lại nhãn để "single" làm gốc
df$marital <- factor(df$marital,levels = c("single","married","divorced"))
# Chỉnh lại nhãn để "failure" làm gốc
df$poutcome <- factor(df$poutcome,levels = c("failure","success","other","unknown"))

Sau khi thực hiện câu lệnh factor trên thì mô hình logistic sẽ tính P(Target = “yes”).

# Ước lượng mô hình logit (link = "logit")
model_logit <- glm(Target ~ poutcome + default + housing+age+marital , data = df,
                   family = binomial(link = "logit"))
summary(model_logit)
## 
## Call:
## glm(formula = Target ~ poutcome + default + housing + age + marital, 
##     family = binomial(link = "logit"), data = df)
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)     -1.390314   0.077320 -17.981  < 2e-16 ***
## poutcomesuccess  2.280582   0.070557  32.323  < 2e-16 ***
## poutcomeother    0.266610   0.077062   3.460 0.000541 ***
## poutcomeunknown -0.494549   0.047658 -10.377  < 2e-16 ***
## defaultyes      -0.481808   0.146005  -3.300 0.000967 ***
## housingyes      -0.797888   0.032644 -24.442  < 2e-16 ***
## age              0.006706   0.001593   4.210 2.56e-05 ***
## maritalmarried  -0.487075   0.038341 -12.704  < 2e-16 ***
## maritaldivorced -0.286400   0.056389  -5.079 3.79e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 32631  on 45210  degrees of freedom
## Residual deviance: 29105  on 45202  degrees of freedom
## AIC: 29123
## 
## Number of Fisher Scoring iterations: 5

Với hệ số chặn thì khi khách hàng có những đặc điểm như không vay mua nhà, độc thân, không nợ xấu và kết quả của chiến dịch marketing trước đó thất bai thì có khả năng lần này có log-odds là -1.4 cho thấy rằng xác suất đồng ý sẽ thấp hơn xác suất thất bại. So với nhóm gốc poutcome = failure, nếu kết quả của chiến dịch marketing trước đó là success, thì log-odds tăng thêm 2.290. Khách hàng đã có tiếp cận thành công với chiến dịch marketing trước đây có xác suất đăng ký cao hơn đáng kể so với những người có kết quả trước đó là thất bại. So với người không có nợ xấu (default = no), những người có nợ xấu có log-odds giảm đi 0.489. Khách hàng có đang có hoặc đã có nợ xấu trong quá khứ thì sẽ có xu hướng ít có khả năng tham gia hơn so với người không có nợ xấu. So với nhóm không có khoản vay mua nhà (housing = no), nhóm có khoản vay nhà có log-odds giảm 0.759. Cho thấy rằng những khách hàng đã từng và đang vay nợ thì họ thường sẽ không muốn gửi tiền có kỳ hạn. So với người độc thân thì những người có gia đình hoặc là ly hôn sẽ có ít khả năng tham gia việc gửi tiền có kỳ hạn. Log-odds sẽ tăng dần theo độ tuổi thể hiện được rằng khi về càng lớn tuổi sẽ có tiền nhàn rỗi để có thể gửi vào ngân hàng.

2.4 Ước lượng mô hình Probit

Ở phần này thì sẽ mô hình hoá xác suất của P(Target = “yes”) bằng việc sử dụng hàm liên kết là hàm phân phối tích luỹ ngược chuẩn tắc \(\Phi^{-1}\). Giá trị khi trả về là chỉ số latent và xác suất sẽ được tính lại bằng hàm phân phối tích luỹ chuẩn tắc $ P = (X)$.

# Ước lượng mô hình probit (link = "probit")
model_probit <- glm(Target ~ poutcome + default + housing+age+marital, data = df, 
                    family = binomial(link = "probit"))
summary(model_probit)
## 
## Call:
## glm(formula = Target ~ poutcome + default + housing + age + marital, 
##     family = binomial(link = "probit"), data = df)
## 
## Coefficients:
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)     -0.8507394  0.0414137 -20.542  < 2e-16 ***
## poutcomesuccess  1.3803418  0.0410129  33.656  < 2e-16 ***
## poutcomeother    0.1449310  0.0423336   3.424 0.000618 ***
## poutcomeunknown -0.2515082  0.0252768  -9.950  < 2e-16 ***
## defaultyes      -0.2277464  0.0700444  -3.251 0.001148 ** 
## housingyes      -0.4088133  0.0168227 -24.301  < 2e-16 ***
## age              0.0032700  0.0008447   3.871 0.000108 ***
## maritalmarried  -0.2566384  0.0200450 -12.803  < 2e-16 ***
## maritaldivorced -0.1478746  0.0295631  -5.002 5.67e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 32631  on 45210  degrees of freedom
## Residual deviance: 29113  on 45202  degrees of freedom
## AIC: 29131
## 
## Number of Fisher Scoring iterations: 5

Hệ số chặn cho thấy rằng khi khách hàng có đặc điểm ở mức gốc tức là khách hàng không vay mua nhà, độc thân, không nợ xấu và kết quả của chiến dịch marketing trước đó thất bai thì chỉ số latent là -0.8578213 tức là mức xác suất đồng ý khi khách hàng ở mức gốc là 0.1954956. Nếu như kết quả của chiến dịch marketing của khách hàng ở kỳ trước thành công thì làm tăng chỉ số latent +lên 1.3860762 đơn vị. Những người đang có nợ thì sẽ làm giảm chỉ số latent đồng nghĩa với việc làm giảm xác suất vì họ đa phần tiền sẽ được dùng để trả nợ nên ít khi gửi tiền có kỳ hạn, cụ thể thì nếu như có nợ xấu thì sẽ làm chỉ số latent giảm đi -0.23195 và đang vay để mua nhà thì chỉ số latent giảm -0.3886, cho thấy rằng người có nợ xấu thì có thể là người đang có nợ hoặc là họ đã trả nợ xong nhưng trả chậm còn những người mà vay mua nhà thì lại đang phải trả tiền nên làm cho xác suất giảm đi nhiều hơn. Hệ số của age cho thấy rằng chỉ số latent tăng khi độ tuổi tăng lên cho thấy rằng khi tuổi càng lớn thì tài chính càng ổn định. Khi một khách hàng đã có gia đình sẽ làm giảm đi chỉ số latent -0.2650766, có thể vì tiền sinh hoạt gia đình đã tăng lên khi có con cái hoặc là họ cũng đang có khoản vay nợ dể dành cho gia đình. Còn so với khách hàng đã ly hôn thì sẽ giảm đi chỉ số latent đi -0.151.

2.5 Thống kê mô tả

2.5.1 Biến định tính

Biến job Đây là biến thể hiện nghề nghiệp của khách hàng đã tiếp thị.

df %>%
    count(job, sort = TRUE) %>%
    ggplot(aes(x = reorder(job, n), y = n)) +
    geom_col(fill = "blue") +
    coord_flip() +
    labs(title = "Nghề nghiệp ", x = "Nghề", y = "Số lượng") +
    theme_minimal() + 
    geom_text(aes(label = n), hjust = -0.5, size = 4,col="black") + ylim(0,11000)

Biến marital

df %>%
    count(marital) %>%
    ggplot(aes(x = marital, y = n)) +
    geom_col(fill = "yellow") +  # dùng geom_col thay vì geom_bar vì đã có y
    geom_text(aes(label = n), vjust = 2, size = 4, color = "black") +
    labs(title = "Tình trạng hôn nhân", x = "Hôn nhân", y = "Số lượng") +
    theme_minimal()

Biến education

df %>%
    count(education) %>%
    ggplot(aes(x = education, y = n)) +
    geom_col(fill = "#FFC0CB") +  # dùng geom_col thay vì geom_bar vì đã có y
    geom_text(aes(label = n), vjust = 1, size = 4, color = "black") +
    labs(title = "Trình độ học vấn", x = "Học vấn", y = "Số lượng") +
    theme_minimal()

Biến default

df %>%
    count(default) %>%
    ggplot(aes(x = default, y = n)) +
    geom_col(fill = "peachpuff") +  # dùng geom_col thay vì geom_bar vì đã có y
    geom_text(aes(label = n), vjust = 1, size = 4, color = "black") +
    labs(title = "Tình trạng Nợ xấu", x = "Tình trạng", y = "Số lượng") +
    theme_minimal()

Biến loan

df %>%
    count(loan) %>%
    ggplot(aes(x = loan, y = n)) +
    geom_col(fill = "#AFEEEE") +  # dùng geom_col thay vì geom_bar vì đã có y
    geom_text(aes(label = n), vjust = 1, size = 4, color = "black") +
    labs(title = "Tình trạng vay tiêu dùng", x = "Tình trạng", y = "Số lượng") +
    theme_minimal()

Biến contact

df %>%
    count(contact) %>%
    ggplot(aes(x = contact, y = n)) +
    geom_col(fill = "#AFEEEE") +  # dùng geom_col thay vì geom_bar vì đã có y
    geom_text(aes(label = n), vjust = 1, size = 4, color = "black") +
    labs(title = "Phương thức liên lạc", x = "Phương thức", y = "Số lượng") +
    theme_minimal()

Biến poutcome

df %>% 
    count(poutcome) %>% 
    ggplot(aes(x=poutcome,y=n))+
    geom_col(fill = "grey")+
    geom_text(aes(label = n),vjust = 1, size = 4 ,color = "black")+
    labs(title = "Kết quả chiến dịch trước",x = "Kết quả", y= "số lượng")+
    theme_minimal()

Biến Target

df %>% 
    count(Target) %>% 
    ggplot(aes(x=Target,y=n))+
    geom_col(fill = "grey")+
    geom_text(aes(label = n),vjust = 1, size = 4 ,color = "black")+
    labs(title = "Kết quả chiến dịch ",x = "Kết quả", y= "số lượng")+
    theme_minimal()

2.5.2 Biến định lượng

Biến age

describe(df$age)[-c(1,2)]
##     mean    sd median trimmed   mad min max range skew kurtosis   se
## X1 40.94 10.62     39   40.25 10.38  18  95    77 0.68     0.32 0.05
ggplot(df, aes(x = age)) +
    geom_histogram(binwidth = 5, fill = "skyblue", color = "black") +
    labs(title = "Phân phối tuổi khách hàng", x = "Tuổi", y = "Tần suất") +
    theme_minimal()

ggplot(df, aes(y = age)) +
    geom_boxplot(fill = "tomato", alpha = 0.7) +
    labs(title = "Boxplot tuổi", y = "Tuổi") +
    theme_minimal()

count_outliers <- function(x) {
    Q1 <- quantile(x, 0.25, na.rm = TRUE)
    Q3 <- quantile(x, 0.75, na.rm = TRUE)
    IQR_value <- Q3 - Q1
    lower <- Q1 - 1.5 * IQR_value
    upper <- Q3 + 1.5 * IQR_value
    below <- sum(x < lower, na.rm = TRUE)
    above <- sum(x > upper, na.rm = TRUE)
    return(list("outlier dưới" = below, "outlier trên" = above))
}
count_outliers(df$age)
## $`outlier dưới`
## [1] 0
## 
## $`outlier trên`
## [1] 487

Biến campaign

describe(df$campaign)[-c(1,2)]
##    mean  sd median trimmed  mad min max range skew kurtosis   se
## X1 2.76 3.1      2    2.12 1.48   1  63    62  4.9    39.24 0.01
ggplot(df, aes(x = campaign)) +
    geom_histogram(binwidth =  1,
                   fill = "skyblue", color = "black") +
    labs(title = "Phân phối số lần giao dịch ở chiến dịch hiện tại", x = "Số lần", y = "Tần suất") +
    theme_minimal()

Biến balance

describe(df$balance)[-c(1,2)]
##       mean      sd median trimmed   mad   min    max  range skew kurtosis    se
## X1 1362.27 3044.77    448  767.21 664.2 -8019 102127 110146 8.36   140.73 14.32
ggplot(df, aes(x = balance)) +
    geom_histogram(binwidth =  200.6488,
                   fill = "skyblue", color = "black") +
    labs(title = "Phân phối số dư trung bình hàng năm", x = "số dư", y = "Tần suất") +
    theme_minimal()

ggplot(df, aes(y = balance)) +
    geom_boxplot(fill = "tomato", alpha = 0.7) +
    labs(title = "Boxplot số dư trung bình hàng năm", y = "số dư") +
    theme_minimal()

count_outliers(df$balance)
## $`outlier dưới`
## [1] 17
## 
## $`outlier trên`
## [1] 4712

2.6 Phân tích biến tác động lên biến Target và poutcome

Khi phân tích có phân tích nào liên quan biến poutcome thì dữ liệu sẽ lọc ra bằng cách loại bỏ những đặc trung nào là “other” và “unknow” để thuận tiện cho việc phân tích.

2.6.1 Phân tích biến Target

Phân tích biến marital lên biến Target

df$marital <- factor(df$marital,levels = c("single","married","divorced"),ordered = T)
tab_tar_mar <- table(df$marital,df$Target)
tab_tar_mar
##           
##               no   yes
##   single   10878  1912
##   married  24459  2755
##   divorced  4585   622
chisq.test(tab_tar_mar )
## 
##  Pearson's Chi-squared test
## 
## data:  tab_tar_mar
## X-squared = 196.5, df = 2, p-value < 2.2e-16

Với mức ý nghĩa 5%, giá trị p-value cực nhỏ (< 0.05) vậy bác bỏ giả thuyết độc lập giữa hai biến. Nói cách khác, tình trạng hôn nhân và hành vi đăng ký sản phẩm tiền gửi có kỳ hạn của khách hàng có mối quan hệ thống kê .

riskratio(tab_tar_mar)
## $data
##           
##               no  yes Total
##   single   10878 1912 12790
##   married  24459 2755 27214
##   divorced  4585  622  5207
##   Total    39922 5289 45211
## 
## $measure
##           risk ratio with 95% C.I.
##             estimate     lower     upper
##   single   1.0000000        NA        NA
##   married  0.6771921 0.6413215 0.7150690
##   divorced 0.7990712 0.7342944 0.8695623
## 
## $p.value
##           two-sided
##             midp.exact fisher.exact   chi.square
##   single            NA           NA           NA
##   married  0.00000e+00 3.970934e-43 1.142954e-44
##   divorced 1.02783e-07 1.170734e-07 1.493358e-07
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

  • Người đã lập gia đình (married) có xác suất đồng ý đăng ký sản phẩm chỉ bằng ~67.7% so với người độc thân.

  • Người đã ly hôn hoặc góa (divorced) cũng có xác suất thấp hơn người độc thân (~79.9%).

  • Cả hai nhóm trên đều có kết quả kiểm định với p-value rất nhỏ (< 0.001), cho thấy khác biệt là có ý nghĩa thống kê.

Kết quả này gợi ý rằng người độc thân có xu hướng quan tâm đến việc gửi tiết kiệm hơn so với các nhóm còn lại. Một cách lý giải hợp lý là: người độc thân có ít ràng buộc tài chính, chủ động hơn trong kế hoạch tiết kiệm hoặc đầu tư cho tương lai, trong khi người có gia đình hoặc đã kết hôn có thể đang ưu tiên chi tiêu cho gia đình hoặc đã có kế hoạch tài chính khác.

oddsratio(tab_tar_mar)
## $data
##           
##               no  yes Total
##   single   10878 1912 12790
##   married  24459 2755 27214
##   divorced  4585  622  5207
##   Total    39922 5289 45211
## 
## $measure
##           odds ratio with 95% C.I.
##             estimate     lower     upper
##   single   1.0000000        NA        NA
##   married  0.6408253 0.6019999 0.6822665
##   divorced 0.7719485 0.7002525 0.8499621
## 
## $p.value
##           two-sided
##             midp.exact fisher.exact   chi.square
##   single            NA           NA           NA
##   married  0.00000e+00 3.970934e-43 1.142954e-44
##   divorced 1.02783e-07 1.170734e-07 1.493358e-07
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

  • Nhóm married (đã kết hôn) có tỷ số odds (đồng ý / không đồng ý) chỉ bằng khoảng 64.1% so với nhóm single, tức là thấp hơn đáng kể.

  • Nhóm divorced (đã ly hôn) có odds cao hơn nhóm đã kết hôn nhưng vẫn thấp hơn nhóm độc thân, chỉ bằng 77.2% so với single.

Với các kiểm định đều có p-value < 0.001, cho thấy sự khác biệt là có ý nghĩa thống kê cao.Khách hàng độc thân là nhóm tiềm năng nhất trong việc đăng ký sản phẩm tiền gửi có kỳ hạn. Ngược lại, những người đã kết hôn có khả năng đồng ý thấp hơn rõ rệt, có thể do họ đã có những ràng buộc tài chính ổn định hơn (ví dụ: mua nhà, nuôi con, chi tiêu hộ gia đình), dẫn đến nhu cầu gửi tiết kiệm thấp hơn.

Phân tích biến poutcome lên biến Target

df_clean <- df %>%filter(poutcome != "unknown",poutcome != "other")
df_clean$poutcome <- factor(df_clean$poutcome,
                            levels = c("failure","success") ,ordered = T)
tab_tar_pout <- table(df_clean$poutcome,df_clean$Target)
tab_tar_pout
##          
##             no  yes
##   failure 4283  618
##   success  533  978
chisq.test(tab_tar_pout)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tab_tar_pout
## X-squared = 1675.1, df = 1, p-value < 2.2e-16

Với p-value rất nhỏ (< 0.05), ta bác bỏ giả thuyết gốc rằng hai biến poutcome và target độc lập nhau. Cho thấy kết quả của chiến dịch tiếp thị trước đó có liên quan đáng kể đến quyết định đăng ký sản phẩm tiền gửi của khách hàng. Điều này cho thấy rằng hành vi trong quá khứ là yếu tố dự báo mạnh cho hành vi hiện tại – một nguyên tắc quan trọng trong marketing và phân tích khách hàng.

riskratio(tab_tar_pout)
## $data
##          
##             no  yes Total
##   failure 4283  618  4901
##   success  533  978  1511
##   Total   4816 1596  6412
## 
## $measure
##          risk ratio with 95% C.I.
##           estimate    lower    upper
##   failure 1.000000       NA       NA
##   success 5.132992 4.726191 5.574809
## 
## $p.value
##          two-sided
##           midp.exact fisher.exact chi.square
##   failure         NA           NA         NA
##   success          0            0          0
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Khách hàng đã có trải nghiệm trong chiến dịch trước có xác suất đăng ký tiền gửi cao gấp ~5.13 lần so với những người không tham gia trong chiến dịch trước.Khoảng tin cậy 95% cho Relative risk là [4.73, 5.57] .Những khách hàng đã phản hồi tích cực trong quá khứ là nhóm rất tiềm năng, có khả năng đồng ý cao gấp 5 lần nên được ưu tiên tiếp cận lại.

oddsratio(tab_tar_pout)
## $data
##          
##             no  yes Total
##   failure 4283  618  4901
##   success  533  978  1511
##   Total   4816 1596  6412
## 
## $measure
##          odds ratio with 95% C.I.
##           estimate    lower    upper
##   failure  1.00000       NA       NA
##   success 12.70688 11.10836 14.55465
## 
## $p.value
##          two-sided
##           midp.exact fisher.exact chi.square
##   failure         NA           NA         NA
##   success          0            0          0
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Khách hàng từng tham gia chiến dịch trước thành công có tỷ lệ odds (đồng ý / không đồng ý) cao gấp ~12.71 lần so với khách hàng thất bại. Khoảng tin cậy 95% của Odds Ratio nằm trong khoảng [11.11 ; 14.55]. Giá trị p-value bằng 0 từ mọi phương pháp kiểm định cho thấy mối quan hệ này có ý nghĩa thống kê rất cao. Điều này khẳng định rằng poutcome là một biến dự báo cực kỳ mạnh mẽ trong việc đánh giá khả năng khách hàng đăng ký sản phẩm ngân hàng.

Phân tích biến loan lên biến Target

df$loan <- factor(df$loan,levels = c("no","yes"))
tab_tar_loan <- table(df$loan,df$Target)
tab_tar_loan
##      
##          no   yes
##   no  33162  4805
##   yes  6760   484
chisq.test(tab_tar_loan)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tab_tar_loan
## X-squared = 209.62, df = 1, p-value < 2.2e-16

Điều này cho thấy rằng việc khách hàng có vay tín chấp hay không có mối quan hệ thống kê với hành vi đăng ký tiền gửi có kỳ hạn.Những khách hàng đang có khoản vay tín chấp có thể đang ở trạng thái tài chính eo hẹp hoặc có hồ sơ tín dụng phức tạp. Do đó, nhóm khách hàng không có khoản vay tín chấp có thể là đối tượng ưu tiên trong chiến dịch tiết kiệm có kỳ hạn.

riskratio(tab_tar_loan)
## $data
##        
##            no  yes Total
##   no    33162 4805 37967
##   yes    6760  484  7244
##   Total 39922 5289 45211
## 
## $measure
##      risk ratio with 95% C.I.
##        estimate     lower     upper
##   no  1.0000000        NA        NA
##   yes 0.5279342 0.4824824 0.5776678
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact  chi.square
##   no          NA           NA          NA
##   yes          0 1.463279e-53 1.24548e-47
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Kết quả phân tích Relative risk giữa biến loan và target cho thấy rằng những khách hàng có khoản vay tín chấp có xác suất đăng ký tiền gửi kỳ hạn thấp hơn so với những người không có khoản vay. Cụ thể, Relative risk ước tính là 0.528, với khoảng tin cậy 95% dao động từ 0.482 đến 0.578, cho thấy xác suất đăng ký ở nhóm có vay tín chấp chỉ bằng khoảng một nửa so với nhóm không vay.Giá trị p-value bằng 0 khẳng định rằng sự khác biệt này có ý nghĩa thống kê rất cao. Kết quả này hàm ý rằng tình trạng vay tín chấp có thể phản ánh phần nào khả năng tài chính hoặc xu hướng tiêu dùng của khách hàng, từ đó ảnh hưởng tiêu cực đến quyết định tham gia các sản phẩm tiết kiệm có kỳ hạn.

oddsratio(tab_tar_loan)
## $data
##        
##            no  yes Total
##   no    33162 4805 37967
##   yes    6760  484  7244
##   Total 39922 5289 45211
## 
## $measure
##      odds ratio with 95% C.I.
##        estimate     lower    upper
##   no  1.0000000        NA       NA
##   yes 0.4942653 0.4480634 0.544081
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact  chi.square
##   no          NA           NA          NA
##   yes          0 1.463279e-53 1.24548e-47
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Kết quả phân tích Odds Ratio cho thấy rằng khách hàng có khoản vay tín chấp có xác suất đồng ý gửi tiền thấp hơn một cách rõ rệt so với nhóm không vay. Cụ thể, Odds Ratio giữa hai nhóm là 0.494, với khoảng tin cậy 95% từ 0.448 đến 0.544. Điều này cho thấy odds (tỷ lệ đồng ý trên không đồng ý) ở nhóm có vay chỉ bằng khoảng 49.4% so với nhóm không vay.

2.6.2 Phân tích biến poutcome

Phân tích biến marital lên biến poutcome

df_clean$marital <- factor(df_clean$marital,levels = c("single","married","divorced"),ordered = T)
tab_pout_mar <- table(df_clean$marital,df_clean$poutcome)
tab_pout_mar
##           
##            failure success
##   single      1426     523
##   married     2919     836
##   divorced     556     152
chisq.test(tab_pout_mar)
## 
##  Pearson's Chi-squared test
## 
## data:  tab_pout_mar
## X-squared = 16.823, df = 2, p-value = 0.0002223

Vì p-value nhỏ hơn ngưỡng ý nghĩa 0.05, ta bác bỏ giả thuyết gốc rằng hai biến này độc lập với nhau. Nói cách khác, tồn tại bằng chứng thống kê cho thấy mối quan hệ giữa tình trạng hôn nhân và kết quả của chiến dịch tiếp thị trước.

riskratio(tab_pout_mar)
## $data
##           
##            failure success Total
##   single      1426     523  1949
##   married     2919     836  3755
##   divorced     556     152   708
##   Total       4901    1511  6412
## 
## $measure
##           risk ratio with 95% C.I.
##             estimate     lower     upper
##   single   1.0000000        NA        NA
##   married  0.8296721 0.7547955 0.9119765
##   divorced 0.8000562 0.6825738 0.9377592
## 
## $p.value
##           two-sided
##              midp.exact fisher.exact   chi.square
##   single             NA           NA           NA
##   married  0.0001341639 0.0001429811 0.0001215338
##   divorced 0.0045874006 0.0047731442 0.0049734872
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Nhóm “married” có Relative risk là 0.83 (95% CI: 0.75 – 0.91), cho thấy xác suất thành công trong chiến dịch tiếp thị của họ chỉ bằng khoảng 83% so với nhóm độc thân. Tương tự, nhóm “divorced” có Relative risk là 0.80 (95% CI: 0.68 – 0.94), nghĩa là xác suất thành công của họ thấp hơn 20% so với nhóm độc thân.Cả hai nhóm đều có p-value < 0.005, chứng tỏ các kết quả này có ý nghĩa thống kê mạnh mẽ. Điều này cho thấy rằng tình trạng hôn nhân có mối quan hệ rõ rệt với khả năng thành công của một chiến dịch tiếp thị, trong đó nhóm độc thân dường như là nhóm phản hồi tích cực hơn.

oddsratio(tab_pout_mar)
## $data
##           
##            failure success Total
##   single      1426     523  1949
##   married     2919     836  3755
##   divorced     556     152   708
##   Total       4901    1511  6412
## 
## $measure
##           odds ratio with 95% C.I.
##             estimate     lower     upper
##   single   1.0000000        NA        NA
##   married  0.7808671 0.6883748 0.8862996
##   divorced 0.7458914 0.6058831 0.9142646
## 
## $p.value
##           two-sided
##              midp.exact fisher.exact   chi.square
##   single             NA           NA           NA
##   married  0.0001341639 0.0001429811 0.0001215338
##   divorced 0.0045874006 0.0047731442 0.0049734872
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Tình trạng hôn nhân có ảnh hưởng đến khả năng thành công của chiến dịch tiếp thị. Khi lấy nhóm “single” làm nhóm tham chiếu, ta thấy nhóm “married” có odds ratio bằng 0.781 (95% CI: 0.688 – 0.886), tức là odds thành công của chiến dịch đối với nhóm đã kết hôn chỉ bằng khoảng 78% so với nhóm độc thân. Tương tự, nhóm “divorced” có odds ratio là 0.746 (95% CI: 0.606 – 0.914), cho thấy odds thành công ở nhóm này cũng thấp hơn so với nhóm độc thân. Giá trị p-value đi kèm đều nhỏ hơn 0.005, khẳng định rằng sự khác biệt là có ý nghĩa thống kê mạnh mẽ. Điều này hàm ý rằng tình trạng hôn nhân là một biến phân nhóm quan trọng trong việc phân tích hành vi phản hồi của khách hàng với các chiến dịch tiếp thị.

Phân tích biến loan lên biến poutcome

df_clean$def <- factor(df_clean$loan,levels = c("no","yes"))
tab_pout_loan <- table(df_clean$loan,df_clean$poutcome)
tab_pout_loan
##      
##       failure success
##   no     4127    1429
##   yes     774      82
chisq.test(tab_pout_loan)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tab_pout_loan
## X-squared = 106.38, df = 1, p-value < 2.2e-16

Với p-value rất nhỏ, nhỏ hơn ngưỡng ý nghĩa 0.05, ta bác bỏ giả thuyết gốc cho rằng hai biến là độc lập với nhau. Nói cách khác, có bằng chứng thống kê mạnh mẽ cho thấy mối quan hệ giữa việc khách hàng có vay tín chấp và kết quả chiến dịch tiếp thị trước đó.

riskratio(tab_pout_loan)
## $data
##        
##         failure success Total
##   no       4127    1429  5556
##   yes       774      82   856
##   Total    4901    1511  6412
## 
## $measure
##      risk ratio with 95% C.I.
##        estimate     lower     upper
##   no  1.0000000        NA        NA
##   yes 0.3724518 0.3017197 0.4597656
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact   chi.square
##   no          NA           NA           NA
##   yes          0 4.619817e-29 3.867215e-25
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

Khi so sánh với nhóm khách hàng không vay và nhóm khách hàng có vay có Relative risk chỉ bằng 0.372, với khoảng tin cậy 95% là [0.302 – 0.460]. Điều này đồng nghĩa với việc xác suất chiến dịch tiếp thị trước thành công ở nhóm có vay chỉ bằng khoảng 37.2% so với nhóm không vay. Giá trị p-value cực kỳ nhỏ gần như bằng 0 cho thấy kết quả này là rất có ý nghĩa thống kê.

oddsratio(tab_pout_loan)
## $data
##        
##         failure success Total
##   no       4127    1429  5556
##   yes       774      82   856
##   Total    4901    1511  6412
## 
## $measure
##      odds ratio with 95% C.I.
##        estimate     lower     upper
##   no  1.0000000        NA        NA
##   yes 0.3065281 0.2405299 0.3855336
## 
## $p.value
##      two-sided
##       midp.exact fisher.exact   chi.square
##   no          NA           NA           NA
##   yes          0 4.619817e-29 3.867215e-25
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"

Nhóm khách hàng có vay tín chấp có Odds Ratio là 0.307 so với nhóm không vay làm nhóm tham chiếu với Odds Ratio = 1). Điều này cho thấy tỷ lệ odds thành công của chiến dịch trong nhóm có vay chỉ bằng khoảng 30.7% so với nhóm không vay. Giá trị p-value từ tất cả các kiểm định đều bằng 0 hoặc xấp xỉ 0, chứng tỏ kết quả này có ý nghĩa thống kê rất cao.

2.7 Bài tập tuần 2

2.7.1 Đọc dữ liệu và kiểm tra dữ liệu

library(tidyverse)
library(DT)
library(scales)
library(forcats)
library(gt)
library(janitor)
library(kableExtra)

# Đọc file dữ liệu 
data <- read.csv("Supermarket Transactions.csv",header = T)

cat("Trình bày nội dung của dữ liệu\n")
## Trình bày nội dung của dữ liệu
datatable(head(data), options = list(scrollX = TRUE))

Cấu trúc của dữ liệu

str(data)
## 'data.frame':    14059 obs. of  16 variables:
##  $ X                : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ PurchaseDate     : chr  "2007-12-18" "2007-12-20" "2007-12-21" "2007-12-21" ...
##  $ 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 ...

Kiểm tra dữ liệu bị thiếu

cat("Số dữ liệu bị thiếu:",sum(is.na(data)))
## Số dữ liệu bị thiếu: 0

2.7.2 Xử lý dữ liệu

Sau đây thì sẽ chọn lọc ra các biến định tính của bộ dữ liệu.Bởi vì bộ dữ liệu này ghi nhận lại lịch sử mua hàng của siêu thị. Điều đó có nghĩa rằng có những khách hàng sẽ mua lại nhiều lần. Vì vậy mà cần phải lọc lại dữ liệu và lấy thông tin gần nhất của khách hàng. Chúng ta cần dựa vào X( số thứ tự ) để sắp xếp lại từ gần nhất đến thấp nhất và dùng CustomerID để loại đếm số khách hàng. Vì thế nên sẽ tạo ra 2 bộ dữ liệu là Thông tin khách hàng(customer_info) và Số lượt bán hàng của cửa hàng(store_sales).Ta sẽ đếm số lượng khách hàng của siêu thị để tạo ra data frame customer_info.

cat("Số lượng khách hàng của siêu thị: ",nrow(table(data$CustomerID)))
## Số lượng khách hàng của siêu thị:  5404

Sau đây thì sẽ tạo ra data frame customer_info. Bằng việc lấy thông tin mua hàng gần nhất của khách hàng để tạo ra bộ dữ liệu mới.

customer_info <- data %>% 
  arrange(desc(X)) %>%  # Sắp xếp dữ liệu theo thứ tự thời gian giảm dần (giao dịch gần nhất trước)
  distinct(CustomerID, .keep_all = TRUE)  # Giữ lại mỗi khách hàng duy nhất, ưu tiên lần mua gần nhất

Tiếp tục chọn ra những biến nào là biến định tính

factors <- c("Gender","MaritalStatus","Homeowner","AnnualIncome",
             "City","StateorProvince","Country","ProductFamily",
             "ProductDepartment","ProductCategory")

customer_info <- customer_info[,factors]
store_sales <- data[,factors]

Tiếp theo là sẽ tìm hiểu các biến có nhãn là gì và bao nhiêu:

for (col in names(customer_info)) {
    name_labels <- unique(customer_info[,col])
    # In ra tên biến và các giá trị duy nhất
    cat("Biến ", col,":" ,length(name_labels),"nhãn \n")
    print(name_labels)
    cat("\n")

}
## Biến  Gender : 2 nhãn 
## [1] "M" "F"
## 
## Biến  MaritalStatus : 2 nhãn 
## [1] "S" "M"
## 
## Biến  Homeowner : 2 nhãn 
## [1] "N" "Y"
## 
## Biến  AnnualIncome : 8 nhãn 
## [1] "$50K - $70K"   "$30K - $50K"   "$10K - $30K"   "$70K - $90K"  
## [5] "$130K - $150K" "$150K +"       "$90K - $110K"  "$110K - $130K"
## 
## Biến  City : 23 nhãn 
##  [1] "Portland"      "Spokane"       "Walla Walla"   "Bremerton"    
##  [5] "Yakima"        "Vancouver"     "San Andres"    "Orizaba"      
##  [9] "Salem"         "Acapulco"      "Tacoma"        "Los Angeles"  
## [13] "Mexico City"   "Merida"        "Beverly Hills" "Hidalgo"      
## [17] "Camacho"       "Seattle"       "Bellingham"    "San Diego"    
## [21] "San Francisco" "Victoria"      "Guadalajara"  
## 
## Biến  StateorProvince : 10 nhãn 
##  [1] "OR"        "WA"        "BC"        "DF"        "Veracruz"  "Guerrero" 
##  [7] "CA"        "Yucatan"   "Zacatecas" "Jalisco"  
## 
## Biến  Country : 3 nhãn 
## [1] "USA"    "Canada" "Mexico"
## 
## Biến  ProductFamily : 3 nhãn 
## [1] "Non-Consumable" "Drink"          "Food"          
## 
## Biến  ProductDepartment : 22 nhãn 
##  [1] "Household"           "Dairy"               "Beverages"          
##  [4] "Frozen Foods"        "Baking Goods"        "Deli"               
##  [7] "Canned Foods"        "Starchy Foods"       "Snack Foods"        
## [10] "Produce"             "Meat"                "Canned Products"    
## [13] "Health and Hygiene"  "Snacks"              "Baked Goods"        
## [16] "Breakfast Foods"     "Eggs"                "Alcoholic Beverages"
## [19] "Carousel"            "Seafood"             "Checkout"           
## [22] "Periodicals"        
## 
## Biến  ProductCategory : 45 nhãn 
##  [1] "Electrical"           "Dairy"                "Pure Juice Beverages"
##  [4] "Vegetables"           "Baking Goods"         "Paper Products"      
##  [7] "Side Dishes"          "Meat"                 "Canned Soup"         
## [10] "Starchy Foods"        "Snack Foods"          "Canned Anchovies"    
## [13] "Specialty"            "Fruit"                "Jams and Jellies"    
## [16] "Cold Remedies"        "Decongestants"        "Bathroom Products"   
## [19] "Candy"                "Drinks"               "Bread"               
## [22] "Breakfast Foods"      "Hygiene"              "Pain Relievers"      
## [25] "Kitchen Products"     "Eggs"                 "Hardware"            
## [28] "Frozen Desserts"      "Pizza"                "Beer and Wine"       
## [31] "Cleaning Supplies"    "Carbonated Beverages" "Canned Tuna"         
## [34] "Canned Sardines"      "Plastic Products"     "Seafood"             
## [37] "Miscellaneous"        "Magazines"            "Candles"             
## [40] "Canned Clams"         "Hot Beverages"        "Frozen Entrees"      
## [43] "Canned Oysters"       "Packaged Vegetables"  "Canned Shrimp"

Kiểm tra rằng các biến có ở dạng factor không. Việc biến là factor sẽ giúp R dễ dàng nhận diện, xử lý và phân tích biến định tính.

for (col in names(customer_info)) {
    cat("Biến",col,":",is.factor(customer_info[,col]),"\n")
    
}
## Biến Gender : FALSE 
## Biến MaritalStatus : FALSE 
## Biến Homeowner : FALSE 
## Biến AnnualIncome : FALSE 
## Biến City : FALSE 
## Biến StateorProvince : FALSE 
## Biến Country : FALSE 
## Biến ProductFamily : FALSE 
## Biến ProductDepartment : FALSE 
## Biến ProductCategory : FALSE

Kết quả cho thấy các biến đều chưa phải là factor nên cần phải xử lý. Biến đầu tiên cần xử lý là biến AnnualIncome vì đây là biến định tính có thứ bậc khi chia ra các khoảng thu nhập với nhau:

customer_info$AnnualIncome <- factor(customer_info$AnnualIncome,
                                    levels =  c( "$10K - $30K" ,  "$30K - $50K" , 
                                                 "$50K - $70K"  ,"$70K - $90K"  ,"$90K - $110K",
                                                 "$110K - $130K" ,
                                                 "$130K - $150K" ,"$150K +"),
                                    ordered = TRUE)
store_sales$AnnualIncome <- factor(store_sales$AnnualIncome,
                                    levels =  c( "$10K - $30K" ,  "$30K - $50K" , 
                                                 "$50K - $70K"  ,"$70K - $90K"  ,"$90K - $110K",
                                                 "$110K - $130K" ,
                                                 "$130K - $150K" ,"$150K +"),
                                    ordered = TRUE)

Tiếp đến là chuyển các biến định tính còn lại thành dạng factor

for (col in names(customer_info)) {
  if (!is.factor(customer_info[[col]])) {
    customer_info[[col]] <- factor(customer_info[[col]])
  }
}

for (col in names(store_sales)) {
  if (!is.factor(store_sales[[col]])) {
    store_sales[[col]] <- factor(store_sales[[col]])
  }
}

2.7.3 Phân tích Mô tả Một biến Định tính

2.7.3.1 Biến Gender

Đây là biến thể hiện giới tính của khách hàng. Sau đây sẽ trình bày bảng tần số và biểu đồ của biến Gender. Và bộ dữ liệu phù hợp để phân tích là customer_info.

table_gender <- table(customer_info$Gender)

as.data.frame(table_gender) %>%
  gt() %>%
  tab_header(
    title = "Tần số Giới tính của khách hàng"
  ) %>%
  cols_label(
    Var1 = "Giới tính",
    Freq = "Số lượng"
  ) %>%
  fmt_number(columns = Freq, sep_mark = ",",decimals = 0)
Tần số Giới tính của khách hàng
Giới tính Số lượng
F 2,674
M 2,730

Tiếp đến là biểu đồ thể hiện tần số của biến Gender.

ggplot(customer_info, aes(x = Gender)) +
    geom_bar(fill = "steelblue")  +
    geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5) +
    labs(title = "Tần số khách hàng theo Giới tính", x = "Giới tính", y = "Tần số") +
    theme_minimal()

Dựa vào biểu đồ và bảng tần số thì ta thấy rằng giới tính khách hàng của siêu thị không có sự chênh lệch nhau quá nhiều. Điều này gợi ý rằng siêu thị có lượng khách hàng nam và nữ tương đương, phù hợp để so sánh hành vi mua sắm giữa hai nhóm.

2.7.3.2 Biến MaritalStatus

Biến MaritalStatus trong bộ dữ liệu customer_info thể hiện tình trạng hôn nhân của khách hàng, cho biết họ đang độc thân (S), đã kết hôn (M), hoặc các trạng thái khác nếu có. Sau đây sẽ trình bày bảng tần số và biểu đồ của biến MaritalStatus.Bộ dữ liệu customer_info là phù hợp để phân tích biến này

table_Marital <- table(customer_info$MaritalStatus)

as.data.frame(table_Marital) %>%
  gt() %>%
  tab_header(
    title = "Tần số Tình trạng hôn nhân của khách hàng"
  ) %>%
  cols_label(
    Var1 = "Tình trạng",
    Freq = "Số lượng"
  ) %>%
  fmt_number(columns = Freq, sep_mark = ",",decimals = 0)
Tần số Tình trạng hôn nhân của khách hàng
Tình trạng Số lượng
M 2,629
S 2,775

Tiếp đến là biểu đồ tần số của biến MaritalStatus

ggplot(customer_info, aes(x = MaritalStatus)) +
    geom_bar(fill = "red") +
    geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5) +
    labs(title = "Tần số khách hàng theo Tình trạng hôn nhân", x = "Tình trạng", y = "Tần số") +
    theme_minimal()

Dựa trên bảng tần số, số lượng khách hàng độc thân (S) là 2,775, hơi nhỉnh hơn so với khách hàng đã kết hôn (M) với 2,629 trong tập dữ liệu customer_info, cho thấy sự phân bố tình trạng hôn nhân khá cân bằng. Chênh lệch nhỏ (146 khách hàng) giữa hai nhóm này có thể không ảnh hưởng lớn đến các phân tích hành vi mua sắm. Kết quả này gợi ý rằng siêu thị thu hút cả hai nhóm khách hàng độc thân và đã kết hôn, tạo cơ hội để so sánh sở thích hoặc thói quen mua sắm giữa họ.

2.7.3.3 Biến Homeowner

Biến Homeowner trong bộ dữ liệu customer_info thể hiện tình trạng sở hữu nhà ở của khách hàng, cho biết họ có sở hữu nhà (Y) hay không (N). Sau đây sẽ trình bày bảng tần số và biểu đồ của biến Homeowner. Bộ dữ liệu customer_info là phù hợp để phân tích biến này.

table_Homeowner <- table(customer_info$Homeowner)

as.data.frame(table_Homeowner) %>%
  gt() %>%
  tab_header(
    title = "Tần số Tình trạng sở hữu nhà của khách hàng"
  ) %>%
  cols_label(
    Var1 = "Tình trạng",
    Freq = "Số lượng"
  ) %>%
  fmt_number(columns = Freq, sep_mark = ",",decimals = 0)
Tần số Tình trạng sở hữu nhà của khách hàng
Tình trạng Số lượng
N 2,149
Y 3,255
 
ggplot(customer_info, aes(x = Homeowner)) +
    geom_bar(fill = "green") +
    geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5) +
    labs(title = "Tần số khách hàng theo Tình trạng hôn nhân", x = "Tình trạng", y = "Tần số") +
    theme_minimal()

Dựa trên bảng tần số, số lượng khách hàng sở hữu nhà (Y) là 3,255, chiếm ưu thế so với khách hàng không sở hữu nhà (N) với 2,149 trong tập dữ liệu customer_info, cho thấy hơn 60% khách hàng có nhà riêng. Sự chênh lệch (1,106 khách hàng) giữa hai nhóm này có thể ảnh hưởng đến các phân tích về hành vi mua sắm, chẳng hạn như chi tiêu hoặc sở thích sản phẩm. Kết quả này gợi ý rằng siêu thị thu hút nhiều hơn nhóm khách hàng có nhà, có thể liên quan đến thu nhập hoặc lối sống ổn định hơn. Điều này tạo cơ hội để phân tích sâu hơn về tác động của tình trạng sở hữu nhà đến quyết định mua sắm.

2.7.3.4 Biến AnnualIncome

Biến AnnualIncome trong bộ dữ liệu customer_info thể hiện mức thu nhập hàng năm của khách hàng, được phân loại theo các khoảng như “$30K - $50K”, “$50K - $70K”, “$70K - $90K”, v.v. Sau đây sẽ trình bày bảng tần số và biểu đồ của biến AnnualIncome. Bộ dữ liệu customer_info với 5,404 quan sát là phù hợp để phân tích biến này.

table_AnnualIncome <- table(customer_info$AnnualIncome)

as.data.frame(table_AnnualIncome) %>%
    gt() %>%
    tab_header(
        title = "Tần số Theo khoảng thu nhập của khách hàng  "
    ) %>%
    cols_label(
        Var1 = "Khoảng thu nhập",
        Freq = "Số lượng"
    ) %>%
    fmt_number(columns = Freq, sep_mark = ",",decimals = 0)
Tần số Theo khoảng thu nhập của khách hàng
Khoảng thu nhập Số lượng
$10K - $30K 1,168
$30K - $50K 1,767
$50K - $70K 949
$70K - $90K 630
$90K - $110K 244
$110K - $130K 257
$130K - $150K 278
$150K + 111
 
ggplot(customer_info, aes(x = AnnualIncome)) +
    geom_bar(fill = "grey") +
    coord_flip() +
    labs(title = "Tần số Theo khoảng thu nhập của khách hàng", x = "Khoảng thu nhập", y = "Tần số") +
    theme_minimal()

Dựa trên bảng tần số của biến AnnualIncome trong tập dữ liệu customer_info, nhóm khách hàng có thu nhập từ $30K - $50K chiếm số lượng lớn nhất (32%), tiếp theo là nhóm $10K - $30K (22%) và $50K - $70K (18%), cho thấy phần lớn khách hàng thuộc các mức thu nhập trung bình và thấp. Các nhóm thu nhập cao hơn ($90K trở lên) có số lượng ít hơn , với nhóm $150K + chỉ chiếm 111 khách hàng, tương ứng khoảng 2% tổng số. Sự phân bố này gợi ý rằng siêu thị chủ yếu phục vụ khách hàng có thu nhập trung bình, có thể ảnh hưởng đến chiến lược định giá hoặc lựa chọn sản phẩm.

2.7.3.5 Biến City

Biến City trong bộ dữ liệu customer_info thể hiện nơi sinh sống của khách hàng, chẳng hạn như “Los Angeles”, “Bremerton”, “Portland”, v.v., phản ánh khu vực địa lý của họ. Sau đây sẽ trình bày bảng tần số và biểu đồ của biến City.

datatable(as.data.frame(table(customer_info$City)),
          colnames = c("Thành phố ", "Số lượng"),
          options = list(pageLength = 10,
                         autoWidth = TRUE) ) # Không hiển thị thanh tìm kiếm nếu không cần
ggplot(customer_info, aes(x = fct_infreq(City))) +
    geom_bar(fill = "darkorange") +
    coord_flip() +
    labs(title = "Tần số khách hàng theo Thành phố sinh sống", x = "Thành phố", y = "Tần số") +
    theme_minimal()

Dựa trên bảng tần số biến City, thành phố Seattle (581), San Diego (560) và Los Angeles (503) có số lượng khách hàng lớn nhất, cho thấy đây là các khu vực tập trung đông khách hàng của siêu thị. Ngược lại, các thành phố như Walla Walla (76), Spokane (83) và Orizaba (88) có ít khách hàng hơn, phản ánh sự phân bố địa lý không đồng đều, có thể ảnh hưởng đến chiến lược tiếp thị hoặc phân phối sản phẩm.

2.7.3.6 Biến StateorProvince

Biến StateorProvince trong bộ dữ liệu customer_info thể hiện bang hoặc tỉnh nơi khách hàng sinh sống, ví dụ như “CA”, “WA”, “OR”, v.v., phản ánh khu vực địa lý rộng hơn của họ. Sau đây sẽ trình bày bảng tần số và biểu đồ của biến StateorProvince.

table_StateorProvince <- table(customer_info$StateorProvince)

as.data.frame(table_StateorProvince) %>%
    gt() %>%
    tab_header(
        title = "Tần số khách hàng theo tiểu bang đang sinh sống"
    ) %>%
    cols_label(
        Var1 = "Tiểu bang",
        Freq = "Số lượng"
    ) %>%
    fmt_number(columns = Freq, sep_mark = ",",decimals = 0)
Tần số khách hàng theo tiểu bang đang sinh sống
Tiểu bang Số lượng
BC 547
CA 1,651
DF 356
Guerrero 157
Jalisco 48
OR 879
Veracruz 88
WA 1,392
Yucatan 98
Zacatecas 188
 
ggplot(customer_info, aes(x = fct_infreq(StateorProvince))) +
    geom_bar(fill = "brown") +
    coord_flip() +
    labs(title = "Tần số khách hàng theo tiểu bang đang sinh sống", x = "Tiểu bang", y = "Tần số") +
    theme_minimal()

Dựa trên bảng tần số biến StateorProvince trong tập dữ liệu customer_info, bang CA (California) có số lượng khách hàng đông nhất với 1,651 người, tiếp theo là WA (Washington) với 1,392 người và OR (Oregon) với 879 người, cho thấy các bang này là thị trường chính của siêu thị. Các khu vực như Jalisco (48), Veracruz (88) và Yucatan (98) có số lượng khách hàng ít hơn , phản ánh sự tập trung khách hàng ở các bang lớn của Mỹ.

2.7.3.7 Biến Country

Biến Country trong bộ dữ liệu customer_info thể hiện quốc gia nơi khách hàng sinh sống, ví dụ như “USA”, “Mexico”, v.v., phản ánh bối cảnh địa lý quốc tế của họ.

table_Country<- table(customer_info$Country)

as.data.frame(table_Country) %>%
    gt() %>%
    tab_header(
        title = "Tần số khách hàng theo Quốc gia đang sinh sống"
    ) %>%
    cols_label(
        Var1 = "Quốc gia",
        Freq = "Số lượng"
    ) %>%
    fmt_number(columns = Freq, sep_mark = ",",decimals = 0)
Tần số khách hàng theo Quốc gia đang sinh sống
Quốc gia Số lượng
Canada 547
Mexico 935
USA 3,922
 
ggplot(customer_info, aes(x = Country)) +
    geom_bar(fill = "yellow") +
    geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5) +
    labs(title = "Tần số khách hàng theo Quốc gia đang sinh sống", x = "Quốc gia", y = "Tần số") +
    theme_minimal()

Dựa trên bảng tần số biến Country trong tập dữ liệu customer_info, phần lớn khách hàng đến từ USA với 3,922 người, chiếm khoảng 72.5% tổng số, cho thấy Mỹ là thị trường chính của siêu thị. Mexico có 935 khách hàng và Canada có 547 khách hàng, lần lượt chiếm khoảng 17.3% và 10.1%, phản ánh sự hiện diện đáng kể nhưng nhỏ hơn của khách hàng từ hai quốc gia này. Sự phân bố này gợi ý rằng chiến lược tiếp thị cần tập trung vào khách hàng Mỹ, đồng thời xem xét các đặc điểm riêng của khách hàng Mexico và Canada để tối ưu hóa doanh thu.

2.7.3.8 Biến ProductFamily

Biến ProductFamily trong bộ dữ liệu store_sales thể hiện nhóm sản phẩm chính mà khách hàng mua, được phân loại thành ba nhãn: “Food” (thực phẩm), “Drink” (đồ uống) và “Non-Consumable” (hàng không tiêu thụ). Sau đây sẽ trình bày bảng tần số và biểu đồ của biến ProductFamily với bộ dữ liệu store_sales.

table_ProductFamily <- table(store_sales$ProductFamily)

as.data.frame(table_ProductFamily) %>%
    gt() %>%
    tab_header(
        title = "Số khách mua nhóm sản phầm chính"
    ) %>%
    cols_label(
        Var1 = "Nhóm sản phẩm",
        Freq = "Số lượng"
    ) %>%
    fmt_number(columns = Freq, sep_mark = ",",decimals = 0)
Số khách mua nhóm sản phầm chính
Nhóm sản phẩm Số lượng
Drink 1,250
Food 10,153
Non-Consumable 2,656
 
ggplot(store_sales, aes(x = ProductFamily)) +
    geom_bar(fill = "#FFCC99") +
    labs(title = "Số khách mua nhóm sản phầm chính", x = "Nhóm sản phẩm", y = "Số lượng") +
    theme_minimal()

Dựa trên bảng tần số biến ProductFamily trong tập dữ liệu store_sales, nhóm sản phẩm Food chiếm ưu thế vượt trội với 10,153 giao dịch, tương đương khoảng 72% tổng số, cho thấy thực phẩm là mặt hàng được mua nhiều nhất tại siêu thị. Nhóm Non-Consumable có 2,656 giao dịch (khoảng 19%), trong khi Drink chỉ chiếm 1,250 giao dịch (khoảng 9%), phản ánh nhu cầu thấp hơn đối với đồ uống. Sự phân bố này gợi ý rằng siêu thị có thể tập trung vào các sản phẩm thực phẩm để tối ưu hóa doanh thu, đồng thời xem xét chiến lược thúc đẩy bán hàng cho đồ uống. Phân tích sâu hơn về ProductCategory hoặc Revenue theo nhóm sản phẩm có thể cung cấp thêm thông tin về sở thích khách hàng.

2.7.3.9 Biến ProductDepartment

Biến ProductDepartment trong bộ dữ liệu store_sales thể hiện các danh mục chi tiết của sản phẩm mà khách hàng mua, bao gồm 22 nhãn như “Household”, “Dairy”, “Beverages”, “Snack Foods”, v.v., phản ánh sự đa dạng của các loại sản phẩm trong siêu thị. Sau đây sẽ trình bày bảng tần số và biểu đồ của biến ProductDepartment với bộ dữ liệu store_sales.

datatable(as.data.frame(table(store_sales$ProductDepartment)),
          colnames = c("Danh mục sản phẩm ", "Số lượng"),
          options = list(pageLength = 10,
                         autoWidth = TRUE) ) # Không hiển thị thanh tìm kiếm nếu không cần
ggplot(store_sales, aes(x = fct_infreq(ProductDepartment))) +
    geom_bar(fill = "#66CC33") +
    coord_flip() +
    labs(title = "Số lượng khách mua theo danh mục chi tiết sản phẩm", x = "Danh mục sản phẩm", y = "Số lượng") +
    theme_minimal()

Dựa trên bảng tần số biến ProductDepartment trong tập dữ liệu store_sales, danh mục Produce có số lượng giao dịch cao nhất (1,994), tiếp theo là Snack Foods (1,600) và Household (1,420), cho thấy các sản phẩm thực phẩm tươi, đồ ăn nhẹ và hàng gia dụng là những mặt hàng được ưa chuộng nhất. Các danh mục như Carousel (59), Checkout (82) và Seafood (102) có số lượng giao dịch thấp nhất, phản ánh nhu cầu hạn chế đối với những sản phẩm này.Sự phân bố này gợi ý rằng siêu thị nên tập trung vào các danh mục phổ biến như thực phẩm tươi và đồ ăn nhẹ để tối ưu hóa doanh thu, đồng thời cân nhắc chiến lược thúc đẩy bán các sản phẩm ít được mua.

2.7.3.10 Biến ProductCategory

Biến ProductCategory trong bộ dữ liệu store_sales thể hiện các danh mục sản phẩm chi tiết hơn mà khách hàng mua, bao gồm 45 nhãn như “Vegetables”, “Snack Foods”, “Dairy”, “Candy”, v.v., phản ánh sự đa dạng của các loại sản phẩm cụ thể trong siêu thị.

datatable(as.data.frame(table(store_sales$ProductDepartment)),
          colnames = c("Danh mục sản phẩm ", "Số lượng"),
          options = list(pageLength = 10,
                         autoWidth = TRUE) ) # Không hiển thị thanh tìm kiếm nếu không cần
store_sales %>%
  count(ProductDepartment, ProductCategory, name = "Frequency") %>%
  ggplot(aes(x = reorder(ProductCategory, Frequency), y = Frequency, color = ProductDepartment)) +
  geom_segment(aes(xend = ProductCategory, yend = 0), color = "gray80") +
  geom_point(size = 3) +
  coord_flip() +
  labs(
    title = "Tần suất mua hàng theo Product Category trong từng Product Department",
    x = "Product Category",
    y = "Tần suất",
    color = "Product Department"
  ) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom")

2.7.4 Ước lượng Khoảng và Kiểm định Giả thuyết cho Tỷ lệ

2.7.4.1 Các hạng mục quan tâm

  • Khoảng thu nhập “$30K - $50K” trong AnnualIncome
  • “Có gia đình” trong MaritalStatus
  • Nhóm khách là người “Canada” trong Country
  • Nhóm khách hàng có sỡ hữu nhà trong Homeowner

Ở đây việc ước lượng và kiểm định giả thuyết sẽ sử dụng bộ dữ liệu store_sales.

Khoảng thu nhập “$30K - $50K”

x <- table(store_sales$AnnualIncome)[["$30K - $50K"]]
n <- sum(table(store_sales$AnnualIncome))
CI <- prop.test(x,n,conf.level = 0.95,correct = TRUE)
cat("Tỷ lệ mẫu ước lượng \n \n",
    CI[["estimate"]],"\n \n",
    "Khoảng ước lượng 95%  \n \n",CI[["conf.int"]])
## Tỷ lệ mẫu ước lượng 
##  
##  0.3272637 
##  
##  Khoảng ước lượng 95%  
##  
##  0.3195204 0.3351018

Khoảng tin cậy này cho thấy chúng ta có 95% độ tin cậy rằng tỷ lệ thực của nhóm khách hàng này nằm trong khoảng từ 31.95% đến 33.51%. Độ hẹp của khoảng tin cậy (khoảng 1.56%) cho thấy ước lượng khá chính xác. Kết quả này phản ánh rằng khoảng một phần ba khách hàng siêu thị thuộc nhóm thu nhập $30K - $50K. Độ hẹp của khoảng tin cậy (khoảng 1.56%) cho thấy ước lượng khá chính xác.

Sau đây thì đặt giả thuyết H0: Tỷ lệ khách hàng trong Khoảng thu nhập “$30K - $50K” >= 1/3

CI<- prop.test(x,n,conf.level = 0.95,p = 1/3 ,correct = TRUE,alternative = "less")
CI
## 
##  1-sample proportions test with continuity correction
## 
## data:  x out of n, null probability 1/3
## X-squared = 2.3035, df = 1, p-value = 0.06454
## alternative hypothesis: true p is less than 0.3333333
## 95 percent confidence interval:
##  0.0000000 0.3338412
## sample estimates:
##         p 
## 0.3272637

Dựa vào p-value = 0.06454 thì ta chấp nhận H0 rằng rằng tỷ lệ thực nhóm khách hàng này đến mua hàng tại siêu thị chiếm hơn một phần ba lượng khách hàng. Đây có thể nhóm khách hàng trọng yếu của siêu thị.

Nhóm khách hàng có gia đình

x <- table(store_sales$MaritalStatus)[["M"]]
n <- sum(table(store_sales$MaritalStatus))
CI <- prop.test(x,n,conf.level = 0.95,correct = TRUE)
cat("Tỷ lệ mẫu ước lượng \n \n",
    CI[["estimate"]],"\n \n",
    "Khoảng ước lượng 95%  \n \n",CI[["conf.int"]])
## Tỷ lệ mẫu ước lượng 
##  
##  0.4883704 
##  
##  Khoảng ước lượng 95%  
##  
##  0.4800765 0.4966708

Khoảng tin cậy 95% cho tỷ lệ khách hàng đã có gia đình (MaritalStatus = M) mua hàng tại siêu thị, nằm trong khoảng [0.4801, 0.4967], cho thấy tỷ lệ thực của nhóm này trong quần thể khách hàng có khả năng dao động từ 48.01% đến 49.67%, với tỷ lệ mẫu ước lượng là 48.84%. Độ hẹp của khoảng tin cậy (1.66%) phản ánh ước lượng khá chính xác, cho thấy nhóm khách hàng đã có gia đình chiếm gần một nửa tổng số khách hàng, là một phân khúc quan trọng của siêu thị.

Sau đây thì đặt giả thuyết H0: Tỷ lệ khách hàng có gia đình = 0.5

CI<- prop.test(x,n,conf.level = 0.95,p = 0.5 ,correct = TRUE)
CI
## 
##  1-sample proportions test with continuity correction
## 
## data:  x out of n, null probability 0.5
## X-squared = 7.5593, df = 1, p-value = 0.00597
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
##  0.4800765 0.4966708
## sample estimates:
##         p 
## 0.4883704

Dựa vào p-value = 0.00597 (< 0.05) cho thấy có bằng chứng thống kê mạnh để bác bỏ giả thuyết rằng tỷ lệ khách hàng đã có gia đình chiếm một nửa.Xác nhận rằng tỷ lệ khách hàng đã có gia đình có khả năng thấp hơn 50%. Điều này gợi ý siêu thị nên xem xét các chiến lược tiếp thị phù hợp cho cả nhóm khách hàng đã có gia đình và độc thân để tối ưu hóa doanh thu.

Nhóm khách hàng là người Canada

x <- table(store_sales$Country)[["Canada"]]
n <- sum(table(store_sales$Country))
CI <- prop.test(x,n,conf.level = 0.95,correct = TRUE)
cat("Tỷ lệ mẫu ước lượng \n \n",
    CI[["estimate"]],"\n \n",
    "Khoảng ước lượng 95%  \n \n",CI[["conf.int"]])
## Tỷ lệ mẫu ước lượng 
##  
##  0.05754321 
##  
##  Khoảng ước lượng 95%  
##  
##  0.05377881 0.06155157

Khoảng tin cậy 95% cho tỷ lệ khách hàng đến từ Canada trong quần thể khách hàng mua sắm tại siêu thị, nằm trong khoảng [0.0538, 0.0616], cho thấy tỷ lệ thực của nhóm này có khả năng dao động từ 5.38% đến 6.16%, với tỷ lệ mẫu ước lượng là 5.75%. Độ hẹp của khoảng tin cậy (khoảng 0.78%) cho thấy ước lượng khá chính xác, phản ánh rằng khách hàng Canada chiếm một tỷ lệ nhỏ trong cơ cấu khách hàng.Phân tích sâu hơn về sở thích sản phẩm hoặc doanh thu từ nhóm khách hàng Canada có thể giúp tối ưu hóa chiến lược kinh doanh.

Sau đây thì đặt giả thuyết H0: Tỷ lệ khách hàng là người Canada <= 0.06

CI<- prop.test(x,n,conf.level = 0.95,p = 0.06 ,correct = TRUE,alternative = "greater")
CI
## 
##  1-sample proportions test with continuity correction
## 
## data:  x out of n, null probability 0.06
## X-squared = 1.4613, df = 1, p-value = 0.8866
## alternative hypothesis: true p is greater than 0.06
## 95 percent confidence interval:
##  0.05436235 1.00000000
## sample estimates:
##          p 
## 0.05754321

Với p-value = 0.8866 (> 0.05) cho thấy không có đủ bằng chứng thống kê để bác bỏ giả thuyết rằng tỷ lệ khách hàng đến từ Canada trong quần thể nhỏ hơn hoặc bằng 6%, đồng thời không ủng hộ giả thuyết đối rằng tỷ lệ này lớn hơn 6%. Và khoảng tin cậy 95% [0.0538, 0.0616], trong đó giá trị 0.06 nằm trong khoảng tin cậy, xác nhận rằng tỷ lệ khách hàng Canada có thể xấp xỉ 6%. Điều này gợi ý rằng siêu thị có thể xem nhóm khách hàng Canada là một phân khúc nhỏ nhưng ổn định.

Nhóm khách hàng có sỡ hữu nhà

x <- table(store_sales$Homeowner)[["Y"]]
n <- sum(table(store_sales$Homeowner))
CI <- prop.test(x,n,conf.level = 0.95,correct = TRUE)
cat("Tỷ lệ mẫu ước lượng \n \n",
    CI[["estimate"]],"\n \n",
    "Khoảng ước lượng 95%  \n \n",CI[["conf.int"]])
## Tỷ lệ mẫu ước lượng 
##  
##  0.6006117 
##  
##  Khoảng ước lượng 95%  
##  
##  0.5924537 0.6087145

Khoảng tin cậy 95% cho tỷ lệ khách hàng sở hữu nhà ở (Homeowner = Y) trong quần thể khách hàng mua sắm tại siêu thị, nằm trong khoảng [0.5925, 0.6087], cho thấy tỷ lệ thực của nhóm này có khả năng dao động từ 59.25% đến 60.87%, với tỷ lệ mẫu ước lượng là 60.06%. Độ hẹp của khoảng tin cậy (khoảng 1.62%) phản ánh ước lượng chính xác, khẳng định rằng hơn nửa số khách hàng sở hữu nhà.

Sau đây thì đặt giả thuyết H0: Tỷ lệ khách hàng sở hữu nhà >= 0.6

CI<- prop.test(x,n,conf.level = 0.95,p = 0.6 ,correct = TRUE,alternative = "less")
CI
## 
##  1-sample proportions test with continuity correction
## 
## data:  x out of n, null probability 0.6
## X-squared = 0.019445, df = 1, p-value = 0.5555
## alternative hypothesis: true p is less than 0.6
## 95 percent confidence interval:
##  0.0000000 0.6074215
## sample estimates:
##         p 
## 0.6006117

Kết quả kiểm định giả thuyết tỷ lệ đơn mẫu với p-value = 0.5555 (> 0.05) cho thấy không có đủ bằng chứng thống kê để bác bỏ giả thuyết rằng tỷ lệ khách hàng sở hữu nhà ở (Homeowner = Y) nhỏ hơn hoặc bằng 0.6, phù hợp với tỷ lệ mẫu ước lượng (0.6006). Điều này khẳng định rằng tỷ lệ khách hàng sở hữu nhà ở xấp xỉ 60%, và siêu thị có thể tiếp tục tập trung vào phân khúc này để tối ưu hóa chiến lược kinh doanh.

2.7.5 Phân tích Mối quan hệ giữa Hai biến Định tính (Bivariate Analysis)

Ba cặp biến quan tâm được quan tâm trong bài là: - Gender và MaritalStatus - Country và AnnualIncome - StateorProvince và ProductFamily

2.7.5.1 Gender và MaritalStatus

Phân tích cặp biến Gender và MaritalStatus nhằm khám phá mối quan hệ giữa giới tính và tình trạng hôn nhân, từ đó xác định nhóm khách hàng nào (nam hay nữ, độc thân hay đã kết hôn) có xu hướng mua sắm nhiều hơn tại siêu thị. Việc này giúp hiểu rõ hơn về hành vi mua sắm theo các phân khúc khách hàng, hỗ trợ siêu thị tối ưu hóa chiến lược tiếp thị và phân phối sản phẩm phù hợp với từng nhóm.

table_cross <- store_sales %>%
  tabyl(Gender, MaritalStatus) %>%   
  adorn_totals("row") %>%            
  adorn_percentages("row") %>%      
  adorn_pct_formatting(digits = 1)                        

table_cross %>%
  kbl(caption = "Bảng tần số chéo: Gender và MaritalStatus") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),
                full_width = FALSE,
                position = "center")
Bảng tần số chéo: Gender và MaritalStatus
Gender M S
F 50.2% 49.8%
M 47.4% 52.6%
Total 48.8% 51.2% 
store_sales %>%
  count(Gender, MaritalStatus, name = "Count") %>%
  ggplot(aes(x = Gender, y = Count, fill = MaritalStatus)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(
    title = "Số Khách hàng mua sản phẩm theo Product Gender và MaritalStatus",
    x = "Tình trạng ",
    y = "Số lượng",
    fill = "Giới tính"
  ) +
  theme_minimal(base_size = 13) +
  theme(axis.text.x = element_text(angle = 30, hjust = 1))

Dựa trên bảng tần số chéo của biến Gender và MaritalStatus tỷ lệ khách hàng nữ độc thân (S) là 49.8% và nữ đã kết hôn (M) là 50.2%, cho thấy sự phân bố gần cân bằng giữa hai trạng thái hôn nhân ở nữ. Trong khi đó, khách hàng nam độc thân chiếm 52.6%, cao hơn nam đã kết hôn (47.4%), cho thấy nam độc thân có xu hướng mua sắm nhiều hơn nam đã kết hôn.

2.7.5.2 Country và AnnualIncome

Phân tích cặp biến Country và AnnualIncome nhằm khám phá mối quan hệ giữa quốc gia nơi khách hàng sinh sống và mức thu nhập hàng năm của họ, từ đó xác định sự phân bố thu nhập theo từng quốc gia (Canada, Mexico, USA). Sau đây sẽ trình bày bảng tần số chéo và phân tích để đánh giá sự khác biệt trong mức thu nhập giữa các quốc gia. Ở đây thì sẽ dùng bộ dữ liệu là customer_info để đánh giá chính xác.

table_cross <- customer_info %>%
  tabyl(Country, AnnualIncome) %>%   
  adorn_totals("row") %>%            
  adorn_percentages("row") %>%      
  adorn_pct_formatting(digits = 1)                        

table_cross %>%
  kbl(caption = "Bảng tần số chéo: Country và AnnualIncome") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),
                full_width = FALSE,
                position = "center")
Bảng tần số chéo: Country và AnnualIncome
Country $10K - $30K $30K - $50K $50K - $70K $70K - $90K $90K - $110K $110K - $130K $130K - $150K $150K +
Canada 19.6% 36.6% 16.6% 10.6% 3.3% 5.5% 5.7% 2.2%
Mexico 23.1% 32.5% 16.7% 12.3% 4.1% 4.5% 5.3% 1.5%
USA 21.5% 32.2% 17.9% 11.7% 4.8% 4.7% 5.0% 2.2%
Total 21.6% 32.7% 17.6% 11.7% 4.5% 4.8% 5.1% 2.1% 
customer_info %>%
  count(Country, AnnualIncome, name = "Count") %>%
  group_by(Country) %>%
  mutate(Percent = Count / sum(Count)) %>%  # tỷ lệ trong từng nhóm Gender
  ggplot(aes(x = Country, y = Percent, fill = AnnualIncome)) +
  geom_bar(stat = "identity", position = "dodge") +
  scale_y_continuous(labels = percent_format(accuracy = 1)) +
  labs(
    title = "Tỷ lệ phân bố thu nhập theo quốc gia",
    x = "Quốc gia",
    y = "Tỷ lệ (%)",
    fill = "Khoảng thu nhập"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    axis.text.x = element_text(angle = 0, hjust = 0.5),
    legend.position = "bottom"
  )

Dữ liệu thu nhập từ bảng cho thấy sự phân bố thu nhập giữa ba quốc gia Canada, Mexico và USA là khá tương đồng nhưng không hoàn toàn đồng đều. Các mức thu nhập phổ biến nhất ở cả ba quốc gia đều rơi vào khoảng 10K–30K và 30K–50K, chiếm tổng cộng hơn 50% ở mỗi quốc gia. Tuy nhiên, Mexico có tỷ lệ người thu nhập dưới 30K cao hơn (55.6%) so với Canada (56.2%) và USA (53.7%), cho thấy phần nào mức thu nhập trung bình ở Mexico thấp hơn. Ngược lại, tỷ lệ người có thu nhập trên 90K ở Canada và USA (~17.7%) cao hơn so với Mexico (~15.3%). Do đó, tuy phân bố có xu hướng chung, nhưng có sự khác biệt đáng kể ở các nhóm thu nhập cao, phản ánh mức sống trung bình tại USA và Canada cao hơn so với Mexico.

2.7.5.3 StateorProvince và ProductFamily

Phân tích cặp biến StateorProvince và ProductFamily nhằm khám phá mối quan hệ giữa bang hoặc tỉnh nơi khách hàng sinh sống và nhóm sản phẩm chính (Food, Drink, Non-Consumable) mà họ mua, từ đó xác định sở thích mua sắm theo khu vực địa lý. Mục đích là hiểu rõ hơn về xu hướng tiêu dùng của khách hàng ở các bang khác nhau, hỗ trợ siêu thị tối ưu hóa chiến lược tiếp thị và phân phối sản phẩm phù hợp với từng khu vực. Sau đây sẽ trình bày bảng tần số chéo và phân tích để đánh giá sự khác biệt trong lựa chọn sản phẩm giữa các bang.

table_cross <- store_sales %>%
  tabyl(ProductFamily, StateorProvince) %>%   
  adorn_totals("row") %>%            
  adorn_percentages("row") %>%      
  adorn_pct_formatting(digits = 1)                        

table_cross %>%
  kbl(caption = "Bảng tần số chéo: ProductFamily và StateorProvince") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),
                full_width = FALSE,
                position = "center")
Bảng tần số chéo: ProductFamily và StateorProvince
ProductFamily BC CA DF Guerrero Jalisco OR Veracruz WA Yucatan Zacatecas
Drink 5.5% 20.6% 5.2% 3.3% 0.4% 15.9% 3.5% 31.9% 3.8% 9.8%
Food 5.7% 19.4% 5.9% 2.7% 0.6% 16.0% 3.2% 32.4% 4.9% 9.3%
Non-Consumable 6.0% 18.9% 5.7% 2.6% 0.5% 16.3% 3.7% 33.2% 4.2% 8.8%
Total 5.8% 19.4% 5.8% 2.7% 0.5% 16.1% 3.3% 32.5% 4.7% 9.2% 
store_sales %>%
  count(ProductFamily, StateorProvince, name = "Count") %>%
  group_by(ProductFamily) %>%
  mutate(Percent = Count / sum(Count)) %>%  # tỷ lệ trong từng nhóm Gender
  ggplot(aes(x = ProductFamily, y = Percent, fill = StateorProvince)) +
  geom_bar(stat = "identity", position = "dodge") +
  scale_y_continuous(labels = percent_format(accuracy = 1)) +
  labs(
    title = "Tỷ lệ lượng mua các tiểu bang theo mặt hàng",
    x = "Mặt hàng",
    y = "Tỷ lệ (%)",
    fill = "Tiểu bang"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    axis.text.x = element_text(angle = 0, hjust = 0.5),
    legend.position = "bottom"
  )

Dữ liệu cho thấy sự khác biệt đáng kể về xu hướng tiêu dùng giữa các bang. Cụ thể, các bang như WA (Washington) và CA (California) có tỷ lệ mua cao nhất ở cả ba nhóm sản phẩm, đặc biệt nổi bật ở nhóm Non-Consumable với hơn 33% và 18% tổng giao dịch tương ứng. Trong khi đó, những bang như Jalisco và Guerrero có tỷ lệ mua rất thấp, cho thấy nhu cầu tiêu dùng hạn chế hoặc quy mô dân số nhỏ. Nhìn chung, WA là khu vực có hành vi mua sắm toàn diện, trải đều trên cả ba dòng sản phẩm, là mục tiêu tiềm năng để đẩy mạnh các chiến dịch tiếp thị đa dạng mặt hàng.

2.7.6 Tổng kết

Dựa trên các dữ liệu thu thập được, phân tích cho thấy nam giới độc thân có xu hướng mua sắm nhiều hơn nam giới đã kết hôn, trong khi ở nữ giới tỷ lệ này tương đối cân bằng. Về mức thu nhập, nhóm phổ biến nhất ở cả ba quốc gia Canada, Mexico và Mỹ là trong khoảng 10K–50K, tuy nhiên Canada và Mỹ có tỷ lệ người thu nhập cao hơn so với Mexico. Về mặt hàng tiêu dùng, thực phẩm là nhóm sản phẩm chủ đạo và được mua nhiều nhất ở tất cả các bang, song sự khác biệt rõ rệt về tỷ lệ mua các nhóm sản phẩm khác như Non-Consumable và Drink giữa các bang phản ánh sự đa dạng trong thị hiếu vùng miền. Tuy nhiên, phân tích hiện tại chủ yếu dựa trên các thống kê mô tả từ bảng tần số, chưa đi sâu vào mối quan hệ nhân quả hay sử dụng các kiểm định thống kê để khẳng định ý nghĩa, đồng thời chưa xem xét các yếu tố nhân khẩu học khác như độ tuổi, nghề nghiệp hay kênh mua sắm ưa thích, vốn có thể ảnh hưởng đến kết quả. Do đó, doanh nghiệp nên cân nhắc tập trung các chiến dịch marketing và ưu đãi đặc biệt vào nhóm khách hàng nam độc thân, đồng thời điều chỉnh danh mục sản phẩm và chiến lược giá dựa trên đặc điểm thu nhập từng quốc gia. Ngoài ra, cần cá nhân hóa chiến lược phân phối sản phẩm theo từng bang, ví dụ như đẩy mạnh nhóm Non-Consumable tại Veracruz và Guerrero, và tìm hiểu thêm nguyên nhân khiến tỷ lệ mua nhóm Drink thấp ở Jalisco và Yucatan để xây dựng chiến lược phù hợp. Cuối cùng, khuyến nghị thực hiện thêm các phân tích chuyên sâu kết hợp dữ liệu định tính để hiểu rõ hơn động lực và hành vi mua sắm của từng phân khúc khách hàng.

2.7.7 Kiểm định tỷ lệ của 2 trạng thái

x <- table(store_sales$Country)

prop.test(c(x[["Canada"]],x[["Mexico"]]),c(sum(x),sum(x)),correct = TRUE)
## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  c(x[["Canada"]], x[["Mexico"]]) out of c(sum(x), sum(x))
## X-squared = 2192.5, df = 1, p-value < 2.2e-16
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.2130785 -0.1964812
## sample estimates:
##     prop 1     prop 2 
## 0.05754321 0.26232307

2.7.8 Rủi ro tương đối

store_sales$Homeowner <- factor(store_sales$Homeowner,
                                levels = c("Y","N"),
                                ordered =TRUE
                                    )
store_sales$Gender <- factor(store_sales$Gender,
                                levels = c("M","F"),
                                ordered =TRUE
                                    )
rr <- table(store_sales$Gender,store_sales$Homeowner)
rr
##    
##        Y    N
##   M 4100 2789
##   F 4344 2826
epitools::riskratio(rr)
## $data
##        
##            Y    N Total
##   M     4100 2789  6889
##   F     4344 2826  7170
##   Total 8444 5615 14059
## 
## $measure
##    risk ratio with 95% C.I.
##      estimate    lower    upper
##   M 1.0000000       NA       NA
##   F 0.9735554 0.934879 1.013832
## 
## $p.value
##    two-sided
##     midp.exact fisher.exact chi.square
##   M         NA           NA         NA
##   F   0.195158    0.1964833  0.1950884
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"

2.7.9 Tính odds

epitools::oddsratio(rr)
## $data
##        
##            Y    N Total
##   M     4100 2789  6889
##   F     4344 2826  7170
##   Total 8444 5615 14059
## 
## $measure
##    odds ratio with 95% C.I.
##     estimate     lower    upper
##   M 1.000000        NA       NA
##   F 0.956381 0.8938974 1.023169
## 
## $p.value
##    two-sided
##     midp.exact fisher.exact chi.square
##   M         NA           NA         NA
##   F   0.195158    0.1964833  0.1950884
## 
## $correction
## [1] FALSE
## 
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"