Embedded Files
# --- Operational Crime Intelligence Dashboard.r ---
# Title: Operational Crime Intelligence Dashboard
# Author: www.gerardking.dev
# Date: 2025-08-30
# Description:
# This Shiny application serves as a dynamic, data-driven tool for law enforcement,
# specifically designed for use by national police detectives, crime analysts, and
# command staff. It provides a comprehensive platform for visualizing, analyzing,
# and filtering crime incident data to support tactical operations and strategic
# planning. The app uses a simulated dataset to demonstrate core functionalities.
#
# Key Features:
# 1. **Dynamic Map & Hotspot Identification**: The core of the app is an interactive
# Leaflet map that displays crime incidents as markers. The map is designed to
# provide an immediate visual representation of geographic crime patterns,
# aiding in the rapid identification of high-density areas.
# 2. **Advanced Filtering**: Users can query the database in real-time by crime
# type, date range, and time of day, enabling highly focused investigations
# on specific criminal patterns and trends.
# 3. **Temporal Analytics**: The dashboard includes a time-series plot that
# visualizes crime volume over time. This feature is critical for understanding
# temporal patterns, predicting crime spikes, and optimizing patrol schedules.
# 4. **Actionable Data Table**: A sortable and searchable data table provides
# full access to the filtered incident records, allowing for detailed case
# review and export for external reporting or case file management.
#
# This tool is a practical example of how modern data analytics can be applied to
# policing, transforming raw data into actionable intelligence for enhanced public
# safety and more efficient resource deployment.
library(shiny)
library(dplyr)
library(leaflet)
library(ggplot2)
library(shinydashboard)
library(DT)
# --- SIMULATED DATA ---
set.seed(42)
num_crimes <- 2500
crime_types <- c("Theft", "Assault", "Burglary", "Vandalism", "Drug Offense", "Homicide", "Robbery")
# Fictional city coordinates (e.g., Toronto, Canada)
lat_center <- 43.6532
lon_center <- -79.3832
lat_range <- 0.08
lon_range <- 0.08
crime_data <- data.frame(
id = 1:num_crimes,
type = sample(crime_types, num_crimes, replace = TRUE, prob = c(0.25, 0.2, 0.2, 0.15, 0.1, 0.05, 0.05)),
date = as.Date("2024-01-01") + sample(0:364, num_crimes, replace = TRUE),
time_of_day = sample(c("Morning (06:00-11:59)", "Afternoon (12:00-17:59)", "Evening (18:00-23:59)", "Night (00:00-05:59)"), num_crimes, replace = TRUE),
case_id = paste0("CASE-", sample(10000:99999, num_crimes, replace = TRUE)),
lat = lat_center + runif(num_crimes, -lat_range, lat_range),
lon = lon_center + runif(num_crimes, -lon_range, lon_range),
description = paste("Case details for ID", 1:num_crimes, "here.")
)
# --- UI DEFINITION ---
ui <- dashboardPage(
skin = "blue",
dashboardHeader(title = "Operational Crime Intelligence"),
dashboardSidebar(
sidebarMenu(
menuItem("Crime Map & Trends", tabName = "map_trends", icon = icon("map-marked-alt")),
menuItem("Incident Log", tabName = "data_table", icon = icon("table"))
),
# Operational Filters for Rapid Analysis
selectInput("crime_type_filter",
"Filter by Crime Type:",
choices = c("All" = "All", crime_types),
selected = "All"
),
dateRangeInput("date_range_filter",
"Incident Date Range:",
start = min(crime_data$date),
end = max(crime_data$date)
),
selectInput("time_of_day_filter",
"Time of Day:",
choices = c("All" = "All", unique(crime_data$time_of_day)),
selected = "All"
)
),
dashboardBody(
tabItems(
# Tab 1: Map and Analytical Plots
tabItem(tabName = "map_trends",
fluidRow(
box(
title = "Geographic Crime Map", status = "primary", solidHeader = TRUE, width = 8,
leafletOutput("crime_map", height = "650px")
),
box(
title = "Temporal Analysis", status = "info", solidHeader = TRUE, width = 4,
plotOutput("time_plot", height = "300px"),
hr(),
plotOutput("time_of_day_plot", height = "300px")
)
)
),
# Tab 2: Raw Data Table
tabItem(tabName = "data_table",
fluidRow(
box(
title = "Filtered Incident Log", status = "warning", solidHeader = TRUE, width = 12,
DTOutput("crime_table")
)
)
)
)
)
)
# --- SERVER LOGIC ---
server <- function(input, output, session) {
# Reactive expression to filter the data based on user inputs
filtered_data <- reactive({
df <- crime_data %>%
filter(date >= input$date_range_filter[1] & date <= input$date_range_filter[2])
if (input$crime_type_filter != "All") {
df <- df %>% filter(type == input$crime_type_filter)
}
if (input$time_of_day_filter != "All") {
df <- df %>% filter(time_of_day == input$time_of_day_filter)
}
df
})
# Render the initial Leaflet map
output$crime_map <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
setView(lng = lon_center, lat = lat_center, zoom = 12)
})
# Observer to update map markers whenever the filtered data changes
observe({
proxy <- leafletProxy("crime_map", data = filtered_data())
# Define color palette for crime types
crime_pal <- colorFactor(palette = "viridis", domain = crime_types)
proxy %>%
clearMarkers() %>%
addCircleMarkers(
lng = ~lon,
lat = ~lat,
radius = 6,
color = ~crime_pal(type),
fillOpacity = 0.8,
stroke = TRUE,
popup = ~paste0(
"<b>Case ID:</b> ", case_id, "<br>",
"<b>Type:</b> ", type, "<br>",
"<b>Date:</b> ", date, "<br>",
"<b>Time:</b> ", time_of_day, "<br>",
"<b>Description:</b> ", description
)
)
})
# Render the time-series plot
output$time_plot <- renderPlot({
plot_data <- filtered_data() %>%
group_by(date) %>%
summarise(count = n())
ggplot(plot_data, aes(x = date, y = count)) +
geom_line(color = "darkblue", size = 1.1) +
geom_point(color = "darkblue", size = 2) +
labs(title = "Crime Incidents by Day",
x = "Date",
y = "Number of Incidents") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 10))
})
# Render the time of day plot (bar chart)
output$time_of_day_plot <- renderPlot({
plot_data <- filtered_data() %>%
group_by(time_of_day) %>%
summarise(count = n()) %>%
mutate(time_of_day = factor(time_of_day, levels = c("Morning (06:00-11:59)", "Afternoon (12:00-17:59)", "Evening (18:00-23:59)", "Night (00:00-05:59)")))
ggplot(plot_data, aes(x = time_of_day, y = count, fill = time_of_day)) +
geom_bar(stat = "identity") +
labs(title = "Incidents by Time of Day",
x = "Time of Day",
y = "Number of Incidents") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"),
axis.title.x = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1, size = 10),
legend.position = "none") +
scale_fill_manual(values = c("Morning (06:00-11:59)" = "#1f78b4", "Afternoon (12:00-17:59)" = "#33a02c", "Evening (18:00-23:59)" = "#e31a1c", "Night (00:00-05:59)" = "#6a3d9a"))
})
# Render the data table
output$crime_table <- renderDT({
datatable(
filtered_data() %>% select(-id, -lat, -lon, -description), # Exclude unnecessary columns
options = list(
pageLength = 15,
scrollX = TRUE,
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf')
),
extensions = 'Buttons'
)
})
}
# --- RUN THE APP ---
shinyApp(ui = ui, server = server)
# --- app.R ---
# Title: Detective Link Analysis Dashboard
# Author: www.gerardking.dev
# Date: 2025-08-30
# Description:
# This Shiny app serves as a link analysis tool for detectives, helping them
# visualize and explore relationships between various entities in a criminal
# investigation. It provides a dynamic and interactive network graph to uncover
# hidden connections that might not be apparent in raw data. The application
# simulates data for an investigation involving suspects, locations, and phone
# records to demonstrate its capabilities.
#
# Key Features:
# 1. **Interactive Network Graph**: The core of the tool is a `visNetwork` graph
# that visualizes entities (nodes) and their relationships (edges). Users can
# drag nodes, zoom, and inspect details by clicking on them.
# 2. **Entity Filtering**: The sidebar allows detectives to filter the network
# to focus on specific entities, such as a primary suspect or a key location,
# simplifying complex networks for focused analysis.
# 3. **Data-Driven Insights**: The app displays the raw data for the nodes and
# edges, providing transparency and allowing for detailed data inspection
# alongside the visual network.
# 4. **Simulated Scenario**: The app uses a simulated dataset to model a real-world
# investigation, including individuals, addresses, and communications data,
# demonstrating how the tool can be applied to real-world cases.
#
# This application is a practical example of how data visualization and network
# analysis can transform raw investigative data into actionable intelligence,
# aiding in pattern recognition and case resolution.
library(shiny)
library(shinydashboard)
library(visNetwork)
library(dplyr)
library(DT)
# --- SIMULATED DATA ---
# This data simulates a criminal investigation scenario
set.seed(123)
num_people <- 20
num_locations <- 10
num_phones <- 15
# Nodes (Entities)
nodes_df <- data.frame(
id = 1:(num_people + num_locations + num_phones),
label = c(
paste("Person", 1:num_people),
paste("Address", 1:num_locations),
paste("Phone", 1:num_phones)
),
group = c(
rep("Person", num_people),
rep("Location", num_locations),
rep("Phone", num_phones)
),
title = c(
paste("Details for Person", 1:num_people),
paste("Details for Address", 1:num_locations),
paste("Details for Phone", 1:num_phones)
)
)
# Edges (Relationships)
edges_df <- bind_rows(
data.frame(
from = sample(1:num_people, 20, replace = TRUE),
to = sample((num_people + 1):(num_people + num_locations), 20, replace = TRUE),
label = "Associated with",
arrows = "to",
color = "blue"
),
data.frame(
from = sample(1:num_people, 15, replace = TRUE),
to = sample((num_people + num_locations + 1):(num_people + num_locations + num_phones), 15, replace = TRUE),
label = "Owns phone",
arrows = "to",
color = "green"
),
data.frame(
from = sample((num_people + num_locations + 1):(num_people + num_locations + num_phones), 30, replace = TRUE),
to = sample((num_people + num_locations + 1):(num_people + num_locations + num_phones), 30, replace = TRUE),
label = "Called",
arrows = "from,to",
color = "red"
)
)
# --- UI DEFINITION ---
ui <- dashboardPage(
dashboardHeader(title = "Detective Link Analysis"),
dashboardSidebar(
sidebarMenu(
menuItem("Network Graph", tabName = "network", icon = icon("project-diagram")),
menuItem("Raw Data", tabName = "data", icon = icon("table"))
),
# Filters to interact with the network
h4("Network Filters", style = "margin-left: 15px;"),
selectizeInput(
"selected_entities",
"Select Entities to Focus:",
choices = NULL, # Will be populated by the server
multiple = TRUE,
options = list(placeholder = 'Search for a suspect, location, etc.')
),
hr(),
actionButton("reset_network", "Reset Network View", icon = icon("undo"))
),
dashboardBody(
tabItems(
tabItem(tabName = "network",
fluidRow(
box(
title = "Investigation Network",
status = "primary",
solidHeader = TRUE,
width = 12,
visNetworkOutput("link_network", height = "700px")
)
)
),
tabItem(tabName = "data",
fluidRow(
box(
title = "Entity Data",
status = "info",
solidHeader = TRUE,
width = 6,
DTOutput("node_table")
),
box(
title = "Relationship Data",
status = "info",
solidHeader = TRUE,
width = 6,
DTOutput("edge_table")
)
)
)
)
)
)
# --- SERVER LOGIC ---
server <- function(input, output, session) {
# Update selectizeInput choices based on available nodes
updateSelectizeInput(session, "selected_entities", choices = nodes_df$label, server = TRUE)
# Reactive expression for filtered nodes and edges
filtered_data <- reactive({
# If no entities are selected, show the full network
if (is.null(input$selected_entities) || length(input$selected_entities) == 0) {
nodes <- nodes_df
edges <- edges_df
} else {
# Identify the IDs of the selected entities
selected_ids <- nodes_df %>% filter(label %in% input$selected_entities) %>% pull(id)
# Filter edges that are connected to the selected nodes
edges <- edges_df %>%
filter(from %in% selected_ids | to %in% selected_ids)
# Identify all nodes connected to the filtered edges
connected_nodes_ids <- unique(c(edges$from, edges$to))
nodes <- nodes_df %>%
filter(id %in% connected_nodes_ids)
}
list(nodes = nodes, edges = edges)
})
# Render the visNetwork graph
output$link_network <- renderVisNetwork({
data <- filtered_data()
visNetwork(data$nodes, data$edges, main = "Investigative Network", submain = "Drag nodes or use filters to explore.") %>%
visGroups(groupname = "Person", shape = "icon", icon = list(code = "f007", color = "darkblue")) %>%
visGroups(groupname = "Location", shape = "icon", icon = list(code = "f3c5", color = "darkgreen")) %>%
visGroups(groupname = "Phone", shape = "icon", icon = list(code = "f095", color = "darkred")) %>%
addFontAwesome() %>%
visEdges(smooth = TRUE, physics = TRUE) %>%
visLayout(randomSeed = 123) %>%
visInteraction(navigationButtons = TRUE, multiselect = TRUE, keyboard = TRUE) %>%
visPhysics(solver = "forceAtlas2Based", forceAtlas2Based = list(gravitationalConstant = -50))
})
# Reset button functionality
observeEvent(input$reset_network, {
updateSelectizeInput(session, "selected_entities", selected = "")
})
# Render data tables
output$node_table <- renderDT({
data <- filtered_data()
datatable(data$nodes, options = list(pageLength = 10, dom = 'Bfrtip', buttons = c('copy', 'csv')), extensions = 'Buttons')
})
output$edge_table <- renderDT({
data <- filtered_data()
datatable(data$edges, options = list(pageLength = 10, dom = 'Bfrtip', buttons = c('copy', 'csv')), extensions = 'Buttons')
})
}
# --- RUN THE APP ---
shinyApp(ui = ui, server = server)
Page updated
Google Sites
Report abuse