人口加权多边形失真(制图)

Population-weighted polygon distortion (cartograms)

我正在尝试在 R 中创建一个地图,它传达了底层几何形状(即物理边界)对象的相对重要性关联值。

为了具体起见,我想专注于复制以下地图(的一个版本)*(形状,而不是 颜色 因为我找不到投票数据):

我也不想费心让阿拉斯加和夏威夷出现在美国下方,而不是在它们的大地测量正确位置。

我只是将数据与权重合并,例如如下所示:

1。获取多边形

library(maptools)
library(data.table) #not strictly necessary but I prefer it
#US states downloaded (500k resolution) from:
#https://www.census.gov/geo/maps-data/data/cbf/cbf_state.html
us.states<-
  readShapePoly("~/Desktop/cb_2014_us_state_5m.shp")

setDT(us.states@data)

#for getting rid of territories, AK, HI
states<-sprintf("%02d",1:59)
ak.hi<-c("02","15")

us.states.contig<-
  us.states[us.states@data$STATEFP %in% 
              setdiff(states,ak.hi),]

#Unadorned plot
plot(us.states.contig)
text(coordinates(us.states.contig),
     us.states.contig@data[,paste0(STUSPS)],
     cex=.7)

2。添加选举团数据

#scraped from government page
library(rvest) #only necessary to scrape table
electoral.college.url<-
  paste0("http://www.archives.gov/federal-register/",
         "electoral-college/allocation.html")

electoral.college.dt<-
  (html(electoral.college.url) %>%
     html_nodes("table"))[[5]] %>% 
  html_table()
setDT(electoral.college.dt)
setnames(electoral.college.dt,c("State","Votes"))

#merge into geodata
us.states.contig@data<-
  copy(us.states.contig@data)[
    electoral.college.dt,electoral.votes:=i.Votes,
    on=c(NAME="State")]

#plot, coloring each state by size
states.ranked<-
  us.states.contig@data[,rank(electoral.votes,
                              ties.method="first")]
cols<-colorRampPalette(c("red","blue"))(51)[states.ranked]

plot(us.states.contig,col=cols)

一切都很好——只要看一眼这张地图,我们就可以知道哪些州在选举人团中的代表人数高低。但是,如果(如在我们的目标地图中)我们想用州的颜色表示另一个变量怎么办?

3。添加 2012 年选举结果

#scrape again
#2012 Election Results by State
election.wiki<-
  paste0("https://en.wikipedia.org/wiki/",
         "United_States_presidential_election,_2012")
         
results<-
  html(election.wiki) %>%
  html_node(xpath='//*[@id="mw-content-text"]/div[22]/table') %>%
  html_table()
#eliminate second header row, delete final row,
#  keep only the important columns
results.trim<-results[2:(nrow(results)-1),c(1,4,21)]
colnames(results.trim)<-c("name","pct","abbr")
results.dt<-setDT(results.trim)
#data idiosyncrasies, see Wiki page
results.dt<-results.dt[!grepl("–",abbr)|grepl("a",abbr)]
results.dt[grepl("–",abbr),abbr:=gsub("–.*","",abbr)]
results.dt[,"pct":=as.numeric(gsub("%","",pct))]

#merge
us.states.contig@data<-
  copy(us.states.contig@data
       )[results.dt,vote.pct:=i.pct,
         on=c(STUSPS="abbr")]
                              
pcts<-us.states.contig@data[,vote.pct]
cols<-c("red","blue")[(pcts>=50)+1L]
tx.col<-c("white","black")[(cols=="red")+1L]
plot(us.states.contig,col=cols)
text(coordinates(us.states.contig),
     us.states.contig@data[,paste0(STUSPS)],
     col=tx.col)

最后一张图是问题的症结所在。从我们可以从地图上红色与蓝色的百分比来判断共和党还是民主党获胜的意义上说,第一个图表要好得多;最后一张地图具有误导性,因为大多数共和党州也是人口最稀少的州。

有什么方法可以创建这张地图的扭曲版本,以传达每个州在选举人团中的相对重要性?我在网上找不到任何帮助,也许主要是因为我不知道这种类型的图表是否有标准名称。

*找到这张地图 here; I've seen similar size-distorted maps before, e.g. in The Economist. It appears it's based on the work of Dr. Sam Wang at Princeton's Election Consortium and was produced by Drew Thaler

按照包维护者@chkaiser 的建议,我寻找并最终找到了一种在 R 中执行此操作的方法。This blog post 提供了巨大的帮助,getcartr 包非常棒。

首先,从GitHub获取Rcartogramgetcartr包:

remotes::install_github("omegahat/Rcartogram")
remotes::install_github('chrisbrunsdon/getcartr', subdir='getcartr')
library(Rcartogram)
library(getcartr)

现在只需即插即用:

us.states.contig.carto = quick.carto(
  us.states.contig,
  us.states.contig@data$electoral.votes
)
plot(us.states.contig.carto, col = cols)
text(
  coordinates(us.states.contig.carto),
  us.states.contig@data[ , paste0(STUSPS)],
  col = tx.col
)

就这样我们有了我们的制图: