一梦江湖费六年——QQ群聊天分析

本文结构：

一、那些年我们加过的QQ群

二、数据读入和整理（一）——来自蓝翔的挖掘机

二、 数据读入和整理（二） ——你不知道的事

三、聊天宏观（1）——寤寐思服

三、聊天宏观（2） 日月篇

三、聊天宏观（3）七曜 篇

四、聊天微观（1） ——黄金档和午夜频道

四、聊天微观（2） ——充电两小时聊天五分钟

四、聊天微观（3） ——幸存者偏差和沉默的羔羊

五、昵称（1） ——我们曾经的非主流

五、昵称（2） ——所爱隔山海

六、内容分词——爱在心口难开，你我之间隔了正无穷个表情包

好吧，我的来捣乱的，原谅我瞎取名字吧，最近真实超喜欢 小椴在他的作品里到处种诗啊，真是忍不住我也要到处放！ ~UC震惊部我大概是去不了了

另，本文是在参考/模仿，甚至可以说是抄袭别人的基础上所作，希望原作者见谅

一梦江湖费五年。归来风物故依然。相逢一醉是前缘。

迁客不应常眊矂，使君为出小婵娟。翠鬟聊著小诗缠。

                                                       ——苏轼《浣溪沙》

        

• 一、那些年我们加过的QQ群
  

    如果标题要这么起的话，那我要想起“刹那芳华尽，弹指红颜老”，想起那个叫做刹那的群来，想起那些人儿来，我加入他们已经六载有余。你要说这是什么鬼名字——不知所踪的群主大概要说“情不知所起”，我想应该是自取《天龙八部》回三十有五，恰这恩怨情仇，也当如无崖子、天山童姥、李秋水之间外加一个李沧海一般复杂了。

          每一个QQ群都有其消亡史， 只怨人在风中，聚散都不由你我

    与其盖棺定论、盗墓考古，不如生前来晒晒太阳。

    当然，我还是舍不得拿它开刀的，所以选择某活跃度适中的群开扒

    

如何导出可分析的QQ群聊天记录？

注意轻聊版没有此功能

选择群——右键——导出

2 保存时选择为txt格式 （尘封旧物，应有戌时的光打着）

数据格式如下：

• 二、数据读入和整理（一）——来自蓝翔的挖掘机
  

寻龙点穴，翻山倒斗，蓝翔挖掘机不可或缺，大概总以蓝翔代山寨，本文既然是一通抄袭，那用这辍学少年必备，小朋友最爱的挖机来挖挖数据是最合适不过的。

# 1读入数据

1. file_data <- read.table('数据分析1excel spss.txt',
   
2. stringsAsFactors = F,
3. encoding = "UTF-8",sep='\n',
4. quote=NULL)

stringsAsFactors = F字符不转为因子

encoding = "UTF-8"是设置解码格式，为了防止中文乱码

sep = '\n'按照行分隔，把txt中的每一行作为数据框 file_data 的一行

注意，如果不加 quote = NULL ，则会出错(部分文件不需要加)

读到的数据如下：

(部分聊天数据后面居然还跟着/n，那我们到时候剔除掉好了)

#2定义数据框和变量

1. data <- data.frame(user_name = c(), datetime = c(), text = c())
2. user_name <- character()
3. datetime <- character()
4. text <- character()

#分解数据为名字、时间、和文本(聊天内容)

1. for(i in 1:dim(file_data)[1]){
2. dt_pattern <- regexpr('[0-9]{4}-[0-9]{2}-[0-9]{2} [0-9]+:[0-9]+:[0-9]+',file_data[i,])
3. if(dt_pattern == 1) {
4. user_begin <- dt_pattern+attr(dt_pattern,'match.length') + 1
5. user_end <- nchar(file_data[i,])
6. user_name <- substring(file_data[i,],user_begin,user_end)
8. dt_begin <- dt_pattern
9. dt_end <- dt_pattern+attr(dt_pattern,'match.length')-1
10. datetime <- substring(file_data[i,],dt_begin,dt_end)
12. text <- file_data[i+1,]
14. data <- rbind(data, data.frame(Name = user_name,datetime = datetime,text = text))
15. }
16. }

正则表达式: [0-9]{4}-[0-9]{2}-[0-9]{2} [0-9]+:[0-9]+:[0-9]+

年-月-日 时:分:秒———— 这作为一个整体

关于regexpr函数

1. regexpr returns an integer vector of the same length as 
2. text giving the starting position of the first match 
3. or -1 if there is none, 
4. with attribute "match.length", 
5. an integer vector giving the length of the matched text (or -1 for no match).
6. 

