Intro

I took a course during my Fall 2024 semester at MTSU about how to analyze, graph and map election-related data using Studio and the R Progamming language. Below are a few examples of the projects I completed along with the code that it runs through.

GRAPI by Tennessee House District

Gross Rent As a Percentage of Income (GRAPI) is often used as a measure of affordability for rent in a specific area. The chart below shows estimate by district in Rutherford county, and the interactive map shows the proportion of renters overspending on housing. All data is taken from the 2022 American Community Survey, published by the U.S. Census Bureau

District	Estimate	Estimate_MOE	From	To
Estimate by district
State House District 13 (2022), Tennessee	42.9	7.7	35.2	50.6
State House District 37 (2022), Tennessee	40.3	5.5	34.8	45.8
State House District 34 (2022), Tennessee	35.9	4.8	31.1	40.7
State House District 49 (2022), Tennessee	35.7	5.6	30.1	41.3
State House District 48 (2022), Tennessee	34.4	5.9	28.5	40.3

# Installing and loading required packages

if (!require("tidyverse"))
  install.packages("tidyverse")
if (!require("tidycensus"))
  install.packages("tidycensus")
if (!require("sf"))
  install.packages("sf")
if (!require("mapview"))
  install.packages("mapview")
if (!require("gtExtras"))
  install.packages("gtExtras")

library(tidyverse)
library(tidycensus)
library(sf)
library(mapview)
library(gtExtras)

# Transmitting API key

census_api_key("7c104e78c808db67e932035eb8d2a91d0a31202c")

# Fetching ACS codebooks

DetailedTables <- load_variables(2022, "acs5", cache = TRUE)
SubjectTables <- load_variables(2022, "acs5/subject", cache = TRUE)
ProfileTables <- load_variables(2022, "acs5/profile", cache = TRUE)
Codebook <- DetailedTables %>% 
  select(name, label, concept)
Codebook <- bind_rows(Codebook,SubjectTables)
Codebook <- bind_rows(Codebook,ProfileTables)
Codebook <- Codebook %>% 
  distinct(label, .keep_all = TRUE)
rm(DetailedTables,
   SubjectTables,
   ProfileTables)

# Filtering the codebook

MyVars <- Codebook %>% 
  filter(grepl("GRAPI", label) &
           grepl("Percent!!", label))

# Making a table of the filtered variables

MyVarsTable <- gt(MyVars) %>%
  tab_header("Variables") %>%
  cols_align(align = "left") %>%
  gt_theme_538

# Displaying the table

MyVarsTable

# Defining the variable to retrieve

VariableList = 
  c(Estimate_ = "DP04_0142P")

# Fetching data

AllData <- get_acs(
  geography = "state legislative district (lower chamber)",
  state = "TN",
  variables = VariableList,
  year = 2022,
  survey = "acs5",
  output = "wide",
  geometry = TRUE
)

# Mutating, selecting and sorting the data

AllData <- AllData %>%
  mutate(
    District = NAME,
    Estimate = Estimate_E,
    Estimate_MOE = Estimate_M,
    From = round(Estimate - Estimate_MOE, 2),
    To = round(Estimate + Estimate_MOE, 2)
  ) %>%
  select(District, Estimate, Estimate_MOE, From, To, geometry) %>%
  arrange(desc(Estimate))

# Filtering for Rutherford County districts

MyData <- AllData %>%
  filter(
    District == "State House District 13 (2022), Tennessee" |
      District == "State House District 37 (2022), Tennessee" |
      District == "State House District 49 (2022), Tennessee" |
      District == "State House District 48 (2022), Tennessee" |
      District == "State House District 34 (2022), Tennessee"
  )

# Producing a map

MapData <- st_as_sf(MyData)

MyMap <- mapview(MapData,
        zcol = "Estimate",
        layer.name = "Estimate",
        popup = TRUE)
#Displaying the map

MyMap

# Producing a table

TableData <- st_drop_geometry(MapData)
MyTable <- gt(TableData) %>%
  tab_header("Estimate by district") %>%
  cols_align(align = "left") %>%
  gt_theme_538

# Displaying the table

MyTable

Race for governor, 2022

Below is voting results from the 2022 Governors race for Rutherford County. Nearly every Rutherford County voting precinct favored incumbent Republican Bill Lee over Democratic challenger Jason Martin in the 2022 race for Tennessee governor.

