Final Project
Kameron Scott
2024-12-10
I took a class on election analytics where, using RStudio, we
generated maps, graphs and charts for the 2024 election. Here are a few
examples of the work that I did in the class:
GRAPI by Tennessee House District
GRAPI stands for Gross Rent as a Percentage of Household Income. According to Census data, around 30% of Rutherford County renters can’t truly afford their rent. In this map, we show a map of renters who are overspending on rent by state house district in Rutherford County.
# 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("8169cbd2acbf0e8192c8227192f97e4411b6d1ab")
# 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
MyTableRutherford County election results by precinct, 2022
The following map shows the 2022 gubernatorial election results by precinct in Rutherford 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
MyMapEarly voting locations in Rutherford County
The map and code below was used to pinpoint the exact locations of the early voting locations in Rutherford County during the early voting period between Oct. 16th-Oct. 31st.
# 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 in Rutherford County numbers
Using the following code, we used the following code to generate both the map and chart with the daily turnout numbers of those who voted in Rutherford County during the early voting period.
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 chart displays the amount of segments CNN, MSNBC and Fox each had aimed at either Trump, Harris, or Biden. This will also include separate charts for each network.
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)
)
figFox2024 election night map
This was the actual election night map that was used for Middle Tennessee News’s four television newscasts for that evening.
```{r. echo=FALSE, warning=FALSE, message=FALSE}
BigMap fig
``` r
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("8169cbd2acbf0e8192c8227192f97e4411b6d1ab")
# 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
figTN Vote shift map from 2016-2024
The following maps show the vote shift from every county from 2016-2020 and 2020-2024
# 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("=8169cbd2acbf0e8192c8227192f97e4411b6d1ab")
# 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