A Mini Tour of Open-source tools for Transportation Planning & Engineering

ITE UWindsor Chapter

November 30th, 2023

About me

• Data Scientist at Presage Group
• Formerly:
  • Postdoctoral Fellow at University of Windsor
  • Data Analytics Instructor at St. Clair College

Routing, Accessibility, and Transit

stplanr: Sustainable Transport Planning

Tools for transport planning with an emphasis on spatial transport data and non-motorized modes

# Install with: install.packages("stplanr")
library(stplanr) # Load library

Origin-desination data

Flows

od_data_sample[1:3, ] # typical form of flow data

Origin-desination data

Spatial geometry

cents_sf[1:3,] # points representing origins and destinations

Network

travel_network <- od2line(flow = od_data_sample, zones = cents_sf) # desire lines
travel_network

Plot the network

# Install with: install.packages("leaflet")
library(leaflet)
leaflet(travel_network) |> 
  addTiles() |> 
  addPolylines(weight = ~all/10, group = "Lines") |> 
  addLayersControl(overlayGroups = c("Lines"),
    options = layersControlOptions(collapsed = FALSE))

Routing

# Install with: install.packages("osrm")
library(osrm)
trip <- route(
  from = "Toronto",
  to = "Markham",
  route_fun = osrmRoute,
  returnclass = "sf"
  )
trip

Routing output

# Install with: install.packages("dplyr")
library(dplyr)
leaflet(trip) |>
  addTiles() |> 
  addPolylines()

r5r: Rapid Realistic Routing with R5 in R

Setup

# Install with: install.packages('r5r')
library(r5r)
# Indicate the path where OSM and GTFS data are stored
data_path <- system.file("extdata/poa", package = "r5r")
r5r_core <- setup_r5(data_path = data_path)

Location

points <- data.table::fread(file.path(data_path, "poa_hexgrid.csv"))

Calculate accessibility

departure_datetime <- as.POSIXct("29-11-2023 14:00:00",
                                 format = "%d-%m-%Y %H:%M:%S")

# calculate accessibility
access <- accessibility(r5r_core = r5r_core,
                        origins = points,
                        destinations = points,
                        opportunities_colnames = c("schools", "healthcare"),
                        mode = c("WALK", "TRANSIT"),
                        max_walk_time = 30,
                        departure_datetime = departure_datetime,
                        decay_function = "step",
                        cutoffs = 20
                        )

Plot accessibility: static plot

access_sf <- access |> 
  dplyr::left_join(points, by = "id") |> 
  sf::st_as_sf(coords = c("lon", "lat")) 

head(access_sf)

Plot accessibility: static plot

# Install with: install.packages("ggplot2")
library(ggplot2)
access_sf |> 
  ggplot() +
    geom_sf(aes(color = accessibility)) +
    scale_color_viridis_c(option = 'B') +
    labs(color = "Number of\nfacilities within\n20 minutes") +
    facet_wrap(~opportunity) +  theme_void()

Plot accessibility: interactive plot

access_sf_schools <- access_sf |> 
  dplyr::filter(opportunity == "schools")

pal <- colorNumeric(
  palette = "magma",
  domain = access_sf_schools$accessibility)

access_sf_schools |> 
  leaflet() |> 
  addTiles() |> 
  addCircles(color = ~pal(accessibility), group = "Points") |> 
  addLegend("bottomright", pal = pal, values = ~accessibility,
    title = "Access within 20 min.",
    opacity = 1
  ) |> 
  addLayersControl(overlayGroups = c("Points"),
    options = layersControlOptions(collapsed = FALSE))

Plot accessibility: interactive plot

Statistics Canada has estimated accessibility for all of Canada

Tidytransit: Transit Windsor

# Install with: install.packages("tidytransit")
library(tidytransit)
library(sf)

gtfs <- read_gtfs("https://opendata.citywindsor.ca/Uploads/google_transit.zip")

names(gtfs)

 [1] "agency"          "shapes"          "trips"           "stops"          
 [5] "stop_times"      "routes"          "calendar"        "calendar_dates" 
 [9] "feed_info"       "fare_attributes" "fare_rules"      "."              

# get all service_ids for mondays
all_mondays <- gtfs$calendar %>% 
  filter(monday == 1) %>% 
  pull(service_id)

# select trips on mondays
selected_trips <- gtfs$routes %>% 
  left_join(gtfs$trips, by = "route_id") %>% 
  filter(service_id %in% all_mondays) # only take trips on mondays

# get linestrings for routes
selected_shapes <- gtfs$shapes %>% 
  filter(shape_id %in% unique(selected_trips$shape_id) )
shapes <- shapes_as_sf(selected_shapes)

# df with linestring, start and end time
windsor_transit <- selected_trips %>% 
  left_join (gtfs$stop_times, by = "trip_id") %>%
  arrange(trip_id, stop_sequence) %>% 
  select(trip_id, route_id, shape_id, route_short_name, departure_time) %>% 
  group_by(trip_id, route_id, route_short_name, shape_id) %>% 
  summarise(starttime = first(departure_time),
            endtime = last(departure_time)) %>% 
  left_join(shapes, by = "shape_id") %>% 
  st_as_sf() %>% 
  mutate(start_timestamp =  as.numeric(as.POSIXct(starttime, format="%H:%M:%S"))) %>% 
  mutate(end_timestamp =  as.numeric(as.POSIXct(endtime, format="%H:%M:%S"))) %>% 
  filter(!is.na(start_timestamp)) %>% 
  filter(!is.na(end_timestamp)) # for simlicity dates greater than 24h are ignored

windsor_transit

Plot

library(mapview)

windsor_transit_1c <- windsor_transit |> 
  filter(route_short_name == "1C")

mapview(windsor_transit_1c)