Reputation: 151
I have a dataset with Pennsylvania counties(67) and the frequency of each county. Now, I want to create a heat map with the frequencies. I am using the map library of R:
require(maps)
m<-map("county","Pennsylvania")
This returns a map like this:
Using this dataset, I have created a summary table of the number of points per counties. The output of dput(Frequency)
is as follows:
Frequency <- structure(list(County_join = c("adams", "allegheny", "armstrong",
"beaver", "bedford", "berks", "blair", "bradford", "bucks", "butler",
"cambria", "cameron", "carbon", "centre", "chester", "clarion",
"clearfield", "clinton", "columbia", "crawford", "cumberland",
"dauphin", "delaware", "elk", "erie", "fayette", "forest", "franklin",
"fulton", "greene", "huntingdon", "indiana", "jefferson", "juniata",
"lackawanna", "lancaster", "lawrence", "lebanon", "lehigh", "luzerne",
"lycoming", "mckean", "mercer", "mifflin", "monroe", "montgomery",
"montour", "northampton", "northumberland", "perry", "philadelphia",
"pike", "potter", "schuylkill", "snyder", "somerset", "sullivan",
"susquehanna", "tioga", "union", "venango", "warren", "washington",
"wayne", "westmoreland", "wyoming", "york", NA), Frequencies = c(312L,
5367L, 263L, 537L, 136L, 1176L, 431L, 203L, 1475L, 541L, 626L,
31L, 322L, 398L, 984L, 174L, 327L, 146L, 245L, 373L, 500L, 954L,
1257L, 174L, 1008L, 554L, 46L, 230L, 24L, 104L, 102L, 272L, 177L,
38L, 1159L, 1040L, 219L, 292L, 933L, 1701L, 458L, 211L, 399L,
126L, 592L, 1890L, 72L, 868L, 330L, 94L, 5300L, 212L, 92L, 724L,
91L, 311L, 48L, 172L, 147L, 87L, 125L, 153L, 795L, 269L, 1388L,
118L, 872L, 1590L)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-68L))
How do I convert this to colored choropleth heat map of frequencies?
Upvotes: 1
Views: 2755
Reputation: 1914
require(maps)
require(sf)
require(dplyr)
# load freq data
df <- read.csv("D:/GoogleDrive/stack/df.csv", sep = ",")
# select administrative divisions with 5 digits code i.e. county level
df_five = df %>% filter(grepl(".*\\b(\\d{5})\\b.*", LID)) %>%
mutate(NAME = gsub(" County", "", County)) %>%
select(-County)
# find county frequencies
freq <- df_five %>%
group_by( NAME) %>%
summarise(n = length(NAME)) %>%
arrange(-n) %>%
filter(NAME != "")
# join county info to count frequency
res <- freq %>% left_join(df_five %>% select(LID, NAME), by="NAME")
# define color buckets
colors = c("#F1EEF6", "#D4B9DA", "#C994C7", "#DF65B0", "#DD1C77", "#980043", "#4c0021")
res$colorBuckets <- as.numeric(cut(res$n, c(0, 500, 1000, 1500, 2000, 2500, 3500)))
leg.txt <- c("< 500", "500-1000", "1000-1500", "1500-2000", "2000-2500", "2500-3500")
# draw map
map("county", "Pennsylvania", col = colors, fill = TRUE, resolution = 0,
lty = 0, projection = "polyconic")
map("state", col = "white", fill = FALSE, add = TRUE, lty = 1, lwd = 0.2,
projection="polyconic")
legend("topright", leg.txt, horiz = TRUE, fill = colors)
Upvotes: 1
Reputation: 13135
library(tidyverse)
library(readr)
library(maps)
LicenseListWithSecondaries <- read_csv("C:/Users/..../Downloads/LicenseListWithSecondaries.csv")
License_final <- LicenseListWithSecondaries %>%
filter(Status == 'Active') %>%
mutate(County_join = tolower(str_remove_all(County, " County"))) %>%
group_by(County_join) %>% summarise(Frequencies = n())
#m <- map("county","Pennsylvania")
Pennsylvania <- map_data("county","Pennsylvania")
Pennsylvania_final <- inner_join(Pennsylvania, License_final,by=c('subregion' = 'County_join'))
pen_base <- ggplot(data = Pennsylvania_final, mapping = aes(x = long, y = lat, group = subregion)) +
coord_fixed(1.3) +
geom_polygon(color = "black", fill = "gray")
ditch_the_axes <- theme(
axis.text = element_blank(),
axis.line = element_blank(),
axis.ticks = element_blank(),
panel.border = element_blank(),
panel.grid = element_blank(),
axis.title = element_blank()
)
pen_base +
geom_polygon(aes(fill = Frequencies), color = "white") +
geom_polygon(color = "black", fill = NA) +
theme_bw() +
ditch_the_axes +
scale_fill_gradientn(colours = rev(rainbow(7)),
breaks = c(2, 4, 10, 100, 1000, 10000),
trans = "log10")
You can check here for more information. I hope it helps.
Upvotes: 3