我使用了Derek Darves的drive_time()软件包中的placement函数，该函数通过Google地图输出两点之间的时间和长度。
但是，即使示例代码也不适合我：
howfar_kms <- drive_time(
address="350 5th Ave, New York, NY 10118, USA",
dest="1600 Amphitheatre Pkwy, Mountain View, CA 94043",
auth="standard_api", privkey="", clean=FALSE,
add_date='today', verbose=FALSE, travel_mode="bicycling",
units="imperial"
)
它给出了这个错误：
vapply错误（json，function（x）{：
值必须是11， 但是FUN（X [[1]]）结果是长度0
应该注意的是，昨天完全相同的代码。我想这是一个依赖于实时交通信息等问题的问题。
无论如何，我不知道如何解决这个问题，因为vapply是函数内部工作的一部分。
你有什么想法吗？
这是完整的功能，感谢@lmo提示。
function (address, dest, auth = "standard_api", privkey = NULL,
clientid = NULL, clean = "TRUE", travel_mode = "driving",
units = "metric", verbose = FALSE, add_date = "none", language = "en-EN",
messages = FALSE, small = FALSE)
{
options(stringsAsFactors = F)
if (!grepl("standard_api|work", auth))
stop("Invalid auth paramater. Must be 'standard_api' or 'work'.")
if (is.null(privkey))
stop("You must specify a valid API key or an empty string (''). To request a key, see:\n\t https://developers.google.com/maps/documentation/javascript/get-api-key#get-an-api-key")
if (auth == "work" & is.null(clientid))
stop("You must specify a client ID with the work authentication method!")
if (!grepl("driving|bicycling|transit|walking", travel_mode,
ignore.case = TRUE))
stop("You must specify a valid travel mode.")
if (!grepl("metric|imperial", units))
stop("Invalid units paramater. Must be 'metric' or 'imperial'")
if (length(address) > 1 & length(address) != length(dest))
stop("Address must be singular or the same length as destination!")
if (!is.vector(c(address, dest), mode = "character"))
stop("Address and destination must be character vectors!")
if (!grepl("today|fuzzy|none", add_date))
stop("Invalid add_date paramater. Must be 'today', 'fuzzy', or 'none'")
if (privkey == "" & travel_mode == "transit")
stop("You must specify a valid API key to use the transit mode!")
if (!is.logical(messages))
stop("messages must be logical! Please choose TRUE or FALSE.")
if (clean) {
if (verbose)
cat("Cleaning origin addresses...\n")
address <- placement::address_cleaner(address, verbose = verbose)
if (verbose)
cat("Cleaning destination addresses...\n")
dest <- placement::address_cleaner(dest, verbose = verbose)
}
not_nambia <- function(x) {
x[is.na(x)] <- ""
return(x)
}
address <- not_nambia(address)
dest <- not_nambia(dest)
enc <- urltools::url_encode(address)
dest <- urltools::url_encode(dest)
if (auth == "standard_api") {
inbound <- data.frame(address = enc, dest = dest)
baserl <- "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
inbound$full_url <- paste0(baserl, inbound$address, "&destinations=",
inbound$dest, "&units=", tolower(units), "&mode=",
tolower(travel_mode), "&language=", language, "&key=",
privkey)
togoogle <- inbound$full_url
}
if (auth == "work") {
togoogle <- placement::google_encode64(enc, dest = dest,
gmode = "dtime", privkey = privkey, clientid = clientid,
verbose = verbose, units = units)
}
if (verbose)
cat("Sending locations (n=", length(togoogle), ") to Google for distance calculation...\n",
sep = "")
json <- placement::pull_geo_data(togoogle, tmout = 10, messages = messages)
if (json[[1]]$status == "REQUEST_DENIED") {
stop(paste0("Request sent to Google, but response returned REQUEST_DENIED. Error details:\n",
json[[1]]$error_message))
}
coord <- t(vapply(json, function(x) {
if (!is.null(x$status)) {
if (x$status == "OK") {
if (!is.null(x$rows$elements[[1]]$status)) {
if (x$rows$elements[[1]]$status == "OK") {
origin <- as.character(x$origin_addresses)
destination <- as.character(x$destination_addresses)
dist_num <- as.character(x$rows$elements[[1]]$distance$value/1000)
if (units == "imperial")
dist_num <- as.character(as.numeric(dist_num) *
0.621371)
dist_txt <- as.character(x$rows$elements[[1]]$distance$text)
time_secs <- as.character(x$rows$elements[[1]]$duration$value)
time_mins <- as.character(as.numeric(time_secs) *
0.0166667)
time_hours <- as.character(as.numeric(time_secs) *
0.000277778)
time_txt <- as.character(x$rows$elements[[1]]$duration$text)
return_stat <- as.character(x$rows$elements[[1]]$status)
status <- as.character(x$status)
error_message <- ""
return(c(origin, destination, dist_num, dist_txt,
time_secs, time_mins, time_hours, time_txt,
return_stat, status, error_message))
}
else {
return(c(as.character(x$origin_addresses),
as.character(x$destination_addresses),
rep(NA, 6), x$rows$elements[[1]]$status,
x$status, ""))
}
}
}
else if (x$status == "CONNECTION_ERROR" & !is.null(x$error_message)) {
return(c(rep(NA, 9), x$status, x$error_message))
}
}
else {
return(c(rep(NA, 10), "Non-conforming response object: check source data/url for this record"))
}
}, character(11)))
if (is.matrix(coord)) {
out <- as.data.frame(coord)
}
else if (length(coord) == 11) {
out <- data.frame(t(unlist(coord)))
}
colnames(out) <- c("origin", "destination", "dist_num", "dist_txt",
"time_secs", "time_mins", "time_hours", "time_txt", "return_stat",
"status", "error_message")
nums <- c("dist_num", "time_secs", "time_mins", "time_hours")
out[, nums] <- vapply(out[, nums], function(x) {
x <- round(as.numeric(x), digits = 2)
return(x)
}, numeric(nrow(out)))
out$input_url <- togoogle
if (small)
out <- out[, c("dist_num", "time_hours")]
if (!add_date == "none") {
out$geocode_dt <- Sys.Date()
if (add_date == "fuzzy")
out$geocode_dt <- out$geocode_dt + stats::runif(nrow(out),
1, 30)
}
if (verbose) {
cat("Finished.", nrow(out[out$return_stat == "OK", ]),
"of", nrow(out), "distance calculations were successful.\n")
if (units == "imperial") {
len <- "miles"
}
else {
len <- "kilometers"
}
message("Note: numeric distances in the 'dist_num' column are expressed in ",
len, ".\n")
}
return(out)
}