library(gtfs) %>% library(sf)

gtfs_sf.R

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)
}