NSF Grant Terminations

Map
R
Author

Steven Villalon

Published

May 6, 2025

#Load dependencies
library(tidyverse)
library(tidytuesdayR)

Load Data

# Load data
tuesdata <- tidytuesdayR::tt_load(2025, week = 18)
nsf_terminations <- tuesdata$nsf_terminations

#View(nsf_terminations)

Explore Data

# Get summary states for each variable
summary(nsf_terminations)
  grant_number     project_title      termination_letter_date
 Min.   :2011780   Length:1041        Min.   :2025-04-18     
 1st Qu.:2152437   Class :character   1st Qu.:2025-04-18     
 Median :2301114   Mode  :character   Median :2025-04-25     
 Mean   :2266765                      Mean   :2025-04-22     
 3rd Qu.:2342769                      3rd Qu.:2025-04-25     
 Max.   :2520318                      Max.   :2025-04-25     
                                                             
   org_name           org_city          org_state         org_district      
 Length:1041        Length:1041        Length:1041        Length:1041       
 Class :character   Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character   Mode  :character  
                                                                            
                                                                            
                                                                            
                                                                            
 usaspending_obligated  award_type        directorate_abbrev directorate       
 Min.   :   6774       Length:1041        Length:1041        Length:1041       
 1st Qu.: 188976       Class :character   Class :character   Class :character  
 Median : 356236       Mode  :character   Mode  :character   Mode  :character  
 Mean   : 590244                                                               
 3rd Qu.: 737336                                                               
 Max.   :6000000                                                               
 NA's   :2                                                                     
   division         nsf_program_name     nsf_url          usaspending_url   
 Length:1041        Length:1041        Length:1041        Length:1041       
 Class :character   Class :character   Class :character   Class :character  
 Mode  :character   Mode  :character   Mode  :character   Mode  :character  
                                                                            
                                                                            
                                                                            
                                                                            
 nsf_startdate        nsf_expected_end_date   org_zip         
 Min.   :2021-02-01   Min.   :2025-04-18    Length:1041       
 1st Qu.:2022-07-15   1st Qu.:2025-07-31    Class :character  
 Median :2023-08-01   Median :2026-04-30    Mode  :character  
 Mean   :2023-04-24   Mean   :2026-07-20                      
 3rd Qu.:2024-05-01   3rd Qu.:2027-06-30                      
 Max.   :2025-04-01   Max.   :2029-12-31                      
                                                              
   org_uei            abstract         in_cruz_list   
 Length:1041        Length:1041        Mode :logical  
 Class :character   Class :character   FALSE:572      
 Mode  :character   Mode  :character   TRUE :469      
                                                      
                                                      
                                                      
                                                      
# Count terminations by state
table(nsf_terminations$org_state)

 AK  AL  AR  AZ  CA  CO  CT  DC  DE  FL  GA  HI  IA  ID  IL  IN  KS  KY  LA  MA 
  3  11   6  32 112  39   8  30   3  36  40   8   6   6  42  23   3   7  12  51 
 MD  ME  MI  MN  MO  MS  MT  NC  ND  NE  NH  NJ  NM  NV  NY  OH  OK  OR  PA  PR 
 32   1  41  19  11   8   2  38   3   9   2  13  10   6  69  22   5  11  45   2 
 RI  SC  TN  TX  UT  VA  VI  WA  WI  WV 
 11   6  15  73  13  41   1  36  17   1 
# Count unique states
length(unique(nsf_terminations$org_state))
[1] 50

In the dataset provided by TidyTuesday, there were no awards cancelled in Wyoming or South Dakota. The list includes Puerto Rico and Washington D.C., which is why the total is 50.

I suspect that blue states were disproportionately affected by these orders. Let’s see if that is true.

# Convert table to dataframe
cancelled_awards <- as.data.frame(table(nsf_terminations$org_state))
cancelled_awards <- cancelled_awards |> 
  rename(state = Var1,
         cancelled_awards_cnt = Freq)
head(cancelled_awards)
# Bring in additional data
election <- read_csv("data/election_results.csv")
awards_by_state <- read_csv("data/awards_by_state.csv")

