最近看到一幅很火的可视化作品，大概也是看到了刘万祥老师的博客中也模仿过，然后想着用R实现，果真就弄出来了！
这个是原图（取自刘老师的新浪博客）
这个是刘老师的案例图：
然后这是我自己的练习图：
以下是真个案例的制作过程：
library(rvest)
library(dplyr)
library(stringr)
library(showtext)
library(Cairo)
library(RColorBrewer)
library(ggplot2)
library(grid)
由于本文用到了一款中国行政区划的字体地图——EyesAsia，每一个行政区都是以一个大写字母代替的，所以需要获取该地图字体对应的索引表。
该字体的开源项目主页为：
https://github.com/HaoyunS/EyesAsia
与此对应的，还有一款也很fashion的字体地图（StateFace），是美帝的行政区划字体地图。项目主页在这里：
http://propublica.github.io/stateface/
一共就43个编号，虽然很少不值得写爬虫去获取，使用Excel复制黏贴、替换清洗可能更加方便，可是这里自己为了练习数据清洗，还是决定把爬取信息的过程展示出来。
因为是一个table，所以可以直接使用rvest非常便捷的表格抓取工具。
url<-"https://github.com/haoyuns/EyesAsia"
table<-read_html(url,encoding="utf-8")%>%html_table()%>%.[[2]]
因为表格非常的不规整，需要自己手动调整成规整的一维表：
table1<-table[table$lowercase!="",]
table2<-table[table$lowercase=="",]%>%.[,2:3]
table11<-table1[,1:2]%>%rename(case=lowercase)
table12<-table1[,3:4]%>%rename(case=UPPERCASE)
table13<-table2%>%rename(case=Content,Content=UPPERCASE)
tabledata<-rbind(table11,table12,table13)
其中名称列里面中英文混在一起，而且英文中有空格，无法使用普通的分列工具，只能写正则，奈何自己水平太次，写不出来一次性匹配带空格的英文单词，只能去社区里报大神大腿，找到一个有点希望的，自己修修补补就完成了哈哈哈~
tabledata$Cname<-str_extract(tabledata$Content,"[\\u4e00-\\u9fa5]+")
tabledata$Ename<-str_extract(tabledata$Content,"[^\\u4e00-\\u9fa5]+")%>%str_trim(side=c("right"))
tabledata<-tabledata[,-2]
setwd("D:/R/File")
write.table(tabledata,"EyesAsia.csv",sep=",",row.names=FALSE)
这里因为只需要整过省级行政区，所以我把那些不相干的都清理掉了！
word<-c("日本","蒙古","朝鲜","韩国","青海湖","鄱阳湖","洞庭湖","太湖","洪泽湖")
mymapdata$m<-mymapdata$Cname %in% word
mymapdata<-mymapdata%>%filter(m==FALSE)%>%.[,1:3]
write.table(mymapdata,"EyesAsia.csv",sep=",",row.names=FALSE)
#------------------------------------------------------------------------------------------------
下面正式进入本案例的作图环节：（本案例其实是两个图表拼在一起——由字体地图构成的外围圆环地图和由中心地图构成的中国行政区划离散填充地图）。为嘛要拼图而不是一气呵成呢，主要是害怕地图投影会影响字体地图的效果，而中国行政地图如果不加投影看着就像是一只背压扁的鸡，看着非常不美观。
所以以下过程也会分成三部分：
mymapdata<-read.csv("EyesAsia.csv",stringsAsFactors=FALSE,check.names=FALSE)
步骤一：外围字体圆环图：
生成一个虚拟指标，并分割为有序分段因子变量。
mymapdata<-transform(mymapdata,scale=5,peform=runif(34,20,50))
mymapdata$scale<-as.numeric(mymapdata$scale)
mymapdata$group<-cut(mymapdata$peform,breaks=c(20,26,32,38,44,50),levels=,labels=c("20~26","26~32","32~38","38~44","44~50"),order=TRUE)
mymapdata<-arrange(mymapdata,desc(peform));mymapdata$order=1:nrow(mymapdata)
mymapdata$order<-as.numeric(mymapdata$order)
作图函数：
CairoPNG("chineserador.png",900,900)
showtext.begin()
ggplot(mymapdata,aes(order,scale,label=case))+
ylim(-6,6)+
coord_polar(theta="x",start=0)+
geom_text(aes(colour=group),family="myfont",size=20)+
scale_colour_brewer(palette="Greens",guide=FALSE)+
theme_minimal()+
theme(
panel.grid=element_blank(),
axis.title=element_blank(),
axis.text=element_blank(),
)
showtext.end()
dev.off()
---------------------------------------------------------------------------------------------------------------
步骤2：制作中心的离散填充地图：
接下来制作中心的中国地图：
其实针对中国省级地图素材而言，大部分shp格式的地图都是可以放心使用的，但是为了练习自己对于json数据的操控能力（毕竟是非常流行的web端数据存储格式），这里我硬生生的抽取了json格式的中国地图数据，所以以下代码看着有些不适，请大家谨慎观看！
library(plyr)
library(maptools)
library(scales)
library(jsonlite)
library(jsonview)
导入json格式中国地图：
setwd("D:/R/mapdata/State/")
china_data<-fromJSON("china.json")
json_tree_view(china_data)
#最新发现的可以自动化解析并渲染json树结构的包，它不仅可以渲染json数据，也可以渲染xml、html格式的树结构：
抽取行政区里列表信息：
china_city_data<-china_data$features$properties[,c(1,3)]
names(china_city_data)[2]<-"region"
china_city_data$ID<-1:nrow(china_city_data)
china_city_data$size<-runif(34,900,1150)
china_city_data$group<-cut(china_city_data$size,breaks=c(900,950,1000,1050,1100,1150),labels=c("900~950","951~1000","1001~1050","1051~1100","1101~1150"),order=TRUE)
抽取行政区划边界经纬度多边形数据：（最艰难的部分）
china_map_data<-china_data$features$geometry$coordinates
还时上次讲到的困难，中国某些省份辖区内有独立于主区域的分离区域（比如河北的廊坊，以及山东、及南部沿海多岛屿的省份）。
今天这个json素材要比上次提取的那个安徽省的素材更加复杂，具体步骤也不详细讲解了，看不太懂就直接略过吧，反正代码写的也比较烂，基本写不出那种可以通用的代码！
####
num<-c();id<-c()
for( i in 1:length(china_map_data)){
citymapdata<-china_map_data[[i]]
num[i]<-length(citymapdata)
id<-1:i
a<-data.frame(id,num)
}
a[a$num<=2,]
id num
12 12 2
14 14 2
####
dim(china_map_data[[14]][[1]])=c(length(china_map_data[[14]][[1]])/2,2)
dim(china_map_data[[14]][[2]])=c(length(china_map_data[[14]][[2]])/2,2)
mapdata1<-data.frame()
mapdata2<-data.frame()
for( i in 1:length(china_map_data)){
citymapdata<-china_map_data[[i]]
if (length(citymapdata)<=2){
for(m in 1:length(citymapdata)){
citymapdata1<-data.frame(citymapdata[[m]])%>%dplyr::rename(long=X1,lat=X2)
citymapdata1$ID<-i
citymapdata1$group<-as.numeric(paste0(i,".",m,1))
citymapdata1$order<-1:nrow(citymapdata1)
mapdata1<-rbind(mapdata1,citymapdata1,citymapdata2)
}
}else{
dim(citymapdata)=c(length(citymapdata)/2,2)
citymapdata2<-data.frame(citymapdata)%>%dplyr::rename(long=X1,lat=X2)
citymapdata2$ID<-i
citymapdata2$group<-as.numeric(paste0(i,".",1))
citymapdata2$order<-1:nrow(citymapdata2)
mapdata2<-rbind(mapdata2,citymapdata2)
}
mydatanew<-rbind(mapdata1,mapdata2)
}
至此经纬度的边界点信息也有了，接下来就可可以映射地图了：
mydatanew<-dplyr::arrange(mydatanew,ID,order)
合并经纬度边界点信息和行政区划信息。
mydatanew_map_data<-merge(mydatanew,china_city_data[,c(2,3,4)])
预览地图素材是否可用：
ggplot(mydatanew_map_data,aes(long,lat,group=group))+geom_polygon(col="white",fill="grey")+
coord_map("polyconic")+
theme(
panel.grid = element_blank(),
panel.background = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank()
)
最后我要放大招了，量两个地图品进行拼接，合并。
步骤三：合并拼图：
第一款字体时最初提到的地图字体（需要事先下载安装哦）；
第二款就是微软雅黑喽，渲染省份标签用的。
font.add("myfont","EyesAsia-Regular.otf")
font.add("myyh","msyhl.ttc")
为了更加舒适的看圆环上的省份标签，这里给标签添加角度偏移量。
circle<-seq(0,95,length=9)
circleALL<-rep(c(-circle,rev(circle[2:9])),2)
mymapdata$circle<-circleALL
鉴于ggplot极坐标下的首尾不衔接的缺陷，这里再插补一个缺失值。
mymapdata<-arrange(mymapdata,order)
mapx<-mymapdata[mymapdata$order==34,]
mapx$order<-35;mapx$Cname=NA;mapx$case=NA
mymapdata1<-rbind(mymapdata,mapx)
所有的步骤都弄完之后，接下来将两幅图表存为对象。
p1<-ggplot(mymapdata1,aes(x=order,y=scale))+
ylim(-6,7.5)+
coord_polar(theta="x",start=0)+
geom_text(aes(colour=group,label=case),family="myfont",size=15)+
geom_text(aes(y=scale+2,angle=circle,label=Cname),family="myyh",size=6,vjust=0.5,hjust=.5)+
scale_colour_brewer(palette="Greens",guide=FALSE)+
theme_minimal()+
theme(
panel.grid=element_blank(),
axis.title=element_blank(),
axis.text=element_blank(),
)
p2<-ggplot(china_city_data,aes(map_id=region,fill=group))+geom_map(map=mydatanew_map_data,colour="white")+
expand_limits(x=mydatanew_map_data$long,y=mydatanew_map_data$lat)+
scale_fill_brewer(palette="YlOrRd",guide=FALSE)+
coord_map("polyconic")+
theme(
panel.grid = element_blank(),
panel.background = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
plot.background=element_rect(I(0),linetype=0)
)
拼接：
CairoPNG("chineserador.png",1000,1000)
showtext.begin()
vs <- viewport(width=0.95,height=0.95,x=0.5,y=0.5)
print(p1,vp=vs)
vs <- viewport(width=0.75,height=0.8,x=0.5,y=0.5)
print(p2,vp=vs)
showtext.end()
dev.off()
OK了，做完收工~
作者简介：
欢迎关注魔方学院QQ群
