为了了解图书馆咨询群的聊天情况，更好的了解学生情况，我对从3月份到目前图书馆咨询群的聊天记录进行了个初步的分析。对未来图书馆群管理做一个简单的建议。全篇分为三个步骤：
- 数据准备和整理
- 基础分析和高级分析
- 结论
# 首先，是数据准备和整理
library(stringr)
library(plyr)
library(lubridate)
library(ggplot2)
library(reshape2)
library(igraph)
# 下载QQ群聊天记录txt
root = "/Users/zhangyi/Desktop/"
file = paste(root, "QQ2(427968708).txt", sep="")
file.data <- scan(file, what = "", sep="\n", encoding="UTF-8")
data <- data.frame(user.name=c(), time=c(),text=c())
time <- c();
user.name <- c();
text <- c()
file.data
我们需要先将其格式分为用户、时间和文本内容三个简单部分，以便后续进行分析。
# 遍历所有的有效数据
for(i in 3:length(file.data)){
reg.time <- regexpr("[0-9]{4}-[0-9]{2}-[0-9]{2} [0-9]+:[0-9]+:[0-9]+", file.data[i])
if(reg.time==1){
data <-rbind(data, data.frame(time=time,user.name=user.name,text=text))
text <- c()
begin <- reg.time;end <- reg.time+attr(reg.time, "match.length")-1
time <- substr(file.data[i], begin, end)
begin <- as.numeric(reg.time+attr(reg.time, "match.length")+1);
end <- nchar(file.data[i])
user.name <- substr(file.data[i], begin,end)
}else{
text <- paste(text,file.data[i])
}
}
# 去掉NA
for(i in 1:dim(data)[1])
if(is.na(data[i,1]))
{
if(is.na(data[i,2]))
{
if(is.na(data[i,3]))
{
data<- data[-i,]
}
}
}
# 转换格式
data$text <- as.character(data$text)
data$user.name <- as.character(data$user.name)
转换前
转换后
data-文本高级分析
# 文本处理data
# 格式化，将每个用户的所有发言合并
user.name <- unique(data$user.name) # 所有不重复的用户名单列表
text<-c();text.num<-c()
for(i in 1:length(user.name)){
text.i <- data$text[which(data$user.name==user.name[i])]
text.i.num <-length(text.i)
for(j in 1:text.i.num){
text[i]<-paste(text[i],text.i[j],sep="")
}
text.num[i]<-text.i.num
}
user.text <- data.frame(user.name=user.name,text=text,text.num=text.num)
user.text$user.name <- as.character(user.text$user.name)
user.text$text <- as.character(user.text$text)
user.text-各个用户的发言合并以及条目
# 非文本处理newdata，主要用来进行基础分析
# 将字符串中的日期和时间划分为不同变量
temp1 <- str_split(data$time,' ')
result1 <- ldply(temp1,.fun=NULL)
names(result1) <- c('date','clock')#分离年月日
temp2 <- str_split(result1$date,'-')
result2 <- ldply(temp2,.fun=NULL)
names(result2) <- c('year','month','day')# 分离小时分钟
temp3 <- str_split(result1$clock,':')
result3 <- ldply(temp3,.fun=NULL)
names(result3) <- c('hour','minutes','second')# 合并数据
newdata <- cbind(data,result1,result2,result3)
# 转换日期为时间格式
newdata$date <- ymd(newdata$date)
newdata-没用星期数据
# 提取星期数据
newdata$wday <- wday(newdata$date)# 转换数据格式
newdata$month <- ordered(as.numeric(newdata$month) )
newdata$year <- ordered(newdata$year)
newdata$day <- ordered(as.numeric(newdata$day))
newdata$hour <- ordered(as.numeric(newdata$hour))
newdata$wday <- ordered(newdata$wday)
newdata
# 非文本基础分析
# 一星期中每天合计的聊天记录次数，可以看到该 QQ 群的聊天兴致随星期的分布。
qplot(wday,data=newdata,geom='bar')
周内分布
很明显的可以看到周三的发言数量是最多的，而周一周二显然比较低迷。同时，周四和周日的也不错。
#聊天兴致在一天中的分布。
qplot(hour,data=newdata,geom='bar')
一天分布
早上十点和下午五点六点是聊天高峰期，晚上十点也相对鼻尖活跃。到了十一点后基本就没人了。
#前十大发言最多用户&话痨
user <- as.data.frame(table(newdata$user.name)) # 用 table 统计频数
user <- user[order(user$Freq,decreasing=T),]
user[1:10,] # 显示前十大发言人的 ID 和 发言次数
topuser <- user[1:10,]$Var1 # 存前十大发言人的 ID
user_hl <- data$user.name
user_hl.n <- as.data.frame(table(user_hl))
user_hl.n.20 <- user_hl.n[order(user_hl.n[,2],decreasing=T),]
user_hl.n.20 <- user_hl.n.20[1:20,]
ggplot(data=user_hl.n.20,aes(x=user_hl,y=Freq))+
geom_bar(stat='identity')+coord_flip()+
theme(text = element_text(family = 'STKaiti'))
#coord_flip()的作用就是讲条形图这些这样90度的旋转。
话痨1
话痨2
# 根据活跃天数统计前十大活跃用户
# 活跃天数计算# 将数据展开为宽表，每一行为用户，每一列为日期，对应数值为发言次数
flat.day <- dcast(newdata,user.name~date,length,value.var='date')
flat.mat <- as.matrix(flat.day[-1]) #转为矩阵# 转为0-1值，以观察是否活跃
flat.mat <- ifelse(flat.mat>0,1,0)# 根据上线天数求和
topday <- data.frame(flat.day[,1],apply(flat.mat,1,sum))
names(topday) <- c('id','days')
topday <- topday[order(topday$days,decreasing=T),]# 获得前十大活跃用户
topday[1:10,]
活跃天数
# 寻找聊天峰值日
# 观察每天的发言次数# online.day为每天的发言次数
online.day <- sapply(flat.day[,-1],sum) # -1 表示去除第一列，第一列是 ID
tempdf <- data.frame(time=ymd(names(online.day)),online.day )
qplot(x=time,y=online.day ,ymin=0,ymax=online.day ,data=tempdf,geom='linerange')
# 观察到有少数峰值日，看超过200次发言以上是哪几天
names(which(online.day>200))
每天活跃度-聊天次数
# 每天活跃人数统计
# 根据flat.day数据观察每天活跃用户变化# numday为每天发言人数
numday <- apply(flat.mat,2,sum)
tempdf <- data.frame(time=ymd(names(numday)),numday)
qplot(x=time,y=numday,ymin=0,ymax=numday,data=tempdf,geom='linerange')
每天活跃人数
四月好像有一天特别活跃。。。
# 十强选手的日内情况
# 再观察十强选手的日内情况
flat.hour <- dcast(newdata,user.name~hour,length,value.var='hour',subset=.(user.name %in% topuser)) # 平行坐标图
hour.melt <- melt(flat.hour)
p <- ggplot(data=hour.melt,aes(x=variable,y=value))
p + geom_line(aes(group=user.name,color=user.name))+theme_bw()+theme(legend.position = "none")
各有千秋
# 连续对话的次数，以三十分钟为间隔
newdata$realtime <- strptime(newdata$time,'%Y-%m-%d %H:%M')# 时间排序有问题，按时间重排数据
newdata2 <- newdata[order(newdata$realtime),]# 将数据按讨论来分组
group <- rep(1,dim(newdata2)[1])
for (i in 2:dim(newdata2)[1]) {
d <- as.numeric(difftime(newdata2$realtime[i],
newdata2$realtime[i-1],
units='mins'))
if ( d < 30) {
group[i] <- group[i-1]
}
else {group[i] <- group[i-1]+1}
}
barplot(table(group))
连续对话的次数
看来也就那一天多了。
# 画社交网络图
# 得到 93 多组对话
newdata2$group <- group
# igraph进行十强之间的网络分析
# 建立关系矩阵，如果两个用户同时在一次群讨论中出现，则计数+1
newdata3 <- dcast(newdata2, user.name~group, sum,value.var='group',subset=.(user.name %in% user[1:10,]$Var1))#
newdata4 <- ifelse(newdata3[,-1] > 0, 1, 0)
rownames(newdata4) <- newdata3[,1]
relmatrix <- newdata4 %*% t(newdata4)# 很容易看出哪两个人聊得最多
deldiag <- relmatrix-diag(diag(relmatrix))
which(deldiag==max(deldiag),arr.ind=T)# 根据关系矩阵画社交网络画
g <- graph.adjacency(deldiag,weighted=T,mode='undirected')
g <-simplify(g)
V(g)$label<-rownames(relmatrix)
V(g)$degree<- degree(g)
layout1 <- layout.fruchterman.reingold(g)#
egam <- 10*E(g)$weight/max(E(g)$weight)
egam <- (log(E(g)$weight)+1) / max(log(E(g)$weight)+1) +
V(g)$label.cex <- V(g)$degree / max(V(g)$degree)+
V(g)$label.color <- rgb(0, 0, .2, .8) +
V(g)$frame.color <- NA +
E(g)$width <- egam +
# E(g)$color <- rgb(0, 0, 1, egam)
plot(g, layout=layout1,vertex.label.family="STKaiti")
社交图
# 找到配对
# 找到配对
pairlist=data.frame(pair=1:length(attributes(deldiag)$dimnames[[1]]))
rownames(pairlist)<-attributes(deldiag)$dimnames[[1]]
for(i in(1:length(deldiag[1,]))){
pairlist[i,1]<-attributes(which(deldiag[i,]==max(deldiag[i,]),arr.ind=T))$names[1]
}
pairlist
pairmatrix=data.frame(pairA=1:length(attributes(deldiag)$dimnames[[1]]),pairB=1:length(attributes(deldiag)$dimnames[[1]]))
pairmatrix=data.frame(pair=1:length(attributes(deldiag)$dimnames[[1]]))
for(i in (1:dim(deldiag)[1])){
deldiag[i,] <- ifelse(deldiag[i,] == max(deldiag[i,]), 1, 0)
}
deldiag
# 分词
library(jiebaR)
cutter<-worker()
jiebatext <-c()
for(i in 1:length(user.text$text)){
jiebatext <- c(jiebatext,list(cutter <= user.text$text[i]))
}#
#分词结束，现在开始统计词频
library(wordcloud2)
library(dplyr)
target_words <- unlist(jiebatext)
p=as.data.frame(table(unlist(target_words)))%>%
arrange(desc(Freq))
wordcloud2(p)
词云
大家都挺喜欢图片和表情的。把的、0等词删除后再看：
# 删除词
target_words=gsub(pattern="[的],[NA],[0]","",target_words);
q=as.data.frame(table(unlist(target_words)))%>%
arrange(desc(Freq))
wordcloud2(q)
删除部分后
果然大家的关注点在图书馆上和借书上。“我”字比较多，看来大多是自我介绍。。。
# 散点图
library(tm)
ovid <- Corpus(VectorSource(jiebatext))
ovid <- tm_map(ovid, FUN = removeWords,c("图片", "表情"))
dtm <- DocumentTermMatrix(ovid)
qq.matrix <-as.matrix(dtm)
qq.freq <- apply(qq.matrix,2,sum)
qq.freq.top<-rev(sort(qq.freq))[1:30]
plot(qq.freq);text(c(1:length(qq.freq),qq.freq,names(qq.freq)))
词汇散点图
本该看到词汇的散点图，没想到词汇有点多。
from <-c(); to<-c()
for(i in 1:length(user.text$user.name)){
from <- c(from, rep(user.text$user.name[i],length(jiebatext[[i]])))
to<-c(to,jiebatext[[i]])
}
from[which(from=="")] <- "数据及内无用户名"
library(igraph)
init.igraph <- function(data,dir=F,rem.multi=T){
labels <- union(unique(data[,1]),unique(data[,2]))
ids <- 1:length(labels);names(ids)<-labels
from <- as.character(data[,1]);to<- as.character(data[,2])
edges <- matrix(c(ids[from],ids[to]),nc=2)
g <- graph.empty(directed=dir)
g <-add.vertices(g,length(labels))
V(g)$labels=labels
g <- add.edges(g,t(edges))
if(rem.multi){
E(g)$weight <- count.multiple(g)
g <- simplify(g, remove.multiple = TRUE, remove.loops = TRUE, edge.attr.comb = 'mean')
}
g
}
g.dir <- init.igraph(data.frame(from=from,to=to), T)
# 核心词汇网络图
std.degree.words=10
words.index <- (degree(g.dir, mode="in") >= std.degree.words)
words <- degree(g.dir, mode="in")[words.index]
names(words) <- V(g.dir)[words.index]$labels
labels=NA
labels[words.index] <- names(words)
V(g.dir)$size=1
max.d <- max(words)
min.d <- min(words)
V(g.dir)[words.index]$size = 2*(words-min.d)/(max.d-min.d)+2
V(g.dir)$color = "white"
V(g.dir)[words.index]$color = "red"
#svg(filename=paste(root,"words.svg",sep=""), width = 40, height =40)
png(filename="sin3.png",width=800,height=800)
par(family='STKaiti')
plot(g.dir,layout=layout.fruchterman.reingold,
vertex.label=labels,
vertex.label.cex=V(g.dir)$size/2,
vertex.color=V(g.dir)$color,
vertex.label.family="STKaiti")
dev.off()
核心词汇
其中可以看到，除了NA外，借书，保存是常见的词汇，大家的问题也常集中在这上面。
# 核心用户网络图
std.degree.user=20
user.index <- (degree(g.dir, mode="out") >= std.degree.user)
user <- degree(g.dir, mode="out")[user.index]
names(user) <- V(g.dir)[user.index]$labels
labels=NA
labels[user.index] <- names(user)
V(g.dir)$size=1
max.d <- max(user)
min.d <- min(user)
V(g.dir)[user.index]$size = 2*(user-min.d)/(max.d-min.d)+2
V(g.dir)$color = "white"
V(g.dir)[user.index]$color = "green"
png(filename="sin2.png",width=800,height=800)
par(family='STKaiti')
plot(g.dir,layout=layout.fruchterman.reingold,
vertex.label=labels,
vertex.label.cex=V(g.dir)$size/3,
vertex.color=V(g.dir)$color,
vertex.label.family="STKaiti",
vertex.label.color="blue")
dev.off()
用户散点图
总结
通过上述的分析，我们得到了以下结论：
- 最活跃的时间。通过最活跃的时间，我们可以知道群成员的活跃时间在周内的哪一天，在一天的哪个时间段。这样发布消息的时间就有了参考。
- 最活跃的人和话痨。通过最活跃的人，可以了解群核心成员。
- 活跃的人数。通过了解活跃的人数，可以间接了解群的活跃度。
- 社交网络。建立起社交网络，可以知道群中成员的互动关系。
- 词云。通过词云可以知道群内主要话题关键词。
- 重点词条网络。通过建立关键词网络，可以知道哪些话题带动了更多的用户参与。入度越大，说明该话题带动的了更多的用户参与讨论。
- 重点用户网络。而建立了重点用户网络，则可以了解哪些用户涉及的哪些关键话题词条。出度越大，表示该用户涉及的话题词条越多。
参考：
- 《R语言与网站分析》
- 仅用四行代码就可以挖掘你的QQ聊天记录
- 使用 R 语言挖掘 QQ 群聊天记录
- 今天来挖挖你的QQ聊天记录