在R中实现动态气泡图

Posted on 2013/01/07 by 严酷的魔王

最近我逐渐发现了ggplot2这个包的好处——只要用过一次，就再也不想回头使用R中自带的作图函数了。前两天鼓捣完一个地图的数据，又受到统计之都最新文章的影响，我忽然想起了Hans Rosling在TED上的精彩演讲。在图中横坐标是国民收入，纵坐标是国民的期望寿命，气泡的大小则是该国人口。整个图从1800年的统计数据开始，一直到2009年不断动态地展示，图上的气泡也随着时间变化不停地抖动上升。有一位在斯坦福专做可视化的博士用JavaScript在网页上重现了这段动态效果图，点开页面即可观看：http://bost.ocks.org/mike/nations/。

于是今天我便将这个图尝试着用R中的ggplot2与animation包实现了出来，边实现边研究ggplot2的用法，花了一天的时间做成了下面的这个视频。

简单地说一下流程：首先是数据文件的获取。数据能够在github上找到，但是数据是JSON格式的，只有一行，因此我的大部分代码都在为让数据变成一个二维矩阵的形式而努力着……很多国家会出现某些年没有统计数据的情况，因此我用了线性插值填补。最后，有两个国家只有一年有数据，我只能将它们删掉了。

弄好了数据就可以使用ggplot2画图了。为了让图像好看，我调整了图像的属性，比如圆圈的大小范围，学习加边框，学习图中加文字（annotate）等语法。但我现在感觉还是有一些地方能够微调改进。

最后使用animation包中的saveMovie函数，结合ffmpeg导出成了一个视频。

最后附上代码。

#Import the Strange Datasetrawdata=readLines("Wealth and Health.txt")#Get the useful wordsdata=unlist(strsplit(rawdata,"\\[\\{\"|\":\"|\",\"|\":\\[\\[|\\],\\[|\\]\\],\"|\\]\\]\\},\\{\"|\\]\\]\\}\\]"))data=data[which(data!="")]n=length(data)#Set indexnameind=which(data=="name")regind=which(data=="region")incind=which(data=="income")popind=which(data=="population")lifind=which(data=="lifeExpectancy")endpoint=nameind-1endpoint=endpoint[2:180]endpoint[180]=45999name=data[nameind+1]region=data[regind+1]#An empty data.frame typeinitdfr=data.frame(name=rep(0,210),region=rep(0,210),year=1800:2009,income=rep(0,210),pop=rep(0,210),life=rep(0,210))#An string split function only working for the commasplt=function(x) return(as.numeric(unlist(strsplit(x,","))))#Linear interpolation function, for those zero dataitpl=function(a){ ind=which(a>0) if (ind[1]>1) a[1:(ind[1]-1)]=rep(a[ind[1]],ind[1]-1) n=length(ind) if (ind[n]<length(a)) a[(ind[n]+1):length(a)]=rep(a[ind[n]],length(a)-ind[n]) for (i in 1:(n-1)) a[ind[i]:ind[i+1]]=rep(a[ind[i]],ind[i+1]-ind[i]+1)+(seq(ind[i],ind[i+1],1)-ind[i])*(a[ind[i+1]]-a[ind[i]])/(ind[i+1]-ind[i]) return(a)}#Drag data information from wordstbls=NULLfor (i in 1:180){ dfr=initdfr dfr$name=rep(name[i],210) dfr$region=rep(region[i],210) for (j in (incind[i]+1):(popind[i]-1)) { tmp=splt(data[j]) ii=which(dfr$year==tmp[1]) dfr$income[ii]=tmp[2] } for (j in (popind[i]+1):(lifind[i]-1)) { tmp=splt(data[j]) ii=which(dfr$year==tmp[1]) dfr$pop[ii]=tmp[2] } for (j in (lifind[i]+1):endpoint[i]) { tmp=splt(data[j]) ii=which(dfr$year==tmp[1]) dfr$life[ii]=tmp[2] } tbls=rbind(tbls,dfr)}#Two country with only one record, meaninglessind=which(tbls$name=="Mayotte")tbls=tbls[-ind,]ind=which(tbls$name=="Tokelau")tbls=tbls[-ind,]name=name[c(-28,-177)]region=region[c(-28,-177)]#Linear interpolationfor (i in 1:178){ ind=(210*(i-1)+1):(i*210) tbls$income[ind]=itpl(tbls$income[ind]) tbls$pop[ind]=itpl(tbls$pop[ind]) tbls$life[ind]=itpl(tbls$life[ind])}require(ggplot2)#Draw function with ggplot2drawit=function(yr,scl=15){ ind=which(tbls$year==yr) d.f=data.frame(yr=yr) p=ggplot(aes(x=log(income),y=life,size=pop,colour=as.factor(region)),pch=21,data=tbls[ind,]) p+geom_point(show_guide = FALSE)+ geom_point(shape = 1,colour = "black",show_guide = FALSE)+ xlim(5.5,11.7)+ylim(10,83)+scale_area(range = c(1, scl))+ annotate("text", x=10, y=15, label = yr,size=30,color="grey")}#drawit(1800)#Automatically repeat the drawing procedurefinaldraw=function(a,b){ for (i in 1:10) print(drawit(a)) for (i in a:b) print(drawit(i)) for (i in 1:10) print(drawit(b))}#finaldraw(1800,2009)require(animation)#sett ffmpeg in Windows = =||oopts = ani.options(ffmpeg = "D:/ffmpeg/bin/ffmpeg.exe")#Use the function from animation to make the final moviesaveVideo({ finaldraw(1800,2009) ani.options(interval = 0.1, nmax = 230)}, video.name = "HansRosling.mp4", other.opts = "-b 500k")