graphhopper-r icon indicating copy to clipboard operation
graphhopper-r copied to clipboard

Matrix Query

Open SebKrantz opened this issue 1 year ago • 0 comments

Thanks for the package! Here a basic matrix query in case this is of interest to add to the package

#' Get a Distance or Time Matrix from GraphHopper
#'
#' This function retrieves a distance or time matrix from the GraphHopper API for specified points.
#'
#' @param from_df A data frame containing longitude and latitude columns of origin points.
#' @param to_df A data frame containing longitude and latitude columns of destination points. Defaults to \code{from_df}.
#' @param profile A string specifying the routing profile. Default is "car". Determines the network, speed, and other physical attributes used.
#' @param out_array A character vector specifying which arrays should be included in the response. Options are "weights", "times", "distances". Default is \code{c("times", "distances")}.
#' @param ... Additional query parameters for the API GET request. See https://docs.graphhopper.com/#operation/getMatrix
#' @param key Your API key for the GraphHopper service.
#'
#' @return A list containing matrices of the requested data (e.g., times, distances).
#'
#' @examples
#' \dontrun{
#' from_df <- data.frame(lat = c(52.52, 48.85), lon = c(13.40, 2.35))
#' result <- gh_get_matrix(from_df, key = "YOUR_API_KEY")
#' }
gh_get_matrix <- function(from_df, to_df = from_df, profile = "car", out_array = c("times", "distances"), ..., 
                          key = NULL) {
  # https://docs.graphhopper.com/#operation/getMatrix
  if(identical(from_df, to_df)) {
    points <-paste0("point=", paste(do.call(paste, c(rev(unclass(from_df)), list(sep = ","))), collapse = "&point="))
  } else {
    points <-paste0("from_point=", paste(do.call(paste, c(rev(unclass(from_df)), list(sep = ","))), collapse = "&from_point="),
                    "&to_point=", paste(do.call(paste, c(rev(unclass(to_df)), list(sep = ","))), collapse = "&to_point="))
  }
  query <- list(
    profile = profile,
    out_array = do.call(paste, c(out_array, list(sep = "&out_array="))),
    ...,
    key = key
  )
  query_string <- paste0("https://graphhopper.com/api/1/matrix?", points, "&type=json&", 
                         paste(paste(names(query), as.character(query), sep = "="), collapse = "&"))
  response <- httr::GET(query_string)
  response <- httr::content(response, as = "parsed")
  res <- lapply(response[out_array], simplify2array)
  lapply(res, function(x) {
    if(!is.matrix(x)) stop("no data returned")
    if(!is.numeric(x)) storage.mode(x) <- "numeric"
    t(x) # Need to transpose
  })
}

SebKrantz avatar Nov 01 '24 11:11 SebKrantz