• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

R语言入门级实例——用igragh包分析社群

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

R语言入门级实例——用igragh包分析社群

引入——

  本文的主要目的是初步实现R的igraph包的基础功能,包括绘制关系网络图(social relationship)、利用算法进行社群发现(community detecting)。对于R语言零基础的同学非常友好。以下R代码中如有含义不清的,建议尝试先在R编辑器中输入?xxx()进行查询(xxx是函数或语句名)。此外,stackflow论坛也帮博主小白看懂了不少报错信息。
  主要参考资料为《R语言与网站分析》[李明著][机械工业出版社][2014.04] 的9.3节《关系网络分析》。

0.背景

  现已获得超市中商品的名称、分类以及大量顾客购物篮子中的商品信息,任务是分析哪些商品存在相关性,经常被放在一起购买。题外话,这种分析的一例经典应用就是沃尔玛超市的“啤酒与尿布”,感兴趣者可自行搜索或参见Jocelyn_燕的一篇博客.

1.原始数据及初步处理

  数据来源是Kaggle竞赛的数据库instacart-market-basket-analysis.下载压缩文件之后,将有用的数据合并到一个Excel文件中,此处需要order_product,order,products,departments的数据.注意,这个文件极大,order_product_prior这个spread sheet里的数据在Excel里已经无法完全显示,博主就截取了前500条信息,形成了mini数据集,以下对数据集的操作都是针对这个mini表进行的.如下:

 

   为了达到参考书上的数据形式,需要先整理这个Excel,形成如下图只有四列数据的形式.这里博主不太熟悉R的操作,就用Python的循环处理了,代码可附在文章最后.

  这是当初处理数据集的一些文件,由于不会用R完成所有命令,显得很笨拙hhh.

2.数据集导入

  导入的数据集包含四列,原商品编号过大,不便于处理,p_id、d_id分别是商品、商品分类的新编号,如下图:(这些也是用Python代劳的)

 

3.建立关系网络与绘图

步骤描述:

引用igraph包,建立空关系网络并设置点数据→
为点数据添加商品号以及商品分类属性→
添加线数据→
plot出来发现是非连通图(存在孤立的点的图),有两个未连通的点(点43,点44),只用手动对点的个数减2即可
将点的个数修改后,重新跑前面的所有代码即可

这部分代码如下:(完整代码见文末)

#建立空关系网络并设置点数据
library(igraph)
gdata<-graph.empty(directed=F)
#num<-ncol(cart)
num<-ncol(cart)-2 #修改点的个数
gdata<-add.vertices(gdata,num)
#为点数据添加商品号以及商品分类属性 category<-c();item<-c() for(i in colnames(cart)) { if(i!=136&& i!=140) { category<-c(category,data$d_id[which(data$p_id==i)[1]] ) item<-c(item,data$p_id[which(data$p_id==i)[1]] ) } } V(gdata)$category<-category V(gdata)$item<-item #添加线数据 #依次遍历每个订单,读取每个订单内的商品ID,并存放于向量item.i for(i in 1:nrow(cart)) { item.i<-c() for(j in 1:ncol(cart)) { if(cart[i,j]==1) { item.i<-cbind(item.i,colnames(cart)[j]) } } #建立向量内不同商品间的关联联系 item.i.num<-length(item.i) from<-c();to<-c() for(m in 1:(item.i.num-1)) { from<-c(from,item.i[-c((item.i.num-m+1):item.i.num)]) to<-c(to,item.i[-c(1:m)]) } if(i>1) { edges<-rbind(edges,matrix(c(from,to),nc=2)) } else { edges<-matrix(data=c(from,to),nc=2) } } edges0<-edges labels<-union(unique(edges[,1]), unique(edges[,2])) ids<-1: length(labels)#对点的编号重新编码,因为在igraph中边信息的ids必须连续 names(ids)<-labels newfrom<-as.character(edges[,1]);newto<-as.character(edges[,2]) edges<-matrix (c(ids[newfrom],ids[newto]), nc=2) #添加线信息并设置线权重 gdata<-add.edges(gdata,t(edges[-1,]))#t()是矩阵转置函数 E(gdata)$weight<-count.multiple(gdata) gdata<-simplify(gdata, remove.multiple=TRUE, remove.loops = TRUE, edge.attr.comb = 'mean') #最后一个参数一定是edge.attr.comb,不是edges.attr.comb dev.off()#关闭图形设备 plot(gdata,edge.width=E(gdata)$weight,main="gdata", edge.label=E(gdata)$weight) #发现是非连通图,有两个未连通的点(点43,点44),只用手动对点的个数减2即可 #将点的个数修改后,重新跑前面的所有代码

  画出来的效果如下:

4.社群发现与绘图

  此处采用自旋玻璃法(spinglass community detecting)进行社群发现。其他社群发现的方法包括中心势、标签传播、随机游走等,这几种方法在算法效率与模拟方式上其实存在不同点。但限于篇幅,此处不再介绍。对这几种方法感兴趣者可自行搜索或参考以下论文(引用格式不够规范,但应该能搜索到):

[1]J¨org Reichardt & Stefan Bornholdt (2008) Statistical Mechanics of Community Detection <=spinglass相关

[2]M. Girvan & M. E. J. Newman (2001) Community structure in social and biological networks <=中心势betweeness相关

[3]Jierui Xie & Boleslaw K. Szymanski (2013) LabelRank: A Stabilized Label Propagation Algorithm for Community Detection in Networks <=标签传播labelrank相关

[4]Pascal Pons and Matthieu Latapy (2006) Computing Communities in Large Networks Using Random Walks <=随机游走randomwalk相关

总之,在这里这种方法适用于购物车商品分析。
  另外,需要注意:
  ①社群发现必须基于连通图(即,所有点上都在线上,没有孤立的点);
  ②此处的社群个数对应之后画子图的分组个数。

