用数据分析挖一挖QQ群聊天记录_数据挖掘与数据分析

原创 admin  2017-06-14 00:00 

原文地址:http://www.jianshu.com/p/940cf43778e9

作者简书:文质彬彬,专注数据分析与自我管理       数据圈圈友 已授权

为了了解图书馆咨询群的聊天情况,更好的了解学生情况,我对从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])
        }
}
# 去掉NAfor(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 # 存前十大发言人的 IDuser_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 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 表示去除第一列,第一列是 IDtempdf <- 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  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=10words.index <- (degree(g.dir, mode="in") >= std.degree.words)
words <- degree(g.dir, mode="in")[words.index]
names(words) <- V(g.dir)[words.index]$labelslabels=NAlabels[words.index] <- names(words)

V(g.dir)$size=1max.d <- max(words)min.d <- min(words)
V(g.dir)[words.index]$size = 2*(words-min.d)/(max.d-min.d)+2V(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=20user.index <- (degree(g.dir, mode="out") >= std.degree.user)
user <- degree(g.dir, mode="out")[user.index]
names(user) <- V(g.dir)[user.index]$labelslabels=NAlabels[user.index] <- names(user)

V(g.dir)$size=1max.d <- max(user)min.d <- min(user)
V(g.dir)[user.index]$size = 2*(user-min.d)/(max.d-min.d)+2V(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聊天记录



    欢迎加入数据君数据分析秘密组织(收费)

    (保存图到手机相册,然后微信扫一扫可以才可以加入)

    这是一份事业!

    数据挖掘与大数据分析

    (datakong)

    传播数据|解读行业|技术前沿|案例分享

    2013年新浪百强自媒体

    2016年中国十大大数据影响平台

    荣誉不重要,干货最实在

赞赏

长按二维码向我转账

受苹果公司新规定影响,微信 iOS 版的赞赏功能被关闭,可通过二维码转账支持公众号。

即将打开""小程序

取消
打开

本文地址:http://www.17xiuwang.com/2017/06/14/%e7%94%a8%e6%95%b0%e6%8d%ae%e5%88%86%e6%9e%90%e6%8c%96%e4%b8%80%e6%8c%96qq%e7%be%a4%e8%81%8a%e5%a4%a9%e8%ae%b0%e5%bd%95_%e6%95%b0%e6%8d%ae%e6%8c%96%e6%8e%98%e4%b8%8e%e6%95%b0%e6%8d%ae%e5%88%86/
关注我们:请关注一下我们的微信公众号:扫描二维码,公众号:aiboke112
版权声明:本文为原创文章,版权归 admin 所有,欢迎分享本文,转载请保留出处!

发表评论


表情