API available at https://data.montpellier3m.fr/dataset/offre-de-transport-tam-en-temps-reel

remotes::install_github("SymbolixAU/gtfsway")
## Skipping install of 'gtfsway' from a github remote, the SHA1 (52c7665e) has not changed since last install.
##   Use `force = TRUE` to force installation
library(gtfsway)
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.2.3
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(sf)
## Warning: package 'sf' was built under R version 4.2.3
## Linking to GEOS 3.9.3, GDAL 3.5.2, PROJ 8.2.1; sf_use_s2() is TRUE
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.2.3
library(leaflet)
## Warning: package 'leaflet' was built under R version 4.2.3

Lines data

Download general lines info

url_gtfs <- "https://data.montpellier3m.fr/TAM_MMM_GTFSRT/GTFS.zip"
f_gtfs <- tempfile(pattern = "gtfs_", fileext = ".zip")
download.file(url_gtfs, f_gtfs)

Extract routes and stops

d_gtfs <- tempfile(pattern = "gtfsdir_")
dir.create(d_gtfs, recursive = TRUE)
utils::unzip(f_gtfs, exdir = d_gtfs)
df_routes <- read.table(file.path(d_gtfs, "routes.txt"), sep = ",", header = TRUE, quote = "")
df_routes
df_stops <-  read.table(file.path(d_gtfs, "stops.txt"), sep = ",", header = TRUE, quote = "")
df_stops

Draw a map with background coming from https://www.data.gouv.fr/fr/datasets/communes-de-lherault

url_com34 <- "https://www.data.gouv.fr/fr/datasets/r/18fe7c3e-dd9e-4c92-ad4e-a93bf8615e33"
sf_com34 <- sf::st_read(url_com34)
## Reading layer `18fe7c3e-dd9e-4c92-ad4e-a93bf8615e33' from data source 
##   `https://www.data.gouv.fr/fr/datasets/r/18fe7c3e-dd9e-4c92-ad4e-a93bf8615e33' 
##   using driver `GeoJSON'
## Simple feature collection with 342 features and 20 fields
## Geometry type: POLYGON
## Dimension:     XY
## Bounding box:  xmin: 2.539409 ymin: 43.21282 xmax: 4.194562 ymax: 43.97275
## Geodetic CRS:  WGS 84
sf_com34 <- cbind(sf_com34, sf::st_coordinates(sf::st_centroid(sf_com34)))
## Warning: st_centroid assumes attributes are constant over geometries
ggplot(sf_com34) +
  geom_sf() + 
  geom_text(aes(X, Y, label = nom_officiel_commune), size = 2) +
  geom_point(data = df_stops, aes(x = stop_lon, y = stop_lat), size = 1, 
        shape = 23, fill = "darkred") + 
  coord_sf(xlim = c(min(df_stops$stop_lon), max(df_stops$stop_lon)), ylim = c(min(df_stops$stop_lat), max(df_stops$stop_lat)), expand = FALSE)

Extract trips of the day

df_trips <-  read.table(file.path(d_gtfs, "trips.txt"), sep = ",", header = TRUE, quote = "")
df_trips

Real time trip information on selected routes…

Load real time data

url_trip <- "https://data.montpellier3m.fr/TAM_MMM_GTFSRT/TripUpdate.pb"
response <- httr::GET(url_trip)
lst <- gtfsway::gtfs_tripUpdates(gtfsway::gtfs_realtime(response, content = "FeedMessage"))
df_trip_info <- do.call(rbind, lapply(lst, "[[", "dt_trip_info"))

Select routes of interest

routes <- c("7-13", "7-22")
stop_rows <- which(df_trip_info$route_id %in% routes)
l_stop_time <- lapply(stop_rows, function(i) {
  df <- lst[[i]]$dt_stop_time_update
  if (nrow(df) == 0) return(NULL)
  cbind(route_id = df_trip_info$route_id[i],
        trip_id = df_trip_info$trip_id[i],
        df)
})
df_stop_time <- do.call(rbind, l_stop_time)
df_stop_time <- df_stop_time %>% filter(arrival_time > 0)
df_stop_time$arrival_time <- as.POSIXct(df_stop_time$arrival_time, origin="1970-01-01")
df_stop_time$departure_time <- as.POSIXct(df_stop_time$departure_time, origin="1970-01-01")
df_stop_time

… and selected stops

stops <- df_stops$stop_id[df_stops$stop_name == "Campus Agropolis"]
df_stops <- df_stops %>% 
  filter(stop_id %in% stops) %>% 
  mutate(stop_id = as.character(stop_id))
df_stop_time <- df_stop_time %>% filter(stop_id %in% stops, arrival_time > Sys.time()) %>%
  arrange(arrival_time) %>% left_join(df_trips %>% select(trip_id, trip_headsign), by = join_by(trip_id))
df_stop_time

Get vehicule positions

url_vp <- "https://data.montpellier3m.fr/TAM_MMM_GTFSRT/VehiclePosition.pb"
response <- httr::GET(url_vp)
lvp <- gtfsway::gtfs_vehiclePosition(gtfsway::gtfs_realtime(response, content = "FeedMessage"))
df_vp <- do.call(rbind, lvp)
df_vp

Select the vehicles related to our bus stop

df_vp <- df_vp %>% filter(trip_id %in% df_stop_time$trip_id) %>% 
  left_join(df_stop_time, by = join_by(trip_id)) %>%
  select(lat, lon, arrival_time, trip_headsign, stop_id) %>%
  left_join(df_stops %>% select(stop_id, stop_lat, stop_lon), by = join_by(stop_id))
df_vp

And plot an interactive map of their current position!

trip_headsigns <- unique(df_vp$trip_headsign)
pal <- colorFactor(palette.colors(length(trip_headsigns)), domain = trip_headsigns)
leaflet(data = df_vp) %>% addTiles() %>%
  addCircleMarkers(~lon, ~lat, color = ~pal(trip_headsigns), popup = ~format(arrival_time, "Arrival at %H:%M:%S"), label = ~trip_headsign, stroke = FALSE, fillOpacity = 0.9) %>%
  addMarkers(~stop_lon, ~stop_lat) %>%
  addLabelOnlyMarkers() %>%
  addLegend(pal = pal, values = ~trip_headsigns, opacity = 1)
## Assuming "lon" and "lat" are longitude and latitude, respectively