R語言入門級實例——用igragh包分析社群
引入——
本文的主要目的是初步實現R的igraph包的基礎功能，包括繪制關系網絡圖(social relationship)、利用算法進行社群發現(community detecting)。對於R語言零基礎的同學非常友好。以下R代碼中如有含義不清的，建議嘗試先在R編輯器中輸入?xxx()進行查詢（xxx是函數或語句名）。此外，StackOverflow論壇也幫博主小白看懂了不少報錯信息。
主要參考資料為《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即可
將點的個數修改后，重新跑前面的所有代碼即可
這部分代碼如下：（完整代碼見文末）
1 #建立空關系網絡並設置點數據 2 library(igraph) 3 gdata<-graph.empty(directed=F) 4 #num<-ncol(cart) 5 num<-ncol(cart)-2 #修改點的個數 6 gdata<-add.vertices(gdata,num) 7 8 #為點數據添加商品號以及商品分類屬性 9 category<-c();item<-c() 10 for(i in colnames(cart)) 11 { 12 if(i!=136&& i!=140) 13 { 14 category<-c(category,data$d_id[which(data$p_id==i)[1]] ) 15 item<-c(item,data$p_id[which(data$p_id==i)[1]] ) 16 } 17 } 18 V(gdata)$category<-category 19 V(gdata)$item<-item 20 21 #添加線數據 22 #依次遍歷每個訂單，讀取每個訂單內的商品ID，並存放於向量item.i 23 for(i in 1:nrow(cart)) 24 { item.i<-c() 25 for(j in 1:ncol(cart)) 26 { 27 if(cart[i,j]==1) 28 { 29 item.i<-cbind(item.i,colnames(cart)[j]) 30 } 31 } 32 #建立向量內不同商品間的關聯聯系 33 item.i.num<-length(item.i) 34 from<-c();to<-c() 35 for(m in 1:(item.i.num-1)) 36 { 37 from<-c(from,item.i[-c((item.i.num-m+1):item.i.num)]) 38 to<-c(to,item.i[-c(1:m)]) 39 } 40 if(i>1) 41 { 42 edges<-rbind(edges,matrix(c(from,to),nc=2)) 43 } 44 else 45 { 46 edges<-matrix(data=c(from,to),nc=2) 47 } 48 } 49 edges0<-edges 50 labels<-union(unique(edges[,1]), unique(edges[,2])) 51 ids<-1: length(labels)#對點的編號重新編碼，因為在igraph中邊信息的ids必須連續 52 names(ids)<-labels 53 newfrom<-as.character(edges[,1]);newto<-as.character(edges[,2]) 54 edges<-matrix (c(ids[newfrom],ids[newto]), nc=2) 55 56 #添加線信息並設置線權重 57 gdata<-add.edges(gdata,t(edges[-1,]))#t()是矩陣轉置函數 58 E(gdata)$weight<-count.multiple(gdata) 59 gdata<-simplify(gdata, remove.multiple=TRUE, remove.loops = TRUE, edge.attr.comb = 'mean') 60 #最后一個參數一定是edge.attr.comb,不是edges.attr.comb 61 dev.off()#關閉圖形設備 62 plot(gdata,edge.width=E(gdata)$weight,main="gdata", edge.label=E(gdata)$weight) 63 64 #發現是非連通圖，有兩個未連通的點（點43,點44）,只用手動對點的個數減2即可 65 #將點的個數修改后，重新跑前面的所有代碼
畫出來的效果如下：
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相關
總之，在這里spinglass方法適用於購物車商品分析。
另外，需要注意：
①社群發現必須基於連通圖（即，所有點上都在線上，沒有孤立的點）；
②此處的社群個數對應之后畫子圖的分組個數。
步驟描述：
對不同商品類別的點配置不同顏色→
建立繪圖分組member.list，作為plot函數mark.groups參數的列表對象→
畫圖並手動添加圖例→
可添加點的標簽屬性vertex.label，呈現原有編號
這部分代碼如下：
1 ##社群發現並繪制關系圖（自旋玻璃法） 2 member<-spinglass.community(gdata, weights= E(gdata)$weight) 3 V(gdata)$member<-member$membership 4 member.num<-length(table(V(gdata)$member)); member.num #注意：此處的社群個數對應之后的繪圖分組 5 6 #對不同商品類別的點配置不同顏色 7 mem.col<-rainbow(length(unique(V(gdata)$category)),alpha=0.5)#注意設置alpha值調節對比度 8 V(gdata)$color<-mem.col[V(gdata)$category] 9 #建立設置繪圖分組(plot函數的mark.groups參數)的列表對象member.list 10 member.list<-list() 11 for(i in 1:member.num) 12 { 13 member.list<-c(member.list, list(which(V(gdata)$member==i))) 14 } 15 #svg(filename=paste(root, "demol.svg",sep=""), width = 14, height = 14) 16 #畫圖並手動添加圖例 17 legend0<-c("dairy eggs","produce","meat seafood","beverages","pantry","bakery","frozen","snacks") 18 #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) 19 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) 20 #第二個plot加了label屬性 21 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.依次畫每個圖，放大后更清晰
1 #繪制不同社群內的關系圖 2 #svg(filename=paste(root, "demol.svg",sep=""), width = 14, height = 14) 3 #par(mfcol=c(3,2)) 4 for(i in 1:length(table(member$membership))) 5 { 6 tmp.g<-induced.subgraph(gdata,which(V(gdata)$member==i));V(tmp.g) 7 member.list<-list() 8 tmp.category<-as.numeric(names(table(V(tmp.g)$category))) 9 for(j in tmp.category) 10 { 11 member.list<-c(member.list,list(which(V(tmp.g)$category==j))) 12 } 13 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) 14 #手動添加圖例 15 #legend("topleft",legend= ,pch=16,col=mem.col,bty="n",cex=1) 16 }
子圖如下：
------------------------------------------------分割線----------------------------------------------------
6.完整代碼
1 ls() 2 rm(list = ls()) 3 #初步讀取數據 4 root="C:/Users/asus/Desktop/" 5 data<-read.csv(file=paste(root,"購物車.csv",sep=""),header=T,encoding="UTF-8"); 6 colname1<-colnames(data) 7 colname1[1]<-"order_id" 8 colnames(data)<-colname1 9 #由於預先對數據集進行了處理，此處不需要書上分離商品名、類別並編號的步驟 10 ##建立關系網絡 11 #用cast函數轉化格式 12 #重鑄函數cast(md,formula,FUN),其中md是已融和的數據，formula描述了想要的結果， 13 #而FUN是數據整合函數，例如mean，也可自定義多值整合函數。默認為統計函數。 14 15 #install.packages('reshape') 16 library('reshape') 17 data<-cbind(data,value=1) 18 #cast返回數據框，再轉換成矩陣 19 cart=as.matrix(cast(data,order_id~p_id,value="value",fill=0)) 20 cart[,-1]<-ifelse(cart[,-1]>=1,1,0)#好像有點多余，因為此數據集中每個購物籃子中的某件商品只被記了一次 21 22 #注：這是最開始的數據准備部分，限於篇幅，后面的部分就是前文各小節代碼的拼湊綜合，不再重復復制粘貼。
參考資料：《R語言與網站分析》[李明著][機械工業出版社][2014.04] 的9.3節《關系網絡分析》。
R代碼部分引用自原書作者，增加了注釋，結合R語言語法的變化也有改動。
7.數據預處理部分的Python代碼（可以用R的指令代替）
1.對商品重新編號（商品分類的重新編號類似，此處不贅述）
1 import openpyxl 2 import re 3 4 def Exceldivide(file_dir): 5 wb=openpyxl.load_workbook(file_dir) 6 sheet=wb.get_sheet_by_name('prior_order') 7 tuple(sheet['A1':'E507']) 8 t=1 9 for i in range(2,508): 10 fd=False 11 for j in range(2,i): 12 if sheet.cell(row=i, column=4).value==sheet.cell(row=j, column=4).value: 13 sheet.cell(row=i, column=6).value=sheet.cell(row=j, column=6).value 14 fd=True 15 if fd==False: 16 sheet.cell(row=i, column=6).value=t 17 t+=1 18 return wb 19 20 g=Exceldivide('C:\\Users\\asus\\Desktop\\購物籃子簡化版.xlsx') 21 g.save('C:\\Users\\asus\\Desktop\\購物籃子簡化版.xlsx')
2.保留被重復購買過的商品（這一步在數據集較大時可省去）
1 import openpyxl 2 import re 3 4 def Exceldivide(file_dir): 5 wb=openpyxl.load_workbook(file_dir) 6 sheet0=wb.get_sheet_by_name('prior_order') # 7 sheet1=wb.get_sheet_by_name('repeat') 8 sheet2=wb.get_sheet_by_name('order') 9 tuple(sheet0['A1':'F507']) 10 tuple(sheet1['A1':'B45']) 11 tuple(sheet2['A1':'D45']) 12 i=1 13 for rows in sheet0['F2':'F507']: 14 for cell0 in rows: 15 for rows2 in sheet1['A2':'A45']: 16 for cell1 in rows2: 17 if cell0.value==cell1.value: 18 i+=1 19 sheet2.cell(row=i, column=1).value=sheet0.cell(row=int(cell0.coordinate[1:]), column=1).value 20 sheet2.cell(row=i, column=2).value=sheet0.cell(row=int(cell0.coordinate[1:]), column=2).value 21 sheet2.cell(row=i, column=3).value=sheet0.cell(row=int(cell0.coordinate[1:]), column=3).value 22 sheet2.cell(row=i, column=4).value=sheet0.cell(row=int(cell0.coordinate[1:]), column=6).value 23 return wb 24 25 g=Exceldivide('C:\\Users\\asus\\Desktop\\購物籃子簡化版.xlsx') 26 g.save('C:\\Users\\asus\\Desktop\\購物籃子簡化版.xlsx')
小注：寫作本文源於博主小白去年一段做RA的經歷，當時與隊友們共同學習社會網絡分析(Social Network Analysis,SNA)，主要參考書是上文提及的《R語言與網站分析》9.3節。博主小白與搭檔負責實現書上的兩個實例，但由於教材沒有提供數據來源、R語言語法近幾年的變化，中間費了一番波折，故寫作本文，主要內容為博主負責的“購物籃子商品相關性分析”實例，轉載請注明來源。如有疏漏，還望指正！