7. The match positions and lengths are in characters unless useBytes = TRUE 
8. is used, when they are in bytes. 
9. If named capture is used 
10. there are further attributes "capture.start", "capture.length" and "capture.names".

亦即匹配则返回一个整型向量

(这个向量中的值表示的是text中满足正则条件的那个串的第一个家伙在text中的位置)， 不匹配则返回-1

例子：

1. > pattern <- '[0-9]{4}-[0-9]{2}-[0-9]{2}'
2. > strings <- "我 测试1 2016-07-12 14:13:45 测试2 2016-07-12 "
3. > regexpr(pattern, strings,
4. + useBytes = FALSE)
5. [1] 7 #返回值
6. attr(,"match.length") #属性match.length
7. [1] 10
8. > length(strings)
9. [1] 1

match.length属性的值存储所匹配的那个串的长度（感觉自己在撸串）

观察数据:

即 

年月日 时分秒 用户名

消息内容

1. user_begin <- dt_pattern+attr(dt_pattern,'match.length') + 1
2. user_end <- nchar(file_data[i,])
3. user_name <- substring(file_data[i,],user_begin,user_end)

user_begin 是用户名起点

attr (变量 ,属性名 )的意思本应是取/ 赋属性

实际上应该是当 match.length 属性存在且右侧有<-时是赋值,否则就是取 match.length 属性的值

user_end是用户名终点

nchar 就是得到一个字符串的长度(有多少个)，举个例子

1. 1. > x <- c("asfef", "qwerty", "yuiop[", "b", "stuff.blah.yech")
   2. > nchar(x)
   3. [1] 5 6 6 1 15
   4. > nchar(deparse(mean))
   5. [1] 18 17
   6. > deparse(mean)
   7. [1] "function (x, ...) " "UseMethod(\"mean\")"

deparse是一个可以将一个任意的R对象转化为字符串的的函数

1. nchar takes a character vector as an argument and 
2. returns a vector whose elements contain the sizes of
3. the corresponding elements of x.

user_name是发布 该条聊天记录的用户的用户名

substring(被截取的字符串，截取起点，截取终点)

datetime是该条聊天记录的发布的时间

text是消息内容(从数据格式可以看到，紧随在下一行)

• 二、数据读入和整理（二）——你不知道的事

如果你听过这首《你不知道的事》，一定觉得它很温柔，但生活并不如歌——多的是你不知道的事。

上面的操作看起来很完美，但是问题出现了，如果该QQ账号发布的消息本身没有换行，那么就算他发布的消息内容很多也会被封装为一行，但如果消息本身就换行了呢？

比如下面这种:

以及，部分是系统消息，比如xxx分享了xxx文件

所以我将上述代码修改为:

1. file_data <- read.table('数据分析1excel spss.txt',
2. stringsAsFactors = F,
3. encoding = "UTF-8",sep='\n',
4. quote=NULL)
5. head(file_data)
6. #2定义数据框和变量
7. data <- data.frame(user_name = c(),
8. datetime = c(), text = c(),
9. stringsAsFactors = F)
10. user_name <- character()
11. datetime <- character()
12. text <- character()
14. user_name <- character()
15. datetime <- character()
16. text <- character()
18. # file_data <- file_data[1:110,,drop=F]
19. class(file_data)
20. #分解数据为名字、时间、和文本(聊天内容)
21. pattern <- '[0-9]{4}-[0-9]{2}-[0-9]{2} [0-9]+:[0-9]+:[0-9]+'
22. 

23. j <- 1
24. for(i in 1:dim(file_data)[1]){
25. dt_pattern <- regexpr(pattern,file_data[i,])
26. if(dt_pattern == 1) {
27. if(i >5 & (i-j)>2){
28. for(k in (j+2):(i-1)){
29. last <- dim(data)[1]
30. data[last,3] <-
31. paste(data[last,3],file_data[k,],sep="")
32. }
33. }
34. user_begin <- dt_pattern+attr(dt_pattern,'match.length') + 1
35. user_end <- nchar(file_data[i,])
36. user_name <- substring(file_data[i,],user_begin,user_end)
38. dt_begin <- dt_pattern
39. dt_end <- dt_pattern+attr(dt_pattern,'match.length')-1
40. datetime <- substring(file_data[i,],dt_begin,dt_end)
41. text <- file_data[i+1,]
42. data <- rbind(data, data.frame(Name = user_name,datetime = datetime,
43. text = text,stringsAsFactors = F))
44. j <- i
45. }
46. }
47. datasave <- data

注意1

两处stringsAsFactors = F的设置

注意2

新增了一个if判断，以避开连续

