Intro

I was a Graduate Teaching Assistant for Dr. Blake’s Election Analytics class where I helped his class learn how to analyze, graph and map election-related data using RStudio and R programming language. Since this was also tied to my independent study course with Dr. Blake, here are some examples of the projects that I completed and helped with.

Pre-Election Analyses:

1. GRAPI by Tennessee House District

GRAPI stands for “Gross Rent as a Percentage of Income” which is a common statistic used to measures how affordable monthly rent is for people who live in a specific area. The map and table below show the proportion of renters in each Tennessee House of Reps district who spend 35% or more of monthly household income on their rent. This includes both rent and utilities.

Data come from the 2022 five-year 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

R Code

For reference, here is the code that produced the map:

# 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("b5b19a06f6bd0f1a6c24177c0a20d7f01bb2b49b")

# 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

2. Precinct-level Rutherford election results from 2022

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 official 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.

RCode

For reference, here is the code that produced the map:

# 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

3. Early Voting Location Map & Code

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. The blue marker shows the location of Middle Tennessee State University.

RCode

For reference, here is the code that produced the map:

# 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

4. Early Voting Turnout Report and Code

Early Voting was from Oct. 16 through Oct. 31. In Rutherford County 115,133 of all registered votershad voted early, or about 51 percent of all county voters registered for the November 5 election. The highest turnout of early voters was the first day with, 10,701 people casting their ballots. MTSU had the lowest turnout of early voters among the districts.

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

## Rows: 33 Columns: 2
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (2): Precinct, RegVoters
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

RCode

For reference, here is the code that produced the map:

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)


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)

5. Cable news coverage tracker

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 vertical “Count” scale measures the number of 15-second airtime segments that mention the terms queried. The content represented includes content from CNN, MSNBC, Fox News, and other cable news outlets. The data in the chart come from GDELT, the Global Database of Events, Language and Tone. GDELT captures online and broadcast news content from outlets around the world and makes that content searchable via keywords.

This chart is interactive. You can:

Turn on “compare mode” to view weekly data simultaneously.
Remove data for one or more of the candidates.
Zoom in on a particular time frame.

RCode

For reference, here is the code that produced the map:

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

Election Night Analyses

6. National Election Map and Electoral Vote Graphic

This code will download a U.S. map from the U.S. Census Bureau and, from Dr.Blake’s GitHub space, an already-completed electoral vote allocation data file. This shows what states each candidate won in the electoral college as well as how many electoral votes Trump and Harris got.

RCode

For reference, here is the code that produced the map:

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("DataEditR"))
  install.packages("DataEditR")
if (!require("leaflet"))
  install.packages("leaflet")
if (!require("leaflet.extras2"))
  install.packages("leaflet.extras2")
if (!require("plotly"))
  install.packages("plotly")

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

# Getting a U.S.map shapefile

# Note: Provide your Census API key in the line below

census_api_key("b5b19a06f6bd0f1a6c24177c0a20d7f01bb2b49b")

# U.S. Map

omit <- c("Alaska", "Puerto Rico", "Hawaii")
USMap <- get_acs(
  geography = "state",
  variables = "DP02_0154P",
  year = 2022,
  survey = "acs5",
  output = "wide",
  geometry = TRUE) %>%
  filter(!(NAME %in% omit)) %>%
  mutate(Full = NAME) %>%
  select(GEOID, Full, geometry)
st_write(USMap,"USMap.shp", append = FALSE)

# Data file

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

# Edit / update election data

USData <- data_edit(USData)
write_csv(USData,"ElectoralVotesByState2024.csv")
write_csv(USData,"ElectoralVotesByState2024_latest.csv")
          
# Merge election and map data

USWinners <- merge(USMap,USData) %>% 
  mutate(Winner = (case_when(
    Harris > Trump ~ "Harris",
    Trump > Harris ~ "Trump",
    .default = "Counting"))) %>%
  mutate(Votes = Votes.to.allocate) %>% 
  select(State, Votes, Harris, Trump, Winner, geometry)

# Make the election map

USpalette = colorRampPalette(c("darkblue","darkred"))

BigMap <- mapview(USWinners, zcol = "Winner",
        col.regions = USpalette,
        alpha.regions = .8,
        layer.name = "Winner",
        popup = popupTable(
          USWinners,
          feature.id = FALSE,
          row.numbers = FALSE,
          zcol = c(
            "State",
            "Votes",
            "Harris",
            "Trump",
            "Winner")))

# Showing the map

BigMap

# Make the electoral vote tracker

# Loading the data from a local .csv file

AllData <- read.csv("ElectoralVotesByState2024.csv")
AllData <- AllData %>%
  arrange(State)

# Formatting and transforming the data for plotting

MyData <- AllData %>%
  select(State, Votes.to.allocate,
         Unallocated, Harris, Trump) %>% 
  arrange(State)

MyData <- MyData %>%
  pivot_longer(cols=c(-State),names_to="Candidate")%>%
  pivot_wider(names_from=c(State)) %>%
  filter(Candidate == "Harris" |
           Candidate == "Trump" |
           Candidate == "Unallocated") %>%
  arrange(Candidate)

MyData <- MyData %>% 
  mutate(total = rowSums(.[2:52]))

# Formatting a horizontal line for the plot

hline <- function(y = 0, color = "darkgray") {
  list(
    type = "line",
    x0 = 0,
    x1 = 1,
    xref = "paper",
    y0 = y,
    y1 = y,
    line = list(color = color)
  )
}

