Detroit Crime Map — 2019

---

Overview

This report visualises 2019 Detroit crime incidents drawn from the Open Crime Database via the crimedata R package. Five high-impact offense categories are mapped interactively using leaflet:

• Assault Offenses
  
• Burglary / Breaking & Entering
  
• Motor Vehicle Theft
  
• Robbery
  
• Homicide Offenses

Note: Up to 8,000 incidents are sampled for browser performance. Toggle between Points by Offense and Heat Map layers using the control panel on the map.

---

1. Install & Load Packages

library(crimedata)
library(leaflet)
library(leaflet.extras)
library(dplyr)
library(RColorBrewer)
library(DT)
library(scales)

---

2. Load Crime Data

crimes_raw <- get_crime_data(
  years  = 2019,
  cities = "Detroit",
  type   = "core"
)

cat(sprintf("Raw records loaded: %s\n", format(nrow(crimes_raw), big.mark = ",")))

## Raw records loaded: 82,682

cat(sprintf("Columns available: %s\n", paste(names(crimes_raw), collapse = ", ")))

## Columns available: uid, city_name, offense_code, offense_type, offense_group, offense_against, date_single, longitude, latitude, census_block

---

3. Clean & Filter

target_offenses <- c(
  "assault offenses",
  "burglary/breaking & entering",
  "motor vehicle theft",
  "robbery",
  "homicide offenses"
)

crimes <- crimes_raw |>
  filter(
    !is.na(longitude),
    !is.na(latitude),
    offense_group %in% target_offenses
  ) |>
  mutate(
    offense_group = as.character(offense_group),
    offense_label = paste0(
      toupper(substring(offense_group, 1, 1)),
      substring(offense_group, 2)
    ),
    date_fmt = format(date_single, "%b %d, %Y")
  ) |>
  slice_sample(n = min(8000, nrow(crimes_raw))) %>%
  mutate(
    offense_label = tools::toTitleCase(offense_group),
    date_fmt      = format(date_single, "%b %d, %Y")
  )

cat(sprintf("Incidents after filtering & sampling: %s\n", format(nrow(crimes), big.mark = ",")))

## Incidents after filtering & sampling: 8,000

cat(sprintf("Offense categories: %d\n", n_distinct(crimes$offense_label)))

## Offense categories: 5

---

4. Summary Statistics

4.1 Incidents by Offense Type

summary_tbl <- crimes %>%
  count(offense_label, name = "Count") %>%
  arrange(desc(Count)) %>%
  mutate(
    Percent = paste0(round(Count / sum(Count) * 100, 1), "%")
  ) %>%
  rename(`Offense Type` = offense_label)

datatable(
  summary_tbl,
  options  = list(pageLength = 10, dom = "t"),
  rownames = FALSE,
  caption  = "Table 1 — Sampled incidents by offense category (Detroit, 2019)"
)

# Offense breakdown — percentage bar chart
par(
  bg      = "#222",
  fg      = "#eee",
  col.axis = "#eee",
  col.lab  = "#eee",
  col.main = "#fff",
  mar     = c(5, 12, 4, 6)
)

colors <- c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00")

bp <- barplot(
  as.numeric(sub("%", "", summary_tbl$Percent)),
  names.arg = summary_tbl$`Offense Type`,
  col       = colors[1:nrow(summary_tbl)],
  border    = NA,
  horiz     = TRUE,
  las       = 1,
  xlim      = c(0, max(as.numeric(sub("%", "", summary_tbl$Percent))) + 10),
  main      = "Crime Incidents by Offense Type — Detroit 2019",
  xlab      = "Percentage of Total Incidents (%)",
  cex.names = 0.85,
  cex.axis  = 0.85
)

# Add percentage labels at end of each bar
text(
  x      = as.numeric(sub("%", "", summary_tbl$Percent)) + 1.5,
  y      = bp,
  labels = summary_tbl$Percent,
  col    = "#fff",
  cex    = 0.85,
  adj    = 0
)

4.2 Monthly Distribution

