R || 聊天记录分析（二）

一般的聊天记录分析教程主要分析下聊天频率以及聊天话题，具体可见上一篇教程。R || 聊天记录分析（一）但是在一个有组织的社群中，群成员可能会通过互相的对话产生一些联系。我在思考如何展示聊天中产生的联系时想到了社交网络分析。所以下面决定展示一下如何对聊天记录信息绘制社交网络图。

一、思路

（1）在一个活跃有组织的群里，常常一个话题仅有少数几个人参与，就比如下面这张图中的对话。在这段对话中，三人互相回复次数多，时间比较紧密。长期群聊天中，或许会形成一个聚集的现象，就比如群内某几个人对话居多。

（2）按照前面的思路，我们可以看一看群中谁与谁关系更紧密。每个人发言后5分钟内（可自行定义时间差）接话的所有成员定义为Ta当时的紧密关联人（一个成员连续出现多次仅算一次），统计每个成员的聊天后面谁出现次数较多。好像一句话就可以解、释全部，但实现起来还是要转下弯，所以直接看图吧。

5分钟内的对话中可能会出现自己接话的情况，并且相近的对话下面重复出现同样的接话人。所以，需要排除接话人为自己的情况，得到不重复计算的接话人。最后就可以得到每个人不同时间点5分钟对话后对应接话的人，进而可以统计每个成员的聊天后面谁出现次数较多。

关键点：准确得到每个成员某个时间点中后面所接的人，且不能重复。绘制社会网络关联图需要两个对象，一个是出现的发言人的名单，另一个是关系表。

nodes : 包含links中s出现的所有且唯一的点，以及点的属性
links : 点与点间的联系，以及边的属性

二、实现

（1）首选确定阈值，几分钟内接话算紧密联系人。这个值可以自行定义，这里设置为5分钟。

#谁与谁关系更紧密
min = 5
datetime = as.POSIXct(paste(data$date,data$time))
connect <-  data.frame(name<-c(),link <-c())
for(i in 1:(length(data[,1])-1)){if(data$Name[i] != data$Name[i+1]){datetime2 = as.POSIXct(paste(data$date[i],data$time[i]))+min*60k1 <- max(which(datetime <= datetime2))if( data$Name[i] %in% data$Name[(i+1):k1] ){k2 <- min(which(data$Name[(i+1):k1] %in% data$Name[i]))+i}else{k2 <- k1}k <- min(k1,k2)dataName <- unique(data$Name[i:k])link <- paste(dataName,collapse = ";")name <- data$Name[i]connect <- rbind(connect,data.frame(name,link))}
}connect$name <- as.character(connect$name)
connect$link <- as.character(connect$link)
connect$name <- enc2native(connect$name)
connect$link <- enc2native(connect$link)
connect$name <- gsub("<.*>","_",connect$name) #-- 利用正则表达式将奇怪字符用"_"替换
connect$link <- gsub("<.*>","_",connect$link)

strsplit_link <- strsplit(as.character(connect$link),";")    #-- 按";"分列并以list方式存储
d <- mapply(cbind,connect$name,strsplit_link) #-- 将connect$name的数据分别和strsplit_link的每个元素做合并,此时d为列表#将列表合并成数据框
link <- data.frame()
for(i in 1:length(d)){d1 <- data.frame(d[i])names(d1) <- c("name","link")link <- rbind(link,d1) #-- 将列表合并成数据框
}connection <- table(link$name,link$link) #-- 列联表 行列 for(i in 1:length(rownames(connection))){for(j in 1:length(colnames(connection))){if(rownames(connection)[i] == colnames(connection)[j]){connection[rownames(connection)[i],colnames(connection)[j]]<-0}}
}connection <- t(connection)
connection <- as.data.frame(connection)
names(connection) <- c("link","name","Freq")

#选出紧密程度大于10的所有紧密关联人
links <- connection[connection$Freq >= 10,]
links <- links[order(links$name,links$Freq,decreasing = TRUE),]#也可以选出前12位话痨，紧密程度大于10的紧密关联人
#links = links[
#  which(is.element(links$name,newtop12$name) == TRUE),]links$name <- as.character(linf$name)
links$link <- as.character(links$link)
nodes <- da.frame(name = unique(c(links$name,links$link)))

三、可视化

（1）用igraph包

library(igraph)
net <- graph_from_data_frame(d=links, vertices=nodes, directed=F)
dev.new()
plot(net) # not a pretty picture!
net <- simplify(net, remove.multiple = F, remove.loops = T)
#V(net)$label <- V(net)$name
plot(net, edge.arrow.size=0.1, edge.color="grey", edge.curved=0,edge.width=2,vertex.color="orange",vertex.size = 11.5, vertex.frame.color="orange",vertex.label=V(net)$name, vertex.label.color="black",vertex.label.cex=0.68)# -- 如果不想显示那么多名字，可以在nodes中新增一列需要显示的名字 # -- 例如仅显示话痨们的名字
newname <- rep(NA,length(nodes$name))
nodes$name <- as.character(nodes$name)
newtop12$name <- as.character(newtop12$name)
for(i in 1:length(nodes$name)){if (nodes$name[i] %in% newtop12$name){newname[i] <- nodes$name[i]}
}
nodes$newname <- newname
net <- graph_from_data_frame(d=links, vertices=nodes, directed=F)
plot(net, edge.arrow.size=0.1, edge.color="grey", edge.curved=0,edge.width=2,vertex.color="orange",vertex.size = 11.5, vertex.frame.color="orange",vertex.label=V(net)$newname, vertex.label.color="black",vertex.label.cex=0.7)

图如下：

（2）networkD3

library(networkD3)
windowsFonts(fc = windowsFont("微软雅黑")
)#可以更改字体
simpleNetwork(links,height = 100, width = 50,linkDistance = 200,fontFamily="fc",fontSize=18,linkColour = "grey", nodeColour = "orange", opacity = 0.8)

图如下：