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)           

由于本文用到了一款中國行政區(qū)劃的字體地圖——EyesAsia，每一個(gè)行政區(qū)都是以一個(gè)字母代替的，所以需要獲取該地圖字體對(duì)應(yīng)的索引表。該字體的開源項(xiàng)目主頁為：EyesAsia

與此對(duì)應(yīng)的，還有一款也很fashion的字體地圖（StateFace），是美帝的行政區(qū)劃字體地圖。項(xiàng)目主頁在這里:stateface

一共43個(gè)編號(hào)，以下是提取過程，因?yàn)槭且粋€(gè)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個(gè)省級(jí)行政區(qū)

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)

作圖主要過程分為三部分：

步驟一：外圍字體圓環(huán)圖：

#導(dǎo)入數(shù)據(jù)：
#生成一個(gè)虛擬指標(biāo)，并分割為有序分段因子變量。
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

作圖函數(shù)：

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()

步驟二：接下來制作中心的中國地圖

其實(shí)針對(duì)中國省級(jí)地圖素材而言，大部分shp格式的地圖都是可以放心使用的，但是為了練習(xí)自己對(duì)于json數(shù)據(jù)的操控能力（畢竟是非常流行的web端數(shù)據(jù)存儲(chǔ)格式），
這里我硬生生的抽取了json格式的中國地圖數(shù)據(jù)，所以以下代碼看著有些不適，請(qǐng)大家謹(jǐn)慎觀看！

library(plyr)         
library(maptools)      
library(scales)       
library(jsonlite)
library(jsonview)

導(dǎo)入json格式中國地圖：

setwd("D:/R/mapdata/State/")
china_data<-fromJSON("china.json")
json_tree_view(china_data) 

jsonview.png

最新發(fā)現(xiàn)的可以自動(dòng)化解析并渲染json樹結(jié)構(gòu)的包，它不僅可以渲染json數(shù)據(jù)，也可以渲染xml、html格式的樹結(jié)構(gòu)：

抽取行政區(qū)里列表信息：

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)

抽取行政區(qū)劃邊界經(jīng)緯度多邊形數(shù)據(jù)：（最艱難的部分）

china_map_data<-china_data$features$geometry$coordinates

還時(shí)上次講到的困難，中國某些省份轄區(qū)內(nèi)有獨(dú)立于主區(qū)域的分離區(qū)域（比如河北的廊坊，以及山東、及南部沿海多島嶼的省份）。

今天這個(gè)json素材要比上次提取的那個(gè)安徽省的素材更加復(fù)雜，具體步驟也不詳細(xì)講解了，看不太懂就直接略過吧，反正代碼寫的也比較爛，基本寫不出那種可以通用的代碼！

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

至此經(jīng)緯度的邊界點(diǎn)信息也有了，接下來就可可以映射地圖了：

mydatanew<-dplyr::arrange(mydatanew,ID,order)

合并經(jīng)緯度邊界點(diǎn)信息和行政區(qū)劃信息。

mydatanew_map_data<-merge(mydatanew,china_city_data[,c(2,3,4)])

預(yù)覽地圖素材是否可用：

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()
          )

預(yù)覽效果圖：

ploygon.png

最后放個(gè)大招，用兩個(gè)地圖品進(jìn)行拼接，合并。

第一款字體時(shí)最初提到的地圖字體（需要事先下載哦）；第二款就是微軟雅黑嘍，渲染省份標(biāo)簽用的。

font.add("myfont","EyesAsia-Regular.otf")
font.add("myyh","msyhl.ttc")

為了更加舒適的看圓環(huán)上的省份標(biāo)簽，這里給標(biāo)簽添加角度偏移量。

circle<-seq(0,95,length=9)
circleALL<-rep(c(-circle,rev(circle[2:9])),2)
mymapdata$circle<-circleALL

鑒于ggplot極坐標(biāo)下的首尾不銜接的缺陷，這里再查補(bǔ)一個(gè)缺失值。

mymapdata<-arrange(mymapdata,order)
mapx<-mymapdata[mymapdata$order==34,]
mapx$order<-35;mapx$Cname=NA;mapx$case=NA
mymapdata1<-rbind(mymapdata,mapx)

所有的步驟都弄完之后，接下來將兩幅圖表存為對(duì)象。

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()

以下是最終的結(jié)果：

chineserador (2).png

OK了，做完收工~

聯(lián)系方式：

wechat：ljty1991

Mail:578708965@qq.com

個(gè)人公眾號(hào)：數(shù)據(jù)小魔方（datamofang）

團(tuán)隊(duì)公眾號(hào)：EasyCharts

qq交流群：[魔方學(xué)院]553270834