干货：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()