R/get_location_xml.R

In bodsr: Call the Bus Open Data Service ('BODS') API Through R

##Return SIRI-VM XML vehicle location data from the 'BODS' API

#' @name get_location_xml
#' @title Return XML vehicle location data from the 'BODS' API
#' @export
#'
#' @param api_key API key for the 'BODS' dataset passed as a string. Can be obtained from \href{https://data.bus-data.dft.gov.uk/api/}{the 'BODS' API login}
#' @param bounding_box vector of four numerics. Limit results to location data
#' for vehicles within the rectangular boundingBox
#' you set using co-ordinates [minLatitude, maxLatitude, minLongitude, maxLongitude].
#' Defaults to NULL.
#' @param noc string or vector of strings. Limit results to fares data sets for specified National Operator Codes.
#' A full lookup of NOC to bus operator names can be seen using noc_lookup().
#' Defaults to NULL.
#' @param vehicle_ref string. Limit results to bus location data with the
#' specified vehicle_ref. This is a unique reference for the vehicle that is
#' consistent and is generated by the vehicle equipment. Defaults to NULL.
#' @param line_ref string. Limit results to bus location data with the
#' specified line_ref. Defaults to NULL.
#' @param producer_ref string. Limit results to bus location data with the
#' specified producer_ref. Defaults to NULL.
#' @param origin_ref string. Limit results to bus location data with the
#' specified origin reference. Accepts any National Public Transport Access Nodes (NaPTAN) value,
#' which can be found \href{https://www.data.gov.uk/dataset/ff93ffc1-6656-47d8-9155-85ea0b8f2251/national-public-transport-access-nodes-naptan}{the NaPTAN access nodes dataset}.
#' Defaults to NULL.
#' @param destination_ref string. Limit results to bus location data with the
#' specified destination reference. Accepts any National Public Transport Access Nodes (NaPTAN) value,
#' which can be found \href{https://www.data.gov.uk/dataset/ff93ffc1-6656-47d8-9155-85ea0b8f2251/national-public-transport-access-nodes-naptan}{the NaPTAN access nodes dataset}.
#' Defaults to NULL.
#'
#' @importFrom httr GET content http_status
#' @importFrom xml2 read_xml
#'
#' @return Returns bus location data in XML SIRI-VM format. More detail on this format can be found \href{https://data.bus-data.dft.gov.uk/guidance/requirements/?section=dataformats}{the 'BODS' data formats documentation}
#'
#' @examples
#'
#' \dontrun{
#' #Before running these examples, ensure you have an API key saved
#'
#' ##Return unfiltered data from XML API
#' get_location_xml()
#'
#' #Return data for vehicle reference "BUSC" only
#' get_location_xml(vehicle_ref = "BUSC")
#'
#' #Return data for specified origin
#' get_location_xml(origin_ref = "21024515")
#'
#' }

#Function to pull in metadata
get_location_xml <- function(api_key = Sys.getenv("BODS_KEY"),
                             bounding_box = NULL,
                             noc = NULL,
                             vehicle_ref = NULL,
                             line_ref = NULL,
                             producer_ref = NULL,
                             origin_ref = NULL,
                             destination_ref = NULL) {

  ##Set user agent so BODS can track R users
  ua <- httr::user_agent("https://github.com/department-for-transport/bodsr")

  ##Use bounding box coordinates to search on
  if(!is.null(bounding_box)){

    ##If there's not 4 coordinates, stop
    if(length(bounding_box) != 4){
      stop("Incorrect number of coordinates provided to bounding_box argument")
    }

    bounding_box <- paste0("boundingBox=",
                           paste0(bounding_box, collapse = ","),
                           "&")
  }

  ##Use noc values to search on if not null
  if(!is.null(noc)) {

    noc_check <- noc_lookup()$noc
    ##Give an error if one or more NOC values aren't in the lookup
    if(!all(noc %in% noc_check)){

      stop("Invalid NOC codes:", noc[!(noc %in% noc_check)])
    }

    noc <- paste0("operatorRef=", paste(noc, collapse = ","), "&")

  }

  ##Create search strings for arguments if they are not null
  vehicle_ref <- not_null(vehicle_ref, "vehicleRef")
  line_ref <- not_null(line_ref, "lineRef")
  producer_ref <- not_null(producer_ref, "producerRef")
  origin_ref <- not_null(origin_ref, "originRef")
  destination_ref <- not_null(destination_ref, "destinationRef")



  #Paste together URL for API
  url <- paste0("https://data.bus-data.dft.gov.uk/api/v1/datafeed?",
                "&",
                bounding_box,
                noc,
                vehicle_ref,
                line_ref,
                producer_ref,
                origin_ref,
                destination_ref,
                "api_key=", api_key)

  ##Read from url
  download <- httr::GET(url)


  ##Return error message if authentication failed
  if(httr::http_status(download)$reason == "Unathorized"){

    stop("Authentication credentials are not valid; please check you are using a valid BODS API key")

    } else if(httr::http_status(download)$reason == "Bad Request"){

    stop("Bad request; please check you have passed arguments to the function correctly")

  } else{

  ##Read xml
  xml2::read_xml(download)
  }

}