monthly <- crimes %>%
  mutate(month = format(date_single, "%b"), month_n = as.integer(format(date_single, "%m"))) %>%
  count(month, month_n, offense_label) %>%
  arrange(month_n)

# Base R barplot for zero extra dependencies
monthly_wide <- tapply(monthly$n, list(monthly$month, monthly$offense_label), sum)
monthly_wide[is.na(monthly_wide)] <- 0
month_order  <- month.abb[month.abb %in% rownames(monthly_wide)]
monthly_wide <- monthly_wide[month_order, , drop = FALSE]

par(bg = "#222", fg = "#eee", col.axis = "#eee", col.lab = "#eee",
    col.main = "#fff", mar = c(4, 4, 3, 1))

barplot(
  t(monthly_wide),
  beside  = TRUE,
  col     = brewer.pal(ncol(monthly_wide), "Set1"),
  names.arg = rownames(monthly_wide),
  legend.text = colnames(monthly_wide),
  args.legend = list(x = "topright", bty = "n", cex = 0.75, text.col = "#eee"),
  main    = "Monthly Crime Incidents by Offense Type — Detroit 2019",
  xlab    = "Month",
  ylab    = "Incident Count",
  border  = NA,
  las     = 1
)

# Time-of-day offense heatmap
# Extract hour from date_single
crimes$hour <- as.integer(format(crimes$date_single, "%H"))

# Define time-of-day bins
crimes$time_of_day <- cut(
  crimes$hour,
  breaks = c(-1, 5, 11, 16, 20, 23),
  labels = c("Late Night (12–5am)", "Morning (6–11am)", 
             "Afternoon (12–4pm)", "Evening (5–8pm)", "Night (9–11pm)")
)

# Build summary table
tod_wide <- tapply(
  rep(1, nrow(crimes)),
  list(crimes$time_of_day, crimes$offense_label),
  sum
)
tod_wide[is.na(tod_wide)] <- 0

# Plot
par(
  bg       = "#222",
  fg       = "#eee",
  col.axis = "#eee",
  col.lab  = "#eee",
  col.main = "#fff",
  mar      = c(5, 14, 4, 8)
)

colors <- c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00")

barplot(
  t(tod_wide),
  beside      = TRUE,
  horiz       = TRUE,
  col         = colors[1:ncol(tod_wide)],
  border      = NA,
  names.arg   = rownames(tod_wide),
  legend.text = colnames(tod_wide),
  args.legend = list(
    x        = "bottomright",
    bty      = "n",
    cex      = 0.75,
    text.col = "#eee",
    inset    = c(-0.02, 0)
  ),
  main  = "Crime Incidents by Time of Day & Offense Type — Detroit 2019",
  xlab  = "Incident Count",
  las   = 1,
  cex.names = 0.8
)

# Crime Incidents by Time of Day — vertical bars
time_data <- crimes |>
  mutate(
    hour = as.integer(format(date_single, "%H")),
    time_of_day = case_when(
      hour >= 0  & hour < 5  ~ "Late Night\n(12–5am)",
      hour >= 5  & hour < 12 ~ "Morning\n(6–11am)",
      hour >= 12 & hour < 17 ~ "Afternoon\n(12–4pm)",
      hour >= 17 & hour < 21 ~ "Evening\n(5–8pm)",
      hour >= 21             ~ "Night\n(9–11pm)"
    )
  ) |>
  count(time_of_day, offense_label)

time_wide <- tapply(time_data$n, list(time_data$time_of_day, time_data$offense_label), sum)
time_wide[is.na(time_wide)] <- 0

# Fix time of day order
time_order <- c("Late Night\n(12–5am)", "Morning\n(6–11am)", 
                "Afternoon\n(12–4pm)", "Evening\n(5–8pm)", "Night\n(9–11pm)")
time_wide <- time_wide[time_order[time_order %in% rownames(time_wide)], , drop = FALSE]

par(
  bg       = "#222",
  fg       = "#eee",
  col.axis = "#eee",
  col.lab  = "#eee",
  col.main = "#fff",
  mar      = c(6, 5, 4, 2)
)

colors <- c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00")

