Ankur
Ankur

Reputation: 151

Plotting a heat map of Pennsylvania counties in R

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:

enter image description here

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

Answers (2)

Aleksandr
Aleksandr

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)

enter image description here

Upvotes: 1

A. Suliman
A. Suliman

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

enter image description here

You can check here for more information. I hope it helps.

Upvotes: 3

Related Questions