Report 6

Introduction

This interactive choropleth map shows the distribution of aggravated assaults across ZIP Code Tabulation Areas (ZCTAs) in Tennessee during the summer of 2026.

The original map showed only the total number of aggravated assaults in each ZCTA. I modified the map by adding separate layers for different times of day. Users can now switch between the total number of incidents, morning, afternoon, evening, and overnight incidents.

This modification makes the map more useful because it allows users to examine not only where aggravated assaults occur, but also when they occur. This could help reveal whether certain areas have different patterns depending on the time of day.

Modified Interactive Map

Here’s the Code

############################################################
# Load Required Packages
############################################################

suppressPackageStartupMessages({
  library(jsonlite)
  library(tidyverse)
  library(sf)
  library(leaflet)
  library(tigris)
})

options(tigris_use_cache = TRUE)

############################################################
# Download Aggravated Assault Data
############################################################

base_url <- paste0(
  "https://services2.arcgis.com/HdTo6HJqh92wn4D8/",
  "arcgis/rest/services/",
  "Metro_Nashville_Police_Department_Incidents_view/",
  "FeatureServer/0/query"
)

query <- paste(
  "Incident_Occurred >= DATE '2026-06-01'",
  "AND Incident_Occurred < DATE '2026-09-01'",
  "AND Offense_NIBRS = '13A'"
)

crime_url <- paste0(
  base_url,
  "?where=",
  URLencode(query, reserved = TRUE),
  "&outFields=*",
  "&f=json"
)

CrimeData <- fromJSON(
  crime_url
)$features$attributes
############################################################
# Step 4: Prepare the Data
############################################################

CrimeData <- CrimeData |>
  mutate(
    Incident_Occurred = as.POSIXct(
      Incident_Occurred / 1000,
      origin = "1970-01-01",
      tz = "America/Chicago"
    )
  ) |>
  filter(
    !is.na(Longitude),
    !is.na(Latitude)
  )

############################################################
# Create Time-of-Day Categories
#
# Morning   = 6 AM - Noon
# Afternoon = Noon - 6 PM
# Evening   = 6 PM - Midnight
# Overnight = Midnight - 6 AM
############################################################

CrimeData <- CrimeData |>
  mutate(
    Hour = lubridate::hour(Incident_Occurred),

    TimeOfDay = case_when(
      Hour >= 6 & Hour < 12 ~ "Morning",
      Hour >= 12 & Hour < 18 ~ "Afternoon",
      Hour >= 18 & Hour < 24 ~ "Evening",
      Hour >= 0 & Hour < 6 ~ "Overnight",
      TRUE ~ NA_character_
    )
  )

############################################################
# Step 5: Convert Incidents into a Spatial Layer
############################################################

CrimeData_sf <- st_as_sf(
  CrimeData,
  coords = c("Longitude", "Latitude"),
  crs = 4326,
  remove = FALSE
)

############################################################
# Step 6: Download ZCTA Boundaries
############################################################

TN_ZCTAs <- zctas(
  cb = TRUE,
  year = 2020
)

############################################################
# Step 7: Keep Tennessee ZCTAs
############################################################

TN_ZCTAs <- TN_ZCTAs |>
  filter(
    startsWith(ZCTA5CE20, "37")
  )

############################################################
# Step 8: Match Coordinate Systems
############################################################

TN_ZCTAs <- st_transform(
  TN_ZCTAs,
  st_crs(CrimeData_sf)
)

############################################################
# Step 9: Assign Each Incident to a ZCTA
############################################################

CrimeWithZCTA <- st_join(
  CrimeData_sf,
  TN_ZCTAs |>
    select(ZCTA5CE20)
)

############################################################
# Step 10: Create Total Incident Counts
############################################################

ZCTACounts <- CrimeWithZCTA |>
  st_drop_geometry() |>
  count(
    ZCTA5CE20,
    name = "Incidents"
  ) |>
  arrange(desc(Incidents))

############################################################
# Step 11: Create Total ZCTA Layer
############################################################

Total_ZCTAs <- TN_ZCTAs |>
  filter(
    !is.na(ZCTA5CE20),
    ZCTA5CE20 %in% unique(ZCTACounts$ZCTA5CE20)
  ) |>
  left_join(
    ZCTACounts,
    by = "ZCTA5CE20"
  ) |>
  mutate(
    Incidents = replace_na(Incidents, 0)
  )

############################################################
# Step 12: Create Time-of-Day Counts
############################################################

TimeCounts <- CrimeWithZCTA |>
  st_drop_geometry() |>
  filter(!is.na(TimeOfDay)) |>
  count(
    ZCTA5CE20,
    TimeOfDay,
    name = "Incidents"
  )

############################################################
# Step 13: Create Morning ZCTA Layer
############################################################

Morning_ZCTAs <- TN_ZCTAs |>
  filter(
    !is.na(ZCTA5CE20),
    ZCTA5CE20 %in% unique(ZCTACounts$ZCTA5CE20)
  ) |>
  left_join(
    TimeCounts |>
      filter(TimeOfDay == "Morning") |>
      select(ZCTA5CE20, Incidents),
    by = "ZCTA5CE20"
  ) |>
  mutate(
    Incidents = replace_na(Incidents, 0)
  )

############################################################
# Step 14: Create Afternoon ZCTA Layer
############################################################

Afternoon_ZCTAs <- TN_ZCTAs |>
  filter(
    !is.na(ZCTA5CE20),
    ZCTA5CE20 %in% unique(ZCTACounts$ZCTA5CE20)
  ) |>
  left_join(
    TimeCounts |>
      filter(TimeOfDay == "Afternoon") |>
      select(ZCTA5CE20, Incidents),
    by = "ZCTA5CE20"
  ) |>
  mutate(
    Incidents = replace_na(Incidents, 0)
  )