# Producing the plot

fig <- plot_ly(
  MyData,
  x = ~ Candidate,
  y = ~ AK,
  legend = FALSE,
  marker = list(color = c("384B70", "B8001F", "gray")),
  type = 'bar',
  name = 'AK'
) %>% 
  add_annotations(
    visible = "legendonly",
    x = ~ Candidate,
    y = ~ (total + 20),
    text = ~ total,
    showarrow = FALSE,
    textfont = list(size = 50)
  ) 
fig <- fig %>% add_trace(y = ~ DE, name = 'DE')
fig <- fig %>% add_trace(y = ~ DC, name = 'DC')
fig <- fig %>% add_trace(y = ~ MT, name = 'MT')
fig <- fig %>% add_trace(y = ~ ND, name = 'ND')
fig <- fig %>% add_trace(y = ~ SD, name = 'SD')
fig <- fig %>% add_trace(y = ~ VT, name = 'VT')
fig <- fig %>% add_trace(y = ~ WY, name = 'WY')
fig <- fig %>% add_trace(y = ~ HI, name = 'HI')
fig <- fig %>% add_trace(y = ~ ID, name = 'ID')
fig <- fig %>% add_trace(y = ~ ME, name = 'ME')
fig <- fig %>% add_trace(y = ~ NH, name = 'NH')
fig <- fig %>% add_trace(y = ~ RI, name = 'RI')
fig <- fig %>% add_trace(y = ~ NE, name = 'NE')
fig <- fig %>% add_trace(y = ~ NM, name = 'NM')
fig <- fig %>% add_trace(y = ~ WV, name = 'WV')
fig <- fig %>% add_trace(y = ~ AR, name = 'AR')
fig <- fig %>% add_trace(y = ~ IA, name = 'IA')
fig <- fig %>% add_trace(y = ~ KS, name = 'KS')
fig <- fig %>% add_trace(y = ~ MS, name = 'MS')
fig <- fig %>% add_trace(y = ~ NV, name = 'NV')
fig <- fig %>% add_trace(y = ~ UT, name = 'UT')
fig <- fig %>% add_trace(y = ~ CT, name = 'CT')
fig <- fig %>% add_trace(y = ~ OK, name = 'OK')
fig <- fig %>% add_trace(y = ~ OR, name = 'OR')
fig <- fig %>% add_trace(y = ~ KY, name = 'KY')
fig <- fig %>% add_trace(y = ~ LA, name = 'LA')
fig <- fig %>% add_trace(y = ~ AL, name = 'AL')
fig <- fig %>% add_trace(y = ~ CO, name = 'CO')
fig <- fig %>% add_trace(y = ~ SC, name = 'SC')
fig <- fig %>% add_trace(y = ~ MD, name = 'MD')
fig <- fig %>% add_trace(y = ~ MN, name = 'MN')
fig <- fig %>% add_trace(y = ~ MO, name = 'MO')
fig <- fig %>% add_trace(y = ~ WI, name = 'WI')
fig <- fig %>% add_trace(y = ~ AZ, name = 'AZ')
fig <- fig %>% add_trace(y = ~ IN, name = 'IN')
fig <- fig %>% add_trace(y = ~ MA, name = 'MA')
fig <- fig %>% add_trace(y = ~ TN, name = 'TN')
fig <- fig %>% add_trace(y = ~ WA, name = 'WA')
fig <- fig %>% add_trace(y = ~ VA, name = 'VA')
fig <- fig %>% add_trace(y = ~ NJ, name = 'NJ')
fig <- fig %>% add_trace(y = ~ NC, name = 'NC')
fig <- fig %>% add_trace(y = ~ GA, name = 'GA')
fig <- fig %>% add_trace(y = ~ MI, name = 'MI')
fig <- fig %>% add_trace(y = ~ OH, name = 'OH')
fig <- fig %>% add_trace(y = ~ IL, name = 'IL')
fig <- fig %>% add_trace(y = ~ PA, name = 'PA')
fig <- fig %>% add_trace(y = ~ FL, name = 'FL')
fig <- fig %>% add_trace(y = ~ NY, name = 'NY')
fig <- fig %>% add_trace(y = ~ TX, name = 'TX')
fig <- fig %>% add_trace(y = ~ CA, name = 'CA')
fig <- fig %>% layout(yaxis = list(title = 'Electoral votes'),
                      barmode = 'stack',
                      showlegend = FALSE,
                      shapes = list(hline(270)))
# Showing the plot

fig

Post-Election Night Analyses

7. TN County Presidential Voting Shifts

Republican Donald Trump easily won Tennessee in both the 2020 and 2024 presidential races. But this analysis suggests he won in a different way each time. One 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. While the second 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.

RCode

For reference, here is the code that produced the map:

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

# 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

INDEPENDENT STUDY PORTFOLIO

Roni Portzen

2024-11-21

Intro

Pre-Election Analyses:

1. GRAPI by Tennessee House District

R Code

2. Precinct-level Rutherford election results from 2022

RCode

3. Early Voting Location Map & Code

RCode

4. Early Voting Turnout Report and Code

RCode

5. Cable news coverage tracker

RCode

Election Night Analyses

6. National Election Map and Electoral Vote Graphic

RCode

Post-Election Night Analyses

7. TN County Presidential Voting Shifts

RCode