测试开头

2022年第06周。
这一周R语言学习，记录如下。

本周学习购物篮分析，即关联分析和关联规则挖掘。

01

是什么？

购物篮分析是一种无监督数据挖掘技术，用于频繁项挖掘和关联规则总结。
购物篮分析的几种常用方式，以电商为例，如下图所示：

R语言学习：购物篮分析，mba包

02

为什么？

为什么学习和应用购物篮分析？
使用这个技术，可以帮助我们做这些事情。

1 推荐引擎
2 目标营销
3 交叉营销
4 分类设计
5 客户体验
等。

如下图所示：

R语言学习：购物篮分析，mba包

购物篮分析的优点。

1 洞见显著
2 应用灵活
3 成本有效
4 执行敏捷

如下图所示：

R语言学习：购物篮分析，mba包

购物篮分析可以在各行各业发挥积极效用。

1 零售
2 通信
3 金融
4 医疗
5 制造业

如下图所示：

R语言学习：购物篮分析，mba包

03

怎么做？

购物篮分析怎么做，步骤如下：

第1步：收集和整理事务数据
第2步：挖掘频繁项
第3步：总结关联规则

如下图所示：

R语言学习：购物篮分析，mba包

关键术语

项目集

R语言学习：购物篮分析，mba包

前项与后项

R语言学习：购物篮分析，mba包

支持度

R语言学习：购物篮分析，mba包

置信度

R语言学习：购物篮分析，mba包

提升度

R语言学习：购物篮分析，mba包

解释

Lift=1：表示无相关性

Lift>1：表示正相关

Lift<1：表示负相关

04

案例

使用R语言进行零售领域的购物篮分析。

第一步：加载所需R包

library(readxl)
library(readr)
library(mbar)
library(arules)
library(arulesViz)
library(magrittr)
library(dplyr)
library(lubridate)
library(forcats)
library(ggplot2)

第二步：数据预处理

mba_data     <- read_excel("./data/online-retail.xlsx")
mba_data %>% 
  glimpse()
transactions <- mbar_prep_data(mba_data, InvoiceNo, Description)
head(transactions) %>% 
  View
# 中间数据保存
write.csv(transactions, 
          './data/transaction_data.csv',
          row.names = FALSE)

第三步：EDA

3.1 人们购买的时段分布？

purchase_time <-
  mba_data %>%
  group_by(InvoiceDate) %>%
  slice(1) %>%
  mutate(time_of_day = hour(InvoiceDate)) %>%
  pull(time_of_day) %>%
  as.factor() %>%
  fct_count()

purchase_time %>%
  ggplot() +
  geom_col(aes(x = f, y = n), fill = "blue") +
  xlab("Hour of Day") + ylab("Transactions") +
  ggtitle("Hourly Transaction Distribution") +
  theme_classic()

结果：

R语言学习：购物篮分析，mba包

3.2 平均购买多少件商品？

items <- 
  mba_data %>%
  group_by(InvoiceNo) %>%
  summarize(count = n()) %>%
  pull(count) 

mean(items)
median(items)

3.3 常购买商品的分布？

mba_data %>%
  group_by(Description) %>%
  summarize(count = n()) %>%
  arrange(desc(count))

结果：

R语言学习：购物篮分析，mba包

3.4 平均订单价值？

total_revenue <- 
  mba_data %>%
  group_by(InvoiceNo) %>%
  summarize(order_sum = sum(UnitPrice)) %>%
  pull(order_sum) %>%
  sum()

total_transactions <- 
  mba_data %>%
  group_by(InvoiceNo) %>%
  summarize(n()) %>%
  nrow()

total_revenue / total_transactions

结果：

R语言学习：购物篮分析，mba包

第四步：购物篮分析

4.1 数据导入

basket_data <- read.transactions("./data/transaction_data.csv", 
                                 format = "basket", 
                                 sep = ",")
basket_data

4.2 数据理解

summary(basket_data)

4.3 项频率图

itemFrequencyPlot(basket_data, 
                  topN = 10, 
                  type = 'absolute')

结果：

R语言学习：购物篮分析，mba包

4.4 生成规则及规则分析和应用

rules <- apriori(basket_data, 
                 parameter = list(supp=0.009, 
                                  conf=0.8, 
                                  target = "rules", 
                                  maxlen = 4))

# 规则分析
summary(rules)

# 规则查看
basket_rules <- sort(rules, by = 'confidence', decreasing = TRUE)
inspect(basket_rules[1:10])

# 冗余规则
inspect(rules[is.redundant(rules)])

# 不考虑冗余规则
inspect(rules[!is.redundant(rules)])

# 规则两种典型应用
# 1）什么影响了糖的购买？
sugar_rules <- apriori(basket_data, 
                       parameter = list(supp = 0.009, conf = 0.8), 
                       appearance = list(default = "lhs", rhs = "SUGAR")) 
rules_sugar <- sort(sugar_rules, 
                    by = "confidence", 
                    decreasing = TRUE)
inspect(rules_sugar)

# 2）糖对购买有什么影响
sugar_rules <- apriori(basket_data, 
                       parameter = list(supp = 0.009, conf = 0.8), 
                       appearance = list(default = "rhs", lhs = "SUGAR")) 
