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

Question

我需要用3位数的zip边界创建热图。 我有3位数的拉链和计数数据

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()