According to offical results from the Tennessee secretary of state, Martin polled best in precincts around the Middle Tennessee State University campus in central Murfreesboro and in precincts along the county’s northwest border with Davidson County.

# Required packages

if (!require("tidyverse"))
  install.packages("tidyverse")
if (!require("mapview"))
  install.packages("mapview")
if (!require("sf"))
  install.packages("sf")
if (!require("leaflet"))
  install.packages("leaflet")
if (!require("leaflet.extras2"))
  install.packages("leaflet.extras2")
if (!require("plotly"))
  install.packages("plotly")

library(tidyverse)
library(mapview)
library(sf)
library(leaflet)
library(leafpop)
library(readxl)
library(plotly)

# Download and import election data
# from TN Secretary of State web site:
# https://sos.tn.gov/elections/results

download.file(
  "https://sos-prod.tnsosgovfiles.com/s3fs-public/document/20221108AllbyPrecinct.xlsx",
  "RawElectionData.xlsx",
  quiet = TRUE,
  mode = "wb"
)

RawElectionData <- read_xlsx("RawElectionData.xlsx", sheet = "SOFFICELso")

# Filter, calculate, and select
# to get data of interest
# then store results in MyData dataframe

MyData <- RawElectionData %>%
  filter(COUNTY == "Rutherford", CANDGROUP == "1") %>%
  mutate(
    Lee = PVTALLY1,
    Martin = PVTALLY2,
    Total = PVTALLY1 + PVTALLY2,
    Lee_Pct = round(PVTALLY1 / (PVTALLY1 + PVTALLY2), 2),
    Martin_Pct = round(PVTALLY2 / (PVTALLY1 + PVTALLY2), 2),
    Winner = case_when(
      PVTALLY1 > PVTALLY2 ~ "Lee (R)",
      PVTALLY2 > PVTALLY1 ~ "Martin (D)",
      .default = "Tie"
    )
  ) %>%
  select(COUNTY, PRECINCT, Total, Lee, Martin, Lee_Pct, Martin_Pct, Winner)

# Download and unzip a precinct map to pair with the vote data

download.file("https://github.com/drkblake/Data/raw/main/Voting_Precincts_5_31_24.zip","TNVotingPrecincts.zip")

unzip("TNVotingPrecincts.zip")

All_Precincts <- read_sf("Voting_Precincts_5_31_24.shp")

# Filter for particular county precincts

County_Precincts <- All_Precincts %>%
  filter(COUNTY == 149) %>%
  rename(PRECINCT = NEWVOTINGP)

# Merge election data and map file

MergeFile <- merge(MyData, County_Precincts, by = "PRECINCT", all.x = TRUE)

# Drop unneeded columns from MergeFile

MergeFile <- MergeFile %>%
  select(PRECINCT,
         Total,
         Lee,
         Martin,
         Lee_Pct,
         Martin_Pct,
         Winner,
         geometry)

# Format MergeFile as a map, and
# call the map MyMap

MyMapFile <- st_as_sf(MergeFile)

mypalette = colorRampPalette(c('blue', 'red'))

MyMap <- mapview(
  MyMapFile,
  zcol = "Lee_Pct",
  col.regions = mypalette, at = seq(0, 1, .2),
  map.types = ("OpenStreetMap"),
  layer.name = "Pct. for Lee",
  popup = popupTable(
    MyMapFile,
    feature.id = FALSE,
    row.numbers = FALSE,
    zcol = c(
      "PRECINCT",
      "Lee",
      "Martin",
      "Total",
      "Lee_Pct",
      "Martin_Pct",
      "Winner"
    )
  )
)

# Showing the map

MyMap

Early voting in Rutherford County

The Map below is a interactive map of places where you can early vote in the 2024 Presidential Election in Rutherford County. Rutherford County voters can beat the election-day rush by casting a ballot early at any one of nine voting locations around the county between Oct. 16 and Oct. 31.

Each orange marker on the map represents an early voting location. Click a marker for the location’s operating hours.

For reference, the blue marker shows the location of Middle Tennessee State University.

# Required packages

if (!require("tidyverse"))
  install.packages("tidyverse")
if (!require("sf"))
  install.packages("sf")
