A R script for updating the Baltimore bike facilities data to use the new schema from the Baltimore Metropolitan Council and add other related attributes as variables.

baltimore-bike-facilities_schema-update.R

# title: R script for validating Baltimore city bike facility data, updating the
# schema to match new BMC standard, and adding new attributes for responsible
# agency and other characteristics
#
# author: Eli Pousson
# date: 2023-09-07
# last-modified: 2023-09-09

# Set up ----

# pak::pkg_install(c("elipousson/mapbaltimore", "elipousson/sfext@dev"))
# mapbaltimore::cache_edge_of_pavement()
# mapbaltimore::cache_baltimore_property()

library(tidyverse)
library(sfext)

# Import cached data ----

# Get cached property data
property <- read_sf_pkg(
  "baltimore_property",
  pkg = "mapbaltimore"
)

# Get cached edge of pavement data
pavement <- read_sf_pkg(
  "edge_of_pavement",
  pkg = "mapbaltimore"
)

# Import FeatureLayer data ----

# Read updated bike facilities data (existing only)
facilities <- read_sf_esri(
  "https://services3.arcgis.com/ZTvQ9NuONePFYofE/ArcGIS/rest/services/BCDOT_Bike_Facilities/FeatureServer/0"
)

# Get earlier (outdated) version of facilities data
prior_facilities <- read_sf_esri(
  "https://geodata.baltimorecity.gov/egis/rest/services/CitiMap/DOT_Layers/MapServer/5"
)

# Get trails data (includes existing and proposed)
prior_trails <- read_sf_esri(
  "https://geodata.baltimorecity.gov/egis/rest/services/CitiMap/DOT_Layers/MapServer/11"
)

# Get statewide data on separated bike routes
separated_bike_routes <- read_sf_esri(
  "https://services.arcgis.com/njFNhDsUCentVYJW/ArcGIS/rest/services/Maryland_Road_Separated_Bike_Routes_(HOSTED_FEATURE)_view/FeatureServer/0",
  bbox = mapbaltimore::baltimore_bbox
)

# Get statewide bike route LTS data
bike_lts <- read_sf_esri(
  "https://services.arcgis.com/njFNhDsUCentVYJW/arcgis/rest/services/Maryland_Bicycle_Level_of_Traffic_Stress_(LTS)_view/FeatureServer/0",
  bbox = mapbaltimore::baltimore_bbox
)

bike_facility_lts <- filter(
  bike_lts,
  !is.na(BIKE_FACILITY_TYPE)
  )

bike_facility_lts |>
  filter(SHOULDER_EXIST == 1) |>
  mapview::mapview()
  View()
  group_by(
    ROUTEID
  ) |>
  summarise() |>
  mapview::mapview(zcol = "ROUTEID")

# Import OSM facility data ----

# TODO: Import OSM bike facility data to allow a join between the updated
# facility data and the OSM data for validity check, identification of missing
# features, and enrichment with supporting attributes

osm_cycleways <- getdata::get_osm_data(
  location = mapbaltimore::baltimore_city,
  features = c("highway" = "cycleway"),
  geometry = "lines"
)

# Import crosswalk file ----

# Get facility schema crosswalk (incomplete)
facility_xwalk <- googlesheets4::read_sheet("https://docs.google.com/spreadsheets/d/1EJe-DhDB4XAmGDdtt8DsS3g3w6dxzM7Y9hk9Bev1uhs/edit?usp=sharing")

# Prep pavement data ----

# Join pavement to street centerline to get street names
pavement <- st_join(pavement, mapbaltimore::streets, largest = TRUE)

# Summarize pavement data by street name, block number, and block text
block_summary <- pavement |>
  filter(
    # Exclude alleys, parking, driveways, medians, and unpaved roads
    !(type.x %in% c("ALYPVD", "PRKNG", "DWPVD", "MEDUPD", "MEDPVD", "RDUPD")),
    # Exclude unnamed streets (unsure if this should be a condition)
    !is.na(street_name),
    # Exclude highway ramps
    street_name != "RAMP"
  ) |>
  select(
    street_name = fullname,
    block = blocktext
  ) |>
  sfext::rename_sf_col() |>
  group_by(
    # pavement_type,
    street_name,
    block_num,
    block_text
  ) |>
  summarise(
    geometry = st_combine(geometry)
  ) |>
  ungroup()


# Prep property data ----

# TODO: Consider if we should use a subset of property with a named agency owner
# public_property <- filter(property, !is.na(agency_name))

# Group, combine, and union by agency abbreviation and name
property_agency_code <- property |>
  st_filter_ext(facilities) |>
  # A blank agency_code is used for private property or property without an assigned agency
  group_by(agency_code, agency_abb, agency_name) |>
  sfext::rename_sf_col() |>
  summarise(
    geometry = st_make_valid(st_union(st_combine(geometry)))
  ) |>
  ungroup() |>
  st_as_sf()

# Prep facilities data ----

