使用R语言挖掘QQ群聊天记录



数据挖掘入门与实战  公众号: datadw



1、获取数据

从 QQ 消息管理器中导出消息记录,保存的文本类型选择 txt 文件。这里获取的是某群从 2016-04-18 到 2016-05-07 期间的聊天记录,记录样本如下所示。




2、数据预处理

打开 R 软件,先通过 File—>Change dir 切换到聊天文件所在目录。

引入包:

library(stringr)
library(plyr)
library(lubridate)
library(ggplot2)
library(reshape2)
library(igraph)

没有的包要通过命令 install.packages(”扩展包名”)  安装。

读取聊天记录文件到内存:


qqsrcdata<-readLines("QQGroup.txt",encoding=UTF-8")

这里我们不关心聊天内容,只看时间和发言人,所以,我们把类似 “2016-04-18 20:04:20 我来弄死谁(66554432)” 这样的内容提取出来。这里要用到正则表达式,对 R 语言的 grep、sub、gregexpr 等字符串处理函数不熟的,网上搜一下,资料多的是。


srcdata<-qqsrcdata[grep(^\\d{4}-\\d{2}-\\d{2} \\d+:\\d{2}:\\d{2} .+$看看 srcdata 内容,就已经全是发言时间和发言人信息了,没有其它闲杂数据。

然后再从 srcdata 中提取发言时间和发言人信息,分别存到列表 data 的 time 和 id 中。对发言人信息的提取很简单:


data={}  # 创建一个空的 listdata$id<-sub(\\d{4}-\\d{2}-\\d{2} \\d+:\\d{2}:\\d{2} "",srcdata)

对发言时间的提取要稍麻烦些,因为时间字符串的长度不一样,有些是 18 位,如 “2016-04-18 7:36:32”,有些是 19 位,如 “2016-04-18 19:24:01”,所以,在提取时间时,需先用 gregexpr 确定时间字符串的起始和结束位置,然后再用 substring 提取出相应的时间,注意 substring 和 sub 是不同的函数


getcontent <- function(s,g){
  substring(s,g,g+attr(g,0); line-height: 1.5 !important;">'match.length')-1)   读取 s 中的数据}

gg<-gregexpr(\\d{4}-\\d{2}-\\d{2} \\d+:\\d{2}:\\d{2}TRUE)for(j in 1:length(gg))
{
data$time[j]<-getcontent(srcdata[j],gg[[j]])
}

现在时间和发言人信息都读到 data 的 time 和 id 中了,可以确认下提取内容:data、data iddatatime。

还没完,时间还是字符串,还需要继续处理:

 数据整理 将字符串中的日期和时间划分为不同变量

temp1 <- str_split(data$time,0); line-height: 1.5 !important;">' ') result1 <- ldply(temp1,.fun=NULL) names(result1) <- c(date',0); line-height: 1.5 !important;">clock')分离年月日

temp2 <- str_split(result1$date,0); line-height: 1.5 !important;">-') result2 <- ldply(temp2,.fun=NULL) names(result2) <- c(yearmonthday 分离小时分钟temp3 <- str_split(result1$clock,0); line-height: 1.5 !important;">:') result3 <- ldply(temp3,.fun=NULL) names(result3) <- c(hourminutessecond 合并数据

newdata <- cbind(data,result1,result2,result3) 转换日期为时间格式

newdata$date <- ymd(newdata$date) 提取星期数据

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 中,可以开始任性地分析了~


3、数据分析

  • 一星期中每天合计的聊天记录次数,可以看到该 QQ 群的聊天兴致随星期的分布。

qplot(wday,data=newdata,geom=bar')

周三是工作日,还这么活跃,周六话最多,周日估计出去玩了,周一专心上班。

  • 聊天兴致在一天中的分布。





qplot(hour,255);">这群一天中聊得最嗨的是上午 10 点和下午 17 点,形成两个高峰。



user <- as.data.frame(table(newdata$id))   用 table 统计频数

user <- user[order(user$Freq,decreasing=T),] user[1:10,] 显示前十大发言人的 ID 和 发言次数

topuser <- user[1:10,]$Var1 存前十大发言人的 ID

 活跃天数计算 将数据展开为宽表,每一行为用户,每一列为日期,对应数值为发言次数

flat.day <- dcast(newdata,id~date,length,value.var=') 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,sum)) names(topday) <- c(iddays') topday <- topday[order(topday$days,] 获得前十大活跃用户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,0); line-height: 1.5 !important;">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,ymax=numday,0); line-height: 1.5 !important;">')
  • 十强选手的日内情况

 再观察十强选手的日内情况

flat.hour <- dcast(newdata,id~hour,subset=.(id %in% topuser)) 平行坐标图

hour.melt <- melt(flat.hour) p <- ggplot(data=hour.melt,aes(x=variable,y=value)) p + geom_line(aes(group=id,color=id))+theme_bw()+theme(legend.position = none
  • 连续对话的次数,以三十分钟为间隔

  •  连续对话的次数,以三十分钟为间隔

    newdata$realtime <- strptime(newdata$time,0); line-height: 1.5 !important;">%Y-%m-%d %H:%M 时间排序有问题,按时间重排数据

    newdata2 <- newdata[order(newdata$realtime),0); line-height: 1.5 !important;"> 将数据按讨论来分组

    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进行十强之间的网络分析 建立关系矩阵,如果两个用户同时在一次群讨论中出现,则计数+1newdata3 <- dcast(newdata2,id~group,sum,0); line-height: 1.5 !important;">groupin% user[1:10,]$Var1))#newdata4 <- ifelse(newdata3[,-1] > 0,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)+ .2V(g)$label.color <- rgb(0,.2,.8) V(g)$frame.color <- NA E(g)$width <- egam E(g)$color <- rgb(0,egam) plot(g,layout=layout1)

  • 找到配对

  • 找到配对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]]))in (1:dim(deldiag)[1]))
    {
    deldiag[i,] <- ifelse(deldiag[i,] == max(deldiag[i,0)
    }
    deldiag

     


    新浪微博名称:大数据_机器学习



    数据挖掘入门与实战

    搜索添加微信公众号:datadw


    教你机器学习,教你数据挖掘


    长按图片,识别二维码,点关注

    相关文章

    自1998年我国取消了福利分房的政策后,房地产市场迅速开展蓬...
    文章目录获取数据查看数据结构获取数据下载数据可以直接通过...
    网上商城系统MySql数据库设计
    26个来源的气象数据获取代码
    在进入21世纪以来,中国电信业告别了20世纪最后阶段的高速发...