Real-time board for Auckland school buses

bus-bot-school.R

## startup
library(jsonlite)
library(httr)
library(knitr)
library(kableExtra)
options(stringsAsFactors=FALSE)

## These two files are part of the static GTFS information
routes<-read.csv("./routes.txt")
routes$route_id<-substr(as.character(routes$route_id),1,5) ## remove versioning info
trips<-read.csv("./trips.txt")
trips$route_id<-substr(as.character(trips$route_id),1,5) ## remove versioning info

route_schoolbus<-trips$route_id[trips$trip_headsign=="Schools"]

load("~/.ssh/twitter-bot-secrets.rda")

oldtab<-NULL

repeat({
gtfs<-tryCatch(
    GET('https://api.at.govt.nz/v2/public/realtime/tripupdates',
        accept_json(),
        add_headers('Ocp-Apim-Subscription-Key' = secrets$newapikey)),
    error=function(e) NULL)

if (is.null(gtfs)) return(NULL)
if (status_code(gtfs)!=200) {
    print(status_code(gtfs))
    return(NULL)
}

buses<-lapply(content(gtfs)[[2]][[2]], function(x) x$trip_update)

schoolbuses<-buses[sapply(buses, function(b) substr(b$trip$route_id,1,5) %in% route_schoolbus)]

if (length(schoolbuses)){

    delay<-sapply(schoolbuses, function(x) if(!is.null(x$stop_time_update$arrival)) x$stop_time_update$arrival$delay else  x$stop_time_update$departure$delay)
    current <-  sapply(schoolbuses, function(x) x$stop_time_update$stop_sequence)
    route_id<-sapply(schoolbuses, function(x) substr(x$trip$route_id,1,5))
    #start_time<-sapply(schoolbuses, function(x) x$trip$start_time)
    
    tab<-merge(data.frame(delay=round(delay/60),current_stop=current,route_id,stringsAsFactors=FALSE), routes[, c("route_id","route_short_name","route_long_name")])[,c(4,5,2,3)]
    tab$report_time <- format(Sys.time(), "%X")

    if(!is.null(oldtab)) {
        awol <- !(oldtab$route_long_name %in% tab$route_long_name)
        tab<-rbind(tab, oldtab[awol,])
        tab<-tab[order(tab$route_short_name),]
        }
    oldtab<-tab
    
    tryCatch({
        kable(unique(tab),row.names=FALSE, col.names=c("Number","Route","Minutes late","current stop #","report time")) %>%  kable_styling(bootstrap_options = c("striped", "hover"),fixed_thead = TRUE) %>% footnote(general = "Based on data from the Auckland Transport real-time GTFS feed. May contain nuts.") %>% save_kable(file = "/Volumes/tlum005/buses/akl-schoolbus.html", self_contained = TRUE)
        write.table(unique(tab), file="/Volumes/tlum005/buses/akl-schoolbus.txt", quote=FALSE, row.names=FALSE)
    },
    error=function(e) cat("writing failed\n")
    )
} else {
    cat("I see no schoolbuses")
}

if( as.POSIXlt(Sys.time())$hour>18) {
    cat(Sys.time(),"Evening: waiting 12 hours\n")
    Sys.sleep(60*12*60)
    oldtab<-NULL

    # New day, maybe new timetables
    tryCatch(
        download.file("https://transitfeeds.com/p/auckland-transport/124/latest/download", "./gtfs.zip"),
        error=function(e) cat("static file download failed; using old version")
    )

    unzip("./gtfs.zip",files=c("routes.txt","trips.txt"))
    routes<-read.csv("./routes.txt")
    routes$route_id<-substr(as.character(routes$route_id),1,5) ## remove versioning info
    trips<-read.csv("./trips.txt")
    trips$route_id<-substr(as.character(trips$route_id),1,5) ## remove versioning info
    
    route_schoolbus<-trips$route_id[trips$trip_headsign=="Schools"]
} else{
    if ( as.POSIXlt(Sys.time())$hour == 10) oldtab<-NULL
    Sys.sleep(5*60)
}
    

})