############################################################
# Step 15: Create Evening ZCTA Layer
############################################################

Evening_ZCTAs <- TN_ZCTAs |>
  filter(
    !is.na(ZCTA5CE20),
    ZCTA5CE20 %in% unique(ZCTACounts$ZCTA5CE20)
  ) |>
  left_join(
    TimeCounts |>
      filter(TimeOfDay == "Evening") |>
      select(ZCTA5CE20, Incidents),
    by = "ZCTA5CE20"
  ) |>
  mutate(
    Incidents = replace_na(Incidents, 0)
  )

############################################################
# Step 16: Create Overnight ZCTA Layer
############################################################

Overnight_ZCTAs <- TN_ZCTAs |>
  filter(
    !is.na(ZCTA5CE20),
    ZCTA5CE20 %in% unique(ZCTACounts$ZCTA5CE20)
  ) |>
  left_join(
    TimeCounts |>
      filter(TimeOfDay == "Overnight") |>
      select(ZCTA5CE20, Incidents),
    by = "ZCTA5CE20"
  ) |>
  mutate(
    Incidents = replace_na(Incidents, 0)
  )

############################################################
# Step 17: Create a Shared Color Palette
############################################################

pal <- colorNumeric(
  palette = "Reds",
  domain = c(
    0,
    max(
      Total_ZCTAs$Incidents,
      Morning_ZCTAs$Incidents,
      Afternoon_ZCTAs$Incidents,
      Evening_ZCTAs$Incidents,
      Overnight_ZCTAs$Incidents,
      na.rm = TRUE
    )
  )
)

############################################################
# Step 18: Create Popup Content
############################################################

TotalPopup <- ~paste0(
  "<strong>ZCTA:</strong> ",
  ZCTA5CE20,
  "<br><strong>Aggravated Assaults:</strong> ",
  Incidents
)

MorningPopup <- ~paste0(
  "<strong>ZCTA:</strong> ",
  ZCTA5CE20,
  "<br><strong>Morning Assaults:</strong> ",
  Incidents
)

AfternoonPopup <- ~paste0(
  "<strong>ZCTA:</strong> ",
  ZCTA5CE20,
  "<br><strong>Afternoon Assaults:</strong> ",
  Incidents
)

EveningPopup <- ~paste0(
  "<strong>ZCTA:</strong> ",
  ZCTA5CE20,
  "<br><strong>Evening Assaults:</strong> ",
  Incidents
)

OvernightPopup <- ~paste0(
  "<strong>ZCTA:</strong> ",
  ZCTA5CE20,
  "<br><strong>Overnight Assaults:</strong> ",
  Incidents
)

############################################################
# Step 19: Create Modified Interactive Choropleth Map
############################################################

ChoroplethMap <- leaflet() |>

  addProviderTiles("Esri.WorldStreetMap") |>

  ##########################################################
  # Total Layer
  ##########################################################

  addPolygons(
    data = Total_ZCTAs,
    fillColor = ~pal(Incidents),
    fillOpacity = 0.7,
    color = "black",
    weight = 1,
    popup = TotalPopup,
    group = "Total Aggravated Assaults"
  ) |>

  ##########################################################
  # Morning Layer
  ##########################################################

  addPolygons(
    data = Morning_ZCTAs,
    fillColor = ~pal(Incidents),
    fillOpacity = 0.7,
    color = "black",
    weight = 1,
    popup = MorningPopup,
    group = "Morning (6 AM - Noon)"
  ) |>

  ##########################################################
  # Afternoon Layer
  ##########################################################

  addPolygons(
    data = Afternoon_ZCTAs,
    fillColor = ~pal(Incidents),
    fillOpacity = 0.7,
    color = "black",
    weight = 1,
    popup = AfternoonPopup,
    group = "Afternoon (Noon - 6 PM)"
  ) |>

  ##########################################################
  # Evening Layer
  ##########################################################

  addPolygons(
    data = Evening_ZCTAs,
    fillColor = ~pal(Incidents),
    fillOpacity = 0.7,
    color = "black",
    weight = 1,
    popup = EveningPopup,
    group = "Evening (6 PM - Midnight)"
  ) |>

  ##########################################################
  # Overnight Layer
  ##########################################################

  addPolygons(
    data = Overnight_ZCTAs,
    fillColor = ~pal(Incidents),
    fillOpacity = 0.7,
    color = "black",
    weight = 1,
    popup = OvernightPopup,
    group = "Overnight (Midnight - 6 AM)"
  ) |>

  ##########################################################
  # Layer Control
  ##########################################################

  addLayersControl(
    baseGroups = c(
      "Total Aggravated Assaults",
      "Morning (6 AM - Noon)",
      "Afternoon (Noon - 6 PM)",
      "Evening (6 PM - Midnight)",
      "Overnight (Midnight - 6 AM)"
    ),
    options = layersControlOptions(
      collapsed = FALSE
    )
  ) |>

  ##########################################################
  # Hide Time-of-Day Layers Initially
  ##########################################################

  hideGroup("Morning (6 AM - Noon)") |>
  hideGroup("Afternoon (Noon - 6 PM)") |>
  hideGroup("Evening (6 PM - Midnight)") |>
  hideGroup("Overnight (Midnight - 6 AM)") |>

  ##########################################################
  # Legend
  ##########################################################

  addLegend(
    position = "bottomright",
    pal = pal,
    values = Total_ZCTAs$Incidents,
    title = "Aggravated Assaults"
  )

ChoroplethMap