将美国边界和缩写添加到带有县区域的USmap

Question

我有map below.from here。如何将州边界和缩写名称添加到此县美国地图？

​

vec1 <- c(4013, 6037, 17031, 26163, 36059)
vec2 <- c(48045, 1009)
vec3 <- c(48289,48291)
library(ggplot2)
library(usmap)
library(dplyr)
library(stringr)

dt <- countypop %>%
  mutate(fill = case_when(
    fips %in% str_pad(vec1, 5, pad = "0") ~ "Blue",
    fips %in% str_pad(vec2, 5, pad = "0") ~ "Red",
    fips %in% str_pad(vec3, 5, pad = "0") ~ "Green",
    TRUE ~ "Other"
  ))

plot_usmap(regions = "counties", data = dt, values = "fill", color = "grey") +
  scale_fill_manual(
    values = c(Blue = "blue", Green = "green", Red = "red", Other = "light gray")
  )

Answer 1

要绘制州边界，您需要获取每个州的x，y坐标，并在地图上绘制它们。由于这是使用plot_usmap()绘制，因此需要将后来的经度坐标转换为当前的绘图坐标系。

states <- map_data("state") %>%
  usmap_transform()

然后使用geom_polygon()将其添加到绘图中。

  geom_polygon(data = states, aes(x = long.1,
                             y = lat.1,
                             group = group),
               color = "black",
               alpha = 0)

要添加州缩写，首先需要将state.center数据集中的最新长数据转换为图表上的坐标系。

state_centers <- data.frame(long = state.center$x,
                      lat = state.center$y) %>%
  usmap_transform()

然后将其与包含每个州的名称/缩写的数据合并。由于您拥有的数据缺少夏威夷/阿拉斯加，因此您需要删除这些州。

centroids <- data.frame(name = state.name,
                          abb = state.abb) %>%
  mutate(center_long = state_centers$long.1,
         center_lat = state_centers$lat.1) %>%
  filter(abb != c("HI", "AK")) %>%
  mutate(name = tolower(name)) %>%
  rename("region" = name)

然后使用geom_text()将缩写添加到绘图中。

  geom_text(data = state_names,
            aes(x = center_long,
                y = center_lat,
                label = abb))

结果：

​

​

东北地区的情况看起来相当紧凑。您可能希望对国家的该地区做些什么，以使其更具可读性。

如果你不想担心坐标变换，你可以按如下方式重新制作绘图(不是很漂亮，但可以很容易地设置样式)：

counties <- map_data("county")
states <- map_data("state")
state_centers <- data.frame(long = state.center$x,
                      lat = state.center$y)

centroids <- data.frame(name = state.name,
                          abb = state.abb) %>%
  mutate(center_long = state_centers$long,
         center_lat = state_centers$lat) %>%
  filter(abb != c("HI", "AK")) %>%
  mutate(name = tolower(name)) %>%
  rename("region" = name)

ggplot() +
  geom_polygon(data = counties, 
               aes(x = long,
                   y = lat, 
                   group = group),
               color = "grey",
               fill = "white") +
  geom_polygon(data = states,
               aes(x = long,
                   y = lat,
                   group = group),
               color = "black",
               alpha = 0) +
  geom_text(data = centroids,
            aes(x = center_long,
                y = center_lat,
                label = abb)) +
  coord_fixed(1.3)

​

​