if (!require("mapview"))
  install.packages("mapview")
if (!require("leaflet")) 
  install.packages("leaflet")
if (!require("leaflet.extras2")) 
  install.packages("leaflet.extras2")

library(tidyverse)
library(sf)
library(mapview)
library(leaflet)
library(leaflet.extras2)
library(leafpop)

mapviewOptions(basemaps.color.shuffle = FALSE)

# Load the address and lat/long data

Addresses_gc <- read_csv("https://raw.githubusercontent.com/drkblake/Data/refs/heads/main/EarlyVotingLocations_gc.csv")

# Add MTSU

long <- -86.361861
lat <- 35.848997

Addresses_gc <- Addresses_gc %>% 
  add_row(Location = "MTSU",
          long = long,
          lat = lat) %>% 
  mutate(Point = case_when(Location == "MTSU" ~ "MTSU",
                           TRUE ~ "Early vote here"))

MapData <- st_as_sf(Addresses_gc,
                    coords = c("long", "lat"),
                    crs = 4326)

# Make the map

MyMap <- mapview(MapData,
                 zcol = "Point",
                 layer.name = "Point",
                 col.regions = c("orange", "blue"),
                 map.types = c("OpenStreetMap","Esri.WorldImagery"),
                 popup = popupTable(
                   MapData,
                   feature.id = FALSE,
                   row.numbers = FALSE,
                   zcol = c("Location",
                            "Address",
                            "Week",
                            "Weekend")))
# Show the map

MyMap

Early voting in Rutherford County

The bar graph below shows some of the early voting results for the 2024 election in Rutherford County. Did Rutherford County’s precinct-level early voting turnout data hold any reliable clues about what the outcome would be? As of Oct. 31, 2024, 115,133 people had voted early in Rutherford County, or about 51 percent of all county voters registered for the November 5 election.

Here are vote totals per day, according to data from the Rutherford County Election Commission.

The subsequent map below shows the precinct-level voter turnout ranged from 31 percent to 61 percent. Click a precinct to see details. You might also look at this precinct level analysis of votes in the 2022 gubernatorial race between Republican incumbent Bill Lee and Democratic challenger Jason Martin.

if (!require("tidyverse"))
  install.packages("tidyverse")
if (!require("foreign"))
  install.packages("foreign")
if (!require("sf"))
  install.packages("sf")
if (!require("scales"))
  install.packages("scales")
if (!require("mapview"))
  install.packages("mapview")
if (!require("leaflet"))
  install.packages("leaflet")
if (!require("leaflet.extras2"))
  install.packages("leaflet.extras2")

library(tidyverse)
library(foreign)
library(sf)
library(scales)
library(mapview)
library(leaflet)
library(leafpop)

# Fetch and unzip the early voting files

download.file("https://github.com/drkblake/Data/raw/refs/heads/main/DailyEVFiles.zip","DailyEVFiles.zip")

unzip("DailyEVFiles.zip")

# Read the first daily voting file

AddData <- read.dbf("10162024.dbf")
AllData <- AddData

# Add each day's  file name to this list, then run

datafiles <- c("10172024.dbf",
               "10182024.dbf",
               "10192024.dbf",
               "10212024.dbf",
               "10222024.dbf",
               "10232024.dbf",
               "10242024.dbf",
               "10252024.dbf",
               "10262024.dbf",
               "10282024.dbf",
               "10292024.dbf",
               "10302024.dbf",
               "10312024.dbf")

for (x in datafiles) {
  AddData <- read.dbf(x, as.is = FALSE)
  AllData <- rbind(AllData, AddData)
}

# Save AllData file as .csv
write_csv(AllData,"EarlyVoterData2024.csv")

# Get total votes so far

TotalVotes <- nrow(AllData)
PctVotes <- round((TotalVotes / 224746)*100, digits = 0)

VotesByDay <- AllData %>% 
  group_by(VOTEDDATE) %>% 
  summarize(Votes = n()) %>% 
  rename(Date = VOTEDDATE) %>% 
  mutate(Date = (str_remove(Date,"2024-")))

# "#2C7865" is a green shade

