R/distanceMatrix.R

In walshc/GoogleMapsAPI: GoogleMapsAPI

distanceMatrix <- function(origins, destinations, units = "metric", key,
                           pause.time = 0.02 ) {

  if (!(any(class(origins) %in% c("data.frame", "matrix")) &
        any(class(destinations) %in% c("data.frame", "matrix")))) {
    stop("'origins' and 'destinations' must be matrices/data.frames'")
  }
  if (ncol(origins) != 2 | ncol(destinations) != 2) {
    stop("'origins' and 'destinations' must have two columns (long & lat)")
  }
  if (nrow(origins) > 25 | nrow(destinations) > 25) {
    stop("A maximum of 25 origins/destinations is permitted.")
  }
  if (nrow(origins) * nrow(destinations) > 100) {
    stop("A maximum of 100 elements (origins * destinations) is permitted.")
  }
  if (!(units %in% c("metric", "imperial"))) {
    stop("'units' should be either 'metric' or 'imperial'")
  }
  # Format coordinates for url:
  formatCoordinates <- function(crd) {
    paste0(apply(t(as.matrix(crd)), 2, function(x)
                 paste(rev(x), collapse = ",")), collapse = "|")
  }
  root <- "https://maps.googleapis.com/maps/api/distancematrix/json?units="
  url <- paste0(root, units, "&origins=", formatCoordinates(origins),
                "&destinations=", formatCoordinates(destinations), "&key=", key)
  x <- RJSONIO::fromJSON(URLencode(url), simplify = FALSE)
  out <- list()
  out$distance <- matrix(NA, nrow = nrow(origins), ncol = nrow(destinations))
  out$duration <- matrix(NA, nrow = nrow(origins), ncol = nrow(destinations))
  if (x$status == "OK") {
    for (i in 1:nrow(out$distance)) {
      for (j in 1:ncol(out$distance)) {
        if (x$rows[[i]]$elements[[j]]$status == "OK") {
          out$distance[i, j] <- x$rows[[i]]$elements[[j]]$distance$value
          out$duration[i, j] <- x$rows[[i]]$elements[[j]]$duration$value
        }
      }
    }
    out$origin_addresses <- unlist(x$origin_addresses)
    out$destination_addresses <- unlist(x$destination_addresses)
  } else {
    # If no result is found:
    out$origin_addresses <- rep(NA, nrow(origins))
    out$desrtination_addresses <- rep(NA, nrow(destinations))
    warning("Request Status: ", x$status)
  }
  Sys.sleep(pause.time)
  return(out)
}