rules_sugar <- sort(sugar_rules, 
                    by = "confidence", 
                    decreasing = TRUE)
inspect(rules_sugar)

# Top规则提取
# 1）支持度观察
supp_rules <- sort(rules, 
                   by = 'support', 
                   decreasing = TRUE)
top_rules <- supp_rules[1:10]
inspect(top_rules)

# 2）置信度观察
supp_rules <- sort(rules, 
                   by = 'confidence', 
                   decreasing = TRUE)
top_rules <- supp_rules[1:10]
inspect(top_rules)

# 3）提升度观察
supp_rules <- sort(rules, 
                   by = 'lift', 
                   decreasing = TRUE)
top_rules <- supp_rules[1:10]
inspect(top_rules)

# 规则可视化
plot(basket_rules)
plot(top_rules, method = 'graph')

05

完整代码

# 1 R包
library(readxl)
library(readr)
library(mbar)
library(arules)
library(arulesViz)
library(magrittr)
library(dplyr)
library(lubridate)
library(forcats)
library(ggplot2)

# 2 数据预处理
mba_data     <- read_excel("./data/online-retail.xlsx")
mba_data %>% 
  glimpse()
transactions <- mbar_prep_data(mba_data, InvoiceNo, Description)
head(transactions) %>% 
  View
# 中间数据保存
write.csv(transactions, 
          './data/transaction_data.csv',
          row.names = FALSE)

# 3 EDA
# 3.1 人们的购买时段分布？
purchase_time <-
  mba_data %>%
  group_by(InvoiceDate) %>%
  slice(1) %>%
  mutate(time_of_day = hour(InvoiceDate)) %>%
  pull(time_of_day) %>%
  as.factor() %>%
  fct_count()

purchase_time %>%
  ggplot() +
  geom_col(aes(x = f, y = n), fill = "blue") +
  xlab("Hour of Day") + ylab("Transactions") +
  ggtitle("Hourly Transaction Distribution") +
  theme_classic()

# 3.2 平均购买多少件商品？
items <- 
  mba_data %>%
  group_by(InvoiceNo) %>%
  summarize(count = n()) %>%
  pull(count) 

mean(items)
median(items)

# 3.3 经常购买商品的分布？
mba_data %>%
  group_by(Description) %>%
  summarize(count = n()) %>%
  arrange(desc(count))

# 3.4 平均订单价值？

total_revenue <- 
  mba_data %>%
  group_by(InvoiceNo) %>%
  summarize(order_sum = sum(UnitPrice)) %>%
  pull(order_sum) %>%
  sum()

total_transactions <- 
  mba_data %>%
  group_by(InvoiceNo) %>%
  summarize(n()) %>%
  nrow()

total_revenue / total_transactions

# 4 购物篮分析
# 4.1 数据导入 
basket_data <- read.transactions("./data/transaction_data.csv", 
                                 format = "basket", 
                                 sep = ",")
basket_data

# 4.2 数据理解

summary(basket_data)

# 4.3 项频率图

itemFrequencyPlot(basket_data, 
                  topN = 10, 
                  type = 'absolute')

# 4.4 生成规则
rules <- apriori(basket_data, 
                 parameter = list(supp=0.009, 
                                  conf=0.8, 
                                  target = "rules", 
                                  maxlen = 4))

# 规则分析
summary(rules)

# 规则查看
basket_rules <- sort(rules, by = 'confidence', decreasing = TRUE)
inspect(basket_rules[1:10])

# 冗余规则
inspect(rules[is.redundant(rules)])

# 不考虑冗余规则
inspect(rules[!is.redundant(rules)])


# 规则两种典型应用
# 1）什么影响了糖的购买？
sugar_rules <- apriori(basket_data, 
                       parameter = list(supp = 0.009, conf = 0.8), 
                       appearance = list(default = "lhs", rhs = "SUGAR")) 
rules_sugar <- sort(sugar_rules, 
                    by = "confidence", 
                    decreasing = TRUE)
inspect(rules_sugar)

# 2）糖对购买有什么影响
sugar_rules <- apriori(basket_data, 
                       parameter = list(supp = 0.009, conf = 0.8), 
                       appearance = list(default = "rhs", lhs = "SUGAR")) 
rules_sugar <- sort(sugar_rules, 
                    by = "confidence", 
                    decreasing = TRUE)
inspect(rules_sugar)

# Top规则提取
# 1）支持度观察
supp_rules <- sort(rules, 
                   by = 'support', 
                   decreasing = TRUE)
top_rules <- supp_rules[1:10]
inspect(top_rules)

# 2）置信度观察
supp_rules <- sort(rules, 
                   by = 'confidence', 
                   decreasing = TRUE)
top_rules <- supp_rules[1:10]
inspect(top_rules)

# 3）提升度观察
supp_rules <- sort(rules, 
                   by = 'lift', 
                   decreasing = TRUE)
top_rules <- supp_rules[1:10]
inspect(top_rules)

# 规则可视化
plot(basket_rules)
plot(top_rules, method = 'graph')