Real time feed of TAM (Montpelllier) transportation traffic info

title: "Real time feed of TAM transportation traffic info"
output:
  html_document:
    df_print: paged

remotes::install_github("SymbolixAU/gtfsway")
library(gtfsway)
library(dplyr)
library(sf)
library(ggplot2)
library(leaflet)

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

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

url_com34 <- "https://www.data.gouv.fr/fr/datasets/r/18fe7c3e-dd9e-4c92-ad4e-a93bf8615e33"
sf_com34 <- sf::st_read(url_com34)
sf_com34 <- cbind(sf_com34, sf::st_coordinates(sf::st_centroid(sf_com34)))
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)

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

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

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

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

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

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

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)