diff --git a/NAMESPACE b/NAMESPACE index 1b1008c7..ba7ee087 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,10 +1,17 @@ # Generated by roxygen2: do not edit by hand +export(classify_active_travel) export(clean_make) export(clean_make_model) export(clean_model) +export(count_active_travel) export(dl_stats19) export(extract_make_stats19) +export(filter_alongside) +export(filter_dooring) +export(filter_failed_give_way) +export(filter_left_hook) +export(filter_right_hook) export(find_file_name) export(format_casualties) export(format_collisions) diff --git a/R/classify.R b/R/classify.R new file mode 100644 index 00000000..d25f0b99 --- /dev/null +++ b/R/classify.R @@ -0,0 +1,141 @@ +#' Classify active travel collision types +#' +#' These functions classify STATS19 collisions involving pedal cycles into +#' common active travel categories based on vehicle maneuvers and collision context. +#' +#' @param vehicles A STATS19 vehicle data frame with vehicle_manoeuvre, junction_location, +#' first_point_of_impact, vehicle_type, and optionally object_hit_in_carriageway columns. +#' @param collisions Optional STATS19 collision data frame for junction_detail context. +#' +#' @return A data frame with an additional `active_travel_category` column containing: +#' - "Left Hook": Motor vehicle turning left across cyclist's path +#' - "Right Hook": Motor vehicle turning right across cyclist's path +#' - "Dooring": Cyclist hit by vehicle door +#' - "Alongside": Sideswipe collisions while moving parallel +#' - "Failed to Give Way": Motor vehicle failed to yield at junction +#' - "Other": Collisions that don't fit above categories +#' +#' @name classify_active_travel +#' @export +NULL + +#' @rdname classify_active_travel +#' @export +classify_active_travel = function(vehicles, collisions = NULL) { + if (!requireNamespace("dplyr", quietly = TRUE)) { + stop("package dplyr required") + } + + required_cols = c("vehicle_manoeuvre", "vehicle_type", "first_point_of_impact") + missing = setdiff(required_cols, names(vehicles)) + if (length(missing) > 0) { + stop(paste("Missing required columns:", paste(missing, collapse = ", "))) + } + + vehicles |> + dplyr::mutate( + active_travel_category = dplyr::case_when( + vehicle_type == "Pedal cycle" & + (tolower(vehicle_manoeuvre) %in% c("parked", "parking") | + hit_object_in_carriageway == "Vehicle door") ~ "Dooring", + + vehicle_type == "Pedal cycle" & + vehicle_manoeuvre == "Turning left" ~ "Left Hook", + + vehicle_type == "Pedal cycle" & + vehicle_manoeuvre == "Turning right" ~ "Right Hook", + + vehicle_type == "Pedal cycle" & + vehicle_manoeuvre == "Going ahead" & + first_point_of_impact %in% c("Nearside", "Offside") ~ "Alongside", + + vehicle_type == "Pedal cycle" & + (vehicle_manoeuvre == "Entering main road" | + junction_location == "Entering main road") ~ "Failed to Give Way", + + vehicle_type == "Pedal cycle" ~ "Other", + + TRUE ~ NA_character_ + ) + ) +} + +#' @rdname classify_active_travel +#' @param ... Additional grouping variables (e.g., collision_severity) +#' @export +count_active_travel = function(vehicles, ...) { + if (!requireNamespace("dplyr", quietly = TRUE)) { + stop("package dplyr required") + } + + vehicles |> + dplyr::filter(!is.na(active_travel_category)) |> + dplyr::group_by(active_travel_category, ...) |> + dplyr::summarise(n = dplyr::n(), .groups = "drop") +} + +#' Filter for left hook collisions +#' +#' @param vehicles A STATS19 vehicle data frame +#' @return Filtered data frame with pedal cycles where the vehicle was turning left +#' @export +filter_left_hook = function(vehicles) { + vehicles |> + dplyr::filter( + vehicle_type == "Pedal cycle", + vehicle_manoeuvre == "Turning left" + ) +} + +#' Filter for right hook collisions +#' +#' @param vehicles A STATS19 vehicle data frame +#' @return Filtered data frame with pedal cycles where the vehicle was turning right +#' @export +filter_right_hook = function(vehicles) { + vehicles |> + dplyr::filter( + vehicle_type == "Pedal cycle", + vehicle_manoeuvre == "Turning right" + ) +} + +#' Filter for dooring collisions +#' +#' @param vehicles A STATS19 vehicle data frame +#' @return Filtered data frame with pedal cycles where vehicle was parked/parking +#' @export +filter_dooring = function(vehicles) { + vehicles |> + dplyr::filter( + vehicle_type == "Pedal cycle", + tolower(vehicle_manoeuvre) %in% c("parked", "parking") + ) +} + +#' Filter for alongside (sideswipe) collisions +#' +#' @param vehicles A STATS19 vehicle data frame +#' @return Filtered data frame with pedal cycles in sideswipe collisions +#' @export +filter_alongside = function(vehicles) { + vehicles |> + dplyr::filter( + vehicle_type == "Pedal cycle", + vehicle_manoeuvre == "Going ahead", + first_point_of_impact %in% c("Nearside", "Offside") + ) +} + +#' Filter for failed to give way collisions +#' +#' @param vehicles A STATS19 vehicle data frame +#' @return Filtered data frame with pedal cycles where vehicle was entering main road +#' @export +filter_failed_give_way = function(vehicles) { + vehicles |> + dplyr::filter( + vehicle_type == "Pedal cycle", + vehicle_manoeuvre == "Entering main road" + ) +} \ No newline at end of file diff --git a/man/classify_active_travel.Rd b/man/classify_active_travel.Rd new file mode 100644 index 00000000..94257c16 --- /dev/null +++ b/man/classify_active_travel.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/classify.R +\name{classify_active_travel} +\alias{classify_active_travel} +\alias{count_active_travel} +\title{Classify active travel collision types} +\usage{ +classify_active_travel(vehicles, collisions = NULL) + +count_active_travel(vehicles, ...) +} +\arguments{ +\item{vehicles}{A STATS19 vehicle data frame with vehicle_manoeuvre, junction_location, +first_point_of_impact, vehicle_type, and optionally object_hit_in_carriageway columns.} + +\item{collisions}{Optional STATS19 collision data frame for junction_detail context.} + +\item{...}{Additional grouping variables (e.g., collision_severity)} +} +\value{ +A data frame with an additional \code{active_travel_category} column containing: +\itemize{ +\item "Left Hook": Motor vehicle turning left across cyclist's path +\item "Right Hook": Motor vehicle turning right across cyclist's path +\item "Dooring": Cyclist hit by vehicle door +\item "Alongside": Sideswipe collisions while moving parallel +\item "Failed to Give Way": Motor vehicle failed to yield at junction +\item "Other": Collisions that don't fit above categories +} +} +\description{ +These functions classify STATS19 collisions involving pedal cycles into +common active travel categories based on vehicle maneuvers and collision context. +} diff --git a/man/filter_alongside.Rd b/man/filter_alongside.Rd new file mode 100644 index 00000000..a2870793 --- /dev/null +++ b/man/filter_alongside.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/classify.R +\name{filter_alongside} +\alias{filter_alongside} +\title{Filter for alongside (sideswipe) collisions} +\usage{ +filter_alongside(vehicles) +} +\arguments{ +\item{vehicles}{A STATS19 vehicle data frame} +} +\value{ +Filtered data frame with pedal cycles in sideswipe collisions +} +\description{ +Filter for alongside (sideswipe) collisions +} diff --git a/man/filter_dooring.Rd b/man/filter_dooring.Rd new file mode 100644 index 00000000..02065d07 --- /dev/null +++ b/man/filter_dooring.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/classify.R +\name{filter_dooring} +\alias{filter_dooring} +\title{Filter for dooring collisions} +\usage{ +filter_dooring(vehicles) +} +\arguments{ +\item{vehicles}{A STATS19 vehicle data frame} +} +\value{ +Filtered data frame with pedal cycles where vehicle was parked/parking +} +\description{ +Filter for dooring collisions +} diff --git a/man/filter_failed_give_way.Rd b/man/filter_failed_give_way.Rd new file mode 100644 index 00000000..7b9a763c --- /dev/null +++ b/man/filter_failed_give_way.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/classify.R +\name{filter_failed_give_way} +\alias{filter_failed_give_way} +\title{Filter for failed to give way collisions} +\usage{ +filter_failed_give_way(vehicles) +} +\arguments{ +\item{vehicles}{A STATS19 vehicle data frame} +} +\value{ +Filtered data frame with pedal cycles where vehicle was entering main road +} +\description{ +Filter for failed to give way collisions +} diff --git a/man/filter_left_hook.Rd b/man/filter_left_hook.Rd new file mode 100644 index 00000000..2b8474dd --- /dev/null +++ b/man/filter_left_hook.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/classify.R +\name{filter_left_hook} +\alias{filter_left_hook} +\title{Filter for left hook collisions} +\usage{ +filter_left_hook(vehicles) +} +\arguments{ +\item{vehicles}{A STATS19 vehicle data frame} +} +\value{ +Filtered data frame with pedal cycles where the vehicle was turning left +} +\description{ +Filter for left hook collisions +} diff --git a/man/filter_right_hook.Rd b/man/filter_right_hook.Rd new file mode 100644 index 00000000..be536d64 --- /dev/null +++ b/man/filter_right_hook.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/classify.R +\name{filter_right_hook} +\alias{filter_right_hook} +\title{Filter for right hook collisions} +\usage{ +filter_right_hook(vehicles) +} +\arguments{ +\item{vehicles}{A STATS19 vehicle data frame} +} +\value{ +Filtered data frame with pedal cycles where the vehicle was turning right +} +\description{ +Filter for right hook collisions +} diff --git a/vignettes/active-travel.Rmd b/vignettes/active-travel.Rmd new file mode 100644 index 00000000..f099c09f --- /dev/null +++ b/vignettes/active-travel.Rmd @@ -0,0 +1,183 @@ +--- +title: "Classifying active travel collision types" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Classifying active travel collision types} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup, message=FALSE} +library(stats19) +library(dplyr) +``` + +# Introduction + +The standard STATS19 data does not have a single column called "Left Hook." Instead, these active travel categories are derived by combining data from the Vehicles table (specifically the vehicle's maneuver) and the Collisions table (junction location). + +This vignette demonstrates how to classify STATS19 collisions involving pedal cycles into common active travel categories using the new classification functions. + +# Key columns + +To identify these categories, we use: + +- `vehicle_manoeuvre`: Describes what the vehicle was doing (turning, overtaking, etc.) +- `junction_location`: Describes where the vehicle was relative to a junction +- `first_point_of_impact`: Helps distinguish between being hit from the side vs. the front +- `hit_object_in_carriageway`: Used for dooring (Vehicle door) +- `generic_make_model` (optional): Used to identify HGVs, which are often culprits in left hook fatalities + +# Getting the data + +We start by downloading 2024 vehicle data: + +```{r} +v = get_stats19(year = 2024, type = "vehicle") +``` + +# Using the classification functions + +The package provides several functions to classify and filter active travel collisions. + +## Filter functions + +Use individual filter functions to get specific collision types: + +```{r, eval=FALSE} +# Left hook collisions +left_hooks = filter_left_hook(v) +nrow(left_hooks) +``` + +```{r, echo=FALSE} +left_hooks = filter_left_hook(v) +cat("Left hooks:", nrow(left_hooks), "\n") +``` + +```{r, eval=FALSE} +# Right hook collisions +right_hooks = filter_right_hook(v) +nrow(right_hooks) +``` + +```{r, echo=FALSE} +right_hooks = filter_right_hook(v) +cat("Right hooks:", nrow(right_hooks), "\n") +``` + +```{r, eval=FALSE} +# Dooring incidents +dooring = filter_dooring(v) +nrow(dooring) +``` + +```{r, echo=FALSE} +dooring = filter_dooring(v) +cat("Dooring:", nrow(dooring), "\n") +``` + +```{r, eval=FALSE} +# Alongside (sideswipe) collisions +alongside = filter_alongside(v) +nrow(alongside) +``` + +```{r, echo=FALSE} +alongside = filter_alongside(v) +cat("Alongside:", nrow(alongside), "\n") +``` + +```{r, eval=FALSE} +# Failed to give way +failed_give_way = filter_failed_give_way(v) +nrow(failed_give_way) +``` + +```{r, echo=FALSE} +failed_give_way = filter_failed_give_way(v) +cat("Failed to give way:", nrow(failed_give_way), "\n") +``` + +## Combined classification + +Use `classify_active_travel()` to add a category column to all vehicle records: + +```{r, eval=FALSE} +v_classified = classify_active_travel(v) +``` + +Get counts by category: + +```{r, eval=FALSE} +count_active_travel(v_classified) +``` + +# 2024 England results + +Based on 2024 STATS19 data for England: + +```{r} +# Left Hooks: Pedal cycles where vehicle was turning left +left_hooks = v |> filter(vehicle_type == "Pedal cycle", vehicle_manoeuvre == "Turning left") +cat("Left Hooks:", nrow(left_hooks), "vehicle records\n") + +# Dooring: Pedal cycles where vehicle was parked/parking +dooring = v |> filter(vehicle_type == "Pedal cycle", tolower(vehicle_manoeuvre) %in% c("parked", "parking")) +cat("Dooring:", nrow(dooring), "vehicle records\n") +``` + +# Severity analysis + +Let's examine the severity of these collision types by linking to casualty data: + +```{r, eval=FALSE} +ca = get_stats19(year = 2024, type = "casualty") + +# Left hook casualties +lh_collisions = left_hooks$collision_index +lh_casualties = ca |> filter(collision_index %in% lh_collisions, casualty_type == "Cyclist") +lh_severe = lh_casualties |> group_by(casualty_severity) |> summarise(n = n()) +print(lh_severe) +``` + +```{r, echo=FALSE} +ca = get_stats19(year = 2024, type = "casualty") + +lh_collisions = left_hooks$collision_index +lh_casualties = ca |> filter(collision_index %in% lh_collisions, casualty_type == "Cyclist") +lh_severe = lh_casualties |> group_by(casualty_severity) |> summarise(n = n()) +cat("Left hook casualties by severity:\n") +print(lh_severe) + +cat("\n") + +d_collisions = dooring$collision_index +d_casualties = ca |> filter(collision_index %in% d_collisions, casualty_type == "Cyclist") +d_severe = d_casualties |> group_by(casualty_severity) |> summarise(n = n()) +cat("Dooring casualties by severity:\n") +print(d_severe) +``` + +# Limitations + +These classifications are based on the STATS19 `vehicle_manoeuvre` field, which describes what the recorded vehicle (often the motorized vehicle, not the pedal cycle) was doing. The classification logic follows common practice used in London (TfL) and by tools like the Junction Assessment Tool (JAT), but: + +1. **Left Hook**: Currently identifies "Turning left" maneuvers - in practice, these often involve HGVs turning left across a cyclist's path +2. **Dooring**: Based on "Parked" or "Parking" vehicle manoeuvre - may miss some door-related incidents captured differently +3. **Right Hook**: May include some cases where the cyclist was also turning right (not a true hook scenario) + +For more accurate classification, additional context like the relative positions and directions of both vehicles would be needed. + +# See also + +- The [STATS19 data schema](https://www.roadsafetydata.gov.uk/data-downloads/) for official column definitions +- London Transport for Work (TfL) collision classification methodology +- Junction Assessment Tool (JAT) documentation \ No newline at end of file