乾貨：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))

參考資料

手把手：R語言文本挖掘和詞雲可視化實踐 - 今日頭條(www.toutiao.com)

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()

----------------------------------------------------

作者：劉順祥

博客專欄：每天進步一點點2015

公眾號：每天進步一點點2015

最近很多人私信問我問題，平常知乎評論看到不多，如果沒有及時回復，大家也可以加小編微信：tszhihu，進知乎大數據分析挖掘交流群，可以跟各位老師互相交流。謝謝。