Wisconsin State Hex Grid - Mapping 2016 Presidential Results
November 16, 2017
NEAT PACKAGE ALERT!
My 1st R package! https://t.co/dI3GJbC7FQ Automatically turn geospatial polygons like states into regular/hexagonal grids #rstats #ggplot2 pic.twitter.com/dxvYCZWJzU
— J Bailey (@iammrbailey) October 31, 2017
I’ve been thinking about implementing something like this for a while - got excited by this tweet I thought I would do some exploring and write out a post over the weekend. Creating a county-level hex grid of Wisconsin makes for a perfect supplment to my earlier post about mapping the 2016 Wisconsin presidential results.
Let’s make a hex grid of Wisconsin
The first thing we’ll do is retrieve a Wisconsin shapefile; we can use the tigris package developed by Kyle Walker to pull a 2010 census shapefile of Wisconsin counties:
library(tigris)
wi <- counties("Wisconsin", cb = TRUE)##
|
| | 0%
|
|= | 0%
|
|= | 1%
|
|== | 1%
|
|== | 2%
|
|=== | 2%
|
|=== | 3%
|
|==== | 3%
|
|===== | 4%
|
|====== | 4%
|
|====== | 5%
|
|======= | 5%
|
|======= | 6%
|
|======== | 6%
|
|======== | 7%
|
|========= | 7%
|
|========== | 7%
|
|========== | 8%
|
|=========== | 8%
|
|=========== | 9%
|
|============ | 9%
|
|============ | 10%
|
|============= | 10%
|
|============== | 10%
|
|============== | 11%
|
|=============== | 11%
|
|=============== | 12%
|
|================ | 12%
|
|================ | 13%
|
|================= | 13%
|
|================== | 13%
|
|================== | 14%
|
|=================== | 14%
|
|=================== | 15%
|
|==================== | 15%
|
|==================== | 16%
|
|===================== | 16%
|
|====================== | 17%
|
|======================= | 17%
|
|======================= | 18%
|
|======================== | 18%
|
|======================== | 19%
|
|========================= | 19%
|
|========================= | 20%
|
|========================== | 20%
|
|=========================== | 20%
|
|=========================== | 21%
|
|============================ | 21%
|
|============================ | 22%
|
|============================= | 22%
|
|============================= | 23%
|
|============================== | 23%
|
|=============================== | 24%
|
|================================ | 24%
|
|================================ | 25%
|
|================================= | 25%
|
|================================= | 26%
|
|================================== | 26%
|
|=================================== | 27%
|
|==================================== | 27%
|
|==================================== | 28%
|
|===================================== | 28%
|
|===================================== | 29%
|
|====================================== | 29%
|
|====================================== | 30%
|
|======================================= | 30%
|
|======================================== | 30%
|
|======================================== | 31%
|
|========================================= | 31%
|
|========================================= | 32%
|
|========================================== | 32%
|
|========================================== | 33%
|
|=========================================== | 33%
|
|============================================ | 34%
|
|============================================= | 34%
|
|============================================= | 35%
|
|============================================== | 35%
|
|============================================== | 36%
|
|=============================================== | 36%
|
|=============================================== | 37%
|
|================================================ | 37%
|
|================================================= | 37%
|
|================================================= | 38%
|
|================================================== | 38%
|
|================================================== | 39%
|
|=================================================== | 39%
|
|=================================================== | 40%
|
|==================================================== | 40%
|
|===================================================== | 41%
|
|====================================================== | 41%
|
|====================================================== | 42%
|
|======================================================= | 42%
|
|======================================================= | 43%
|
|======================================================== | 43%
|
|========================================================= | 43%
|
|========================================================= | 44%
|
|========================================================== | 44%
|
|========================================================== | 45%
|
|=========================================================== | 45%
|
|=========================================================== | 46%
|
|============================================================ | 46%
|
|============================================================= | 47%
|
|============================================================== | 47%
|
|============================================================== | 48%
|
|=============================================================== | 48%
|
|=============================================================== | 49%
|
|================================================================ | 49%
|
|================================================================ | 50%
|
|================================================================= | 50%
|
|================================================================== | 50%
|
|================================================================== | 51%
|
|=================================================================== | 51%
|
|=================================================================== | 52%
|
|==================================================================== | 52%
|
|==================================================================== | 53%
|
|===================================================================== | 53%
|
|====================================================================== | 54%
|
|======================================================================= | 54%
|
|======================================================================= | 55%
|
|======================================================================== | 55%
|
|======================================================================== | 56%
|
|========================================================================= | 56%
|
|========================================================================= | 57%
|
|========================================================================== | 57%
|
|=========================================================================== | 57%
|
|=========================================================================== | 58%
|
|============================================================================ | 58%
|
|============================================================================ | 59%
|
|============================================================================= | 59%
|
|============================================================================= | 60%
|
|============================================================================== | 60%
|
|=============================================================================== | 60%
|
|=============================================================================== | 61%
|
|================================================================================ | 61%
|
|================================================================================ | 62%
|
|================================================================================= | 62%
|
|================================================================================= | 63%
|
|================================================================================== | 63%
|
|=================================================================================== | 63%
|
|=================================================================================== | 64%
|
|==================================================================================== | 64%
|
|==================================================================================== | 65%
|
|===================================================================================== | 65%
|
|===================================================================================== | 66%
|
|====================================================================================== | 66%
|
|======================================================================================= | 67%
|
|======================================================================================== | 67%
|
|======================================================================================== | 68%
|
|========================================================================================= | 68%
|
|========================================================================================= | 69%
|
|========================================================================================== | 69%
|
|========================================================================================== | 70%
|
|=========================================================================================== | 70%
|
|============================================================================================ | 70%
|
|============================================================================================ | 71%
|
|============================================================================================= | 71%
|
|============================================================================================= | 72%
|
|============================================================================================== | 72%
|
|============================================================================================== | 73%
|
|=============================================================================================== | 73%
|
|================================================================================================ | 74%
|
|================================================================================================= | 74%
|
|================================================================================================= | 75%
|
|================================================================================================== | 75%
|
|================================================================================================== | 76%
|
|=================================================================================================== | 76%
|
|==================================================================================================== | 77%
|
|===================================================================================================== | 77%
|
|===================================================================================================== | 78%
|
|====================================================================================================== | 78%
|
|====================================================================================================== | 79%
|
|======================================================================================================= | 79%
|
|======================================================================================================= | 80%
|
|======================================================================================================== | 80%
|
|========================================================================================================= | 80%
|
|========================================================================================================= | 81%
|
|========================================================================================================== | 81%
|
|========================================================================================================== | 82%
|
|=========================================================================================================== | 82%
|
|=========================================================================================================== | 83%
|
|============================================================================================================ | 83%
|
|============================================================================================================= | 84%
|
|============================================================================================================== | 84%
|
|============================================================================================================== | 85%
|
|=============================================================================================================== | 85%
|
|=============================================================================================================== | 86%
|
|================================================================================================================ | 86%
|
|================================================================================================================ | 87%
|
|================================================================================================================= | 87%
|
|================================================================================================================== | 87%
|
|================================================================================================================== | 88%
|
|=================================================================================================================== | 88%
|
|=================================================================================================================== | 89%
|
|==================================================================================================================== | 89%
|
|==================================================================================================================== | 90%
|
|===================================================================================================================== | 90%
|
|====================================================================================================================== | 91%
|
|======================================================================================================================= | 91%
|
|======================================================================================================================= | 92%
|
|======================================================================================================================== | 92%
|
|======================================================================================================================== | 93%
|
|========================================================================================================================= | 93%
|
|========================================================================================================================== | 93%
|
|========================================================================================================================== | 94%
|
|=========================================================================================================================== | 94%
|
|=========================================================================================================================== | 95%
|
|============================================================================================================================ | 95%
|
|============================================================================================================================ | 96%
|
|============================================================================================================================= | 96%
|
|============================================================================================================================== | 97%
|
|=============================================================================================================================== | 97%
|
|=============================================================================================================================== | 98%
|
|================================================================================================================================ | 98%
|
|================================================================================================================================ | 99%
|
|================================================================================================================================= | 99%
|
|================================================================================================================================= | 100%
|
|==================================================================================================================================| 100%wi_original <- wi
plot(wi)
We’ll then port some code from the hexmapr github README:
library(hexmapr)
wi_details <- get_shape_details(wi)
wi@data$xcentroid <- coordinates(wi)[,1]
wi@data$ycentroid <- coordinates(wi)[,2]We’re going for the closest shapefile match, preferring a final shape than looks like the outline of the state than one with appropriate placement of counties - there is rarely a perfect grid match. So let’s test a whole bunch:
# hexagon - red border for the 28th seed
png(file = "/home/michael/Documents/mikeleeco.github.com/static/img/hexGridWisconsin.png", width = 700, height = 500)
par(mfrow=c(7,5), mar = c(0,1,2,1))
for (i in 1:35){
new_cells <- calculate_cell_size(wi, wi_details,0.03, 'hexagonal', i)
if(i == 28) {
plot(new_cells[[2]], main = paste("Seed",i, sep=" "), border = "red")
} else {
plot(new_cells[[2]], main = paste("Seed",i, sep=" "))
}
}
# squares - red border for the 7th seed
png(file = "/home/michael/Documents/mikeleeco.github.com/static/img/squareGridWisconsin.png", width = 700, height = 500)
par(mfrow=c(7,5), mar = c(0,1,2,1))
for (i in 1:35){
new_cells <- calculate_cell_size(wi, wi_details,0.03, 'regular', i)
if(i == 7) {
plot(new_cells[[2]], main = paste("Seed",i, sep=" "), border = "red")
} else {
plot(new_cells[[2]], main = paste("Seed",i, sep=" "))
}
}
hex grid options
square grid options
I like the look of the 28th hexagon grid, and the 7th square grid. Let’s take those and assign the polygons to a new SpatialPolygonsDataFrame, then fortify .
library(dplyr)
library(ggplot2)
clean <- function(shape){
shape@data$id = rownames(shape@data)
shape.points = fortify(shape, region="id")
shape.df = left_join(shape.points, shape@data, by="id")
}
new_cells_hex <- calculate_cell_size(wi_original, wi_details,0.03, 'hexagonal', 28)
resulthex <- assign_polygons(wi_original,new_cells_hex)
result_df_hex <- clean(resulthex)
new_cells_square <- calculate_cell_size(wi_original, wi_details,0.03, 'regular', 7)
resultsquare <- assign_polygons(wi_original,new_cells_square)
result_df_square <- clean(resultsquare)Now that we’ve got our modified SpatialPolygonsDataFrames - covered to a dataframe for use with ggplot2 - we can plot the result using geom_polygon:
library(viridis)
library(extrafont)
loadfonts()
theme_open_sans <- theme(text=element_text(family="Open Sans"), plot.title = element_text(family = "Open Sans Semibold", size = 24), plot.subtitle = element_text(family = "Open Sans Light",size = 14), legend.title = element_text(family="Open Sans Semibold"))
hexplot <- ggplot(result_df_hex) +
geom_polygon(aes(x=long, y=lat, fill = as.numeric(ALAND), group = group))+
geom_text(aes(V1, V2, label = NAME), size=2.5, color = "white", family = "Open Sans") +
scale_fill_viridis() +
guides(fill=FALSE) +
theme_void() + theme_open_sans
hexplot
squareplot <- ggplot(result_df_square) +
geom_polygon(aes(x=long, y=lat, fill = as.numeric(ALAND), group = group))+
geom_text(aes(V1, V2, label = NAME), size=2.5, color = "white", family = "Open Sans") +
scale_fill_viridis() +
guides(fill=FALSE) +
theme_void() + theme_open_sans
squareplot
I saw on twitter that sf can now be used natively, so I gave that I try as well. First convert the SpatialPolygonsDataFrame to a simple feature (sf), then plot the resultant object using geom_sf:
sfResultSquare <- st_as_sf(resultsquare)
sfResultHex <- st_as_sf(resulthex)
class(sfResultHex)## [1] "sf" "data.frame"sfHexPlot <-ggplot(sfResultHex) +
geom_sf(aes(fill = as.numeric(ALAND)), color = "transparent") +
geom_text(aes(V1, V2, label = NAME), size=2.5, color = "white", family = "Open Sans") +
scale_fill_viridis() +
guides(fill=FALSE) +
theme(panel.background = element_rect(fill = NA), axis.text = element_blank(), axis.ticks = element_blank(), axis.title = element_blank())
sfHexPlot
Cool to know that’s possible! Let’s use some more novel data than land area. Building off of a previous post mapping Wisconsin presidential election results, let’s map vote totals to our new gridmaps.
library(stringr)
library(tidyr)
all_results <- read.csv("https://raw.githubusercontent.com/mkearney/presidential_election_county_results_2016/master/pres16results.csv", stringsAsFactors = FALSE)
wisconsin <- all_results %>%
filter(str_detect(fips, "^55"))
wisconsin_spread <- wisconsin %>%
filter(cand %in% c("Donald Trump", "Hillary Clinton")) %>%
select(fips, cand, votes, total_votes) %>%
spread(cand, votes)
wisconsin_spread <- wisconsin_spread %>% mutate(voteDiff = `Donald Trump` - `Hillary Clinton`,
pctDiff = `Donald Trump`/total_votes - `Hillary Clinton`/total_votes,
weight = total_votes/ sum(total_votes))
wisconsin_spread$weight <- ifelse(wisconsin_spread$pctDiff > 0 , -wisconsin_spread$weight, wisconsin_spread$weight)We can create some custom breaks to give counties with higher vote totals more prominence in the figure, then merge these onto our hex and square SpatialPolygonsDataFrame:
wisconsin_spread$breaks <- cut(wisconsin_spread$weight,
breaks = c(-1, -.1, -0.05, -0.01, 0, 0.01, .05, .1, 1),
labels = c("R More than 10 Percent", "R 5 to 10 Percent", "R 1 to 5 Percent", "R Less than 1 Percent",
"D Less than 1 Percent","D 1 to 5 Percent", "D 5 to 10 Percent", "D More than 10 Percent"))
wiHex <- merge(result_df_hex, wisconsin_spread, by.x = "GEOID", by.y = "fips")
wiSquare <- merge(result_df_square, wisconsin_spread, by.x = "GEOID", by.y = "fips")Once we’ve got our data sets finalized, figures are created usng geom_polygon:
library(RColorBrewer)
wiHexPlot <- ggplot(wiHex) +
geom_polygon(aes(x=long, y=lat, fill=breaks, group = group), color = "#f5f5f5") +
geom_text(aes(V1, V2, label = NAME), size=2.5, color = "black", family = "Open Sans") +
scale_fill_manual(name = "Portion of WI Vote", values = brewer.pal(8, "RdBu"), drop = FALSE) +
guides(alpha=FALSE) +
ggtitle(label = "2016 Presidential Results by Wisconsin Counties", subtitle = "59 of 72 Wisconsin counties leaned Republican, while the only two counties with\nmore than 10 percent of the state's votes totaled more Democratic votes") +
theme(panel.background = element_rect(fill = NA), axis.text = element_blank(), axis.ticks = element_blank(), axis.title = element_blank()) +
theme_open_sans
wiHexPlot
wiSquarePlot <- ggplot(wiSquare) +
geom_polygon(aes(x=long, y=lat, fill=breaks, group = group), color = "#f5f5f5") +
geom_text(aes(V1, V2, label = NAME), size=2.5, color = "black", family = "Open Sans") +
scale_fill_manual(name = "Percentage of WI Vote Total", values = brewer.pal(8, "RdBu"), drop = FALSE) +
guides(alpha=FALSE) +
ggtitle(label = "2016 Presidential Results by Wisconsin Counties", subtitle = "59 of 72 Wisconsin counties leaned Republican, while the only two counties with\nmore than 10 percent of the state's votes totaled more Democratic votes") +
theme(panel.background = element_rect(fill = NA), axis.text = element_blank(), axis.ticks = element_blank(), axis.title = element_blank()) +
theme_open_sans
wiSquarePlot
Interested in learning more? Hire me to consult on your next project, follow me on twitter, leave a comment, or contact me via email. All inquiries welcome!