Mapping NIBRS Progress: State-by-State Adoption Rates and Historical Agency Enrollment

Using {ggplot2} and {geofacet}, this graphic showcases a creative hack to apply continuous color scales in geom_density() by converting it to geom_line(), alongside composing geographically arranged layouts for state-by-state insights into NIBRS adoption trends.

About the Data

The data explored this week comes from the FBI Crime Data API, specifically focusing on agency-level data across all 50 states in the USA. This dataset, part of the FBI’s Uniform Crime Reporting (UCR) Program, includes information from over 18,000 law enforcement agencies, ranging from federal and state agencies to local, university, and tribal entities.

The data is dynamically updated through the FBI’s Crime Data Explorer (CDE), which was launched in 2017 to provide a more accessible and interactive platform for analyzing crime statistics.

Key variables in the dataset include agency type, geographic location (latitude, longitude, county, and state), and participation in the National Incident-Based Reporting System (NIBRS). Questions such as how agency types vary, their geographic distribution, and trends in NIBRS adoption can be explored using this dataset.

The data is available for analysis in both R and Python, with options to access it via the TidyTuesday GitHub repository. Thanks to Ford Johnson for curating this dataset.

Figure 1: This graphic explores the adoption of the FBI’s National Incident-Based Reporting System (NIBRS) across the United States, combining geographic and temporal insights. The faceted map, arranged by state, highlights the percentage of law enforcement agencies participating in NIBRS, revealing regional trends in adoption. Paired with density plots, it also visualizes the yearly enrollment of agencies into NIBRS, showcasing when states saw the most significant shifts toward modernized crime reporting, offering a deeper understanding of its geographic spread and historical progression across the U.S. law enforcement landscape.

How I made this graphic?

Loading required libraries

# Data Import and Wrangling Tools
library(tidyverse)            # All things tidy

# Final plot tools
library(scales)               # Nice Scales for ggplot2
library(fontawesome)          # Icons display in ggplot2
library(ggtext)               # Markdown text support for ggplot2
library(showtext)             # Display fonts in ggplot2
library(colorspace)           # Lighten and Darken colours
library(geofacet)             # Geographic facets in R

# Option 2: Read directly from GitHub
agencies <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2025/2025-02-18/agencies.csv')

Visualization Parameters

# Font for titles
font_add_google("Kavivanar",
  family = "title_font"
) 

# Font for the caption
font_add_google("Saira Extra Condensed",
  family = "caption_font"
) 

# Font for plot text
font_add_google("Mulish",
  family = "body_font"
) 

showtext_auto()

# A base Colour
bg_col <- "grey92"
seecolor::print_color(bg_col)

# Colour for highlighted text
text_hil <- "grey30"
seecolor::print_color(text_hil)

# Colour for the text
text_col <- "grey20"
seecolor::print_color(text_col)

# Define Base Text Size
bts <- 90 

# Caption stuff for the plot
sysfonts::font_add(
  family = "Font Awesome 6 Brands",
  regular = here::here("docs", "Font Awesome 6 Brands-Regular-400.otf")
)
github <- "&#xf09b"
github_username <- "aditya-dahiya"
xtwitter <- "&#xe61b"
xtwitter_username <- "@adityadahiyaias"
social_caption_1 <- glue::glue("<span style='font-family:\"Font Awesome 6 Brands\";'>{github};</span> <span style='color: {text_hil}'>{github_username}  </span>")
social_caption_2 <- glue::glue("<span style='font-family:\"Font Awesome 6 Brands\";'>{xtwitter};</span> <span style='color: {text_hil}'>{xtwitter_username}</span>")
plot_caption <- paste0(
  "**Data:** Ford Johnson through FBI's Crime Data Explorer", 
  " |  **Code:** ", 
  social_caption_1, 
  " |  **Graphics:** ", 
  social_caption_2
  )
rm(github, github_username, xtwitter, 
   xtwitter_username, social_caption_1, 
   social_caption_2)

# Add text to plot-------------------------------------------------
plot_title <- "Mapping NIBRS Progress"

plot_subtitle <- str_wrap("State-by-State Adoption Rates and Historical Agency Enrollment in FBI's National Incident-Based Reporting System.", 62)

str_view(plot_subtitle)

Exploratory Data Analysis and Wrangling

library(summarytools)
agencies |> 
  dfSummary() |> 
  view()



names(agencies)
range(agencies$nibrs_start_date, na.rm = T)

agencies |> 
  group_by(state_abbr) |> 
  summarise(
    is_nibrs = mean(is_nibrs, na.rm = T)
  )

# Custom labeling function for displaying years in 2 or 4 digits
custom_date_labels <- function(x) {
  year_labels <- format(x, "%y") # Two-digit year
  year_labels[x == as.Date("1985-01-01") | x == as.Date("2000-01-01")] <- format(x[x == as.Date("1985-01-01") | x == as.Date("2000-01-01")], "%Y") # Four-digit for 1985 and 2000
  return(year_labels)
}

