数学建模社区-数学中国

标题: r语言商品购物篮分析 [打印本页]

作者: 1047521767 时间: 2021-10-29 11:36
标题: r语言商品购物篮分析
商品购物篮分析
现代商品种类繁多，顾客往往会由于需要购买的商品众多而变得疲于选择，且顾客并不会因为商品选择丰富而选择购买更多的商品。

对于某些商品，顾客会选择同时购买，如面包与牛奶、薯片与可乐等，当面包与牛奶或者薯片与可乐分布在商场的两侧，且距离十分遥远时，顾客购买的欲望就会减少，在时间紧迫的情况下顾客甚至会放弃购买某些计划购买的商品。相反，把牛奶与面包摆放在相邻的位置，既给顾客提供便利，提升购物体验，又提高顾客购买的概率，达到了促销的目的。

某商品零售企业共收集了9835个购物篮的数据，其中包含169个不同的商品类别，售出商品总数为43367件。其数据示例如表所示。

针对原始数据中不同商品销量进行统计，结果如表所示。
Ø全脂牛奶销售量最高，销量为2513件，占比5.795%。
Ø其余热销商品还有其他蔬菜销量1903件，占比4.388%。
Ø面包卷销量1809件，占比4.171%。
Ø苏打销量1715件，占比3.955%。酸奶销量1372件，占比3.164%等。
前20种商品销量占据的比例约为50%，基本符合“二八定律”。

对每一类商品的热销程度进行分析，有利于商家制定商品在货架的摆放策略和位置。若是某类商品较为热销，它的摆放位置可以有如下选择。
Ø可以把此类商品摆放到商场的中心位置，方便顾客选购。
Ø或者把此类商品摆放到商场深处位置，使顾客在购买热销商品前经过非热销商品，增加在非热销商品处的停留时间，促进非热销产品的销量。
关联规则算法主要用于寻找数据中项集之间的关联关系，基于样本的统计规律，进行关联规则分析。根据所分析的关联关系，可从一个特征的信息来推断另一个特征的信息。当信息置信度达到某一阈值时，就可以认为规则成立。
关于这个算法有一个非常有名的故事：“尿布和啤酒”。故事是这样的：美国的妇女们经常会嘱咐她们的丈夫下班后为孩子买尿布，而丈夫在买完尿布后又要顺手买回自己爱喝的啤酒，因此啤酒和尿布在一起被购买的机会很多。这个举措使尿布和啤酒的销量双双增加，并一直为众商家所津津乐道。

Ø1. Apriori算法应用广泛，可用于消费市场价格分析，猜测顾客的消费习惯，比如较有名的“尿布和啤酒”的故事；
Ø2.网络安全领域中的入侵检测技术；
Ø3.可用在用于高校管理中，根据挖掘规则可以有效地辅助学校管理部门有针对性的开展贫困助学工作；
Ø4.也可用在移动通信领域中，指导运营商的业务运营和辅助业务提供商的决策制定。
Ø关联规则算法的主要应用是购物篮分析，是为了从大量的订单中发现商品潜在的关联。其中常用的一个算法叫Apriori先验算法。

Ø关联规则（association rule）：是形如 X → Y 的蕴含表达式，其中X和Y是不相交的项集，即：X∩Y=∅。关联规则的强度可以用它的支持度（support）和置信度（confidence）来度量。
Ø支持度：一个项集或者规则在所有事物中出现的频率，确定规则可以用于给定数据集的频繁程度。σ(X):表示项集X的支持度计数
Ø项集X的支持度：s(X)=σ(X)/N；规则X → Y的支持度：s(X → Y) = σ(X∪Y) / N
Ø通俗解释：简单地说，X==>Y的支持度就是指物品集X和物品集Y同时出现的概率。
Ø概率描述：物品集X对物品集Y的支持度support（X==>Y）=P（X n Y）
Ø实例说明：某天共有1000 个顾客到商场购买物品，其中有150个顾客同时购买了圆珠笔和笔记本，那么上述的关联规则的支持度就是15％。
##商品购物篮分析数据科学实验 20210428

#install.packages('arules')
# 用来画很神奇的云词图！！
#install.packages('htmlwidgets')
#install.packages('wordcloud2')
#install.packages('ggplot2')
#install.packages('rlang')
library(Matrix)
library(arules)
library(wordcloud2)
library(ggplot2)
library(rlang)

GoodOrder <- read.csv("/Users/janine/testt/GoodsOrder.csv")
GoodsTypes <- read.csv("/Users/janine/testt/GoodsTypes.csv")
head(GoodOrder,10)

hotGoods <- data.frame(table(GoodOrder[,2]))
names(hotGoods) <- c("Goods","Num")
hotGoods$Percent <- hotGoods$Num / sum(hotGoods$Num)
hotGoods <- hotGoods[order(hotGoods$Percent, decreasing = T),] #商品按销量降序排列
write.csv(hotGoods, "/Users/janine/testt/hotGoods.csv", row.names = F) #导出数据
set.seed(3)
#hotGoods排完序
wordcloud2(hotGoods[1:60,1:2],size = 0.75) #制作销量前60的商品名称词云，size:颜色
head(hotGoods,10) #展示销量前10名商品名称、销量和占比
sum(hotGoods[1:20,3]) #前20中商品销量累积占比