barplot(
  t(time_wide),
  beside     = TRUE,
  col        = colors[1:ncol(time_wide)],
  border     = NA,
  horiz      = FALSE,
  las        = 1,
  main       = "Crime Incidents by Time of Day & Offense Type — Detroit 2019",
  ylab       = "Incident Count",
  xlab       = "",
  cex.names  = 0.78,
  cex.axis   = 0.85,
  legend.text = colnames(time_wide),
  args.legend = list(
    x        = "topright",
    bty      = "n",
    cex      = 0.75,
    text.col = "#eee",
    fill     = colors[1:ncol(time_wide)],
    border   = NA
  )
)

mtext("Time of Day", side = 1, line = 4, col = "#eee", cex = 0.9)

# Crime Incidents by Day of Week & Offense Type
dow_data <- crimes |>
  mutate(
    day_of_week = weekdays(as.Date(date_single))
  ) |>
  count(day_of_week, offense_label)

dow_wide <- tapply(dow_data$n, list(dow_data$day_of_week, dow_data$offense_label), sum)
dow_wide[is.na(dow_wide)] <- 0

# Fix day order Monday through Sunday
day_order <- c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")
dow_wide <- dow_wide[day_order[day_order %in% rownames(dow_wide)], , drop = FALSE]

par(
  bg       = "#222",
  fg       = "#eee",
  col.axis = "#eee",
  col.lab  = "#eee",
  col.main = "#fff",
  mar      = c(6, 5, 4, 2)
)

colors <- c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00")

barplot(
  t(dow_wide),
  beside      = TRUE,
  col         = colors[1:ncol(dow_wide)],
  border      = NA,
  horiz       = FALSE,
  las         = 1,
  main        = "Crime Incidents by Day of Week & Offense Type — Detroit 2019",
  ylab        = "Incident Count",
  xlab        = "",
  cex.names   = 0.78,
  cex.axis    = 0.85,
  legend.text = colnames(dow_wide),
  args.legend = list(
    x        = "topright",
    bty      = "n",
    cex      = 0.75,
    text.col = "#eee",
    fill     = colors[1:ncol(dow_wide)],
    border   = NA
  )
)

mtext("Day of Week", side = 1, line = 4, col = "#eee", cex = 0.9)

# Crime Incidents by Day of Week — Line Chart
dow_line <- crimes |>
  mutate(
    day_of_week = weekdays(as.Date(date_single))
  ) |>
  count(day_of_week, offense_label)

# Fix day order
day_order <- c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")
offense_types <- unique(dow_line$offense_label)
colors <- c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00")

par(
  bg       = "#222",
  fg       = "#eee",
  col.axis = "#eee",
  col.lab  = "#eee",
  col.main = "#fff",
  mar      = c(6, 5, 4, 2)
)

# Set up empty plot with correct dimensions
plot(
  1:7,
  type  = "n",
  xlim  = c(1, 7),
  ylim  = c(0, max(dow_line$n) * 1.15),
  xaxt  = "n",
  main  = "Crime Incidents by Day of Week & Offense Type — Detroit 2019",
  ylab  = "Incident Count",
  xlab  = "",
  las   = 1,
  cex.axis = 0.85
)

# Add subtle grid lines
abline(h = seq(0, max(dow_line$n) * 1.15, length.out = 6),
       col = "#444", lty = 2, lwd = 0.8)

# Plot a line for each offense type
for (i in seq_along(offense_types)) {
  offense_data <- dow_line[dow_line$offense_label == offense_types[i], ]
  offense_data <- offense_data[match(day_order, offense_data$day_of_week), ]
  
  lines(
    x   = 1:7,
    y   = offense_data$n,
    col = colors[i],
    lwd = 2.5,
    lty = 1
  )
  points(
    x   = 1:7,
    y   = offense_data$n,
    col = colors[i],
    pch = 19,
    cex = 1.2
  )
}

# X axis labels
axis(
  side     = 1,
  at       = 1:7,
  labels   = day_order,
  col.axis = "#eee",
  cex.axis = 0.78,
  las      = 1
)

