使用R语言挖掘QQ群聊天记录
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} .+$",qqsrcdata)]
看看 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,'match.length')-1) # 读取 s 中的数据}
gg<-gregexpr("\d{4}-\d{2}-\d{2} \d+:\d{2}:\d{2}",srcdata,perl=TRUE)for(j in 1:length(gg))
{
data$time[j]<-getcontent(srcdata[j],gg[[j]])
}
现在时间和发言人信息都读到 data 的 time 和 id 中了,可以确认下提取内容:data、dataid、datatime。
还没完,时间还是字符串,还需要继续处理:
# 数据整理# 将字符串中的日期和时间划分为不同变量
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$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,data=newdata,geom='bar')
这群一天中聊得最嗨的是上午 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='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 表示去除第一列,第一列是 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,id~hour,length,value.var='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,'%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进行十强之间的网络分析# 建立关系矩阵,如果两个用户同时在一次群讨论中出现,则计数+1newdata3 <- dcast(newdata2, id~group, sum,value.var='group',subset=.(id %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)+ .2V(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)
- 找到配对
#找到配对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
- 为什么是link-visited-hover-active
- 51Nod 1051 最大子矩阵和
- Javascript之创建对象
- Leetcode-Easy 136. Single Number
- 2017.10.25水题大作战题解
- Angular开发实践(四):组件之间的交互
- Leetcode-Easy 70. Climbing Stairs
- Angular开发实践(八): 使用ng-content进行组件内容投射
- Angular开发实践(六):服务端渲染
- Leetcode-Easy 657. Judge Route Circle
- 洛谷P1138 第k小整数
- Leetcode-Easy 796. Rotate String
- 2017.10.23解题报告
- Leetcode-Easy 461.Hamming Distance
- JavaScript 教程
- JavaScript 编辑工具
- JavaScript 与HTML
- JavaScript 与Java
- JavaScript 数据结构
- JavaScript 基本数据类型
- JavaScript 特殊数据类型
- JavaScript 运算符
- JavaScript typeof 运算符
- JavaScript 表达式
- JavaScript 类型转换
- JavaScript 基本语法
- JavaScript 注释
- Javascript 基本处理流程
- Javascript 选择结构
- Javascript if 语句
- Javascript if 语句的嵌套
- Javascript switch 语句
- Javascript 循环结构
- Javascript 循环结构实例
- Javascript 跳转语句
- Javascript 控制语句总结
- Javascript 函数介绍
- Javascript 函数的定义
- Javascript 函数调用
- Javascript 几种特殊的函数
- JavaScript 内置函数简介
- Javascript eval() 函数
- Javascript isFinite() 函数
- Javascript isNaN() 函数
- parseInt() 与 parseFloat()
- escape() 与 unescape()
- Javascript 字符串介绍
- Javascript length属性
- javascript 字符串函数
- Javascript 日期对象简介
- Javascript 日期对象用途
- Date 对象属性和方法
- Javascript 数组是什么
- Javascript 创建数组
- Javascript 数组赋值与取值
- Javascript 数组属性和方法
- laravel http 自定义公共验证和响应的方法
- Windows服务器中PHP如何安装redis扩展
- NBA投篮数据可视化,4行代码就能实现!
- Laravel框架实现文件上传的方法分析
- PHP集成环境XAMPP的安装与配置
- Laravel解决nesting level错误和隐藏index.php的问题
- PHP反射原理与用法深入分析
- Thinkphp5.0 框架实现控制器向视图view赋值及视图view取值操作示例
- laravel Validator ajax返回错误信息的方法
- Linux下 php7安装redis的办法
- php实现的数组转xml案例分析
- Laravel框架Auth用户认证操作实例分析
- yii2实现Ueditor百度编辑器的示例代码
- PHP下载文件函数与用法示例
- php实现银联商务公众号+服务窗支付的示例代码