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 />
})


</p>

可以看到我对微博名人的关注和对同学(粉丝较少的小点)的关注在时间上是有聚集效应的。为啥呢,这要感谢sina微博的推荐机制,它会智能的把与你当前关注的同一“类别”的人群在你点击“关注”之后同时推送给你,于是你对这一类人的关注几乎就变成不分先后啦。

In the end:

作图的过程我觉得还是要优化,一开始我试图对不同的点按照省份加上不同的颜色,后来发现似乎ggplot2不支持两种不同的color scale,可以见这里的解答,如果你有更好的颜色配置方法,可以告诉我~另外,彩带的画法让我感到很愁人……不知道为啥这里显示的颜色是断断续续的,如果完全调成黑色或者灰色虽然避免了颜色的断续(而且实在太丑),但是会出现线边缘的锯齿形状;试图增加边的绘制点数似乎可以缓解这种问题不过画图时间也会相应增加,资源上……略捉急。按理说我觉得应该不会有这种问题呃,求大神解释……

另外,不知道为什么animation包的ffmpeg在我这里没办法使用(可以正确运行,但是打开之后到片尾一直没有显示我的图像- -||||),试过其他的ffmpeg生成可行,应该不是配置的问题……目前不知道具体问题在哪……

欢迎讨论和解答~

不错!

断断续续的颜色意外出现了蜡笔的效果 。。[s:11]

回复 第2楼 的 肖楠:对呀……就是不知道为啥会断断续续……让我感到很诡异……[s:12]

想请教下,为什么我这个总是不成功

roauth <- createOAuth(app_name ="mytest", access_name = "shartoo")

Error in get(name, envir = asNamespace(pkg), inherits = FALSE) :

object '.setDummyField' not found

我的用户昵称是:shartoo,在开发者里也是这个.

回复 第5楼 的 PuddingNnn:Encoding(myfri2$province)<-"UTF-8"

Error in Encoding<-(*tmp*, value = "UTF-8") :

a character vector argument expected

您好,您出现这个问题了吗,这个问题怎么解决啊

不错哈,关于获取经纬度的,我的方法是在网上搜到一个中文地名和汉语拼音的表,然后merge了一下,用geocode获取经纬度。仅供参考。

回复 第5楼 的 PuddingNnn:哦,那个问题正好就是我提出来的,是五天前提出的,后来忘记去看回复了。你正好是楼上?已经解决~

回复 第7楼 的 bigknife:本来做完了结果接着看到ggmap里有获取经纬度的函数就跪了……不过我想也要先从网上找到拼音所以就没再改了……嘿嘿,谢谢,学习了^^~

回复 第6楼 的 dongguozhong:我似乎没出现这个问题呃,你可以看看你那里的myfri2$province是不是一个character vector……

回复 第11楼 的 shartoo:而且help(strsplit)没有这个函数的帮助文档。

回复 第12楼 的 shartoo:抱歉,是我自己弄错了。这个fri根本就没有获得数据

rouath$login(username="shartoo",password="********")

reason=抱歉!登录失败,请稍候再试' --

Error in rouath$login(username = "shartoo", password = "**********")

这里一直登陆失败,所以无法获取数据。

回复 第12楼 的 shartoo:- -||||我表示strsplit()是在base里的啊……有R就应该有的

回复 第14楼 的 PuddingNnn嗯,是我弄错了。后来才发现不是函数方法问题,而是我的String本身是空的,没有获取任何内容,导致一直报错。

19 天 后

这篇文章应该上主站啊!

回复 第16楼 的 谢益辉:那万分荣幸~可以投稿的咩~

回复 第17楼 的 PuddingNnn:可以啊。整理下发到editor@cos.name吧[s:13]

1 个月 后

回复 第2楼 的 肖楠:我 用R命令装在Rweibo包失败,同时Rforge站点,Rweibo下载不了,求解答[s:15]

5 天 后