head(election)
head(awards_by_state)
# Join datasets
df <- left_join(election, awards_by_state, by = "state")
df <- left_join(df, cancelled_awards, by = "state")
df <- df |> 
  select("state_nm.x", "state", "electoral_votes", "winner", "population", "cancelled_awards_cnt", "awards_funded") |> 
  rename("state_nm" = "state_nm.x") |> 
  mutate(cancelled_awards_cnt = replace_na(cancelled_awards_cnt, 0))

#View(df)
# Calculate % of awards cancelled and the index
df <- df |> 
  mutate(
    defund_rate = round(cancelled_awards_cnt / awards_funded, digits = 4),
    defund_index = round(defund_rate / mean(defund_rate, na.rm = TRUE) * 100, digits = 1))

# Add red/blue flag for winner of each state
df <- df |> 
  mutate(state_color = case_when(
    winner == "Trump" ~ "red",
    winner == "Harris" ~ "blue"),
    defund_flag = ifelse(defund_index >= 100, "Over Index", "Under Index")
  )

# Bring in centroids
state_centroids <- usmapdata::centroid_labels("states")

# Join centroids to df
df <- left_join(df, state_centroids, by = c("state" = "abbr"))

# Create a sf object for mapping purposes
library(sf)
Linking to GEOS 3.13.0, GDAL 3.8.5, PROJ 9.5.1; sf_use_s2() is TRUE
df_sf <- st_as_sf(df)

#View(df)
#View(df_sf)
# Cross tab of how many states over/under indexed
df |> 
  group_by(state_color, defund_flag) |> 
  summarize(cnt = n(), .groups = "drop")
mean(df$defund_rate)
[1] 0.08928431

Plot

library(usmap)
library(sf)
library(showtext)
Loading required package: sysfonts
Loading required package: showtextdb
# Load Lato font
font_add_google("Lato", "lato")
showtext_auto()

# Extract the Coordinate Reference System (CRS) for usmap and apply it to the df_sf
usmap_proj <- usmap_crs()
df_sf <- st_set_crs(df_sf, st_crs(usmap_proj))

# Convert defund_flag to a factor
df_sf$defund_flag <- factor(df_sf$defund_flag)

# Plot map of U.S.
plot_usmap(
  regions = "states",
  data = df_sf,
  values = "state_color") +

  # Plot the over/under index bubbles by explicitly mapping the 'geom' column to the 'geometry' aesthetic
  geom_sf(data = df_sf,
          aes(geometry = geom, size = defund_flag),
          color = "black",
          alpha = 0.6,
          inherit.aes = FALSE) +

  # Fill colors for election results
  scale_fill_manual(
    name = "2024 Election Winner",
    values = c("blue" = "#3498db","red" = "#e74c3c"),
    labels = c("Harris", "Trump")) +

  # Define bubble sizes
  scale_size_manual(
      name = "% of Grants Terminated", # Legend title
      values = c("Over Index" = 4, "Under Index" = 1),
      labels = c("Over Index", "Under Index")
      ) +

    # Plot labels
  labs(title = "Were NSF grants more likely to be terminated in blue states in April 2025?",
       subtitle = "Average grant terminations per state was ~9%, so over index states are those where 9% or \nmore of active NSF grants were defunded.",
       caption = "Chart produced by Steven Villalon for Tidy Tuesday exercise on May 6, 2025") +

  # Finer details
  theme(
    text = element_text(family = "lato"),
    plot.title = element_text(face = "bold"),
    legend.position = "right",
    plot.caption = element_text(hjust = 0))

This is a clean bit of code to get a usmap object and fill the states with a color for future use.

# Clean map plot example
library(usmap)
plot_usmap(
  regions = "states",
  data = df,
  values = "state_color") +
  
  # Fill colors for election results
  scale_fill_manual(
    name = "2024 Election Winner",
    values = c("blue" = "#3498db","red" = "#e74c3c"),
    labels = c("Harris", "Trump")) +
    
  # Format election results legend
  theme(
    legend.position = "right",
    plot.caption = element_text(hjust = 0))

Back to top