Skip to content

Instantly share code, notes, and snippets.

@nathancday
Last active March 31, 2019 18:06
Show Gist options
  • Save nathancday/d50afccb762174d402f54486d3d328b6 to your computer and use it in GitHub Desktop.
Save nathancday/d50afccb762174d402f54486d3d328b6 to your computer and use it in GitHub Desktop.
library(gtfs) %>% library(sf)
library(sf)
library(magrittr)
library(tidyverse)
gtfs_routes_sf <- function(gtfs) {
## gather key-values first ----
# trips_df has route_id:shape_id
shape_key <- gtfs$trips_df %>%
select(route_id, shape_id) %>%
unique()
# routes_df has route_id:route_name
route_key <- gtfs$routes_df %>%
select(route_id, route_short_name) %>%
mutate(route_short_name = paste("route", route_short_name)) %>%
inner_join(shape_key)
# check for colors
if ( !is.null(gtfs$routes_df$route_color) ) { # extract if possible
route_key %<>% inner_join(select(gtfs$routes_df, route_color, route_id))
}
else { # plan b is make some from my favorite pallette 'd3'
route_key %<>% mutate(route_color = rep(ggsci::pal_d3()(10),
length.out = nrow(route_key)))
}
## build the sf object ----
# exctract lon/lat values as matrix to build linestrings for each "shape_id"
sfc <- gtfs$shapes_df %>% # long data frame
split(.$shape_id) %>% # list of shorted data framee, one per shape
map(~ select(., shape_pt_lon, shape_pt_lat) %>% # order maters, lon-1st lat-2nd
as.matrix %>% # coherce for st_linestrings happiness
st_linestring) %>%
st_sfc(crs = 4326) # bundle all shapes into a collection
# add collection on and convert to sf
sf <- unique(gtfs$shapes_df$shape_id) %>%
sort() %>% # sort to match with names(sfc); split()'s factor-cohercion alpha sorts
st_sf(shape_id = ., geometry = sfc) %>%
inner_join(route_key)
# strip names from geometry to make Leaflet happy
names(sf$geometry) <- NULL
sf
}
# repeat the pattern
gtfs_stops_sf <- function(gtfs) {
shape_key <- gtfs$trips_df %>%
select(trip_id, route_id, shape_id) %>%
unique()
# stop_times_df also has stop sequence and arrive/depart time for specific stops
stop_key <- gtfs$stop_times_df %>%
select(trip_id, stop_id) %>%
unique() %>%
inner_join(shape_key) %>% # one stop is on multiple routes
# need to pair down
arrange(route_id) %>% # use route_id as tiebreaker (for now)
group_by(stop_id) %>% # group_by() to stop_id
slice(1) # to slice() out the first row
if ( !is.null(gtfs$routes_df$route_color) ) {
stop_key %<>% inner_join(select(gtfs$routes_df, route_color, route_id)) }
else {stop_key %<>% mutate(route_color = rep(ggsci::pal_d3()(10), length.out = nrow(route_key))) }
stops_sfc <- gtfs$stops_df %>%
split(.$stop_id) %>%
map(~select(., stop_lon, stop_lat) %>%
unlist() %>%
st_point() ) %>% # point instead of linestring
st_sfc()
st_sf(stop_key, geometry = stops_sfc) %>%
inner_join(gtfs$stops_df)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment