干货：QQ聊天记录数据分析

如果您对某个QQ聊天群感兴趣，并想了解某段时间内大家都聊了什么话题？或者是群里哪些人最活跃？或者这些群员都在哪些时间段比较活跃？本文将教你用R实现这些问题的回答。

一、下载QQ群聊天记录

如果您还不知道如何下载某个QQ群的聊天记录，您可以参考下文链接：

http://jingyan.baidu.com/article/a3a3f811f5a1538da2eb8ac5.html

二、聊天记录格式化

您下载下来的聊天记录是这样的格式：

如何将这样的文本记录转换为二维表格式呢？即一张表中包含用户名、说话时间和说话内容三列。

如下是我的R脚本实现聊天记录的格式化：

#定义数据框和变量

data <- data.frame(user_name = c(), datetime = c(), text = c())

user_name <- character()

datetime <- character()

text <- character()

#开始遍历整个文本，取出三列数据

for(i in 5:length(file_data)){

dt_pattern <- regexpr('[0-9]{4}-[0-9]{2}-[0-9]{2} [0-9]+:[0-9]+:[0-9]+',file_data[i])

if(dt_pattern == 1) {

user_begin <- dt_pattern+attr(dt_pattern,'match.length') + 1

user_end <- nchar(file_data[i])

user_name <- substring(file_data[i],user_begin,user_end)

dt_begin <- dt_pattern

dt_end <- dt_pattern+attr(dt_pattern,'match.length')-1

datetime <- substring(file_data[i],dt_begin,dt_end)

text <- file_data[i+1]

data <- rbind(data, data.frame(Name = user_name,datetime = datetime,text = text))

}

}

#字段类型转换

data$user_name <- as.character(data$Name)

data$text <- as.character(data$text)

data$datetime <- as.POSIXlt(data$datetime)

#取出时间戳（datetime）的年、月、日、时、分、秒部分

data <- transform(data,

year = datetime$year+1900,

month = datetime$mon+1,

day = datetime$mday,

hour = datetime$hour,

min = datetime$min,

sec = datetime$sec)

data$datetime <- as.character(data$datetime)

结构化的数据格式如下：

三、绘图

绘图主题一：群中哪些天最热闹

统计每月每天总的聊天次数

library(sqldf)

my.data1 <- sqldf('select month,day,count(*) Freq from data

group by month,day')

首先来一张热图，图中反映了哪月哪些天群里最热闹

library(ggplot2)

p1 <- ggplot(data = my.data1, mapping = aes(x = factor(day), y = factor(month), fill = Freq))

p1 <- p1 + geom_tile() + scale_fill_gradient(low = 'steelblue', high = 'darkred')

p1

绘图主题二：群中哪些人最活跃

#每个用户的说话频次

df <- as.data.frame(table(data$Name)

#这里挑出发言量前10的群员

top10 <- df[order(df$Freq, decreasing = TRUE),][1:10,]

))

#绘制没有排序的条形图

p2 <- ggplot(data = top10, mapping = aes(x = Name, weight = Freq, fill = Name)) + xlab(NULL) + ylab(NULL)

p2 <- p2 + geom_bar() + coord_flip() #+ scale_fill_manual(values = rainbow(10), guide = FALSE)

p2

#绘制排序的条形图

p3 <- ggplot(data = top10)+ xlab(NULL) + ylab(NULL)

p3 <- p3 + geom_bar(aes(x = reorder(Name, Freq), y = Freq, fill = Name), stat="identity") + coord_flip()

p3

绘图主题三：这群活跃的人都喜欢什么时候发言

#读取10人的发言汇总信息

my.data3 <- sqldf('select Name,hour,count(*) Freq from data where Name in (select Name from top10) group by Name,hour')

Encoding(my.data3$Name) <- 'UTF-8'

#绘制面积图

p4 <- ggplot(data = my.data3, mapping = aes(x = hour, y = Freq, fill = Name))

p4 <- p4 + geom_area() + facet_wrap(~Name) + scale_fill_manual(values = rainbow(10), guide = FALSE)

p4

绘图主题四：这段时间内，大家都聊了什么？

#分词

library(Rwordseg)

library(tmcn)

library(tm)

#读入自定义的停止词

my.stopwords <- readLines('stopwords.txt', encoding = 'UTF-8')

#添加自定义词汇

insertWords(c('顺丰','外卖','快递','娜娜','丽娜','9楼','10楼','小李','帐号','it','IT','客服','楼下','门禁'))

#根据分词结果再一次添加自定义停止词

my.stopwords <- c(my.stopwords, '下','人','图片','表情','号','好','请','录','机','群')

segwd1 <- unlist(segmentCN(strwords = data$text))

Encoding(segwd1) <- 'UTF-8'

#剔除停止词

segwd2 <- segwd1[which((segwd1 %in% my.stopwords) == FALSE)]

#分词后的词语频率汇总

wdfreq <- as.data.frame(table(segwd2))

#排列语频顺序

wdfreq <- arrange(df = wdfreq, Freq, decreasing = TRUE)

#取出前50的词频

wdfreq <- wdfreq[1:50,]

前50的词频格式如下图所示（图中记录了每个词语的出现频次）：

#绘制文字云

library(wordcloud)

par(bg = 'black')

wordcloud(words = wdfreq$segwd2, freq = wdfreq$Freq, random.color=TRUE, colors=rainbow(10))

参考资料

http://toutiao.com/a6195625237992964354/

R语言与网站分析

总结：文中涉及到的R包和函数

stats包

regexpr()

substring()

rbind()

transform()

table()

%in%

sqldf包

sqldf()

plyr包

arrange()

ggplot2包

ggplot()

geom_tile()

scale_fill_gradient()

geom_bar()

geom_area()

facet_wrap()

scale_fill_manual()

Rwordseg包

tm包

insertWords()

segmentCN()

wordcloud包

wordcloud()