星期四, 十二月 13, 2012

来玩玩QQ群的数据

上周COS论坛上有位老兄发布了一个关于QQ群的数据,正好拿来玩玩。这批数据并不复杂,只有两列,一列是用户名,一列是用户发言时间,不过从这批数据中仍然可以得出一些好玩的东西,且让本人一一道来。



先对数据进行整理,然后以时间维度进行数据汇集,观察各周的发言分布情况。可以看到周一和周日聊天不多,难道说是周一大家都比较安心上班?下图是对不同的时间段进行数据汇集,观察是白天上班的时间聊天比较多,下午4、5点下班前形成高峰。

然后还可以根据用户名来汇集发言频数,获得发言最多前十大用户
用户 频数
7cha18 1498
6cha4376 1209
4cha3875 1079
8cha083 691
4cha698 528
1cha65314 438
acha@vip.qq.com 372
2cha1 350
5cha80 296
3cha4233 294


此外,若用户在一天之内有发言,则视为活跃,下面是计算出来的活跃天数的十大用户。


6cha4376 160
4cha3875 147
7cha18 109
acha@vip.qq.com 89
4cha698 87
2cha1 77
8cha083 74
1cha457 58
1cha59002 53
8cha08 50


再来观察每天的发言次数变化,可见QQ群在2012年初讨论热烈,而在最近几个月则趋于平淡,末日准备中?
观察每天活跃用户变化,最多一次达到40人,而一般都是在10人左右。
当某天活跃人数增加的话,发言数也会增加吗?  是的,是有这个情况。
前十大发言最多用户我们暂称为十大话唠,这十大的日内发言情况如何?平行坐标图可以观察到他们的QQ群发言习性。
之前的时间划分是按天来计算,下面将时间窗口划分得更细一些,如果两个发言间相隔30分钟,则认为一次群讨论结束,另一次新的群讨论开始(这个思路是听R会议上肖嘉敏说的)。下面按照群讨论来观察数据。将数据按讨论来分组,得到719次群讨论。然后可以根据一次群讨论为时间单位为观察发言次数和参与用户,这和前面的计算是差不多的,就不再重复。好玩的地方在于,可以根据用户是否参与同一次群讨论来建立他们之间的关联程度。从下面社交图可看到,6cha4376和4cha3875的关系最为密切,有基情?(我用igraph画图总是不如人家好看啊,唉,有没人教教我)
代码如下,请多批评

# 数据读入
data <- read.csv('qq.csv',T,stringsAsFactors=F)
data <- data[-nrow(data),] # 最后一行有问题,删除
 
library(stringr)
library(plyr)
library(lubridate)
library(ggplot2)
library(reshape2)
library(igraph)
 
# 数据整理
# 将字符串中的日期和时间划分为不同变量
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')
 
# 合并数据
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)
 
# 关于时间的一元描述
# 观察时间相关各变量的频数分布
# 周一和周日聊天不多,难道说是周一要安心上班?
qplot(wday,data=newdata,geom='bar')
# 白天上班的时间聊天比较多嘛,下午形成高峰。
qplot(hour,data=newdata,geom='bar')
 
# 关于用户的频度描述
# 前十大发言最多用户
user <- as.data.frame(table(newdata$id))
user <- user[order(user$Freq,decreasing=T),]
user[1:10,]
topuser <- user[1:10,]$Var1
 
# 活跃天数计算
# 将数据展开为宽表,每一行为用户,每一列为日期,对应数值为发言次数
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)
tempdf <- data.frame(time=ymd(names(online.day )),online.day )
qplot(x=time,y=online.day ,ymin=0,ymax=online.day ,
      data=tempdf,geom='linerange')
ggsave('2.png')
# 观察到有少数峰值日,看超过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')
ggsave('3.png')
#直方图观察
qplot(x=numday,data=tempdf,geom='histogram')
 
# 当某天登录人数增加的话,发言数也会增加吗?   
tempdf <- data.frame(time=ymd(names(online.day )),people=numday,
                     speech=online.day)
 
qplot(x=people,y=speech ,
      data=tempdf,geom=c('point','smooth'))
 
# 再观察十强选手的日内情况
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()+
    opts(legend.position = "none")
 
# 连续对话的次数,以三十分钟为间隔
newdata$realtime <- strptime(newdata$time,'%Y/%m/%d %H:%M')
# 时间排序有问题,按时间重排数据
newdata2 <- newdata[order(newdata$realtime),]
# 将数据按讨论来分组
group <- rep(1,11279)
for (i in 2:11279) {
    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))
 
# 得到719多组对话
newdata2$group <- group
 
# igraph进行十强之间的网络分析
# 建立关系矩阵,如果两个用户同时在一次群讨论中出现,则计数+1
newdata3 <- dcast(newdata2, id~group, sum, 
                  value.var='group',
                  subset=.(id %in% topuser))
newdata4 <- ifelse(newdata3[,-1] > 0, 1, 0)
rownames(newdata4) <- newdata3[,1]
relmatrix <- newdata4 %*% t(newdata4)
# 很容易看出哪两个人聊得最多,6cha4376和4cha3875,有基情?
deldiag <- relmatrix-diag(diag(relmatrix))
which(deldiag==max(deldiag),arr.ind=T)
 
# 根据关系矩阵画社交网络画
g <- graph.adjacency(relmatrix,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)+ .2
V(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)

11 条评论:

  1. 最后的graph确实有点奇怪,每个节点跟其他所有节点都有联系,应该可以换种画法吧。但是又说不上怎么个不对劲,唉水平有限。

    回复删除
    回复
    1. 这是前十用户之间的联系,所以都有联系是对的,如果是所有用户都进来的话,可能就有比较孤独的点了。

      删除
    2. 所以我想这种情况的话,是不是应该不需要显示是否有关系,而只显示关系强弱就好了。不过好像做不到。

      删除
    3. 线的粗细可以表示关系强弱,就是比较丑。

      删除
    4. 蛤我想起来了,这幅图每两两间都有联系,所以"有联系"已经不重要,也许用levelplot会更好哦。

      删除
  2. 哈哈,终于可以自由翻墙了!

    我来研究研究大牛的代码!

    回复删除
  3. 看x大的博客,是我购买VPN的主因啊

    回复删除
  4. 能否介绍一下有哪些经济实惠的VPN?谢谢!

    回复删除
    回复
    1. 这....好偏题。我买的是一年的VPN。 90多元吧,应该还可以。

      删除