• 三、聊天宏观（1）——寤寐思服
  

        渺万里层云，千山暮雪，只影向谁去

    如果你暗恋一个妹纸，你一定会埋伏在她的在线时刻，乘隙找她聊几句，“ 求之不得，寤寐思服。悠哉悠哉，辗转反侧 ”，我们还是观察下她在什么时候发言较多吧（表明她有闲暇且有交流欲望）。以此类推，尽管，我们这里都是基佬或女汉子......但是但是！骚年如果你要提问，不也应该选择在人多的时候嘛？这样你获得答案的概率也更高。

那么就让我们来看看大家都喜欢在什么时候上线聊天吧

1. library(sqldf)
2. # lubridate包是为了方便取日期数据的
3. library(lubridate)
4. library(ggplot2)
5. library(ggthemes)
6. #######################################################第二部分
7. #每天的消息都有多少？
8. time <- data$datetime
9. p <- paste(year(time),month(time),day(time),sep = "-")
10. tail(p,50)
11. Timed <- data.frame(days = p)
12. mydata1 <- sqldf('select days iddays,count() Freq from
13. Timed group by days')
14. #不要加AS
15. mydata1 <- mydata1[order(as.Date(mydata1$iddays)),]
16. head(mydata1)
17. ggplot(mydata1,aes(x=as.Date(iddays),y=Freq))+
18. geom_area(fill='mediumpurple1',alpha=0.5)+
19. geom_point(shape="♠",size=3,colour='salmon')+
20. xlab("时间")+ylab("消息密集度")+
21. theme_solarized_2()

1其中 sqldf 包可以 按照sql的方式来查询dataframe的内容

2其中 lubridate 包是用来操作日期数据的(如month、day、hour等函数)

3要想达到这样的效果，只要用搜狗插入（所有的符号大全里，并不是所有的符号都支        持，挑选几个试试就好啦~），通过alpha设置透明度。

4  order ( as . Date ( mydata1$iddays )) 要先转化为日期格式再使用order，不然字符串是识别不了顺序的。

5  回忆下：order给出升序排序时，应该排在第一位的那个数，在当前的第几个位置，其他的以此类推。比如 a[order(a)]就是对向量a升序排序。

这个图画的是每一天的消息记录条数

可见我的样本其实是不全的，基本上集中在7月至9月，而9月到12月的数据是空白，而1月-2月数据又重新开始出现，嗨，了解我的人大概知道为什么我那段时间不在的了。

• 三、聊天宏观（2）日月篇
  

     日月忽其不淹兮，春与秋其代序

    

     大家喜欢在哪几个月的哪些天扯淡呢？

1. Time <- data.frame(year = year(time),
2. month = month(time),
3. day = day(time),
4. hour = hour(time))
5. my.data2 <- sqldf('select month,day,count(*) Freq from Time
6. group by month,day')
7. head(my.data2)
8. p2 <- ggplot(data = my.data2,
9. mapping = aes(x = factor(day), y = factor(month),
10. fill = Freq))
11. p2 <-p2+geom_tile()+
12. scale_fill_gradient(low = '#2ecc71',
13. high = '#e74c3c')+
14. xlab("所在天数")+
15. ylab("所在月份")
16. p2
17. p2+theme_solarized_2()

tile在英语中的意思是地砖、瓦片,很形象吧？

scale_fill_gradient函数作用是设置高频率和低频率各自的颜色

效果如下：

那些黑色的块，其实就是缺失值吧。

由于缺失值的存在，让我觉得自己是卖狗皮膏药的，所以 上个主题吧

但是我又想起《晚秋》，总感觉自己像是吃软饭的....所以！

1. my.data2
2. <- sqldf('select month,day,count(*) Freq from Time
3. group by month,day')
4. #方式一
5. #生成序列
6. date <- seq.Date(from=as.Date('2016-01-01'),
7. to=as.Date('2016-12-31'), by='1 day')
8. head(date)
9. library(lubridate)
10. months <-month(date)
11. days<-day(date)
13. #构建一个数据框
14. dataf <- data.frame(month = c(),
15. datetime = c(),
16. text = c())
17. all <- paste(months,days,sep = "")
18. my.data2all <- paste(my.data2[,1],my.data2[,2],sep = "")
19. pos <- match(all,my.data2all)
20. for(i in 1:length(days)){
21. dataf[i,1] <- months[i]
22. dataf[i,2] <- days[i]
23. if(!is.na(pos[i])){
24. dataf[i,3] <- my.data2[pos[i],3]
25. }else{
26. dataf[i,3] <- NA
27. }
28. }
29. colnames(dataf) <- c("month","day","Freq")
30. library(ggplot2)
31. p1 <- ggplot(data = dataf,
32. mapping = aes(x = factor(day), y = factor(month),
33. fill = Freq))
34. p1 <-p1+geom_tile()+
35. scale_fill_gradient(low = '#2ecc71',
36. high = '#e74c3c',na.value="#ecf0f1")+
37. xlab("所在天数")+
38. ylab("所在月份")
39. p1

效果如下：

是的，你没看错， na . value 这个参数就是这么坑爹，只有当值为NA的时候才发挥作用(毕竟Freq可以是NA，但是x和y还是要存在才可以啊)，所以我就用上述代码自己拼接了一个数据框出来

可是，虽说箪食瓢饮回也不改其乐，但这个看脸的年代，脸上有几颗痘痘，衣服上有几块补丁，实在是苦啊~！

所以，就别怪我整容了！

1. d <- rep(1:31,12)
2. m <- rep(1:12,each =31)
4. all <- paste(m,d,sep = "")
5. all
6. my.data2all <- paste(my.data2[,1],my.data2[,2],sep = "")
7. pos <- match(all,my.data2all)
9. for(i in 1:length(d)){
10. dataf[i,1] <- m[i]
11. dataf[i,2] <- d[i]
12. if(!is.na(pos[i])){
13. dataf[i,3] <- my.data2[pos[i],3]
14. }else{
15. dataf[i,3] <- NA
16. }
17. }
18. colnames(dataf) <- c("month","day","Freq")
19. library(ggplot2)
20. p1 <- ggplot(data = dataf,
21. mapping = aes(x = factor(day), y = factor(month),
22. fill = Freq))
23. p1 <-p1+geom_tile(colour="papayawhip")+
24. scale_fill_gradient(low = '#2ecc71',
25. high = '#e74c3c',na.value="peachpuff")+
26. xlab("所在天数")+
27. ylab("所在月份")
28. p1

虽然说有可能整残了，不过呢，不整一整，是不会死心哒

              

• 三、聊天宏观（3）七曜篇
  

阴阳为之愆度，七曜为之盈缩——“谓之七曜者，日月五星皆照天下，故谓之曜”

那么大家喜欢在星期几呢？

1. # 大家喜欢在星期几聊天呢？
2. weekdays <- wday(data$datetime)
3. p3 <- ggplot(data = NULL,
4. mapping = aes(x = weekdays,
5. fill = factor(weekdays)))
6. labels <- c("周一","周二","周三",
7. "周四","周五","周六","周日")
8. p3+geom_bar(show.legend = F,alpha=0.6)+
9. scale_x_continuous(breaks = seq(1,7,by=1),
10. labels = labels)+
11. xlab('星期几')+ylab('消息条数')+
12. theme_solarized_2()

设定了alpha， 通过labels设定了坐标轴标签，这里的breaks和labels的长度要一致

看来周一大家都忙着干活，嗯，第一天嘛，肯定是很多事情的了，周四就开始有怠工的情绪了，到周五，真是按耐不住周末到来的喜悦啊，喜迎工人阶级对资本家们的伟大胜利——终于放假啦！最大值就出现在工作日，老板你心里怎么想？我这是业务交流啊业务交流！....周六的消息也蛮多的，个人觉得，要么大家都是没有女票的死宅，要么...大概是在一把辛酸泪的加班吧。

• 四、聊天微观（1）——黄金档和午夜频道
  

小时候我们有的八点黄金档，后来我们学会了熬夜

大家喜欢在一天里的那些时间扯淡呢？

1. my.data3 <- sqldf('select hour,count(*) Freq from Time
   
2. group by month,day')
3. #取得了小时的频率
4. #(Freq的意思是计数后的频率存在名为Frequency的列)
5. head(my.data3)
6. #查看数据后发现有相同值
7. #于是我们打算合并之
8. mydata3 <- my.data3
9. 

10. #需要这一步是因为如果写的是my.data3会识别不了
11. my.data23 <- sqldf('select hour,SUM(Freq) Freq from mydata3
12. group by hour')
13. head(my.data3)

1. ggplot(my.data3,aes(x=hour,y=Freq))+
2. geom_area(fill='cadetblue2',alpha=0.5)+
3. geom_line(linetype = "dotdash",colour='brown2',
4. size=1.2,alpha=0.9)+
5. geom_point(shape="★",size=3,colour='brown1')+
6. scale_x_continuous(breaks = seq(8,23,by=1),
7. labels = seq(8,23,by=1))+
8. xlab("时间")+ylab("消息密集度")+
9. theme_solarized_2()

出图如下：

早上：

你看，早起干活的人很少呐 （早于8点的消息记录是0,当然，对于有固定上班时间的白领们而言，早起是不合理的）

早上大家基本上忙着干活（8点到12点），老板快发员工奖！

中午：

中午吃饭是没人扯淡的（12-13点之间）

下午：

吃完午饭闲扯个蛋(14点出现一个小浪尖)

开始活跃起来了

下午4点之后大家基本上开始怠工啦，消息开始增加，在下班前达到峰值。

晚上:

大家都得浪费时间在下班路上/吃饭（18--19点之间），这个点也没人。

20点次峰开始出现，所以说黄金档 八点整 不是白叫的，看肥皂剧或者泡论坛闲扯

都在这个时间段，聊天也在这个点也很合乎逻辑。

21点的下降可以认为部分人已经开始准备洗漱和入睡，在东部对于第二天还要上班的同学把10点左右设为上床时间也蛮正常，不过具体是上床玩手机还是睡觉是个问题呐，反正不跟基友们瞎扯了，毕竟还有妹子/游戏/小说呢？

夜猫子总是很顽强的.....大概是夜猫军团源源增兵，也许是没有女票的猿们上床了还是跟基友们扯淡，峰值居然出现在23点。好吧，不是跟老板说好了——感觉身体被掏空？不知道这个午夜频道有没有福利呢？

剧情反转:

上面我们提到聊天消息最多的日子出现在一周的周五，看起来好像大家是怠工了，但实际上未必如此，从这里的消息时间来看，大家还是很有职业道德的，赞一个，老板你感动吗？因为大家的聊天基本上集中在下午4点之后，所以相信大家还是在认真完成工作的前提下在群里灌灌水的。看来周五真是让人想来一个生命的大和谐。

• 四、聊天微观（2）——充电两小时聊天五分钟
  

充电五分钟，通话两小时，其实并没什么卵用，事实是我们很遇到愿意跟你持续沟通的对方，往往就是满格的电池容量，空荡荡的聊天列表。 

如果一条消息五分钟都没有得到回应，那么就算是断裂了，这作为一组对话。

1. #连续聊天的次数
2. # 连续对话的次数，以五分钟为间隔
3. data$realtime <- strptime(data$datetime,'%Y-%m-%d %H:%M')
4. # 时间排序没有问题
5. # （毕竟我是读取txt后提取的，人家腾讯帮我搞好了）
6. head(data)
7. # 将数据按讨论来分组
8. group <- rep(1,dim(data)[1])
9. head(group)
10. for (i in 2:dim(data)[1]) {
11. d <- as.numeric(difftime(data$realtime[i],
12. data$realtime[i-1],
13. units='mins'))
14. if ( d < 5) {
15. group[i] <- group[i-1]
16. #小于5分钟的,我们认为是同一组对话
17. }
18. else {group[i] <- group[i-1]+1}
19. #大于5分钟，就是一组新的对话的看，所以连续对话的组数+1
20. }
21. head(group,20)
22. tcon <- as.data.frame(table(group))
23. head(tcon)
24. p4 <- ggplot(data = tcon,
25. mapping = aes(x =group,y=Freq)
26. )
27. p4 +geom_bar(aes(x = group, y = Freq,
28. col='red',alpha=0.5),
29. show.legend=F,
30. stat="identity")+
31. xlab('连续聊天次数')+ylab(NULL)+
32. theme(axis.text.x = element_blank(),
33. axis.ticks.x = element_blank())

1 为什么需要 as . data . frame ( table ( group )) 呢？转化为数据框很有必要，虽然你查看class的时候，看到table函数的返回结果是一个数据框，但实际取数据的时候一些扯淡的问题就开始出现啦~

实际上，上述图形是毫无意义的。正确的做法是，选出一条内的聊天消息数大于均值的那些天，然后计算那些天的连续聊天组数

一天才多少分钟？60*24=1440分钟，每5分钟为一组的话，有288组， 如果考虑到有效聊天时间集中在8点-234点，那么实际上最大值只有192组。

连续聊天组数普遍较低，说明大家不会总是聊着聊着人就不见了，有些人呐，“吟安一个字,捻断数茎须”，回消息有一搭没一搭，也的确令人惊奇。

• 四、聊天微观（3）——幸存者偏差和沉默的羔羊
  

 如果我告诉你整个群有近1800个成员，你是什么感受呢？茫茫人海，我们都是成群的羔羊，既不会相遇，还保持着沉默。

哪些人最喜欢聊天？取出前20名

1. #活跃用户前20名
2. #每个用户的说话频次(取前20名)
3. mydf <- as.data.frame(table(data$Name))
4. #前20名活跃的群成员
5. names(mydf)[1]="Name"
6. top20 <- mydf[order(mydf$Freq, decreasing = TRUE),][1:20,]
7. #绘制没有排序后的条形图
8. p5 <- ggplot(data = top20,
9. mapping = aes(x = Name,
10. weight = Freq,
11. fill = Name)) +
12. xlab(NULL) + ylab(NULL)
13. p5 <- p5 +geom_bar(aes(x = reorder(Name, Freq),
14. y = Freq, fill = Name,
15. alpha=0.5),show.legend=F,
16. stat="identity") +
17. coord_flip()+
18. theme_solarized_2()
19. p5

出图如下：

（抱歉，并未给大家打上马赛克）

那么这些前20又喜欢在什么时候发言呢？

事实上，他们的发言量占据了52.13%

1. > head(sum(top20$Freq))/sum(all$Freq)
2. [1] 0.5213432

所以说互联网上的的幸存者偏差严重吧？占据了一半的数量。

我们注意到系统消息占据第四，所以刨掉系统消息

1. > head(sum(top20$Freq[-4]))/sum(all$Freq)
2. [1] 0.47786

前20名仍然占据着消息流量的47.786%

我想，知乎大概也是一样的，占据言论主导权的，基本上是敢于发言，有能力输出文字和表达的人吧？ 何不食肉糜之类的问答屡见不鲜， 所以说知乎上的收入高么？我相信，如果没有知乎，不少所谓大V他们的收入可能要下降一个档次呢。

• 四、聊天微观（3）——英雄惜英雄，扼腕于墓道也
  

忆得歌翻肠断句，更惺惺言语

大V抱团，跟英雄所见略同，英雄惺惺相惜，大概是一个道理

然， 庄王未绝弦， 季子仍佩剑，不能墓道 扼腕 ， 发其志士之悲，不过鸟兽尔

# 前10名之间的关系（毕竟人多嘴杂，咱还是少分析点）

说英雄谁是英雄，英雄惺惺相惜

前10的社交网络关系

1. # 前10名之间的关系
2. data$group <- group
3. dfName <- as.data.frame(table(data$Name))
4. #前20名活跃的群成员
5. names(dfName)[1]="Name"
6. top10 <- dfName[order(dfName$Freq, decreasing = TRUE),][1:10,]
7. head(top10)
8. class(top10$Name)
9. library(stringr)
10. library(plyr)
11. library(reshape2)
12. library(igraph)
13. netdata <- dcast(data, Name~group, sum,
14. value.var='group',
15. subset=.(Name %in% as.character(top10$Name)[1:10])
16. )
17. #value.var=指定值是来自group
18. #subset=.指定来自子集
19. netdata1 <- ifelse(netdata[,-1] > 0, 1, 0)
20. #newdata1[,-1]就是去掉了ID后的
21. rownames(netdata1) <- netdata[,1]
22. relmatrix <- netdata1 %*% t(netdata1)
23. # 很容易看出哪两个人聊得最多
24. deldiag <- relmatrix-diag(diag(relmatrix))
25. which(deldiag==max(deldiag),arr.ind=T)
27. # 根据关系矩阵画社交网络画
28. g <- graph.adjacency(deldiag,weighted=T,mode='undirected')
29. g <-simplify(g)
30. V(g)$label<-rownames(relmatrix)
31. V(g)$degree<- degree(g)
32. layout1 <- layout.fruchterman.reingold(g)
33. egam <- (log(E(g)$weight)+1) / max(log(E(g)$weight)+1)
34. V(g)$label.color <- rgb(79,148,205, 255,max = 255) #字体的颜色
35. V(g)$label.degree <- pi
36. V(g)$label.dist <- 1.5
37. V(g)$frame.color <- 'springgreen4' #圈子的颜色
38. V(g)$shape <- 'sphere'
39. V(g)$label.cex <- 0.7
40. E(g)$width <- egam
41. E(g)$color <- rgb(255, 181, 205, egam*255,max = 255)#线的颜色
42. plot(g, layout=layout1,
43. vertex.color= rgb(255, 181, 205, 197,max = 255))

效果如下：

• 五、昵称（1）——我们曾经的非主流
  

打开你的QQ空间/人人/豆瓣，我们发过的内容和去过的昵称，谁没有非主流过呢？

QQ群昵称的分析，分解下用户的群昵称

由于许多群会要求大家修改备注为城市，职业，这样就可以看看大家所在地和行业分布

当然，也有一些人是不改的

1. #提取用户名部分
2. dfall <- as.data.frame(table(data$Name))
3. names(dfall)[1]="Name"
4. allUserFreq<- dfall[order(dfall$Freq, decreasing = TRUE),]
5. write.csv(allUserFreq,"Users.csv")
7. #设计数据框
8. dataQQ <- data.frame(user_QQ = c(),
9. nikename = c())
10. user_QQ <- character()
11. nikename <- character()
12. #提取出昵称（群昵称）
13. pattern2 <- '\\([0-9]{5,11}\\)'
14. for(i in 1:length(allUserFreq$Name)){
15. str <- as.character(allUserFreq$Name[i])
16. reg <- regexpr(pattern2,str)
17. qq_begin <- reg+1
18. qq_end <- reg+(attr(reg,'match.length')-1)-1
19. user_QQ <- substring(str,qq_begin,qq_end)
20. # browser()
21. nikename <- substring(str,1,reg-1)
22. dataQQ <- rbind(dataQQ,
23. data.frame(QQ = user_QQ,
24. nikename = nikename))
25. }
26. dataQQ
27. write.csv(dataQQ,"QQ.csv")#保存一下

分词

1. #分词
2. library(Rwordseg)
3. library(tmcn)
4. library(tm)
5. #写出又读入
6. write.table(dataQQ$nikename,"QQ.txt",row.names = F)
7. segmentCN("QQ.txt",returnType="tm")
8. nikename_text=readLines("QQ.segment.txt",encoding = "UTF-8")
10. word = lapply(X = nikename_text, FUN = strsplit, "\\s")
11. word1=unlist(word)
12. #统计词频
13. dfname=table(word1)
14. dfname=sort(dfname,decreasing = T)
15. head(dfname)
16. #把词汇词频存入数据框
17. namedf = data.frame("word" = names(dfname),
18. "freq" = as.numeric(dfname))
19. # 过滤掉1个字和词频小于10的记录
20. d <- subset(namedf,
21. nchar(as.character(namedf$word))>1 & namedf$freq >= mean(dfname))
23. #加载包和清洗后的数据
24. library(wordcloud2)
25. head(d)
26. wordcloud2(d, size = 1, shape='star',
27. color = 'random-dark',
28. backgroundColor = "white",
29. fontFamily = "微软雅黑")
30. write.csv(d,"分词1.csv")

出图如下:

北上广深等主要城市赫然在列，其他主要省会城市也都不少。

而数据、互联网、金融这三个行业关键字也身在其中（真是到哪都能看见既然你），果然这是近两年很火爆的行业，尤其是数据，而零售、商品等行业也在列。统计、运维、DT、学生等职业信息也是一样的。

鉴于很多人的群昵称乱写,或者喜欢填一些奇怪的表情或符号，所以很可能在分词的失衡没有解析出来，变成空的，这个很难用代码去操作了，只能人为的 删掉了那么几个，得到如下的excel

容我偷个懒，用excel做两张图

前8个关键字就占据了一半

图1

图2

• 五、昵称（2）——所爱隔山海啊~
  

一望可相见，一步如重城。所爱隔山海，山海不可平

为了表示群里来自五湖四海的基友们互相之间满满的基情，我也只有这么肉麻他们了

取出里面所有的地名然后作图

不行不行还是不能偷懒

偷懒可以用地图慧——

：领导，您办公室的地图已经到货了，这就给您挂上

：什么？怎么少了高丽行省？

我都懒得去水印！ 

但是！

鉴于REmap不能识别省分和城市混排的，所以我就全部合并为省份

所以我整理了下数据，将之合并为省份

1. library(REmap)
2. mymap <- read.csv("city.csv",header=T)
3. head(mymap)
4. remapC(data=mymap,title='群成员分布图',
5. maptype = "china",color=c('#CD3333'),
6. theme=get_theme("Bright"))

其中REmap（在github上）的安装方式为：

1. library(devtools)
2. install_github('lchiffon/REmap')

这样不就实现大和谐了嘛？

北上广(深圳被合并在广)依然遥遥领先，当然，这仅是填写了城市的数据，并不能反映全部，感觉主要还是在高校聚集区相对容易出现从业人员集中现象，遗憾的是浙江和江苏未能扛起东部的大旗，而西部的四川遥遥领先，贵州喊了几年大数据，大概也有点从业人员？比起西部几个省也算不太打脸了。

广东省各个市的数据

1. gd <- read.csv("guangdong.csv",header=T)
2. remapC(data=gd,title='广州群成员分布图',
3. maptype = "广东")

注意要在每个市后面加“ 市 ”字，否则无法识别，比如说要写深圳市，而不是深圳。

我们还是搞一个美食地图吧。。。

数据如下：

广州的发展水平的区域差异可见一斑，貌似广州的从业人员比深圳的还多点。

比如我还可以看看北上广深各自是那些人最活跃，选出区域明星，不过我真的没力气倒腾了。

• 六、内容分词——爱在心口难开，你我之间隔了正无穷个表情包
  

就你图多系列，你们到底有多喜欢喜欢发图和表情呢？连这群基佬们都不能例外

看看大家都用喜欢聊些什么

1. library(Rwordseg)
2. library(tmcn)
3. library(tm)
4. #群消息分词
5. #分词
6. write.table(data$text,"text.txt",row.names = F)
7. segmentCN("text.txt",returnType="tm")
8. text1=readLines("text.segment.txt",encoding = "UTF-8")
10. word = lapply(X = text1, FUN = strsplit, "\\s")
11. word1=unlist(word)
12. #统计词频
13. df=table(word1)
14. df=sort(df,decreasing = T)
15. # 把词汇词频存入数据框
16. df1 = as.data.frame(df)
17. # 转为数据框的时候中文开始抽风，也是奇怪的很（变成/u的形式）
18. # 这种情况不定期出现，所以我干脆在这部分写了重新导入数据
19. head(df1)
20. #对列命名
21. datafreq <- data.frame(word = as.character(df1$word),
22. freq = df1$Freq,
23. stringsAsFactors = F)

2. #过滤掉数字或者3个以下的字母
3. a <- integer()
4. for(i in 1:dim(datafreq)[1]){
5.   dreg <- regexpr('^[0-9]{1,15}$|^[a-zA-Z]{1,3}$',
6.                   datafreq[i,1])
7.   if(dreg == 1)
8.     a <- c(a,i)
9. }
10. datafreq <- datafreq[-a,]
11. #去掉频率低于均值的
12. mean(datafreq$freq)
13. datafreq <- datafreq[datafreq$freq >= mean(datafreq$freq),]

1. wordcloud2(datafreq, size = 1, shape='star',
2.            color = 'random-dark',
3.            backgroundColor = "white",
4.            fontFamily = "微软雅黑")

看到了吧？这么多表情和图片，这么多单个的无意义的词，我们还是在后面删掉好了

先删除最多的那四个单个汉字

1. head(datafreq)
2. #删去1:4这几个单词的汉字
3. wordcloud2(datafreq[-seq(1:4),], size = 1, shape='star',
4.            color = 'skyblue',
5.            backgroundColor = "white",
6.            fontFamily = "微软雅黑")

表情跟图片真是派大星的两个大盾牌啊.... 该配合我演出的演出的时候你视而不见，绵宝宝，我是你的派大星...

注意，skyblue是可以的，但是skyblue1....后面加上数据就不行啦

#删掉单个汉字

1. aa <- integer()
2. for(i in 1:dim(datafreq)[1]){
3.   dreg <- regexpr('^[\u4e00-\u9fa5]{1}$',
4.                   datafreq[i,1])
5.   if(dreg == 1)
6.     aa <- c(aa,i)
7. }
8. datafreq2 <- datafreq[-aa,]
9. wordcloud2(datafreq2, size = 1, shape='star',
10.            color = 'yellow',
11.            backgroundColor = "white",
12.            fontFamily = "微软雅黑")
13. head(datafreq2)

派大星应该是这个颜色才对（在太阳下脱水晒晒之后）那么，你是玩游戏输了贴纸条变僵尸？ 

#去掉图片和表情

1. a <- datafreq2[c(-1,-2),]
2. a
3. wordcloud2(a, size = 1, shape='star',
4.            color = 'random-dark',
5.            backgroundColor = "white",
6.            fontFamily = "微软雅黑")

哦，这是基佬们的表白墙啊~

“数据”占据最大头，可见聊天内容还是正常的，处在业务范围呢，

当然，"签到"这种无聊的行为占据大头，“问题”关键字还没法超过他，也是有点无语，           毕竟大家的目的是交流学习，而不是灌水。

“加入”说明信任还是不少的，

excel，spss的关键字也出现了，其他一些专业词汇也不少，大家自己看吧

当然，有趣的是，“工资”也出现了，说明大家还是会在群里吐槽下工资水平的。

“简单”这两个字出现的频率还不算太高，不然的话是很糟糕的，个人觉得，有问题就回            答问题不要装逼嘲笑新手，

#以下部分纯属娱乐。（感觉不准确）

#图标放在 D:\RSets\R-3.3.2\library\wordcloud2\examples

安卓图标

360图标

QQ图标

最后要感谢这么多人提供这么多资料和工具，帮助我完成这篇消遣之作

所有代码:

              

主要参考:

http://www.cnblogs.com/NaughtyBaby/p/5497714.html

https://zhuanlan.zhihu.com/p/25171755

null

附件列表