mtext("Day of Week", side = 1, line = 4, col = "#eee", cex = 0.9)

# Legend
legend(
  "topright",
  legend  = offense_types,
  col     = colors[1:length(offense_types)],
  lwd     = 2.5,
  pch     = 19,
  bty     = "n",
  cex     = 0.75,
  text.col = "#eee"
)

# Crime Incidents by Time of Day — Line Chart
tod_line <- crimes |>
  mutate(
    hour = as.integer(format(date_single, "%H")),
    time_of_day = case_when(
      hour >= 0  & hour < 5  ~ "Late Night\n(12–5am)",
      hour >= 5  & hour < 12 ~ "Morning\n(6–11am)",
      hour >= 12 & hour < 17 ~ "Afternoon\n(12–4pm)",
      hour >= 17 & hour < 21 ~ "Evening\n(5–8pm)",
      hour >= 21             ~ "Night\n(9–11pm)"
    )
  ) |>
  count(time_of_day, offense_label)

time_order   <- c("Late Night\n(12–5am)", "Morning\n(6–11am)", 
                  "Afternoon\n(12–4pm)", "Evening\n(5–8pm)", "Night\n(9–11pm)")
offense_cats <- sort(unique(tod_line$offense_label))
colors       <- c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00")

par(
  bg       = "#222",
  fg       = "#eee",
  col.axis = "#eee",
  col.lab  = "#eee",
  col.main = "#fff",
  mar      = c(6, 5, 4, 2)
)

# Set up empty plot with correct scale
all_counts <- tod_line$n
plot(
  1:5,
  rep(0, 5),
  type  = "n",
  xlim  = c(1, 5),
  ylim  = c(0, max(all_counts) * 1.15),
  xaxt  = "n",
  yaxt  = "n",
  main  = "Crime Incidents by Time of Day & Offense Type — Detroit 2019",
  xlab  = "",
  ylab  = "Incident Count",
  panel.first = {
    abline(h = pretty(all_counts), col = "#444", lty = 2, lwd = 0.8)
    abline(v = 1:5, col = "#333", lty = 2, lwd = 0.8)
  }
)

# Custom axes
axis(1, at = 1:5, labels = time_order, col = "#eee", col.axis = "#eee", cex.axis = 0.78, las = 1)
axis(2, col = "#eee", col.axis = "#eee", cex.axis = 0.85, las = 1)
mtext("Time of Day", side = 1, line = 5, col = "#eee", cex = 0.9)

# Draw one line per offense type
for (i in seq_along(offense_cats)) {
  cat_data <- tod_line[tod_line$offense_label == offense_cats[i], ]
  cat_data <- cat_data[match(time_order, cat_data$time_of_day), ]

  lines(
    x   = 1:5,
    y   = cat_data$n,
    col = colors[i],
    lwd = 2.5,
    lty = 1
  )
  points(
    x   = 1:5,
    y   = cat_data$n,
    col = colors[i],
    pch = 19,
    cex = 1.2
  )
}

# Legend
legend(
  "topright",
  legend   = offense_cats,
  col      = colors[seq_along(offense_cats)],
  lwd      = 2.5,
  pch      = 19,
  bty      = "n",
  cex      = 0.75,
  text.col = "#eee"
)

# Box & Whisker — Incident Hour by Offense Type
box_data <- crimes |>
  mutate(
    hour = as.integer(format(date_single, "%H"))
  )

offense_cats <- sort(unique(box_data$offense_label))
colors       <- c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00")

# Split hour values into a list by offense type
hour_list <- lapply(offense_cats, function(cat) {
  box_data$hour[box_data$offense_label == cat]
})
names(hour_list) <- offense_cats

par(
  bg       = "#222",
  fg       = "#eee",
  col.axis = "#eee",
  col.lab  = "#eee",
  col.main = "#fff",
  mar      = c(8, 5, 4, 2)
)

