查看原文
其他

关于美国地图中的两个海外州坐标平移与原始投影问题~

2017-09-18 杜雨 R语言中文社区

杜雨,EasyCharts团队成员,R语言中文社区专栏作者,兴趣方向为:Excel商务图表,R语言数据可视化,地理信息数据可视化。个人公众号:数据小魔方(微信ID:datamofang) ,“数据小魔方”创始人。


通常我们在政治新闻或者财经日报中看到的数据可视化图表中,美国地图中的两个海外州——阿拉斯加和夏威夷都是被平移过的,主要因为这两个海外州偏离本土太远,使用原始位置会使得美国地图的整体比例尺偏大,局部内容被缩小,整个版面中留有大量空隙。

政治新闻中最长出现的美国地图:



这是一个带有polyconic(普通多圆锥投影的)投影的美国地图,最重要的是,为了控制整个地图版面的比例尺并提高空间利用效率,该地图将美国的海外两州(阿拉斯加、夏威夷)移至大陆左下侧空隙处。


而且这两个州是带着原始投影(即在原始经纬度位置的多圆锥投影参数)迁移过来的,也就是说大陆部分、阿拉斯加部分、夏威夷部分当前并非在同一个多圆锥投影空间里,它们是三个投影图层拼贴在一起的。


但是通常来讲,我们从网络上免费获取的美国地图素材(无论是shp\json\svg),都是原始经纬度数据,仅有少量适量素材(eps\ai等)会做过处理,所以我们需要自己处理坐标平移的问题。


按照通常的方法做出来的美国地图:


library("ggplot2")

library("RColorBrewer")

library("ggthemes")

library("ggmapr")

library("plyr")

library("dplyr")

mymapdata<-states %>% filter(NAME!="Puerto Rico")

ggplot(mymapdata,aes(long,lat,group=group))+

geom_polygon(fill="grey95",col="grey")+

coord_map("polyconic")+

theme_map()


这样的地图很多信息会因为版面问题无法呈现清楚,想要为东北部的小州(单指面积小)基本在视觉上很难被发现,需要添加大量备注信息。

我们要在R语言中动手处理这个动作,能使用的素材格式非常有限,通常以shp和json为主。


今天我给大家讲解我在此问题上所经历过的四次探索:

  • 纯手工调整;(只能移动位置,无法修正投影)

  • 使用图层贴合技术(可以带原始位置投影调整,相当于拼图)

  • 使用ggmapr包调整(同方案1,只能调整位置,无法修正投影)

  • 使用albersusa包(通过封装函数自动完成调整过程,带投影,效率最高,效果最好)

1纯手工调整

newdata<-read.csv("D:/R/File/President.csv",stringsAsFactors=FALSE,check.names=FALSE)  


#分离大陆与夏威夷、阿拉斯加并更改阿拉斯加与夏威夷坐标并合并:


fun<-function(data){

data1<-subset(data,NAME!='Alaska'& NAME!='Hawaii')

data2<-subset(data,NAME=="Hawaii")%>%transform(long=long+65,lat=lat+5)

data3<-subset(data,NAME=="Alaska")%>%transform(long=(long+40)*.3-78,lat=(lat-42)*.3+20)

mydata<-rbind(data1,data2,data3)

}

American_data<-fun(mymapdata)

###合并地理信息数据与选举数据:

American_data<-merge(American_data,newdata,by.x="NAME",by.y="STATE_NAME")


###提取各州中心经纬度指标:

midpos <- function(AD1){mean(range(AD1,na.rm=TRUE))} 

centres <- ddply(American_data,.(NAME),colwise(midpos,.(long,lat)))

mynewdata<-join(centres,newdata,type="full")

ggplot()+

geom_polygon(data=American_data,aes(x=long,y=lat,group=group),colour="grey",fill="white")+