# Since geom_density() and stat_density() do not support clour along x-axis,
# lets compute density manually, and then colour it using geom_line() or
# geom_point()
# Compute density for each state separately
df1 <- agencies |> 
  
  # Remove missing values
  filter(!is.na(nibrs_start_date)) |> 
  
  mutate(
    numeric_date = as.numeric(nibrs_start_date)
  ) |>  # Convert date to numeric
    
  group_by(state_abbr) |> 
  summarise(
    density_obj = list(
      density(
        numeric_date, n = 512
      )
    ), 
    .groups = "drop"
  ) |>  # Compute density per state
  
  mutate(
    x = map(
      density_obj, ~ as.Date(.x$x, origin = "1970-01-01")
      ),  # Convert back to dates
    
    y = map(density_obj, ~ .x$y)  # Extract density values
  ) |> 
  
  select(state_abbr, x, y) |> 
  
  unnest(cols = c(x, y)) # Expand lists into columns
  

# Compute percentage agencies in each state reporting data to FBI
df2 <- agencies |> 
  group_by(state_abbr) |>
  summarise(
    yes = mean(is_nibrs, na.rm = TRUE),
    no = 1 - yes
  ) |> 
  pivot_longer(
    cols = c(yes, no),
    names_to = "fill_var",
    values_to = "value"
  ) |> 
  mutate(fill_var = str_to_title(fill_var))

The Base Plots

g1 <- ggplot(
  data = df1,
  mapping =  aes(
      x = x,
      y = y,
      colour = x
    )
  ) +
  geom_line(
    linewidth = 1
  ) +
  scale_x_date(
    limits = as.Date(c("1985-01-01", "2025-01-01")),
    breaks = seq(
      as.Date("1985-01-01"), 
      as.Date("2025-01-01"), 
      by = "5 years"), 
    labels = custom_date_labels
  ) +

  scale_color_gradientn(
    # Use Viridis Turbo colors
    colors = paletteer::paletteer_c("viridis::turbo", n = 100),  
    
    # Limits
    limits = c(as.Date("1990-01-01"), 
               as.Date("2025-01-01")),
    oob = scales::squish,
    
    # Breaks at 10-year intervals
    breaks = as.Date(seq(as.Date("1990-01-01"), 
                         as.Date("2025-01-01"), 
                         by = "5 years")), 
    
    # Display labels as years (YYYY)
    labels = scales::date_format("%Y")  
  ) +
  facet_geo(
    ~state_abbr, 
    scales = "free_y",
    move_axes = TRUE
  ) +
  labs(
    x = NULL,
    y = NULL,
    colour = NULL,
    subtitle = "When did agencies start reporting to National Incident-Based Reporting System?",
    title = plot_title
  ) +
  theme_minimal(
    base_family = "body_font",
    base_size = bts
  ) +
  theme(
    
    # Overall Plot
    text = element_text(
      margin = margin(0,0,0,0, "mm"),
      colour = text_col,
      hjust = 0.5,
      vjust = 0.5
    ),
    plot.title = element_text(
        margin = margin(10,0,2,0, "mm"),
        colour = text_hil,
        hjust = 0.5,
        size = bts * 3,
        family = "title_font",
        face = "bold"
      ),
    plot.subtitle = element_text(
      colour = text_hil,
      size = bts,
      hjust = 0.5, 
      lineheight = 0.3,
      margin = margin(5,0,2,0, "mm"),
      family = "title_font"
    ),
    plot.margin = margin(3,25,2,25, "mm"),
    
    # Axis and Strips
    axis.text.y = element_blank(),
    axis.text.x = element_text(
      angle = 90, 
      size = bts / 3,
      hjust = 1
    ),
    axis.ticks = element_blank(),
    axis.ticks.length = unit(0, "mm"),
    axis.text = element_text(
      margin = margin(0,0,0,0, "mm")
    ),
    panel.spacing.y = unit(0, "mm"),
    panel.spacing.x = unit(2, "mm"),
    strip.text = element_text(
      margin = margin(2,0,0,0, "mm"),
      family = "body_font"
    ),
    panel.background = element_rect(
      fill = bg_col,
      colour = bg_col
    ),
    plot.background = element_rect(
      fill = bg_col,
      colour = bg_col
    ),
    
    # Legend
    legend.position = "inside",
    legend.position.inside = c(1, 0),
    legend.justification = c(1, 0),
    legend.direction = "vertical",
    legend.key.height = unit(15, "mm"),
    legend.key.width = unit(3, "mm"),
    legend.text = element_text(
      margin = margin(0,0,0,3, "mm"),
      size = 0.6 * bts
    ),
    legend.margin = margin(0,0,0,0, "mm"),
    legend.box.margin = margin(0,0,0,0, "mm")
  )

ggsave(
  filename = here::here(
    "data_vizs",
    "tidy_fbi_crime_data1.png"
  ),
  plot = g1,
  width = 400,
  height = 250,
  units = "mm",
  bg = bg_col
)

