Tennessee 2016 Presidential Election results by district

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