chart = ggplot(data = VotesByDay,
               aes(x = Date,
                   y = Votes))+
  geom_bar(stat="identity", fill = "#41B3A2") +
  geom_text(aes(label=comma(Votes)),
            vjust=1.6,
            color="black",
            size=3.5)+
  theme(
    axis.title.x = element_blank(),
    axis.ticks.y = element_blank(),
    axis.title.y = element_blank(),
    axis.text.y = element_blank(),
    panel.background = element_blank())

chart

### Precinct-level map of early voting turnout ***

# Aggregate early voting data by precinct

PrecinctData <- AllData %>% 
  group_by(PCT_NBR) %>% 
  summarize(Votes = n()) %>% 
  rename(Precinct = PCT_NBR)

# Download and unzip a precinct map to pair with the vote data

download.file("https://github.com/drkblake/Data/raw/main/Voting_Precincts_5_31_24.zip","TNVotingPrecincts.zip")

unzip("TNVotingPrecincts.zip")

All_Precincts <- read_sf("Voting_Precincts_5_31_24.shp")

# Filter for RuCo precincts and 
# strip dash from precinct numbers

County_Precincts <- All_Precincts %>%
  filter(COUNTY == 149) %>%
  rename(Precinct = NEWVOTINGP) %>% 
  mutate(Precinct = (str_remove(Precinct,"-")))

MapData <-  left_join(PrecinctData, County_Precincts, by = "Precinct")

RegData <- read_csv("https://raw.githubusercontent.com/drkblake/Data/refs/heads/main/RegVotersRuCo.csv") %>% 
  mutate(Precinct = as.character(Precinct))

MapData <- left_join(MapData, RegData, by = "Precinct")

MapData <- MapData %>% 
  mutate(Percent = round((Votes/RegVoters)*100), digits = 0) %>%
  rename(Voters = RegVoters) %>% 
  select(Precinct, Votes, Voters, Percent, geometry)

MapData_sf <- st_as_sf(MapData)

Map <- mapview(
  MapData_sf,
  zcol = "Percent",
  layer.name = "Pct. early voted",
  popup = popupTable(
    MapData_sf,
    feature.id = FALSE,
    row.numbers = FALSE,
    zcol = c(
      "Precinct",
      "Votes",
      "Voters",
      "Percent"
    )
  )
)

Map

MinTurnout <- min(MapData$Percent)
MaxTurnout <- max(MapData$Percent)
MedianTurnout <- median(MapData$Percent)
MeanTurnout <- mean(MapData$Percent)

Cable News Topic Tracker

How effective have the Trump and Harris campaigns been at attracting media coverage? Not all media coverage is necessarily good for a candidate, of course. Coverage of gaffes or scandals can damage a candidate’s chances at the polls. But media visibility of at least some kind is essential.

This interactive plotly chart lets you compare the amount of cable news coverage mentioning “Donald Trump,” “Joe Biden,” and “Kamala Harris” between late April the most recent period for which data are available.

The three charts that follow all look to the three biggest legacy news companies: MSNBC, CNN, and Fox News.

if (!require("tidyverse"))
  install.packages("tidyverse")
if (!require("plotly"))
  install.packages("plotly")
library(tidyverse)
library(plotly)

# Defining date range

startdate <- "20240429"
enddate <- "20241112"

### Trump

# Defining query

# Note:
# In queries, use %20 to indicate a space
# Example: "Donald%20Trump" is "Donald Trump"
# Use parentheses and %20OR%20 for "either/or" queries
# Example: "(Harris%20OR%20Walz)" is "(Harris OR Walz)"

query <- "Donald%20Trump"

# Building the volume dataframe

vp1 <- "https://api.gdeltproject.org/api/v2/tv/tv?query="
vp2 <- "%20market:%22National%22&mode=timelinevol&format=csv&datanorm=raw&startdatetime="
vp3 <- "000000&enddatetime="
vp4 <- "000000"
text_v_url <- paste0(vp1, query, vp2, startdate, vp3, enddate, vp4)
v_url <- URLencode(text_v_url)
v_url
Trump <- read_csv(v_url)
Trump <- Trump %>%
  rename(Date = 1, Trump = 3)

### Biden

# Defining query

query <- "Joe%20Biden"

# Building the volume dataframe

