Rweibo里面记录了关注者的各项信息,其中比较有意思的一项是location,一个想法是,通过关注者的location(省市),可以找到他们的地理分布信息,同时,又可以得到他们的粉丝数目信息(可以判断是否是“微博名人”)。Rweibo的抓取顺序正是我的关注顺序,这些信息可以用可视化的形式表示出来,正好被我拿来练手。
首先,收集关注者的信息,并进行整理,我的做法是去除在“海外”或者所在地为“其他”的人群(如果市的信息为“其他”而省份不为“其他”,令它与省份相同)。整理工作的代码如下:
library(Rweibo)<br />
roauth <- createOAuth(app_name ="pudding", access_name = "rweibo")<br />
my_fri <- friendships.friends(roauth, uid=2530951134,count = 200,<br />
cursor = 0)<br />
save(my_fri,file="my_fri.rda")<br />
fri=my_fri[[1]]<br />
info1=lapply(fri,function(x) c(x$name,x$location,x$followers_count))<br />
info=do.call(rbind,info1)<br />
loc=strsplit(info[,2]," ")<br />
a=do.call(rbind,loc)<br />
a[,1][a[,1]=="台湾"]="台"<br />
a[,2][a[,2]=="台湾"]="台"<br />
a[,2][a[,2]=="其他"]=a[,1][a[,2]=="其他"]</p>
<p>myfri=data.frame(name=info[,1],province=a[,1],city=a[,2],loc=apply(a,1,paste,collapse=" ")<br />
,follower=as.numeric(info[,3]))<br />
myfri=myfri[which(myfri$province!="其他"&myfri$province!="海外"),]
</p>
不过,有了地理位置的名称是不够的,我们必须知道他们的经纬度信息,这一部分信息可以通过网页抓取而得:
library(XML)<br />
# get data from web<br />
webpage <-'http://blog.csdn.net/svrsimon/article/details/8255051'<br />
tables <- readHTMLTable(webpage,stringsAsFactors = FALSE)<br />
raw <- tables[[1]]<br />
zh_posi <- raw[-1,]<br />
colnames(zh_posi)=c("province","city","county","lon","lat")<br />
save(zh_posi,file="zh_posi.rda")<br />
zh_posi$loc=apply(zh_posi[,1:3],1,paste,collapse=" ")<br />
zh_posi[,4:5]=apply(zh_posi[,4:5],2,as.numeric)</p>
<p>get.loc<-function(loc)<br />
{<br />
pro=grepl(loc[1],zh_posi$loc)<br />
cit=grepl(loc[2],zh_posi$loc)<br />
match=which(pro&cit)<br />
show(match)<br />
return(c(mean(zh_posi$lon[match]),mean(zh_posi$lat[match])))<br />
}</p>
<p>b=apply(myfri[,2:3],1,get.loc)<br />
myfri$lon=b[1,]<br />
myfri$lat=b[2,]
鉴于关注人数在某些地区过于集中,此处只取在这些地区的均值表示:
library(sqldf)<br />
myfri2=sqldf("select province,city, avg(lon) as m_lon,avg(lat) as m_lat, avg(follower) as m_fol from myfri group by province,city")<br />
Encoding(myfri2$province)="UTF-8"<br />
Encoding(myfri2$city)="UTF-8"
</p>
作图,这里作图我借鉴了这位大神的作品(科学上网),做了一点小修改。可惜我做出来没这么好效果……T_T 重点在于对边的画法,方法是根据地图的中心点决定线的弯曲程度和方向,这里用到Hmisc包的bezier函数,相当于过任意三个点画平滑曲线。很不错:
library(ggmap)<br />
library(Hmisc)<br />
edgeMaker <- function(whichRow, len = 1, curved = TRUE){<br />
fromC <- c(113.27, 23.13) # Origin<br />
toC <- c(myfri2[whichRow,3],myfri2[whichRow,4]) # Terminus<br />
weight <- myfri2[whichRow, 5] # Terminus<br />
# Add curve:<br />
graphCenter <- c(mean(myfri2$m_lon),mean(myfri2$m_lat))#colMeans(myfri[,1:2]) # Center of the overall graph<br />
bezierMid <- c(fromC[1], toC[2]) # A midpoint, for bended edges<br />
distance1 <- sum((graphCenter - bezierMid)^2)<br />
if(distance1 < sum((graphCenter - c(toC[1], fromC[2]))^2)){<br />
bezierMid <- c(toC[1], fromC[2])<br />
} # To select the best Bezier midpoint<br />
bezierMid <- (fromC + toC + bezierMid) / 3 # Moderate the Bezier midpoint<br />
if(curved == FALSE){bezierMid <- (fromC + toC) / 2} # Remove the curve<br />
edge <- data.frame(bezier(c(fromC[1], bezierMid[1], toC[1]), # Generate<br />
c(fromC[2], bezierMid[2], toC[2]), # X & y<br />
evaluation = len)) # Bezier path coordinates<br />
edge$Sequence <- 1:len # For size and colour weighting in plot<br />
edge$weight <- weight<br />
edge$Group <- whichRow<br />
return(edge)<br />
}<br />
allEdges <- lapply(1:nrow(myfri2), edgeMaker, len = 100, curved = TRUE)<br />
allEdges <- do.call(rbind, allEdges)
</p>
与ggmap组合。效果图就是下面这张彩图啦,各个彩带起点的位置正是我目前的方位(广东 广州),终点就是我关注的各位的方位啦,用彩带可以表示出我们的关注关系(实际上还可以做更多关系,不过我目前的时间和资源上耗费不起……)。至于点的大小和线的粗细表示什么呢,它们的size被我设置成与被关注者的粉丝数目成正比(也就是可以表示传说中的微博名人)。几个大的微博名人聚集地多位于中国东部沿海的大城市中(准确的说,是在我关注的范围中的微博名人们~)而我可爱的童鞋们大多数也位于东部由山东到广东的范围内。
china=get_map(location = c(lon = mean(myfri2$m_lon), lat = mean(myfri2$m_lat)), zoom=5,maptype= "roadmap")<br />
p1=ggmap(china,extent='device',darken=0.2)<br />
drawit<-function(i){<br />
p=p1+geom_path(data=allEdges[1:i,], aes(x = x, y = y,group = Group, # Edges with gradient<br />
size=log(weight+1),color=Sequence),alpha=0.6,show_guide=F)+ # and taper<br />
scale_colour_gradient(low = "red3", high = "white", guide = "none")<br />
if (i>=100)<br />
{<br />
p=p+geom_point(data=myfri2[1:floor(i/100),],aes(x=m_lon,y=m_lat,size=log(m_fol+1)*1.3),alpha=0.5,show_guide=F,colour = "black") +<br />
geom_point(data=myfri2[1:floor(i/100),],aes(x=m_lon,y=m_lat,size=(log(m_fol+1))),alpha=0.6,show_guide=F,colour="red3")<br />
}<br />
return(p)<br />
}<br />
print(drawit(3800))
</p>
用彩带表示还有一个好玩的地方就是可以用动画的形式呈现出我关注的顺序~用谢老大的animation包做成gif形式就可以做到(但是我为啥用不了ffmpeg?):
library(animation)<br />
saveMovie({<br />
ani.options(interval=.1,<br />
convert = shQuote('C:/Program Files/ImageMagick-6.8.5-Q16/convert.exe'))<br />
for( i in seq(50,3000,50)) print(drawit(i))<br />
})

可以看到我对微博名人的关注和对同学(粉丝较少的小点)的关注在时间上是有聚集效应的。为啥呢,这要感谢sina微博的推荐机制,它会智能的把与你当前关注的同一“类别”的人群在你点击“关注”之后同时推送给你,于是你对这一类人的关注几乎就变成不分先后啦。
In the end:
作图的过程我觉得还是要优化,一开始我试图对不同的点按照省份加上不同的颜色,后来发现似乎ggplot2不支持两种不同的color scale,可以见这里的解答,如果你有更好的颜色配置方法,可以告诉我~另外,彩带的画法让我感到很愁人……不知道为啥这里显示的颜色是断断续续的,如果完全调成黑色或者灰色虽然避免了颜色的断续(而且实在太丑),但是会出现线边缘的锯齿形状;试图增加边的绘制点数似乎可以缓解这种问题不过画图时间也会相应增加,资源上……略捉急。按理说我觉得应该不会有这种问题呃,求大神解释……
另外,不知道为什么animation包的ffmpeg在我这里没办法使用(可以正确运行,但是打开之后到片尾一直没有显示我的图像- -||||),试过其他的ffmpeg生成可行,应该不是配置的问题……目前不知道具体问题在哪……
欢迎讨论和解答~