facilities_ext <- facilities |>
  getdata::fix_epoch_date(
    .cols = dplyr::all_of("DATE_INST")
  ) |>
  mutate(
    id = row_number()
  ) |>
  mutate(
    across(
      .cols = all_of(
        c(
          "ST_NAME", "ROUTE_NAM", "FROM_ST", "TO_ST", "FAC_TYPE2",
          "PROJECT", "PRKG_CURB", "REMARKS"
        )
      ),
      .fns = function(x) {
        stringr::str_replace_all(x, "[:space:]+", " ")
      }
    )
  ) |>
  mutate(
    across(
      all_of(
        c(
          "ST_NAME", "ROUTE_NAM", "FROM_ST", "TO_ST", "FAC_TYPE2",
          "PROJECT", "PRKG_CURB", "REMARKS"
        )
      ),
      function(x) {
        x[(x == "") | (x == " ") | x == "<Null>"] <- NA_character_
        x
      }
    ),
    ROUTE_NAM = stringr::str_to_title(ROUTE_NAM)#,
    # DATE_INST = esri2sf::fmt_epoch_dates(as.numeric(DATE_INST))
  ) |>
  # Correct inconsistent or missing route names
  mutate(
    ROUTE_NAM = case_when(
      ROUTE_NAM == "Ft Mchenry" ~ "Fort McHenry",
      is.na(ROUTE_NAM) & (ST_NAME == "GWYNNS FALLS TRAIL") ~ "Gwynns Falls Trail",
      is.na(ROUTE_NAM) & (ST_NAME == "MIDDLE BRANCH TRAIL") ~ "Multi-use Trail",
      is.na(ROUTE_NAM) & (ST_NAME == "HERRING RUN TRAIL") ~ "Multi-use Trail",
      .default = ROUTE_NAM
    ),
    PROJECT = stringr::str_to_title(PROJECT),
    PROJECT = case_when(
      PROJECT == "Collegetown Network" ~ "Collegetown"
    )
  ) |>
  # Join BMC schema to existing data
  left_join(facility_xwalk, na_matches = "na") |>
  # Recode BMC_FACILITY_SUB_TYPE values based on ST_NAME
  mutate(
    BMC_FACILITY_SUB_TYPE = case_when(
      # FIXME: This is incomplete and should be expanded to complete update to
      # new schema
      ST_NAME == "PROMENADE" ~ "Multi-use Trail",
      ST_NAME == "GWYNNS FALLS TRAIL" ~ "Multi-use Trail",
      ST_NAME == "PATTERSON PARK PATH" ~ "Multi-use Trail",
      ST_NAME == "MIDDLE BRANCH TRAIL" ~ "Multi-use Trail",
      ST_NAME == "HERRING RUN TRAIL" ~ "Multi-use Trail",
      .default = BMC_FACILITY_SUB_TYPE
    ),
    PRKG_CURB = tolower(PRKG_CURB),
    PRKG_CURB = case_match(
      PRKG_CURB,
      "parking" ~ "p",
      "curb" ~ "c",
      "n/a" ~ NA_character_,
      .default = PRKG_CURB
    )
  )

# Intersect facilities with reference geometries ----

# Intersect facilities data with parks
facilities_ext <- st_intersection(
  facilities_ext,
  mapbaltimore::parks |>
    bind_sf_coverage(
      mapbaltimore::baltimore_city,
      combine = TRUE,
      coverage_nm = "Not a park"
    ) |>
    select(park_name = name) |>
    st_transform(2248)
)

facilities_ext <- facilities_ext |>
  mutate(
    agency = if_else(
      park_name != "Not a park",
      "BCRP",
      "DOT"
    )
  )

# Intersect facilities data with pavement to add block names to break facilities
# into block-length segments and add street names
facilities_ext <- st_intersection(
  facilities_ext,
  block_summary_ext |>
    st_transform_ext(crs = facilities_ext)
)

# Check for mismatch between block street name and facility name (mostly an
# issue at intersections)
facilities_ext <- facilities_ext |>
  mutate(
    matched_streets = ST_NAME == street_name
  ) |>
  relocate(
    park_name,
    ROUTE_NAM,
    matched_streets,
    ST_NAME,
    street_name,
    block,
    FROM_ST,
    TO_ST,
    .before = everything()
  ) # |>
# View()

# Join facilities to reference geometries ----

facilities_ext_join <- st_join(
  facilities_ext,
  st_transform(separated_bike_routes, crs = st_crs(facilities_ext)),
  join = sf::st_touches
  )



# Join facilities data to property data to further identify responsible agencies
#
# TODO: Check if this is sufficiently accurate to include or if manual review
# and attribute updates in QGIS are preferable
#
# facilities_ext_agency <- st_join_ext(
#   facilities_ext, property_agency_code, largest = TRUE
#   )

# Validating updated vs. prior bike facility data ----

prior_trails <- prior_trails |>
  filter(PHASE != "Proposed")

compared_facilities <- st_difference(
  facilities_ext,
  prior_trails |>
    bind_rows(
      prior_facilities
    ) |>
    sfext::st_buffer_ext(
      dist = 4,
      unit = "m"
    ) |>
    # prior_facilities |>
    st_make_valid_union(combine = TRUE),
)

# Review updated facility data to create xwalk ----

# FIXME: Add documentation on how the crosswalk is based on the unique
# combinations of the existing facility attributes
#
# facilities |>
#   distinct(PUB_CATG, FAC_TYPE1, FAC_TYPE2) |>
#   View()
#
# facilities |>
#   filter(
#     # PUB_CATG == "Bike Lane",
#     #FAC_TYPE1 == "Bike Lane	",
#     FAC_TYPE2 == "Signed Bike Route"
#   ) |>
#   View()