vp1 <- "https://api.gdeltproject.org/api/v2/tv/tv?query="
vp2 <- "%20market:%22National%22&mode=timelinevol&format=csv&datanorm=raw&startdatetime="
vp3 <- "000000&enddatetime="
vp4 <- "000000"
text_v_url <- paste0(vp1, query, vp2, startdate, vp3, enddate, vp4)
v_url <- URLencode(text_v_url)
v_url
Biden <- read_csv(v_url)
Biden <- Biden %>%
  rename(Date = 1, Biden = 3)

AllData <- left_join(Trump, Biden)

### Harris

# Defining query

query <- "Kamala%20Harris"

# Building the volume dataframe

vp1 <- "https://api.gdeltproject.org/api/v2/tv/tv?query="
vp2 <- "%20market:%22National%22&mode=timelinevol&format=csv&datanorm=raw&startdatetime="
vp3 <- "000000&enddatetime="
vp4 <- "000000"
text_v_url <- paste0(vp1, query, vp2, startdate, vp3, enddate, vp4)
v_url <- URLencode(text_v_url)
v_url
Harris <- read_csv(v_url)
Harris <- Harris %>%
  rename(Date = 1, Harris = 3)

AllData <- left_join(AllData, Harris)

### Graphic

AllData <- AllData %>%
  arrange(Date)

# Add "WeekOf" variable to the data frame

if (!require("lubridate"))
  install.packages("lubridate")
library(lubridate)

AllData$WeekOf <- round_date(AllData$Date,
                             unit = "week",
                             week_start = getOption("lubridate.week.start", 1))

CombinedCoverage <- AllData %>%
  group_by(WeekOf) %>%
  summarize(
    Trump = sum(Trump, na.rm = TRUE),
    Biden = sum(Biden, na.rm = TRUE),
    Harris = sum(Harris, na.rm = TRUE)
  )

fig <- plot_ly(
  CombinedCoverage,
  x = ~ WeekOf,
  y = ~ Trump,
  name = 'Trump',
  type = 'scatter',
  mode = 'none',
  stackgroup = 'one',
  fillcolor = '#B8001F')
fig <- fig %>% add_trace(y = ~ Biden,
                         name = 'Biden',
                         fillcolor = '#507687')

fig <- fig %>% add_trace(y = ~ Harris,
                         name = 'Harris',
                         fillcolor = '#384B70')
fig <- fig %>% layout(
  title = 'Segment counts, by topic and week',
  xaxis = list(title = "Week of", showgrid = FALSE),
  yaxis = list(title = "Count", showgrid = TRUE)
)

fig

### Results for MSNBC, CNN, and Fox News, separately

# MSNBC

MSNBC <- AllData %>%
  filter(Series == "MSNBC")
figMSNBC <- plot_ly(
  MSNBC,
  x = ~ WeekOf,
  y = ~ Trump,
  name = 'Trump',
  type = 'scatter',
  mode = 'none',
  stackgroup = 'one',
  fillcolor = '#B8001F')
figMSNBC <- figMSNBC %>% add_trace(y = ~ Biden,
                                   name = 'Biden',
                                   fillcolor = '#507687')
figMSNBC <- figMSNBC %>% add_trace(y = ~ Harris,
                                   name = 'Harris',
                                   fillcolor = '#384B70')
figMSNBC <- figMSNBC %>% layout(
  title = 'Segment counts, MSNBC, by topic and week',
  xaxis = list(title = "Week of", showgrid = FALSE),
  yaxis = list(title = "Count", showgrid = TRUE)
)

figMSNBC

# CNN

CNN <- AllData %>%
  filter(Series == "CNN")
figCNN <- plot_ly(
  CNN,
  x = ~ WeekOf,
  y = ~ Trump,
  name = 'Trump',
  type = 'scatter',
  mode = 'none',
  stackgroup = 'one',
  fillcolor = '#B8001F')
figCNN <- figCNN %>% add_trace(y = ~ Biden,
                               name = 'Biden',
                               fillcolor = '#507687')
figCNN <- figCNN %>% add_trace(y = ~ Harris,
                               name = 'Harris',
                               fillcolor = '#384B70')
figCNN <- figCNN %>% layout(
  title = 'Segment counts, CNN, by topic and week',
  xaxis = list(title = "Week of", showgrid = FALSE),
  yaxis = list(title = "Count", showgrid = TRUE)
)

figCNN

#Fox News

FoxNews <- AllData %>%
  filter(Series == "FOXNEWS")