geom_point(data=mynewdata,aes(x=long,y=lat,size=Count,fill=Count),shape=21,colour="black")+

      scale_size_area(max_size=15)+ 

      scale_fill_gradient(low="white",high="#D73434")+

      coord_map("polyconic") +

      theme_map() %+replace% theme(legend.position ="none")


大家可以看到,以上虽然使用了多圆锥投影,但是我是先把夏威夷和阿拉斯加移动到指定位置之后才使用的投影,这样投影作用的当前位置而非阿拉斯加和夏威夷的原始坐标位置,实际上这样看到的地图,除了大陆部分之外,阿拉斯加和夏威夷的投影并非真实位置投影。


为此我想了很多办法,之前因为做过关于ggplot的拼图(也就是那篇母子图)的技术,想着可以用将地图图形映射三次,然后三个图拥有原始投影之后再拼接在一起,这种方式确实是可行的,最终的效果也是真是的,可是步骤就复杂多了。


2使用图层拼接技术:


library("grid") 

centres <- ddply(mymapdata,.(NAME),colwise(midpos,.(long,lat)))

#计算中心经纬度:

mynewdata<-merge(centres,newdata,by.x="NAME",by.y="STATE_NAME")

mynewdata1<-subset(mynewdata,NAME!='Alaska'& NAME!='Hawaii')    

mynewdata2<-subset(mynewdata,NAME=="Hawaii")    

mynewdata3<-subset(mynewdata,NAME=="Alaska") 

#将美国各州的经纬度中心也三成三分

mytheme<-theme_map() %+replace% theme(legend.position ="none",plot.background=element_rect(I(0),linetype=0))

#定制一个主题:


然后我做了三个ggplot图表对象:


p1<-subset(mymapdata,NAME!='Alaska'& NAME!='Hawaii') %>%ggplot()+

 geom_polygon(aes(x=long,y=lat,group=group),colour="grey",fill="white",size=.2)+

geom_point(data=mynewdata1,aes(x=long,y=lat,size=Count,fill=Count),shape=21,colour="black")+

      scale_size_area(max_size=10)+ 

      scale_fill_gradient(low="white",high="#D73434")+

      coord_map("polyconic") +

      mytheme

#图一,只含美国大陆本土


p2<-subset(mymapdata,NAME=="Hawaii")%>%ggplot()+  geom_polygon(aes(x=long,y=lat,group=group),colour="grey",fill="white",size=.2)+    geom_point(data=mynewdata2,aes(x=long,y=lat,size=Count,fill=Count),shape=21,colour="black")+

      scale_size_area(max_size=10)+ 

      scale_fill_gradient(low="white",high="#D73434")+

      coord_map("polyconic") +

      mytheme

#图二,只包含夏威夷州


p3<-subset(mymapdata,NAME=="Alaska")%>%ggplot()+

 geom_polygon(aes(x=long,y=lat,group=group),colour="grey",fill="white",size=.2)+  geom_point(data=mynewdata3,aes(x=long,y=lat,size=Count,fill=Count),shape=21,colour="black")+

      scale_size_area(max_size=10)+ 

      scale_fill_gradient(low="white",high="#D73434")+

      coord_map("polyconic") +

      mytheme

#图三,只包含阿拉斯加:

p1

vs <- viewport(width=0.1,height=0.1,x=0.35,y=0.16)    

print(p2,vp=vs) 

vs <- viewport(width=0.2,height=0.2,x=0.2,y=0.2)   

print(p3,vp=vs)  

将三个图表独享拼贴在一起(具体的位置要一点儿一点儿调试)



以上方案是通过三个图层拼合,才凑成的版面,但是这个方法弊端很多,其一:过程复杂,图形需要映射三次,其二,仔细看你会发现,阿拉斯加和夏威夷的选举人票数原本没那么多,这里从大小来看,竟然与加州差不多,从颜色来看,票数很一般(我将size和fill都映射给了票数这个变量)。


