按邮政编码绘制边界并创建热图

Question

我需要创建具有 3 位数 zip 边界的热图。 我有 3 位数的 zip 和这样的计数数据

zip <- c(790, 791, 792, 793)
count <- c(0, 100, 20, 30)
TX <- data.frame(zip, count)

另外，我画了 TX 地图。

library(ggplot2)
library(ggmap)
library(maps)
library(mapdata)
states <- map_data("state")
texas<- subset(states, region =="texas")

ggplot(data = texas) + 
geom_polygon(aes(x = long, y = lat), fill = "gray", color = "black") 

我想要实现的是 (1) 使用 3 位邮政编码绘制边界和 (2) 使用计数列创建热图。使用热图着色的结果将如下所示。

Answer 1

此问题不包含可重现的样本数据。因此，我需要一些大量的时间来交付以下内容。请提供您下次尝试的最低可重现数据和代码。 （我怀疑你是否真的投入时间认真编写代码。）

无论如何，我认为如果不支付一些钱就很难获得美国邮政编码的良好多边形数据。 This question 提供了很好的信息。我从this link 获得数据，因为数据是可访问的。您必须为自己找到任何合适的多边形数据。 我还从here 获得了德克萨斯州邮政编码的数据并将其保存为“zip_code_database.csv”。

我为下面的每个代码添加了解释。所以我在这里不写详尽的解释。基本上，您需要通过减去邮政编码中的前三个数字来合并多边形数据。您还需要使用 3 位邮政编码为数据中的任何值创建聚合数据。另一件事是找到多边形的中心点以将邮政编码添加为标签。

library(tidyverse)
library(rgdal)
library(rgeos)
library(maptools)
library(ggalt)
library(ggthemes)
library(ggrepel)
library(RColorBrewer)

# Prepare the zip poly data for US
mydata <- readOGR(dsn = ".", layer = "cb_2016_us_zcta510_500k")

# Texas zip code data
zip <- read_csv("zip_code_database.csv")
tx <- filter(zip, state == "TX")


# Get polygon data for TX only
mypoly <- subset(mydata, ZCTA5CE10 %in% tx$zip)

# Create a new group with the first three digit.
# Drop unnecessary factor levels.
# Add a fake numeric variable, which is used for coloring polygons later.

mypoly$group <- substr(mypoly$ZCTA5CE10, 1,3)
mypoly$ZCTA5CE10 <- droplevels(mypoly$ZCTA5CE10)

set.seed(111)
mypoly$value <- sample.int(n = 10000, size = nrow(mypoly), replace = TRUE)

# Merge polygons using the group variable
# Create a data frame for ggplot.
mypoly.union <- unionSpatialPolygons(mypoly, mypoly$group)

mymap <- fortify(mypoly.union)

# Check how polygons are like

plot(mypoly)
plot(mypoly.union, add = T, border = "red", lwd = 1)


# Convert SpatialPolygons to data frame and aggregate the fake values
mypoly.df <- as(mypoly, "data.frame") %>%
             group_by(group) %>%
             summarise(value = sum(value))



# Find a center point for each zip code area
centers <- data.frame(gCentroid(spgeom = mypoly.union, byid = TRUE))
centers$zip <- rownames(centers)


# Finally, drawing a graphic
ggplot() +
geom_cartogram(data = mymap, aes(x = long, y = lat, map_id = id), map = mymap) +
geom_cartogram(data = mypoly.df, aes(fill = value, map_id = group), map = mymap) +
geom_text_repel(data = centers, aes(label = zip, x = x, y = y), size = 3) +
scale_fill_gradientn(colours = rev(brewer.pal(10, "Spectral"))) +
coord_map() +
theme_map()