figFox <- plot_ly(
  FoxNews,
  x = ~ WeekOf,
  y = ~ Trump,
  name = 'Trump',
  type = 'scatter',
  mode = 'none',
  stackgroup = 'one',
  fillcolor = '#B8001F')
figFox <- figFox %>% add_trace(y = ~ Biden,
                               name = 'Biden',
                               fillcolor = '#507687')
figFox <- figFox %>% add_trace(y = ~ Harris,
                               name = 'Harris',
                               fillcolor = '#384B70')
figFox <- figFox %>% layout(
  title = 'Segment counts, Fox News, by topic and week',
  xaxis = list(title = "Week of", showgrid = FALSE),
  yaxis = list(title = "Count", showgrid = TRUE)
)

figFox

TN County Presidential Voting Shifts

Voting shifts, 2016-2020

This map shows county-level vote shifts by party for the 2016 and 2020 elections. In 2016, Trump beat Democratic nominee Hillary Clinton. In 2020, Trump lost to Democratic nominee Joe Biden.

Voting shifts 2020-2024

This map shows county-level vote shifts by party for the 2020 and 2024 elections. In 2020, Trump lost to Democratic nominee Joe Biden. In 2024, Trump beat to Democratic nominee Kamala Harris.

# Required packages

if (!require("tidyverse"))
  install.packages("tidyverse")
if (!require("mapview"))
  install.packages("mapview")
if (!require("sf"))
  install.packages("sf")
if (!require("leaflet"))
  install.packages("leaflet")
if (!require("leaflet.extras2"))
  install.packages("leaflet.extras2")
if (!require("plotly"))
  install.packages("plotly")
if (!require("tidycensus"))
  install.packages("tidycensus")

library(tidyverse)
library(mapview)
library(sf)
library(leaflet)
library(leafpop)
library(readxl)
library(plotly)
library(tidycensus)

# Go ahead and transmit your Census API key
# so you don't forget to do it later when getting
# the map you will need:

census_api_key("7c104e78c808db67e932035eb8d2a91d0a31202c")

# Download and import election data
# from TN Secretary of State web site:
# https://sos.tn.gov/elections/results

# Get 2016 data

download.file(
  "https://sos-tn-gov-files.s3.amazonaws.com/StateGeneralbyPrecinctNov2016.xlsx",
  "RawElectionData2016.xlsx",
  quiet = TRUE,
  mode = "wb"
)

RawElectionData2016 <- read_xlsx("RawElectionData2016.xlsx")

# Filter, calculate, and select
# to get data of interest
# then store results in MyData dataframe

MyData2016 <- RawElectionData2016%>%
  filter(OFFICENAME == "United States President",
         CANDGROUP == "1") %>%
  mutate(
    Rep16 = PVTALLY1,
    Dem16 = PVTALLY2,
    Total16 = Rep16 + Dem16) %>%
  select(COUNTY, PRECINCT, OFFICENAME, Rep16, Dem16, Total16)

CountyData2016 <- MyData2016 %>% 
  select(COUNTY, Rep16, Dem16, Total16) %>% 
  group_by(COUNTY) %>% 
  summarize(across(everything(), sum)) 

# Get 2020 data

download.file(
  "https://sos-tn-gov-files.tnsosfiles.com/Nov2020PrecinctDetail.xlsx",
  "RawElectionData2020.xlsx",
  quiet = TRUE,
  mode = "wb"
)

RawElectionData2020 <- read_xlsx("RawElectionData2020.xlsx", sheet = "SOFFICEL")

# Filter, calculate, and select
# to get data of interest
# then store results in MyData dataframe

MyData2020 <- RawElectionData2020%>%
  filter(OFFICENAME == "United States President",
         CANDGROUP == "1") %>%
  mutate(
    Rep20 = PVTALLY1,
    Dem20 = PVTALLY2,
    Total20 = Rep20 + Dem20) %>%
  select(COUNTY, PRECINCT, OFFICENAME, Rep20, Dem20, Total20)

MyData2020 <- MyData2020 %>% 
  mutate(COUNTY = case_when(COUNTY == "Dekalb" ~ "DeKalb",
                            TRUE ~ COUNTY))

