After I found the data from various sources I than normalized the datasets and correct minor spelling mistakes, like fixing Delaware spelling in the IIJA file. I then combined the funding, population, and election data into a single dataset for analysis. Finally, I split the combined data into two files: one containing only locations that participated in the 2020 presidential election and another containing all locations in the dataset.
library(readxl)library(dplyr)
Attaching package: 'dplyr'
The following objects are masked from 'package:stats':
filter, lag
The following objects are masked from 'package:base':
intersect, setdiff, setequal, union
library(tidyverse)
Warning: package 'tidyverse' was built under R version 4.6.1
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(scales)
Attaching package: 'scales'
The following object is masked from 'package:purrr':
discard
The following object is masked from 'package:readr':
col_factor
library(ggrepel)
Warning: package 'ggrepel' was built under R version 4.6.1
library(kableExtra)
Warning: package 'kableExtra' was built under R version 4.6.1
Attaching package: 'kableExtra'
The following object is masked from 'package:dplyr':
group_rows
library(broom)
Warning: package 'broom' was built under R version 4.6.1
# Load datapopulation_data <-read.csv("https://raw.githubusercontent.com/Jeovany97/Data-608/refs/heads/main/Homework/NST-EST2025-ALLDATA.csv")territory_data <-read.csv("https://raw.githubusercontent.com/Jeovany97/Data-608/refs/heads/main/Homework/US%20Territory.csv")election_data <-read.csv("https://raw.githubusercontent.com/Jeovany97/Data-608/refs/heads/main/Homework/election_2020_results_reference.csv", check.names =FALSE)url_excel <-"https://raw.githubusercontent.com/Jeovany97/Data-608/main/Homework/IIJA%20FUNDING%20AS%20OF%20MARCH%202023.xlsx"temp_excel <-tempfile(fileext =".xlsx")download.file(url_excel, destfile = temp_excel, mode ="wb")iija_data <-read_excel(temp_excel)#iija_data <- read_excel("IIJA FUNDING AS OF MARCH 2023.xlsx")
# Cleaning the datapopulation_data <- population_data %>%filter(STATE !=0) %>%select(NAME, POPESTIMATE2023)# Adding Territory population to the dataterritory_data <- territory_data %>%transmute(NAME = Territory,POPESTIMATE2023 = Population )population_data <-bind_rows( population_data, territory_data)# Function to standardize names for comparisonpreprocess_name <-function(x) { x %>%toupper() %>%# Convert to uppercasegsub("[[:punct:]]", "", .) %>%# Remove punctuationtrimws() %>%# Remove leading/trailing spacesgsub("\\s+", " ", .) # Replace multiple spaces with one}# Preparing for IIJA Funding Dataiija_data <- iija_data %>%mutate(join_name =preprocess_name(`State, Teritory or Tribal Nation`) ) %>%select( join_name,`Total (Billions)` )# Adding IIJA Funding to the datasetpopulation_data <- population_data %>%mutate(join_name =preprocess_name(NAME) ) %>%left_join( iija_data,by ="join_name" ) %>%select(-join_name)# Creating a political datasetterritories <-c("Puerto Rico","Guam","US Virgin Islands","American Samoa","Northern Mariana Islands")political_data <- population_data %>%filter(!NAME %in% territories)# 2020 Election Dataelection_data <- election_data %>%mutate(join_name =preprocess_name(state_name) ) %>%select( join_name, state_abbr,`2020_winner`, electoral_votes, biden_pct, trump_pct, lean )political_data <- political_data %>%mutate(join_name =preprocess_name(NAME) ) %>%left_join( election_data,by ="join_name" ) %>%select(-join_name)# Validiation View(population_data)View(political_data)
This first graph compares IIJA funding on a per-capital basis across states and the District of Columbia, with the dashed line representing the national average of about $569 per person. What immediately stands out is how uneven the distribution is. Alaska, Wyoming, Montana, and North Dakota receive substantially more funding per resident than the national average, while many of the larger states fall below it. The colors represent the winner of each jurisdiction in the 2020 presidential election. We can see that both Biden- and Trump-won jurisdictions appear above and below the national average, while several of the largest per-capital recipients were won by Trump. This suggests that the allocation is not proportional to population on a per-person basis, although that alone does not establish that the funding is inequitable because IIJA programs use funding formulas and infrastructure-related factors beyond population
df %>%filter(!is.na(funding_per_capita)) %>%mutate(NAME =fct_reorder(NAME, funding_per_capita)) %>%ggplot(aes(x = NAME, y = funding_per_capita, fill = biden_group)) +geom_col() +geom_hline(yintercept = natl_avg, linetype ="dashed", color ="grey30", linewidth =0.6) +coord_flip() +scale_y_continuous(labels =label_dollar()) +scale_fill_manual(values =c("Biden (2020)"="#2166ac", "Trump (2020)"="#b2182b"),na.value ="grey60", name ="2020 winner") +labs(title ="IIJA Funding per Capita Varies Substantially Across States", x =NULL, y ="IIJA funding per capita ($)",subtitle =paste0("Dashed line = national average (", label_dollar()(round(natl_avg)), " per capita)")) +theme_minimal(base_size =12) +theme(legend.position ="top", panel.grid.minor =element_blank())
This scatterplot examines whether population helps explain the differences we saw in the first graph. The downward-sloping trend line shows that as state population increases, funding per-capital generally decreases. The most noticeable examples are Alaska, Wyoming, and Montana, which have relatively small populations but some of the highest funding amounts per resident. Meanwhile, highly populated states such as California receive much less on a per-capital basis. This suggests that population is an important part of the pattern, smaller states tend to receive considerably more funding per resident than larger states. However, this should not be interpreted as proof of unfairness, since IIJA funding includes formula programs based on factors such as existing transportation funding, bridge conditions, and other infrastructure measures rather than population alone
outliers <- df %>%filter(!is.na(funding_per_capita), !is.na(POPESTIMATE2023)) %>%mutate(resid =abs(resid(lm(funding_per_capita ~log10(POPESTIMATE2023), data = .)))) %>%slice_max(resid, n =8)ggplot(df, aes(x = POPESTIMATE2023, y = funding_per_capita)) +geom_smooth(method ="lm", se =FALSE, color ="grey30", linetype ="dashed") +geom_point(aes(color = biden_group), size =3, alpha =0.85) +geom_text_repel(data = outliers, aes(label = state_abbr), size =3.3, max.overlaps =20) +scale_x_log10(labels =label_number(scale =1e-6, suffix ="M")) +scale_y_continuous(labels =label_dollar()) +scale_color_manual(values =c("Biden (2020)"="#2166ac", "Trump (2020)"="#b2182b"),na.value ="grey60", name ="2020 winner") +labs(title ="Smaller States Tend to Receive More IIJA Funding Per Resident", x ="Population (log scale)", y ="Funding per capita ($)") +theme_minimal(base_size =12) +theme(legend.position ="top")
`geom_smooth()` using formula = 'y ~ x'
pop_cor <-cor(log10(df$POPESTIMATE2023), df$funding_per_capita, use ="complete.obs")
The final graph examines the second question of whether higher IIJA funding is associated with greater political support for Biden in the 2020 election. The x-axis shows Biden’s share of the 2020 presidential vote, while the y-axis shows IIJA funding per capital, and the colors indicate which candidate won each jurisdiction. If funding per capital systematically favored areas with greater Biden support, we might expect the trend line to increase as Biden’s vote share increases. Instead, the fitted line slopes downward in this visualization, and several of the highest-funded jurisdictions are on the lower Biden vote share side of the graph. Based on this comparison, the visualization does not provide evidence that jurisdictions with greater Biden support systematically received more IIJA funding per resident. This does not prove that political considerations played no role in individual funding decisions, but it does mean that the overall pattern shown here does not support a simple relationship between greater Biden vote share and greater per-capital funding.
lm_fit <-lm(funding_per_capita ~ biden_pct, data = df)slope <-coef(lm_fit)[["biden_pct"]]p_val <-summary(lm_fit)$coefficients["biden_pct", "Pr(>|t|)"]ggplot(df, aes(x = biden_pct, y = funding_per_capita)) +geom_smooth(method ="lm", se =TRUE, color ="black") +geom_point(aes(color = biden_group), size =3, alpha =0.85) +scale_y_continuous(labels =label_dollar()) +scale_x_continuous(labels =label_number(suffix ="%")) +scale_color_manual(values =c("Biden (2020)"="#2166ac", "Trump (2020)"="#b2182b"),na.value ="grey60", name ="2020 winner") +labs(title ="Higher Biden Vote Share Is Not Associated with Higher IIJA Funding Per Capita", x ="Biden vote share, 2020 (%)", y ="Funding per capita ($)") +theme_minimal(base_size =12) +theme(legend.position ="top")
`geom_smooth()` using formula = 'y ~ x'
Data sources: IIJA allocation data (provided by assignment on Brightspace); U.S. Census Bureau Population Estimates Program (2023 & 2020 Decennial Census); 2020 presidential election results, official certified state results / FEC.
