The Queensland government collects data on road accidents dating back to 1st January 2001 and details characteristics of the incident including,

• Location of the crash (lat / long coordinates)
• ABS statistical area codes (SA2-4, LGA, remoteness)
• Atmospheric and road conditions (weather, lighting, sealed / unsealed roads, speed limit zone, etc)
• Severity of the incident (minor injury to fatality)
• Types of vehicles involved (car, bus, truck, bike, etc) and
• Description of the incident

Mapping this data highlights hot spots where car accidents occur more often. In particular the dangerous areas in wet conditions, problematic intersections and the areas of Queensland which are more dangerous than others in terms of fatality rates.

I developed a Shiny App utilising leaflet to easily explore the data (and just for fun). It features,

• A collapsible panel for filtering the data by selecting statistical areas and other features.
• An insights panel showing the breakdown of severity, vehicles involved, accidents over time and a Bayesian estimate of the fatality rate for the selected area.
• Data explorer tab.

This data is of road accidents, so the estimate of fatality rate in this case is the fatality rate given the vehicle was involved in an accident, rather than the fatality rate by road accident in the population. It is a slightly different take on how this statistic is usually published, but a useful one.

The best way to view the app is to run the following code. Firstly, check to make sure you have the packages installed by running

check_packages <- function(packages){
  if(all(packages %in% rownames(installed.packages()))){
    TRUE
  }else{
    cat("Install the following packages before proceding\n", packages[!(packages %in% rownames(installed.packages()))], "\n")
  }
}
packages_needed <- c("tidyverse", "shiny", "leaflet", "leaflet.extras", "magrittr", "htmltools", "htmlwidgets", "showtext", "data.table")
check_packages(packages_needed)

If all good, now run the line below and it will load the app.

runGitHub("doehm/road-accidents/", "doehm", launch.browser = TRUE)

This will launch it directly on your machine. Or you can follow the link directly to the Shiny app.

There are a lot of neat things we can do with this data and I’ll be adding to the app over time.

Brisbane Inner

A subset of the app focuses on the “Brisbane Inner” SA3 area to give a taste of what to expect. It shows car accidents in the city since 1st January 2013. When zooming in, hover over the marker to get a short description of the crash.

View the full screen map here.

Code bits

Below is the underlying code of the example above leaflet map, but I strongly recommend running the code above to view the Shiny app. See Github for the full code.

# queensland road accident data

# libraries
library(tidyverse)
library(shiny)
library(leaflet)
library(leaflet.extras)
library(magrittr)
library(htmltools)
library(htmlwidgets)
library(showtext)
library(data.table)

# font
try({
  font_add_google(name = "Montserrat", family = "mont")
  showtext_auto()
}, TRUE)

# load data
# or if it doesn't work grab the Rdata file from Github - see link above
load_data <- function(){
  if(!file.exists("locations.csv")){
    cat('\n Download may take a few minutes...\n')
    url <- "http://www.tmr.qld.gov.au/~/media/aboutus/corpinfo/Open%20data/crash/locations.csv"
    download.file(url, destfile = "locations.csv", method="libcurl")
  }
  accidents_raw <- read_csv("locations.csv")
  return(accidents_raw)
}
accidents_raw <- load_data() %>% filter(Crash_Severity != "Property damage only")


# sample of brisbane inner
accidents <- accidents_raw %>% 
  filter(
    Loc_ABS_Statistical_Area_3 == "Brisbane Inner",
    Crash_Year > 2013
  ) %>% 
  mutate(fatality = Count_Casualty_Fatality > 0)

# basic leaflet
m <- leaflet(accidents) %>% 
  addProviderTiles(providers$Stamen.Toner, group = "Black and white") %>% 
  addTiles(options = providerTileOptions(noWrap = TRUE), group="Colour") %>% 
  addMarkers(
    lng = ~Crash_Longitude_GDA94, 
    lat = ~Crash_Latitude_GDA94,
    clusterOptions = markerClusterOptions(),
    label = ~htmlEscape(Crash_DCA_Description)
  ) %>% 
  addCircleMarkers(
    lng = ~Crash_Longitude_GDA94[accidents$fatality], 
    lat = ~Crash_Latitude_GDA94[accidents$fatality],
    color = "#8B0000",
    stroke = FALSE,
    fillOpacity = 0.8,
    group = "Fatalities"
  ) %>% 
  addHeatmap(
    lng = ~Crash_Longitude_GDA94, 
    lat = ~Crash_Latitude_GDA94,
    radius = 17,
    blur = 25,
    cellSize = 25
  ) %>% 
  addLayersControl(
    overlayGroups = c("Fatalities"),
    baseGroups = c("Black and white","Colour"), 
    options = layersControlOptions(collapsed = FALSE)
  )

The post Queensland road accidents mapped with Shiny and leaflet in R appeared first on Daniel Oehm | Gradient Descending.