Goods <- merge(GoodOrder, GoodsTypes, "Goods", all.x=T, all.y=T)
head(Goods, 10)
hotTypes <- data.frame(table(Goods$Types))
names(hotTypes) <- c("Types", "Num") # 重新命名
# 求出每个大类的比例值 round是保留四位小数
hotTypes$Percent <- round(hotTypes$Num / sum(hotTypes$Num),4)
hotTypes <- hotTypes[order(hotTypes$Percent, decreasing = T),]#数据从大到小排序
write.csv(hotTypes,"/Users/janine/testt/hotGoods.csv",row.names = F)
hotTypes$Types <- factor(hotTypes$Types ,levels =hotTypes$Types ,ordered = T)
head(hotTypes,10) #展示销量前10大类商品名称、销量和占比
sum(hotTypes[1:3,3])  # 证明排名前三的商品销量和超过全部销量总和的50%
wordcloud2(hotTypes[1:10,1:2],size = 0.65) #制作销量前30的商品大类名称词云, size:颜色

# 利用which函数将这一类全部取出来
Drink <- Goods[which(Goods$Types=="非酒精饮料"),]
hotDrink <- data.frame(table(Drink$Goods))
names(hotDrink) <- c("Goods","Num")
hotDrink$Percent <- round(hotDrink$Num/sum(hotDrink$Num),4)
hotDrink <- hotDrink[order(hotDrink$Percent, decreasing = T), ]
head(hotDrink)
sum(hotDrink[1:3,3]) #计算前三种饮料的占比
# 第一大类热销商品的前三销量接近70%

par(family='STKaiti') #输出中文
hotDrink1<- hotDrink[1:5,]
Others.drk <- data.frame(Goods="其他", Num=sum(hotDrink$Num)-sum(hotDrink1$Num), Percent=1-sum(hotDrink1$Percent))
hotDrink1 <- rbind(hotDrink1, Others.drk)
hotDrink1 <- hotDrink1[order(hotDrink1$Num, decreasing = F),]
hotDrink1$Goods <- factor(hotDrink1$Goods ,levels =hotDrink1$Goods ,ordered = T)
myLabel = as.vector(hotDrink1$Goods)
myLabel = paste(myLabel, "(", round(hotDrink1$Percent * 100, 2), "%)       ", sep = "")
library(RColorBrewer)
p <- ggplot(hotDrink1, aes(x="", y=Percent, fill=Goods))+
  geom_bar(stat = "identity")+
  coord_polar(theta = "y")+
  labs(x="", y="", title = "")+
  theme(axis.ticks = element_blank())+
  theme(legend.title = element_blank(), legend.position = "top")+
  theme(axis.text.x = element_blank())
p+scale_fill_brewer(breaks = hotDrink1$Goods, labels = myLabel)+guides(fill=guide_legend(reverse = T))

# 建模之前要转换数据格式list 然后才能使用apriori
datalist <- list()
for(i in unique(GoodOrder$ID)){
  datalist[] <- GoodOrder[which(GoodOrder$ID == i), 2]& |$ l! U2 ^2 y7 Q8 Q, g% H" i% R
}$ K7 _# o9 c+ x% ?" u
#datalist  # 可以显示出所有的购物篮里面的九千多条" y& I/ B( D% Q/ k- p% _- r; t$ W
- S, o) r# y; B9 l
# 以下才正式开始关联分析apriori
2 @9 s2 Y) L, z. E& p3 f# 导入到关联分析函数中
* L9 E& y) q& b0 Q6 ~3 q9 QTransRep <- as(datalist, "transactions")8 Y- `2 _  @+ s
RulesRep <- apriori(TransRep, parameter = list(support=0.02, confidence=0.25))" ]9 S1 k- J% s) v, ?: _* N6 s3 y
inspect(sort(RulesRep, by="lift")[1:25]) #按提升度从高到低查看前25条规则
& n' A3 {. E' o) O/ k! @
) u* v) O: c- p! [" R2 E
% Q& w1 [8 B! W) I7 Hguides(fill=guide_legend(reverse = T))
9 N: m" G/ K3 O, {$ e通过模型的规则得出在顾客购买商品的时候会同时购买全脂牛奶。因此，商场可以根据实际情况进行布置。5 T. e& y$ h- e3 h

3 e/ }0 O8 ]9 Y  `( vØ将全脂牛奶放在顾客购买商品的必经之路，或者商场显眼位置，方便顾客拿取。
8 [* A. e* h  n% `# t( b1 M1 Q/ B. kØ其他蔬菜、根茎类蔬菜、酸奶油、猪肉、黄油、本地蛋类和多种水果同时购买的概率较高，可以考虑捆绑销售，或者适当调整商场布置，将这些商品的距离尽量拉近，提升购物体验。
% N$ v0 {1 q+ d( ~8 @; e1 h" {( R( Z% X# S/ {
结论
1 i, ^  k) T& i8 ^2 c本案例主要结合商品零售购物篮的案例，重点介绍了关联规则算法中的Apriori算法在商品零售购物篮分析案例中的应用。过程中详细的分析了商品零售的现状与问题，同时给出某商场的商品零售数据，分析了商品的热销程度，最后通过Apriori算法构建相应模型，并根据模型结果制定销售策略。
" L6 V: A% R7 Q/ Y! T( u& v0 F
2 ]2 N, J! Z/ L$ c% N
7 M1 |* s# G6 ]8 |  l& \' u
# }4 R0 F1 L2 v5 n' Q# [
; q) q! Y. X1 q, F
! u! K. c# R8 d5 U& _" m% f" G0 z) \. l

欢迎光临数学建模社区-数学中国 (http://www.madio.net/) Powered by Discuz! X2.5