inst/extdata/Templates/functions_to_find_Intersection_crashes.R

In jacciz/wisdotcrashdatabase: A package used for internal WisDOT crash database pulls and analysis

# st_transform(p, crs = 3701)
# st_crs(p2)$units
# https://www.spatialreference.org/ref/?page=1&search=Wisconsin


#' Find County FIPS/DMV codes
#'
#' @param county county name, "Dane"
#'
#' @return
#' @export
#'
#' @examples
county_to_find <- function(county){
  codes <- find_countycode_fips(county)
  c(codes$countyname, codes$ctycode)
}

muni_to_find <- function(muni_name, ctv) {
  codes <- find_municipality_codes(muni_name, ctv)
  c(stringr::str_to_upper(codes$Municipality), codes$MuniCode)
}

# First grab intersection crashes
# find_by_intersection(crsh, "xxxxx", "65th|Marion") 
find_by_intersection <-
  function(crash_df,
           highway_names,
           road_names) {
    highway_names <- stringr::str_to_upper(highway_names)
    road_names <- stringr::str_to_upper(road_names)
    by_highway <-
      crash_df[grepl(highway_names, ONHWY) &
                 grepl(highway_names, ATHWY), CRSHNMBR] # 
    by_roadname <-
      crash_df[grepl(road_names, ONSTR) &
                 grepl(road_names, ATSTR) , CRSHNMBR] # 
    
    crash_df[CRSHNMBR %in% c(by_highway, by_roadname)]
    # crash_df[CRSHNMBR %in% by_highway & CRSHNMBR %in% by_roadname]
  }

# Find crashes by road they happen at
find_by_road <-
  function(crash_df,
           highway_names,
           road_names) {
    highway_names <- stringr::str_to_upper(highway_names)
    road_names <- stringr::str_to_upper(road_names)
    
    by_highway <-
      crash_df[grepl(highway_names, ONHWY) , CRSHNMBR]
    by_roadname <-
      crash_df[grepl(road_names, ONSTR) , CRSHNMBR]
    
    crash_df[CRSHNMBR %in% c(by_highway, by_roadname)]
  }


find_by_lat_long <- function(crash_df,
                 lower_left_lon,
                 lower_left_lat,
                 upper_right_lon,
                 upper_right_lat) {
  crash_df |>
    dplyr::filter(
      LATDECDG >= lower_left_lat,
      LONDECDG >= lower_left_lon,
      LONDECDG <= upper_right_lon,
      LATDECDG <= upper_right_lat
    )
    # dplyr::filter(
    #   LONDECDG <=  upper_right_lon &
    #     LONDECDG >= lower_left_lon,
    #   LATDECDG <= upper_right_lat & LATDECDG >= lower_left_lat
    # )
}

map_data <- function(crash_df) {
  crash_df |> dplyr::filter(!is.na(LONDECDG), LONDECDG != 0) |>
    sf::st_as_sf(
      coords = c("LONDECDG", "LATDECDG"),
      crs = 4326
    ) |>
    dplyr::mutate(CRSHSVR = factor(CRSHSVR, levels = c("Fatal", "Injury", "Property Damage"))) |>
    dplyr::select(CRSHNMBR, year, CRSHSVR) |> # what will show in the pop-up
    mapview::mapview(
      xcol = "LONDECDG",
      ycol = "LATDECDG",
      zcol = "CRSHSVR",
      col.regions = list("#D50032", "#428BCA", "#4DB848"), # order of the factors
      alpha = .3,
      alpha.regions = 1,
      layer.name = "Crash Severity",
      map.types = "OpenStreetMap"
    )
}

# makes crash df into a spatial df, removes unknown Lat/Longs
crash_to_sf <- function(crash_df){
  crash_df = crash_df[!is.na(LONDECDG) & LONDECDG != 0]
  sf::st_as_sf(
    x = crash_df,
    coords = c("LONDECDG", "LATDECDG"),
    crs = 4326
  )
}

# cluster analysis
# https://gis.stackexchange.com/questions/17638/clustering-spatial-data-in-r
# QGIS method https://gis.stackexchange.com/questions/211106/clustering-points-polygons-based-on-proximity-within-specifed-distance-using-q
# Finds clusters of crashes, input should be intersection crashes only
cluster_crashes <- function(crash_sf, distance_threshold = 40) {
  to_map_sp = as(crash_sf, Class = "Spatial")
  
  # use the distm function to generate a geodesic distance matrix in meters. SLOW
  mdist <- geosphere::distm(to_map_sp)
  
  # cluster all points using a hierarchical clustering approach
  hc <- hclust(as.dist(mdist), method = "complete")
  
  # define the distance threshold, in this case 40 m
  d = distance_threshold
  
  # define clusters based on a tree "height" cutoff "d" and add them to the SpDataFrame
  to_map_sp$clust <- cutree(hc, h = d)
  to_map_sp
}

# Finds top crashes from the cluster analysis
top_clusters <- function(crash_cluster, top_n = 10){
  crash_cluster |> as.data.frame() |> count(clust) |> top_n(wt = n, n = top_n)
}

# same as wisdotcrashdatabase functions, but add a group_by(clust)
# aggregate_crashes_by_crshsvr_tot_inj <- function(df, chart_title) {
#   df = df |> as.data.frame()
#   inj_count <- df |>
#     group_by(clust, .drop = FALSE) |>
#     summarise(`People injured` = sum(TOTINJ),
#               `People killed` = sum(TOTFATL))
#   
#   crash_count <- df |>
#     group_by(clust, CRSHSVR, .drop = FALSE) |>
#     summarise(total_crashes = n())
#   
#   left_join(inj_count, crash_count, by = "clust") |> pivot_wider(names_from = CRSHSVR, values_from = total_crashes) |> mutate_if(is.integer, replace_na, replace = 0) |> mutate(`Total crashes` = `Injury` +  `Property Damage` + `Fatal`) |> kableExtra::kbl(caption = chart_title) |> kableExtra::kable_styling(full_width = T) # removed 
# }