R Final Project

GRAPI by Tennessee House District

Along the Rutherford-Davidson County boarder, about two in five renters spend 35 percent or more of their pre-tax income in housing costs, according to the 2022 American Community Survey conducted by the U.S. Census Bureau, though financial experts generally recommend spending no more than 30 percent of one’s pre-tax income on housing.

The Map:

The Table:

Estimate by district
District	Estimate	Estimate_MOE	From	To
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:

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

# 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

---

Rutherford Election Results

Race for Governor, 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.

Gubernatorial voting in Rutherford County, by precinct

R Code:

What’s necessary to produce 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

Early voting 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.

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.

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.

For more information, see the Early Voting page on Rutherford County’s website.

R Code:

Orange and Blue Point 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

Voter Turnout Bar Chart and Map Code:

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

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

Where did this come from?

The data in the chart come from GDELT, the Global Database of Events, Language and Tone, which captures online and broadcast news globally. It works as a search engine, making content accessable via keywords.

The best way to access GDELT is through the GDELT Summary web interface, but it has its limitations. Accessing the GDELT database through it’s APIs gives you more flexibility. This chart uses data from GDELT’s 2.0 Television API.

The code is complex (see below), but some key things to know:

• You can adjust the startdate and enddate values to search a different range of dates.

• With a little more involved fiddling, you can change the terms the code searches for. For example, changingquery <- "Kamala%20Harris" to query <- (Harris%20OR%20Walz) would find not only coverage of Harris but also coverage of Tim Walz, her running mate.

R Code:

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

---

Electoral Votes, 2024 Presidential Election

Electoral vote map

The Big Map, Votes by State:

The Plot, Votes by Candidate:

R Code:

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("2ccc86990a2333b21111a7e3115ef97682ce0f03")

# 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

---

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.

The following maps compare the most recent elections in terms of Republican and Democratic county-level gains and losses. Click on each county to see vote counts for each election. Zoom and pan the map to get a better look at each county.

It’s recommended to position the slider in the middle of a county so that you can observe its Democratic and Republican voter counts at the same time.

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.

Code:

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

# 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