在R中绘制带有国家值作为颜色的地图？

Question

我有以下简单的示例数据，我想在地图上绘制与给定国家的值相对应的渐变颜色。

ddf = read.table(text="
country value
USA 10
UK 30
Sweden 50
Japan 70
China 90
Germany 100
France 80
Italy 60
Nepal 40
Nigeria 20
", header=T)

在谷歌搜索中，我找到了几个网站。但是，我正在寻找小而清晰的代码，最好是快速的（我发现 ggplot 方法相对较慢）。世界地图的分辨率不需要很高。

我尝试了以下代码：

library(maptools)
data(wrld_simpl)
plot(wrld_simpl)

特定国家可以按以下方式着色：Using [R] maps package - colouring in specific nations on a world map 使用命令：

plot(wrld_simpl, col = c(gray(.80), "red")[grepl("^U", wrld_simpl@data$NAME) + 1])

但是我怎样才能得到带有渐变颜色的上述数据的地图。 感谢您的帮助。

Answer 1

我认为其他答案有点复杂，也许是因为这个问题是在相对较长之前被问到/回答的？这是使用ggplot2 的简单方法。我不知道这是否“快”的基准是什么。

library(ggplot2)
library(dplyr)

ddf = read.table(text="
country value
USA 10
UK 30
Sweden 50
Japan 70
China 90
Germany 100
France 80
Italy 60
Nepal 40
Nigeria 20
", header=T)

world <- map_data("world")

world %>%
  merge(ddf, by.x = "region", by.y = "country", all.x = T) %>%
  arrange(group, order) %>%
  ggplot(aes(x = long, y = lat, group = group, fill = value)) + geom_polygon()

这使得使用所有常见的ggplot2 句柄进行修改变得容易。例如，如果我们想快速美化：

library(viridis)

world %>%
  merge(ddf, by.x = "region", by.y = "country", all.x = T) %>%
  arrange(group, order) %>%
  ggplot(aes(x = long, y = lat, group = group, fill = value)) +
  geom_polygon(color = "white", size = 0.2) +
  scale_fill_viridis("", na.value = "gray90") +
  theme_minimal() +
  theme(axis.text = element_blank(),
        axis.title = element_blank(),
        panel.grid = element_blank())

Answer 2

定义“慢”。 ggplot 提供了一种最灵活的方式来在地图上呈现数据，但需要花费几秒钟的额外时间。

library(RColorBrewer)
library(maptools)
library(ggplot2)

data(wrld_simpl)

ddf = read.table(text="
                 country value
                 'United States' 10
                 'United Kingdom' 30
                 'Sweden' 50
                 'Japan' 70
                 'China' 90
                 'Germany' 100
                 'France' 80
                 'Italy' 60
                 'Nepal' 40
                 'Nigeria' 20", header=TRUE)

# Pascal had a #spiffy solution that is generally faster

plotPascal <- function() {

  pal <- colorRampPalette(brewer.pal(9, 'Reds'))(length(ddf$value))
  pal <- pal[with(ddf, findInterval(value, sort(unique(value))))]

  col <- rep(grey(0.8), length(wrld_simpl@data$NAME))
  col[match(ddf$country, wrld_simpl@data$NAME)] <- pal

  plot(wrld_simpl, col = col)

}

plotme <- function() {

  # align colors to countries

  ddf$brk <- cut(ddf$value, 
                 breaks=c(0, sort(ddf$value)), 
                 labels=as.character(ddf[order(ddf$value),]$country),
                 include.lowest=TRUE)

  # this lets us use the contry name vs 3-letter ISO
  wrld_simpl@data$id <- wrld_simpl@data$NAME

  wrld <- fortify(wrld_simpl, region="id")
  wrld <- subset(wrld, id != "Antarctica") # we don't rly need Antarctica

  gg <- ggplot()

  # setup base map
  gg <- gg + geom_map(data=wrld, map=wrld, aes(map_id=id, x=long, y=lat), fill="white", color="#7f7f7f", size=0.25)

  # add our colored regions
  gg <- gg + geom_map(data=ddf, map=wrld, aes(map_id=country, fill=brk),  color="white", size=0.25)

  # this sets the scale and, hence, the legend
  gg <- gg + scale_fill_manual(values=colorRampPalette(brewer.pal(9, 'Reds'))(length(ddf$value)), 
                               name="Country")

  # this gives us proper coords. mercator proj is default
  gg <- gg + coord_map()
  gg <- gg + labs(x="", y="")
  gg <- gg + theme(plot.background = element_rect(fill = "transparent", colour = NA),
                   panel.border = element_blank(),
                   panel.background = element_rect(fill = "transparent", colour = NA),
                   panel.grid = element_blank(),
                   axis.text = element_blank(),
                   axis.ticks = element_blank(),
                   legend.position = "right")
  gg

}

system.time(plotme())
##  user  system elapsed 
## 1.911   0.005   1.915 

system.time(plotthem())
##  user  system elapsed 
## 1.125   0.014   1.138 

ggplot 代码生成以下地图：

每次运行的时间都不同，但我没有看到它们之间的间隔超过一分钟（在我的系统上似乎平均 0.6m，但我不打算进行广泛的基准测试）。

更新

随着您的需求不断被梳理出来，您可以相当轻松地将离散刻度替换为连续刻度。

pal <- colorRampPalette(brewer.pal(9, 'Reds'))(length(ddf$value))
palSz <- 10 # not sure what you really want/need for this range

gg <- gg + scale_fill_gradient2(low = pal[1],
                                mid = pal[palSz/2],
                                high = pal[palSz],
                                midpoint = (max(ddf$value) + min(ddf$value)) / 2,
                                name="value")

但是，听起来您可能应该坚持使用@Andy 的rworldmap，因为它抽象了复杂性。

Answer 3

如果您想要更少的代码和更粗略的分辨率地图，您可以使用 rworldmap。

library(rworldmap)

#create a map-shaped window
mapDevice('x11')
#join to a coarse resolution map
spdf <- joinCountryData2Map(ddf, joinCode="NAME", nameJoinColumn="country")

mapCountryData(spdf, nameColumnToPlot="value", catMethod="fixedWidth")

默认分类、颜色和图例可以更改，请参阅RJournal paper。

使用国家代码而不是名称会更快。

Answer 4

可能没有优化：

library(RColorBrewer)
library(maptools)
data(wrld_simpl)

ddf = read.table(text="
country value
'United States' 10
'United Kingdom' 30
'Sweden' 50
'Japan' 70
'China' 90
'Germany' 100
'France' 80
'Italy' 60
'Nepal' 40
'Nigeria' 20", header=TRUE)

Reds 是调色板的名称。有关其他可用调色板，请参阅 ?brewer.pal。

pal <- colorRampPalette(brewer.pal(9, 'Reds'))(length(ddf$value))
pal <- pal[with(ddf, findInterval(value, sort(unique(value))))]

col <- rep(grey(0.8), length(wrld_simpl@data$NAME))
col[match(ddf$country, wrld_simpl@data$NAME)] <- pal

plot(wrld_simpl, col = col)