g2 <- ggplot(
    data = df2,
    mapping = aes(
      y = value,
      x = 1,
      fill = fill_var
    )
  ) +
  geom_col(
    colour = bg_col
  ) +
  geom_text(
    aes(label = if_else(
      value < 0.02,
      "",
      paste0(round(100 * value, 0), "%")
    ),
        x = 1),
    position = position_stack(
      vjust = 0.5
    ),
    colour = text_col,
    size = bts / 6,
    family = "caption_font"
  ) +
  coord_polar(
    theta = "y",
    clip = "off"
  ) +
  scale_fill_manual(
    values = c("#E13A3EFF", "#009E73FF")
  ) +
  scale_x_continuous(
    expand = expansion(0)
  ) +
  scale_y_continuous(
    expand = expansion(0)
  ) +
  facet_geo(
    ~state_abbr,
    move_axes = TRUE
  ) +
  labs(
    x = NULL,
    y = NULL,
    subtitle = "How many agencies participate in National Incident-Based Reporting System?",
    fill = "Participation",
    caption = plot_caption
  ) +
  theme_minimal(
    base_family = "body_font",
    base_size = bts
  ) +
  theme(
    
    # Overall Plot
    text = element_text(
      margin = margin(0,0,0,0, "mm"),
      colour = text_col,
      hjust = 0.5,
      vjust = 0.5
    ),
    
    plot.subtitle = element_text(
      colour = text_hil,
      size = bts,
      hjust = 0.5, 
      lineheight = 0.3,
      margin = margin(10,0,0,0, "mm"),
      family = "title_font"
    ),
    plot.margin = margin(0,0,3,0, "mm"),
    
    # Axis and Strips
    axis.text.y = element_blank(),
    axis.text.x = element_blank(),
    axis.ticks = element_blank(),
    axis.ticks.length = unit(0, "mm"),
    panel.spacing.y = unit(0, "mm"),
    panel.spacing.x = unit(2, "mm"),
    strip.text = element_text(
      margin = margin(0,0,-3,0, "mm"),
      family = "body_font"
    ),
    panel.background = element_rect(
      fill = bg_col,
      colour = bg_col
    ),
    plot.background = element_rect(
      fill = bg_col,
      colour = bg_col
    ),
    
    # Legend
    legend.position = "inside",
    legend.position.inside = c(1, 0),
    legend.justification = c(1, 0),
    legend.direction = "vertical",
    legend.key.height = unit(8, "mm"),
    legend.key.width = unit(16, "mm"),
    legend.text = element_text(
      margin = margin(3,0,3,3, "mm"),
      size = 1.2 * bts
    ),
    legend.title = element_text(
      hjust = 0.2,
      margin = margin(0,0,5,0, "mm")
    ),
    legend.margin = margin(0,0,30,0, "mm"),
    legend.box.margin = margin(0,0,0,0, "mm"), 
    legend.spacing.y = unit(5, "mm"),
    plot.caption = element_textbox(
        family = "caption_font",
        hjust = 0.5,
        halign = 0.5,
        margin = margin(5,0,10,0, "mm"),
        size = bts * 0.7,
        colour = text_hil
      )
  )

ggsave(
  filename = here::here(
    "data_vizs",
    "tidy_fbi_crime_data2.png"
  ),
  plot = g2,
  width = 400,
  height = 250,
  units = "mm",
  bg = bg_col
)

Compose the final image

library(magick)

img1 <- image_read(
  here::here(
    "data_vizs", "tidy_fbi_crime_data1.png"
  )
)
img2 <- image_read(
  here::here(
    "data_vizs", "tidy_fbi_crime_data2.png"
  )
)

c(img1, img2) |> 
  magick::image_append(
    stack = TRUE
  ) |> 
  image_write(
    here::here(
    "data_vizs", "tidy_fbi_crime_data.png"
    )
  )

unlink(here::here("data_vizs", "tidy_fbi_crime_data1.png"))
unlink(here::here("data_vizs", "tidy_fbi_crime_data2.png"))

Savings the thumbnail for the webpage

# Saving a thumbnail

library(magick)

# Saving a thumbnail for the webpage
image_read(here::here("data_vizs", 
                      "tidy_fbi_crime_data.png")) |> 
  image_resize(geometry = "x400") |> 
  image_write(
    here::here(
      "data_vizs", 
      "thumbnails", 
      "tidy_fbi_crime_data.png"
    )
  )

Session Info

# Data Import and Wrangling Tools
library(tidyverse)            # All things tidy

# Final plot tools
library(scales)               # Nice Scales for ggplot2
library(fontawesome)          # Icons display in ggplot2
library(ggtext)               # Markdown text support for ggplot2
library(showtext)             # Display fonts in ggplot2
library(colorspace)           # Lighten and Darken colours
library(geofacet)             # Geographic facets in R


sessioninfo::session_info()$packages |> 
  as_tibble() |> 
  select(package, 
         version = loadedversion, 
         date, source) |> 
  arrange(package) |> 
  janitor::clean_names(
    case = "title"
  ) |> 
  gt::gt() |> 
  gt::opt_interactive(
    use_search = TRUE
  ) |> 
  gtExtras::gt_theme_espn()

Table 1: R Packages and their versions used in the creation of this page and graphics