步骤描述:

对不同商品类别的点配置不同颜色→
建立绘图分组member.list,作为plot函数mark.groups参数的列表对象→
画图并手动添加图例→
可添加点的标签属性vertex.label,呈现原有编号

这部分代码如下:

##社群发现并绘制关系图(自旋玻璃法)
member<-spinglass.community(gdata, weights= E(gdata)$weight)
V(gdata)$member<-member$membership
member.num<-length(table(V(gdata)$member)); member.num #注意:此处的社群个数对应之后的绘图分组

#对不同商品类别的点配置不同颜色
mem.col<-rainbow(length(unique(V(gdata)$category)),alpha=0.5)#注意设置alpha值调节对比度
V(gdata)$color<-mem.col[V(gdata)$category]
#建立设置绘图分组(plot函数的mark.groups参数)的列表对象member.list
member.list<-list()
for(i in 1:member.num)
{
  member.list<-c(member.list, list(which(V(gdata)$member==i)))
}
#svg(filename=paste(root, "demol.svg",sep=""), width = 14, height = 14)
#画图并手动添加图例
legend0<-c("dairy eggs","produce","meat seafood","beverages","pantry","bakery","frozen","snacks")
#plot(gdata, vertex.size=10, layout=layout.fruchterman.reingold, vertex.color=V(gdata)$color, edge.width=scale(E(gdata)$weight, center=F)+1, mark.groups=member.list)
plot(gdata, vertex.label=V(gdata)$item, vertex.size=10, layout=layout.fruchterman.reingold, vertex.color=V(gdata)$color, edge.width=scale(E(gdata)$weight, center=F)+1, mark.groups=member.list)
#第二个plot加了label属性
legend(
"topleft",legend=legend0, pch=16, col=mem.col, bty="n", cex=1)

  画出图如下(右图为加了lable标签后的效果,所有点恢复了真实编号,而不是左图中临时的连续编号):

  OK! 看上去还不错。

  现在我们得到的图里,每个点的颜色对应左侧图例中的不同商品分类(蛋奶制品、烘焙类、冷冻品、零食等等),点与点之间的连线代表两个曾在同一购物篮子(即订单信息order)中出现过。现在利用算法已经发现了五个可能存在的社群,即,在这个图中关系更密切的点的集合,由浅色“冲积扇”形状色块标出。右图中,点的编号就是原mini数据库中的商品号码。现在就可以研究能不能得出有趣的结论了!

  对照如下图的数据库,上方右图中编号81,80,31,119的商品位于一个社群中。也许数据量再大些能说明热爱有机蔬果的顾客也偏好矿泉水?

5.绘制子图

  为了单独研究形成的各个社群,还可以把关系图拆成子图分别绘制。

  有两种方法画子图:
  A.设置par,用循环一次性画出;
  B.依次画每个图,放大后更清晰

#绘制不同社群内的关系图
#svg(filename=paste(root, "demol.svg",sep=""), width = 14, height = 14)
#par(mfcol=c(3,2))
for(i in 1:length(table(member$membership)))
{
  tmp.g<-induced.subgraph(gdata,which(V(gdata)$member==i));V(tmp.g)
  member.list<-list()
  tmp.category<-as.numeric(names(table(V(tmp.g)$category)))
  for(j in tmp.category)
  {
    member.list<-c(member.list,list(which(V(tmp.g)$category==j)))
  }
  plot(tmp.g, vertex.size=10,layout=layout.fruchterman.reingold, edge.width=scale(E(tmp.g)$weight,center=F)+1,mark.groups=member.list,vertex.label=V(tmp.g)$item)
  #手动添加图例
  #legend("topleft",legend= ,pch=16,col=mem.col,bty="n",cex=1)
}

  子图如下:

                            

                        

------------------------------------------------分割线----------------------------------------------------

6.完整代码

ls()
rm(list = ls())
#初步读取数据
root="C:/Users/asus/Desktop/"
data<-read.csv(file=paste(root,"购物车.csv",sep=""),header=T,encoding="UTF-8");
colname1<-colnames(data)
colname1[1]<-"order_id"
colnames(data)<-colname1
#由于预先对数据集进行了处理,此处不需要书上分离商品名、类别并编号的步骤
##建立关系网络
#用cast函数转化格式
#重铸函数cast(md,formula,FUN),其中md是已融和的数据,formula描述了想要的结果,
#而FUN是数据整合函数,例如mean,也可自定义多值整合函数。默认为统计函数。

#install.packages('reshape')
library('reshape')
data<-cbind(data,value=1)
#cast返回数据框,再转换成矩阵
cart=as.matrix(cast(data,order_id~p_id,value="value",fill=0))
cart[,-1]<-ifelse(cart[,-1]>=1,1,0)#好像有点多余,因为此数据集中每个购物篮子中的某件商品只被记了一次

#注:这是最开始的数据准备部分,限于篇幅,后面的部分就是前文各小节代码的拼凑综合,不再重复复制粘贴。

参考资料:《R语言与网站分析》[李明著][机械工业出版社][2014.04] 的9.3节《关系网络分析》。

代码部分引用自原书作者,增加了注释,结合R语言语法的变化也有改动。

小注:写作本文源于博主小白去年一段做RA的经历,当时与队友们共同学习社会网络分析(Social Network Analysis,SNA),主要参考书是上文提及的《R语言与网站分析》9.3节。博主小白与搭档负责实现书上的两个实例,但由于教材没有提供数据来源、R语言语法近几年的变化,中间费了一番波折,故写作本文,主要内容为博主负责的“购物篮子商品相关性分析”实例。如有疏漏,还望指正!


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
热门推荐
热门话题
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap