README.qmd

---
format: gfm
execute: 
  message: false
  warning: false
  echo: false
---


<!-- badges: start -->
[![R-CMD-check](https://github.com/ITSLeeds/opsnap/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/ITSLeeds/opsnap/actions/workflows/R-CMD-check.yaml)
<!-- badges: end -->

```{r}
#| echo: false
#| eval: false
# Package setup:
# usethis::use_description()
# usethis::use_package("sf")
# usethis::use_package("stplanr")
# usethis::use_package("ggplot2")
# usethis::use_package("dplyr")
# usethis::use_r("opsnap")
# 
# # Rbuildignore the data folder:
# usethis::use_build_ignore("data")
# # MIT license:
# usethis::use_mit_license("Leeds Institute for Transport Studies")
# 
# # Add CI
# usethis::use_github_action_check_standard()
# # Add pkgdown
# usethis::use_pkgdown()
# # Add pkgdown action
# usethis::use_github_action("pkgdown")
# # Add gh pages:
# usethis::use_github_pages()
```

# Note

This package is in development and not yet on CRAN.
If you would like to use it, please install it from GitHub as shown below, and cite it as follows:

Farrell, G., Lovelace, R., & O'Hern, S. (2024). Road User Video Evidence of Road Traffic Offences: Preliminary Analysis of Operation Snap Data and Suggestions for a Research Agenda. https://doi.org/10.31235/osf.io/cgjmr

```
@misc{farrellRoadUserVideo2024,
  title = {Road {{User Video Evidence}} of {{Road Traffic Offences}}: {{Preliminary Analysis}} of {{Operation Snap Data}} and {{Suggestions}} for a {{Research Agenda}}},
  shorttitle = {{{ROAD USER VIDEO EVIDENCE OF ROAD TRAFFIC OFFENCES}}},
  author = {Farrell, Graham and Lovelace, Robin and O'Hern, Steve},
  year = {2024},
  month = jul,
  publisher = {OSF},
  doi = {10.31235/osf.io/cgjmr},
  urldate = {2024-07-29},
  archiveprefix = {OSF},
  langid = {american},
  keywords = {antisocial driving,dangerous driving,near misses,Operation Snap,OpSnap,roas safety,Video evidence}
}

```

Read the full paper [here](https://osf.io/cgjmr/download/).

# Installation

Install the package from GitHub:

```{r}
#| eval: false
remotes::install_github("ITSLeeds/opsnap", force = TRUE, dependencies = TRUE)
```

```{r}
#| include: false
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "man/figures/README-",
  out.width = "100%"
)
library(tidyverse)
remotes::install_github("ITSLeeds/opsnap")
```

```{r}
#| include: false
#| echo: false
devtools::load_all()
```

# Opsnap data

The `opsnap` package provides a function to download and read in data from the West Yorkshire Police Operation Snap database. The data is available at the following URL: https://www.westyorkshire.police.uk/SaferRoadsSubmissions

Data for the following years are provided:

```{r}
#| echo: false
library(rvest)
query = ".file-link a"
url = "https://www.westyorkshire.police.uk/SaferRoadsSubmissions"
files_available = read_html(url) |>
  html_nodes(query) |>
  html_text()
links_available = read_html(url) |>
  html_nodes(query) |>
  html_attr("href")
urls = paste0("https://www.westyorkshire.police.uk", links_available)
file_names = basename(links_available)
tibble::tibble(file_names) |>
  knitr::kable()

# In preparation for reading-in all data:
# date_str = format(Sys.Date(), "%Y-%m")
date_str = format(as.Date("2024-04-01"), "%Y-%m")
file_name = paste0("data/west-yorkshire/operation_snap_", date_str, ".csv")
```

```{r}
#| eval: false
#| echo: false
# Download them to raw_data/west-yorkshire:
dir.create("raw_data/west-yorkshire", recursive = TRUE, showWarnings = FALSE)
pbapply::pblapply(urls, function(u) {
  download.file(u, paste0("raw_data/west-yorkshire/", basename(u)))
})

# Test with 2nd url:
u = urls[2]
d2 = opsnap:::download_and_read(u)
d_all = purrr::map_df(urls, opsnap:::download_and_read)
dir.create("data/west-yorkshire", recursive = TRUE, showWarnings = FALSE)
# Date to nearest month:
write_csv(d_all, file_name)
```

The data is open acess and looks like this, with names cleaned up by the package:

```{r}
#| eval: false
#| echo: true
u = "https://www.westyorkshire.police.uk/sites/default/files/2024-01/operation_snap_oct-dec_2023_0.xlsx"
d = opsnap:::download_and_read(u)
names(d_with_location)
# Old names:
#  [1] "REPORTER TRANSPORT MODE" "OFFENDER VEHICLE MAKE"  
#  [3] "OFFENDER VEHICLE MODEL"  "OFFENDER VEHICLE COLOUR"
#  [5] "OFFENCE"                 "DISTRICT"               
#  [7] "DISPOSAL"                "DATE OF SUBMISSION"     
#  [9] "...9"                    "OFF LOCATION"
# New names:
# [1] "mode"     "make"     "model"    "colour"   "offence"  "district" "disposal"
# [8] "date"     "location"
```

<!-- The data looks like this (first 3 rows shown): -->

```{r}
#| echo: false
d_all = read_csv(file_name)
d_all = d_all |>
  mutate_if(is.character, tolower)
d_all |>
  head(3) |>
  knitr::kable()
```

# Preliminary analysis

There are `r nrow(d_all)` records in the data, with increasing numbers of records over time (average n. records per month shown below):

```{r}
d_all_monthly = d_all |>
  mutate(month = lubridate::floor_date(date, "month")) |>
  group_by(month) |>
  summarise(n = n()) |>
  mutate(records = "All")
d_with_offence = d_all |>
  opsnap:::filter_offence_nas()
# nrow(d_all) - nrow(d_with_offence) # only 1 record -> ignore
d_with_location = d_all |>
  opsnap:::filter_location_nas()
d_with_location_monthly = d_with_location |>
  mutate(month = lubridate::floor_date(date, "month")) |>
  group_by(month) |>
  summarise(n = n()) |>
  mutate(records = "With location")
d_monthly = bind_rows(d_all_monthly, d_with_location_monthly)
d_monthly |>
  ggplot() +
  geom_line(aes(month, n, colour = records), alpha = 0.5, size = 2) +
  # geom_smooth(aes(month, n, colour = records), method = "lm", se = FALSE) +
  labs(title = "Number of records in West Yorkshire Police Operation Snap data",
       x = "Date",
       y = "Number of records per month") +
  theme_minimal() +
  ylim(c(0, NA))
```

As shown in the graph above not all (`r round(nrow(d_with_location) / nrow(d_all) * 100, 1)`%) records have values for the 'location' column.

The breakdown of all records by mode of transport (of the observer) is shown below:

```{r}
d_all |>
  count(mode, sort = TRUE) |>
  mutate(percent_records = n / nrow(d_all)) |>
  mutate(percent_records = scales::percent(percent_records, accuracy = 0.1)) |>
  arrange(desc(n)) |>
  knitr::kable()
```

The offence text strings are quite long, with the most common offences shown below:

```{r}
d_all |>
  count(offence, sort = TRUE) |>
  mutate(percent_records = n / nrow(d_all)) |>
  mutate(percent_records = scales::percent(percent_records, accuracy = 0.1)) |>
  arrange(desc(n)) |>
  head(10) |>
  knitr::kable()
```

The equivalent table excluding records with missing location data is shown below:

```{r}
d_all |>
  opsnap:::filter_offence_nas() |>
  filter(offence != "n/a") |>
  count(offence, sort = TRUE) |>
  mutate(percent_records = n / nrow(d_with_location)) |>
  mutate(percent_records = scales::percent(percent_records, accuracy = 0.1)) |>
  arrange(desc(n)) |>
  head(10) |>
  knitr::kable()
```

The equivalent for cyclists, with location present and the least common offences categorised as 'other', is shown below:

```{r}
d_all |>
  opsnap:::filter_offence_nas() |>
  filter(offence != "n/a") |>
  filter(mode == "cyclist") |>
  count(offence, sort = TRUE) |>
  mutate(percent_records = n / nrow(d_with_location)) |>
  mutate(percent_records = scales::percent(percent_records, accuracy = 0.1)) |>
  mutate(
    offence = ifelse(n < 20, "other", offence)
  ) |>
  group_by(offence) |>
  summarise(n = sum(n), n_hybrid = n()) |>
  arrange(n_hybrid, desc(n)) |>
  select(-n_hybrid) |>
  mutate(`% of total` = scales::percent(n / sum(n), accuracy = 0.1)) |>
  knitr::kable()
```

In terms 'disposal', the most common values are shown below:

```{r}
d_all |>
  count(disposal, sort = TRUE) |>
  mutate(percent_records = n / nrow(d_all)) |>
  mutate(percent_records = scales::percent(percent_records, accuracy = 0.1)) |>
  arrange(desc(n)) |>
  knitr::kable()
```

There are `r unique(d_with_location$location) |> length()` unique location text strings (addresses) in the data, with the most common locations shown below:

```{r}
#| echo: false
d_with_location |>
  mutate(location = tolower(location)) |> 
  count(location, sort = TRUE) |>
  mutate(percent_records = n / nrow(d_with_location)) |>
  mutate(percent_records = scales::percent(percent_records, accuracy = 0.1)) |>
  arrange(desc(n)) |>
  head(10) |>
  knitr::kable()
```

# Geocoding

We provide a function to geocode the records:

```{r}
#| eval: false
#| echo: true
d_sample = d_with_location[1:5, ]
d_sf = opsnap:::op_geocode(d_sample)
mapview::mapview(d_sf)
```

```{r}
#| eval: false
#| echo: false
# Geocode all data:
d_geocoded = opsnap:::op_geocode(d_with_location)
table(d_geocoded$address) |>
  sort() |>
  tail(1)
# d_geometries = d_geocoded |>
#   filter(address != "NA, West Yorkshire") |>
  sf::st_as_sf(coords = c("long", "lat"), crs = 4326)
d_sf = sf::st_sf(
  d_with_location,
  geometry = d_geometries$geometry
)
west_yorkshire = pct::get_pct_zones("west-yorkshire")
sf::sf_use_s2(FALSE)
d_sf_wy = d_sf[west_yorkshire, ]
proportion_outside_wy = 1 - nrow(d_sf_wy) / nrow(d_sf)
# Sanity check
d_sf_wy |>
  sample_n(1000) |>
  # mapview::mapview()
  plot()
# Save to file:
sf::write_sf(d_sf_wy, paste0("data/west-yorkshire/operation_snap_geocoded_", date_str, ".gpkg"))
```

After geocoding all records we kept only those within the boundary of West Yorkshire, which removed another 3% of records.

# Location of incidents

Due to inaccuracy in the geocoding, we only know the locations of the records to within around 500m of each crash (although we can link to specific roads).
We'll present the geographic distribution of crashes using a 500m grid:

```{r}
d_sf = sf::read_sf(paste0("data/west-yorkshire/operation_snap_geocoded_", date_str, ".gpkg"))
```

```{r}
#| eval: false
d_sf_aggregated = d_sf |> 
  group_by(location) |> 
  count(mode)
library(tmap)
tmap_mode("view")
d_sf |> 
  sample_n(1000) |> 
  tm_shape() +
  tm_dots()
```


```{r}
d_projected = sf::st_transform(d_sf, 27700)
library(terra)
raster_template = rast(ext(d_projected), res = 500)
raster_count = rasterize(d_projected, raster_template, fun = "length")
# mapview::mapview(raster_count)
plot(raster_count)
```

The map above represents `r nrow(d_sf)` incidents in West Yorkshire with an offence that could be geocoded.

<!-- The results show there is one outlier with a very high number of crashes. We can remove this and plot the data again: -->

```{r}
# raster_count_no_outlier = raster_count |>
#   clamp(-Inf, 100)
# plot(raster_count_no_outlier)
```

<!-- You can query the data downloaded with `opsnap` functions, e.g. as follows (results not shown): -->


```{r}
#| eval: false
#| echo: false
table(d_with_location$offence) |>
  sort()
```

<!-- Let's make a plot of the data: -->

```{r}
#| eval: false
#| echo: false
d |>
  # Reduce nchar of offence
  mutate(offence = stringr::str_sub(offence, 1, 60)) |>
  group_by(offence) |>
  # Count number of rows in each group
  mutate(n = n()) |>
  filter(n > nrow(d_with_location) / 50)|>
  ggplot() +
  geom_bar(aes(offence)) +
  # Make x labels vertical
  theme(axis.text.x = element_text(angle = 60, hjust = 1))
  
```