从而可以发现,在单独的图形对象中进行映射的话,颜色映射和大小映射会根据单个ggplot对象中的赋值变量的标度范围(数值型变量的极差分布)进行适应性调整。所以该方法通用性也不强,除非是只要位置效果,不做任何颜色、大小邓数据信息的映射。它唯一的好处是,真正的实现了原始位置的坐标投影信息。


3使用ggmapr包调整


该包封装了一个位置调整函数,即将我第一种笨办法(手动调整经纬度的方式)进行了函数化,相比第一种笨办法来说,提高了效率,相对于第二方法来说,效率也提高了很多,可以精准的控制调整位置,但是缺陷仍然是——无法保留原始位置的坐标投影信息。


rm(list=ls())

#该句清空内存数据(数据太多有时候会混)


newdata<-read.csv("D:/R/File/President.csv",stringsAsFactors=FALSE,check.names=FALSE) 

#从新读入美国大选的选票数据集:


states<-states %>% 

filter(NAME!="Puerto Rico") %>% 

shift(NAME=="Hawaii",shift_by=c(52.5,5.5))%>%

scale(NAME=="Alaska",scale=0.25,set_to=c(-117,27))%>% filter(lat>20)

#该函数可以很方便的将海外两州进行调整


midpos <- function(AD1){mean(range(AD1,na.rm=TRUE))} 

centres<- ddply(American_data,.(STATE_ABBR),colwise(midpos,.(long,lat)))

mynewdata<-join(centres,newdata,type="full")

#获取各州多边形中心经纬度中心坐标:


#美国总统大选各州选举人票数分布:

ggplot()+

geom_polygon(data=American_data,aes(x=long,y=lat,group=group),colour="grey",fill="white")+

geom_point(data=mynewdata,aes(x=long,y=lat,size=Count,fill=Count),shape=21,colour="black")+

      scale_size_area(max_size=15)+ 

      scale_fill_gradient(low="white",high="#D73434")+

      coord_map("polyconic") +

      theme_map() %+replace% theme(legend.position ="none")


这种方法的弊端同第一种方法一样,没法保留原始的坐标投影信息,虽然效率上高了好多,不过它的所有颜色映射、大小映射店铺是准确无误的,毕竟是在同一个图表对象中使用的同分布的变量进行映射,标度范围上可以保持一致。


4

使用albersusa包(最佳)


library("albersusa")


mapdata <-usa_composite()%>%fortify(us,region="name")

#这是该包中处理过位置偏移的地理位置信息


midpos <- function(AD1){mean(range(AD1,na.rm=TRUE))} 

centres<- ddply(mapdata,.(id),colwise(midpos,.(long,lat)))

#获取各州中心点经纬度坐标:


mynewdata<-merge(centres,newdata,by.x="id",by.y="STATE_NAME")

ggplot()+

geom_polygon(data=mapdata,aes(x=long,y=lat,group=group),colour="grey",fill="white")+

geom_point(data=mynewdata,aes(x=long,y=lat,size=Count,fill=Count),shape=21,colour="black")+

      scale_size_area(max_size=15)+ 

      scale_fill_gradient(low="white",high="#D73434")+

      coord_map("polyconic")+

      theme_map()%+replace% theme(legend.position ="none")



因而,从目前来看,第四种方法是效率最高,效果最好,整体最佳的可选方案,虽然不知道它内部是如何处理阿拉斯加和夏威夷的原始坐标投影问题。


但是那又如何,只要大神们为我们造好了轮子,我们直接用就好了,还用管那么多呢~



微信回复关键字即可学习

回复 R              R语言快速入门免费视频 
回复 统计          统计方法及其在R中的实现
回复 用户画像   民生银行客户画像搭建与应用 
回复 大数据      大数据系列免费视频教程
回复 可视化      利用R语言做数据可视化
回复 数据挖掘   数据挖掘算法原理解释与应用
回复 机器学习   R&Python机器学习入门 

您可能也对以下帖子感兴趣

文章有问题?点此查看未经处理的缓存