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

数据小磨坊

发布于 2018-04-11 16:44:06

1.5K0

发布于 2018-04-11 16:44:06

文章被收录于专栏：数据小魔方数据小魔方

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

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

这是一个带有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")