FontMap-of-China
Use the font of EyesAsia to make a beautiful ChinaMap which circles each privince ploygon.
library the packages
library(rvest)
library(dplyr)
library(stringr)
library(showtext)
library(Cairo)
library(RColorBrewer)
library(ggplot2)
library(grid)
由于本文用到了一款中国行政区划的字体地图——EyesAsia，每一个行政区都是以一个字母代替的，所以需要获取该地图字体对应的索引表。该字体的开源项目主页为：EyesAsia
与此对应的，还有一款也很fashion的字体地图（StateFace），是美帝的行政区划字体地图。项目主页在这里:stateface
一共43个编号，以下是提取过程，因为是一个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)
筛选出中国的34个省级行政区
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<-tabledata
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)
chineserador.png
作图函数：
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()
步骤二：接下来制作中心的中国地图
其实针对中国省级地图素材而言，大部分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)
jsonview.png
最新发现的可以自动化解析并渲染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()
)
预览效果图：
ploygon.png
最后放个大招，用两个地图品进行拼接，合并。
第一款字体时最初提到的地图字体（需要事先下载哦）；第二款就是微软雅黑喽，渲染省份标签用的。
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(),
)
图表效果大致是这样的：
chineserador.png
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)
)
图表效果大致是这样的：
2017-04-10_093318.png
拼接：
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()
以下是最终的结果：
chineserador (2).png
OK了，做完收工~
联系方式：
wechat：ljty1991
Mail:578708965@qq.com
个人公众号：数据小魔方（datamofang）
团队公众号：EasyCharts
qq交流群：[魔方学院]553270834
