R語言入門級實例之用igragh包分析社羣

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代碼部分引用自原書做者，增長了註釋，結合R語言語法的變化也有改動。

7.數據預處理部分的Python代碼（能夠用R的指令代替）

1.對商品從新編號（商品分類的從新編號相似，此處不贅述）

import openpyxl
import re
 
def Exceldivide(file_dir):
 wb=openpyxl.load_workbook(file_dir)
 sheet=wb.get_sheet_by_name('prior_order')
 tuple(sheet['A1':'E507'])
 t=1
 for i in range(2,508):
     fd=False
     for j in range(2,i):
        if sheet.cell(row=i, column=4).value==sheet.cell(row=j, column=4).value:
            sheet.cell(row=i, column=6).value=sheet.cell(row=j, column=6).value
            fd=True
     if fd==False:
         sheet.cell(row=i, column=6).value=t
         t+=1
 return wb
 
g=Exceldivide('C:\\Users\\asus\\Desktop\\購物籃子簡化版.xlsx')
g.save('C:\\Users\\asus\\Desktop\\購物籃子簡化版.xlsx')

2.保留被重複購買過的商品（這一步在數據集較大時可省去）

import openpyxl
import re
 
def Exceldivide(file_dir):
 wb=openpyxl.load_workbook(file_dir)
 sheet0=wb.get_sheet_by_name('prior_order')  #
 sheet1=wb.get_sheet_by_name('repeat')
 sheet2=wb.get_sheet_by_name('order') 
 tuple(sheet0['A1':'F507'])
 tuple(sheet1['A1':'B45'])
 tuple(sheet2['A1':'D45'])
 i=1
 for rows in sheet0['F2':'F507']:
      for cell0 in rows:
         for rows2 in sheet1['A2':'A45']:
             for cell1 in rows2:
                 if cell0.value==cell1.value:
                      i+=1
                      sheet2.cell(row=i, column=1).value=sheet0.cell(row=int(cell0.coordinate[1:]), column=1).value
                      sheet2.cell(row=i, column=2).value=sheet0.cell(row=int(cell0.coordinate[1:]), column=2).value
                      sheet2.cell(row=i, column=3).value=sheet0.cell(row=int(cell0.coordinate[1:]), column=3).value
                      sheet2.cell(row=i, column=4).value=sheet0.cell(row=int(cell0.coordinate[1:]), column=6).value
 return wb
 
g=Exceldivide('C:\\Users\\asus\\Desktop\\購物籃子簡化版.xlsx')
g.save('C:\\Users\\asus\\Desktop\\購物籃子簡化版.xlsx')

小注：寫做本文源於博主小白去年一段作RA的經歷，當時與隊友們共同窗習社會網絡分析(Social Network Analysis,SNA)，主要參考書是上文說起的《R語言與網站分析》9.3節。博主小白與搭檔負責實現書上的兩個實例，但因爲教材沒有提供數據來源、R語言語法近幾年的變化，中間費了一番波折，故寫做本文，主要內容爲博主負責的「購物籃子商品相關性分析」實例，轉載請註明來源。若有疏漏，還望指正！