### We need the following packages for this example. packages <- c("tidyverse", "politicaldata", "ggplot2", "maps", "cartogram", "rgeos", "sf", "dplyr", "tigris", "readxl", "usmap") ### Install packages if needed, then load them quietly new_packages <- packages[!(packages %in% installed.packages()[, "Package"])] if (length(new_packages)) install.packages(new_packages, quiet = TRUE) invisible(lapply(packages, "library", quietly = TRUE, character.only = TRUE, warn.conflicts = FALSE)) ### We're trying to map the entire state, so pull the FIPS code for all counties my_counties <- fips_codes %>% filter(state == "TN") %>% pull(county_code) ### We need to change the CRS when we construct the cartogram later crs_tn <- "+proj=aea +lon_0=-85.978599 +lat_0=35.830545 +lat_1=34.982972 +lat_2=36.678118" ### Pull a map of county districts, as well as their population state_map <- get_acs(geography = "county subdivision", variables = c("B01003_001"), # Census series for population state = "47", county = my_counties, year = 2016, geometry = TRUE, cache_table = TRUE) %>% rename(population = estimate) %>% mutate(state_fips = substr(GEOID, 1, 2)) %>% mutate(county_fips = substr(GEOID, 3, 5)) %>% mutate(NAME = gsub(" County, Tennessee", "", NAME)) %>% mutate(NAME = gsub("District ", "", NAME)) %>% separate(NAME, c("precinct", NA), sep = ",") %>% select(state_fips, county_fips, precinct, population) %>% mutate(precinct_id = paste(county_fips, ":", precinct, sep = "")) ### Generate a cartogram. Stop at iteration 21 because the computation starts ### diverging after that, increasing the error. cartogram_map <- state_map %>% st_transform(crs = crs_tn) %>% cartogram_cont("population", itermax = 21) ### Read in the election results and start munging. There's almost certainly ### a better way of doing this, but it works... election_2016 <- read_xlsx("Data/StateGeneralbyPrecinctNov2016.xlsx") %>% filter(OFFICENAME == "United States President") %>% select(-OFFICENAME, -ELECTDATE, -ELECTTYPE) %>% mutate(fips_code = fips(state = "Tennessee", county = COUNTY)) %>% mutate(county_fips = substr(fips_code, 3, 5)) %>% filter(county_fips %in% my_counties) %>% #filter(!grepl("Absentee|Early Voting|Provisional|Paper Ballots", PRECINCT)) %>% rename(OLD_PRECINCT = PRECINCT) %>% mutate(PRECINCT = as.integer(PRCTSEQ)) %>% select(county_fips, PRECINCT, CANDGROUP, RNAME1, PARTY1, PVTALLY1, RNAME2, PARTY2, PVTALLY2, RNAME3, PARTY3, PVTALLY3, RNAME4, PARTY4, PVTALLY4, RNAME5, PARTY5, PVTALLY5, RNAME6, PARTY6, PVTALLY6, RNAME7, PARTY7, PVTALLY7, RNAME8, PARTY8, PVTALLY8, RNAME9, PARTY9, PVTALLY9, RNAME10, PARTY10, PVTALLY10) %>% pivot_wider(names_from = "CANDGROUP", values_from = c(RNAME1, PARTY1, PVTALLY1, RNAME2, PARTY2, PVTALLY2, RNAME3, PARTY3, PVTALLY3, RNAME4, PARTY4, PVTALLY4, RNAME5, PARTY5, PVTALLY5, RNAME6, PARTY6, PVTALLY6, RNAME7, PARTY7, PVTALLY7, RNAME8, PARTY8, PVTALLY8, RNAME9, PARTY9, PVTALLY9, RNAME10, PARTY10, PVTALLY10)) %>% select(county_fips, PRECINCT, RNAME1_1, PVTALLY1_1, RNAME2_1, PVTALLY2_1, RNAME3_1, PVTALLY3_1, RNAME4_1, PVTALLY4_1, RNAME5_1, PVTALLY5_1, RNAME6_1, PVTALLY6_1, RNAME7_1, PVTALLY7_1, RNAME8_1, PVTALLY8_1, RNAME9_1, PVTALLY9_1, RNAME10_1, PVTALLY10_1, RNAME1_2, PVTALLY1_2, RNAME2_2, PVTALLY2_2, RNAME3_2, PVTALLY3_2, RNAME4_2, PVTALLY4_2, RNAME5_2, PVTALLY5_2, ) %>% rename(Donald_Trump = PVTALLY1_1, Hillary_Clinton = PVTALLY2_1, Roque_De_La_Fuente = PVTALLY3_1, Gary_Johnson = PVTALLY4_1, Alyson_Kennedy = PVTALLY5_1, Mike_Smith = PVTALLY6_1, Jill_Stein = PVTALLY7_1, Darrell_Castle = PVTALLY8_1, Cherunda_Fox = PVTALLY9_1, Tom_Hoefling = PVTALLY10_1, Kyle_Kenley_Kopitke = PVTALLY1_2, Laurence_Kotlikoff = PVTALLY2_2, David_Limbaugh = PVTALLY3_2, Evan_McMullin = PVTALLY4_2, Marshall_Schoenke = PVTALLY5_2) %>% select(-starts_with("RNAME")) %>% rename(PRECINCT_INT = PRECINCT) %>% group_by(PRECINCT_INT, county_fips) %>% summarise(across(!matches('PRECINCT_INT|county_fips'), sum)) %>% mutate(conservative = Donald_Trump) %>% mutate(liberal = Hillary_Clinton) %>% #mutate(conservative = Donald_Trump + Gary_Johnson + Evan_McMullin) %>% #mutate(liberal = Hillary_Clinton + Jill_Stein) %>% select(county_fips, PRECINCT_INT, conservative, liberal) %>% mutate(conservative_per = conservative / (conservative + liberal)) %>% mutate(liberal_per = liberal / (conservative + liberal)) %>% rename(precinct = PRECINCT_INT) %>% mutate(precinct_id = paste(county_fips, ":", precinct, sep = "")) map <- state_map %>% select(precinct_id, geometry, population) %>% left_join(election_2016, by = "precinct_id") cartomap <- cartogram_map %>% select(precinct_id, geometry, population) %>% left_join(election_2016, by = "precinct_id") ### Map the vote g_map <- ggplot(map, col = "black") + theme_void() + theme(legend.title = element_blank()) + theme(plot.title = element_text(hjust = 0.5)) + geom_sf(aes(fill = conservative_per), size = 0.1) + scale_fill_gradient2( midpoint = 0.5, labels = scales::percent, low = "steelblue2", mid = "white", high = "firebrick1") + labs(title = "2016 Presidential Election results by county district") ### Now map it using the cartogram g_cartogram <- ggplot(cartomap, col = "black") + theme_void() + theme(legend.title = element_blank()) + theme(plot.title = element_text(hjust = 0.5)) + geom_sf(aes(fill = conservative_per), size = 0.1) + scale_fill_gradient2( midpoint = 0.5, labels = scales::percent, low = "steelblue2", mid = "white", high = "firebrick1") + labs(title = "County districts weighted by population") ### Print the map plot_grid(g_map, g_cartogram, align = "hv", nrow = 2, ncol = 1)