Final Project Portfolio
2024-12-10
This is a compilation of all the election analytics I did in the fall 2024 election season
From county, to state, to country wide, we worked on putting together countless graphs and graphics to show different aspects of election analytics.
GRAPI by Tennessee House District
This graphic below shows the amount of renters that are over spending on housing per Housing district.
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("gtExtras"))
install.packages("gtExtras")
library(tidyverse)
library(tidycensus)
library(sf)
library(mapview)
library(gtExtras)
census_api_key("01c8ac866a65ea0aad83190e9b5c5591ab47b0df")
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)
MyVars <- Codebook %>%
filter(grepl("GRAPI", label) &
grepl("Percent!!", label))
MyVarsTable <- gt(MyVars) %>%
tab_header("Variables") %>%
cols_align(align = "left") %>%
gt_theme_538
# Displaying the table
MyVarsTable
VariableList =
c(Estimate_ = "DP04_0142P")
AllData <- get_acs(
geography = "state legislative district (lower chamber)",
state = "TN",
variables = VariableList,
year = 2022,
survey = "acs5",
output = "wide",
geometry = TRUE
)
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))
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"
)
MapData <- st_as_sf(MyData)
MyMap <- mapview(MapData,
zcol = "Estimate",
layer.name = "Estimate",
popup = TRUE)
#Displaying the map
MyMap
TableData <- st_drop_geometry(MapData)
MyTable <- gt(TableData) %>%
tab_header("Estimate by district") %>%
cols_align(align = "left") %>%
gt_theme_538
# Displaying the table
MyTablePrecinct-Level 2022 Gubernatorial election results
The map below shows the Rutherford County voting Precincts. And who was favored in each one.
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")
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
MyMapEarly Voting in Rutherford County
This graphic shows the early voting location in Rutherford county. These locations will be open between Oct. 16 and Oct. 31.
Code
# 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
MyMapEarly Voting Turnout in Rutherford County
The graph below shows the early voter turn out from the first day of early voting to the last.
The map shows precinct-level analysis.
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
The graphics below show the coverage Donald Trump, Kamala Harris, and Joe Biden had on the three largest cable news outlets.
MSNBC
CNN
FOX
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)
)
figFoxElectoral Votes, 2024 Presidential Election
These Graphics below show the electoral outcome of the election. Both by state and by vote count.
Electoral vote map
Electoral votes by candidate
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("01c8ac866a65ea0aad83190e9b5c5591ab47b0df")
# 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
figTennessee County Presidential Voting shifts
These graphics below show the shift in each TN county by party from 2016-2020, as well as 2020-2024.
2016-2020
2020-2024
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("01c8ac866a65ea0aad83190e9b5c5591ab47b0df")
# 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