bp <- boxplot(
  hour_list,
  col        = colors[seq_along(offense_cats)],
  border     = "#eee",
  whisklty   = 1,
  whisklwd   = 1.5,
  staplelwd  = 1.5,
  medlwd     = 2.5,
  medcol     = "#fff",
  outpch     = 20,
  outcex     = 0.4,
  outcol     = "#aaa",
  boxwex     = 0.5,
  xaxt       = "n",
  yaxt       = "n",
  main       = "Distribution of Incident Hour by Offense Type — Detroit 2019",
  ylab       = "Hour of Day (0 = Midnight, 23 = 11pm)",
  xlab       = ""
)

# Custom X axis — angled labels
axis(
  side     = 1,
  at       = seq_along(offense_cats),
  labels   = FALSE
)
text(
  x      = seq_along(offense_cats),
  y      = par("usr")[3] - 1.2,
  labels = offense_cats,
  srt    = 30,
  adj    = 1,
  xpd    = TRUE,
  col    = "#eee",
  cex    = 0.82
)

# Custom Y axis with hour labels
axis(
  side     = 2,
  at       = c(0, 3, 6, 9, 12, 15, 18, 21, 23),
  labels   = c("12am", "3am", "6am", "9am", "12pm", "3pm", "6pm", "9pm", "11pm"),
  col      = "#eee",
  col.axis = "#eee",
  cex.axis = 0.82,
  las      = 1
)

# Subtle grid lines
abline(h = c(0, 3, 6, 9, 12, 15, 18, 21, 23), col = "#444", lty = 2, lwd = 0.8)

mtext("Offense Type", side = 1, line = 6.5, col = "#eee", cex = 0.9)

# Median labels above each box
text(
  x      = seq_along(offense_cats),
  y      = bp$stats[3, ] + 0.8,
  labels = paste0("med: ", bp$stats[3, ], ":00"),
  col    = "#fff",
  cex    = 0.72
)

# Histogram — Incident Hour Distribution by Offense Type
hist_data <- crimes |>
  mutate(
    hour = as.integer(format(date_single, "%H"))
  ) |>
  filter(!is.na(hour))

offense_cats <- sort(unique(trimws(hist_data$offense_label)))
colors       <- c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00")

# Set up grid layout — one histogram per offense type
par(
  mfrow    = c(2, 3),
  bg       = "#222",
  fg       = "#eee",
  col.axis = "#eee",
  col.lab  = "#eee",
  col.main = "#fff",
  mar      = c(4, 4, 3, 1)
)

for (i in seq_along(offense_cats)) {
  cat_hours <- hist_data$hour[hist_data$offense_label == offense_cats[i]]

  hist(
    cat_hours,
    breaks   = 0:24,
    col      = colors[i],
    border   = "#222",
    main     = offense_cats[i],
    xlab     = "Hour of Day",
    ylab     = "Incident Count",
    xaxt     = "n",
    yaxt     = "n",
    cex.main = 0.88,
    cex.lab  = 0.82,
    freq     = TRUE
  )

  # Custom X axis with readable time labels
  axis(
    side     = 1,
    at       = c(0, 6, 12, 18, 24),
    labels   = c("12am", "6am", "12pm", "6pm", "11pm"),
    col      = "#eee",
    col.axis = "#eee",
    cex.axis = 0.75
  )
  axis(
    side     = 2,
    col      = "#eee",
    col.axis = "#eee",
    cex.axis = 0.75,
    las      = 1
  )

  # Subtle grid lines
  abline(v = c(0, 6, 12, 18, 24), col = "#444", lty = 2, lwd = 0.8)

  # Mean line
  abline(v = mean(cat_hours), col = "#fff", lty = 2, lwd = 1.8)
  text(
    x      = mean(cat_hours) + 0.5,
    y      = max(hist(cat_hours, breaks = 0:24, plot = FALSE)$counts) * 0.92,
    labels = paste0("mean: ", round(mean(cat_hours), 1), "h"),
    col    = "#fff",
    cex    = 0.68,
    adj    = 0
  )
}

# 6th panel — combined legend
plot.new()
legend(
  "center",
  legend   = offense_cats,
  fill     = colors[seq_along(offense_cats)],
  border   = NA,
  bty      = "n",
  cex      = 0.88,
  text.col = "#eee",
  title    = "Offense Type",
  title.col = "#fff"
)