CountyData2020 <- MyData2020%>% 
  select(COUNTY, Rep20, Dem20, Total20) %>% 
  group_by(COUNTY) %>% 
  summarize(across(everything(), sum)) 

# Get 2024 data

CountyData2024 <- read_csv("https://raw.githubusercontent.com/drkblake/Data/refs/heads/main/CountyData2024.csv")

# Merge Data Files

AllData <- left_join(CountyData2016, CountyData2020, by = "COUNTY")
AllData <- left_join(AllData, CountyData2024, by = "COUNTY")

AllData <- AllData %>% 
  mutate(
    Rep16to20 = Rep20-Rep16,
    Dem16to20 = Dem20-Dem16,
    Rep20to24 = Rep24-Rep20,
    Dem20to24 = Dem24-Dem20,
    Rep20finish = case_when(
      Rep16to20 < 0 ~ "Loss",
      Rep16to20 > 0~ "Gain",
      TRUE ~ "No change"),
    Dem20finish = case_when(
      Dem16to20 < 0 ~ "Loss",
      Dem16to20 > 0~ "Gain",
      TRUE ~ "No change"),
    Rep24finish = case_when(
      Rep20to24 < 0 ~ "Loss",
      Rep20to24 > 0~ "Gain",
      TRUE ~ "No change"),
    Dem24finish = case_when(
      Dem20to24 < 0 ~ "Loss",
      Dem20to24 > 0~ "Gain",
      TRUE ~ "No change"))

# Get a county map

CountyMap <- get_acs(geography = "county",
                   state = "TN",
                   variables = c(Japanese_ = "DP05_0048"),
                   year = 2022,
                   survey = "acs5",
                   output = "wide",
                   geometry = TRUE)

CountyMap <- CountyMap %>%
  mutate(COUNTY = (str_remove(NAME," County, Tennessee"))) %>%
  left_join(AllData, CountyMap, by = "COUNTY") %>% 
  select(COUNTY,
         Rep16, Dem16, Total16,
         Rep20, Dem20, Total20,
         Rep24, Dem24, Total24,
         Rep16to20, Dem16to20,
         Rep20to24, Dem20to24,
         Rep20finish,Dem20finish,
         Rep24finish,Dem24finish,
         geometry)

# 2020 Map

Map16to20Rep <- mapview(
  CountyMap,
  zcol = "Rep20finish",
  col.regions = "red",
  layer.name = "Rep 2020",
  popup = popupTable(
    CountyMap,
    feature.id = FALSE,
    row.numbers = FALSE,
    zcol = c("COUNTY", "Rep16", "Rep20", "Rep16to20")
  )
)

mypalette = colorRampPalette(c('blue', 'lightblue'))

Map16to20Dem <- mapview(
  CountyMap,
  zcol = "Dem20finish",
  col.regions = mypalette,
  layer.name = "Dem 2020",
  popup = popupTable(
    CountyMap,
    feature.id = FALSE,
    row.numbers = FALSE,
    zcol = c("COUNTY", "Dem16", "Dem20", "Dem16to20")
  )
)

Map16to20Dem | Map16to20Rep

# 2024 Map

mypalette = colorRampPalette(c('red', 'pink'))

Map20to24Rep <- mapview(
  CountyMap,
  zcol = "Rep24finish",
  col.regions = mypalette,
  layer.name = "Rep 2024",
  popup = popupTable(
    CountyMap,
    feature.id = FALSE,
    row.numbers = FALSE,
    zcol = c("COUNTY", "Rep20", "Rep24", "Rep20to24")
  )
)

mypalette = colorRampPalette(c('blue', 'lightblue'))

Map20to24Dem <- mapview(
  CountyMap,
  zcol = "Dem24finish",
  col.regions = mypalette,
  layer.name = "Dem 2024",
  popup = popupTable(
    CountyMap,
    feature.id = FALSE,
    row.numbers = FALSE,
    zcol = c("COUNTY", "Dem20", "Dem24", "Dem20to24")
  )
)

Map20to24Dem | Map20to24Rep

Code Portfolio

Phinehas Rollman

2024-12-04

Intro

GRAPI by Tennessee House District

Race for governor, 2022

Early voting in Rutherford County

Early voting in Rutherford County

Cable News Topic Tracker

TN County Presidential Voting Shifts

Voting shifts, 2016-2020

Voting shifts 2020-2024