# Reset layout
par(mfrow = c(1, 1))

---

5. Interactive Crime Map

categories   <- sort(unique(crimes$offense_label))
palette_cols <- brewer.pal(max(3, length(categories)), "Set1")[seq_along(categories)]
pal          <- colorFactor(palette = palette_cols, domain = categories)

map <- leaflet(crimes) %>%
  # --- Basemap tiles ---
  addProviderTiles(providers$CartoDB.DarkMatter, group = "Dark") %>%
  addProviderTiles(providers$CartoDB.Positron,   group = "Light") %>%
  addProviderTiles(providers$Esri.WorldImagery,  group = "Satellite") %>%

  # --- Heatmap overlay ---
  addHeatmap(
    lng       = ~longitude,
    lat       = ~latitude,
    intensity = 1,
    blur      = 18,
    max       = 0.05,
    radius    = 12,
    group     = "Heat Map"
  ) %>%

  # --- Circle markers coloured by offense type ---
  addCircleMarkers(
    lng         = ~longitude,
    lat         = ~latitude,
    color       = ~pal(offense_label),
    radius      = 4,
    stroke      = FALSE,
    fillOpacity = 0.65,
    popup = ~paste0(
      "<b style='font-size:13px;'>", offense_label, "</b><br>",
      "<i>", date_fmt, "</i><br>",
      "<span style='color:#888;'>Census Block: ", census_block, "</span>"
    ),
    group       = "Points by Offense"
  ) %>%

  # --- Legend ---
  addLegend(
    position = "bottomright",
    pal      = pal,
    values   = ~offense_label,
    title    = "Offense Type",
    opacity  = 0.85
  ) %>%

  # --- Layer switcher ---
  addLayersControl(
    baseGroups    = c("Dark", "Light", "Satellite"),
    overlayGroups = c("Points by Offense", "Heat Map"),
    options       = layersControlOptions(collapsed = FALSE)
  ) %>%
  hideGroup("Heat Map") %>%

  # --- UI extras ---
  addMiniMap(toggleDisplay = TRUE, minimized = TRUE) %>%
  addScaleBar(position = "bottomleft") %>%
  addResetMapButton() %>%

  # --- Title overlay ---
  addControl(
    html = "<div style='
              background:rgba(0,0,0,0.7);
              color:#fff;
              padding:8px 14px;
              border-radius:6px;
              font-family:Georgia,serif;
              font-size:14px;
              line-height:1.5;'>
              <b>Detroit  Crime Map — 2019</b><br>
              <span style='font-size:11px;color:#bbb;'>
                Click any marker for offense details
              </span>
            </div>",
    position = "topleft"
  )

map

---

6. Raw Data Preview

The table below shows a random sample of 200 records from the filtered dataset. Use the search box to filter by offense type, census_block, or date.

crimes %>%
  select(
    Date        = date_fmt,
    `Offense`   = offense_label,
    census_block     = census_block,
    Latitude    = latitude,
    Longitude   = longitude
  ) %>%
  slice_sample(n = 200) %>%
  datatable(
    filter   = "top",
    options  = list(pageLength = 10, scrollX = TRUE),
    rownames = FALSE,
    caption  = "Table 2 — Sample of 200 incidents (randomly drawn)"
  )

---

7. Notes & Customisation

Parameter	Current Value	How to Change
City	Detroit	Replace in get_crime_data(cities = ...)
Year	2019	Replace in get_crime_data(years = ...)
Sample size	8,000	Change n = min(8000, n())
Offense filter	5 categories	Edit target_offenses vector
Basemap default	Dark	Swap addProviderTiles order

htmlwidgets::saveWidget(map, "Detroit_crime_map_2019.html", selfcontained = TRUE)

Export tip: To save the map as a standalone HTML file, add this chunk at the end:

htmlwidgets::saveWidget(map, "Detroit_crime_map_2019.html", selfcontained = TRUE)

---

Report generated with R 4.5.2 · crimedata · leaflet · leaflet.extras · DT