我已在 Google 中注册,以获取更多有关行驶时间距离的请求。然而,Google 不会自动获得每天运行超过 2500 个查询的“权限”。此外,mapdist()
没有用于集成 API key 的参数。
我已成功通过 Google 控制台获取 API key 。
我尝试修改原始代码,添加 key 并更改第 56、90 和 91 行,如下所示:
mapdist <- function(from, to, mode = c("driving","walking","bicycling"),
output = c("simple","all"), messaging = FALSE, sensor = FALSE,
language = "en-EN", override_limit = FALSE, key = "XXXX")
{
message("by using this function you are agreeing to the terms at :")
message("http://code.google.com/apis/maps/documentation/distancematrix/\n")
# check parameters
if(is.numeric(from) && length(from) == 2) from <- revgeocode(from)
stopifnot(is.character(from))
if(is.numeric(to) && length(to) == 2) to <- revgeocode(to)
stopifnot(is.character(to))
from_to_df <- data.frame(from = from, to = to, stringsAsFactors = FALSE)
origins <- from_to_df$from
destinations <- from_to_df$to # this ensures # from = # to
mode <- match.arg(mode)
output <- match.arg(output)
stopifnot(is.logical(messaging))
stopifnot(is.logical(sensor))
getdists <- function(df){
# format url
origin <- df$from[1]
origin <- gsub(",", "", origin)
origin <- gsub(" ", "+", origin)
origin <- paste("origins=", origin, sep = "")
destinations <- df$to
destinations <- gsub(",", "", destinations)
destinations <- gsub(" ", "+", destinations)
destinations <- paste("destinations=", paste(destinations, collapse = "|"), sep = "")
mode4url <- paste("mode=", mode, sep = "")
lang4url <- paste("language=", language, sep = "")
sensor4url <- paste("sensor=", tolower(as.character(sensor)), sep = "")
keyUrl <- paste("key=", key, sep = "")
posturl <- paste(origin, destinations, mode4url, sensor4url, keyUrl, sep = "&")
url_string <- paste("http://maps.googleapis.com/maps/api/distancematrix/json?",
posturl, sep = "")
url_string <- URLencode(url_string)
# check if query is too long
if(nchar(url_string) >= 2048){
n <- nrow(df)
half_df <- floor(n/2)
return(
rbind(
getdists(df[half_df,]),
getdists(df[(half_df+1):n,])
)
)
}
# check/update google query limit
check_dist_query_limit(url_string, elems = nrow(df),
override = override_limit, messaging = messaging)
# distance lookup
if(messaging) message("trying url ", url_string)
connect <- url(url_string)
tree <- fromJSON(paste(readLines(connect), collapse = ""))
close(connect)
# message user
message(paste0("Information from URL : ", url_string))
# label destinations - first check if all were found
if(length(df$to) != length(tree$destination_addresses)){
message("matching was not perfect, returning what was found.")
names( tree$rows[[c(1,1)]] ) <- tree$destination_addresses
output <<- "all"
# stringdist::amatch(df$to, tree$destination_addresses, maxDist = 10)
} else {
names( tree$rows[[c(1,1)]] ) <- df$to
}
# return
tree$rows[[c(1,1)]]
}
out <- dlply(from_to_df, "from", getdists)
# return all
if(output == "all") return(out)
# format output
out <-
ldply(out, function(oneFromList){
ldply(oneFromList, function(oneToList){
data.frame(
m = oneToList$distance$value,
km = oneToList$distance$value/1000,
miles = 0.0006214 * oneToList$distance$value,
seconds = oneToList$duration$value,
minutes = oneToList$duration$value / 60,
hours = oneToList$duration$value / 3600
)
})
})
names(out) <- c("from", "to", names(out)[3:ncol(out)])
# "simple" return
suppressMessages(join(from_to_df, out))
}
check_dist_query_limit <- function(url_string, elems, override, messaging){
.GoogleDistQueryCount <- NULL; rm(.GoogleDistQueryCount); # R CMD check trick
if(exists(".GoogleDistQueryCount", .GlobalEnv)){
.GoogleDistQueryCount <<-
subset(.GoogleDistQueryCount, time >= Sys.time() - 24*60*60)
# 2500 per 24 hours
if(sum(.GoogleDistQueryCount$elements) + elems > 2500){
message("query max exceeded, see ?mapdist. current total = ",
sum(.GoogleDistQueryCount$elements))
if(!override) stop("google query limit exceeded.", call. = FALSE)
}
# 100 per 10 seconds
if(with(.GoogleDistQueryCount,
sum(elements[time >= Sys.time() - 10]) + elems > 100
)){
if(messaging) message("waiting 10 seconds for another 100 queries...", appendLF=F)
Sys.sleep(10) # can do better
if(messaging) message(" done")
}
# append to .GoogleDistQueryCount
.GoogleDistQueryCount <<- rbind(.GoogleDistQueryCount,
data.frame(time = Sys.time(), url = url_string,
elements = elems, stringsAsFactors = FALSE)
)
} else {
.GoogleDistQueryCount <<-
data.frame(time = Sys.time(), url = url_string,
elements = elems, stringsAsFactors = FALSE)
}
}
#' Check Google Maps Distance Matrix API query limit
#'
#' Check Google Maps Distance Matrix API query limit
#'
#' @return a data frame
#' @author David Kahle \email{david.kahle@@gmail.com}
#' @seealso \url{http://code.google.com/apis/maps/documentation/distancematrix/}
#' @export
#' @examples
#' distQueryCheck()
distQueryCheck <- function(){
.GoogleDistQueryCount <- NULL; rm(.GoogleDistQueryCount); # R CMD check trick
if(exists(".GoogleDistQueryCount", .GlobalEnv)){
remaining <- 2500-sum(
subset(.GoogleDistQueryCount, time >= Sys.time() - 24*60*60)$elements
)
message(remaining, " distance queries remaining.")
} else {
remaining <- 2500
message(remaining, " distance queries remaining.")
}
invisible(remaining)
}
但是,我在运行 mapdist() 时收到此错误消息:
by using this function you are agreeing to the terms at :
http://code.google.com/apis/maps/documentation/distancematrix/
Information from URL : http://maps.googleapis.com/maps/api/distancematrix/json?origins=NG17+7LG&destinations=CV2+2DX&mode=driving&sensor=false&key=AIzaSyBQN9Dvgfw3bXpWj_-ddluungZcDv8Y4rg
matching was not perfect, returning what was found.
Error in `*tmp*`[[c(1, 1)]] : no such index at level 1
Called from: .fun(piece, ...)
Browse[1]> results <- dput(result)
list()
Browse[1]> res_df <- do.call(rbind, results)
我感觉我必须将此 key 集成到 R 上的代码中,以便 Google 获得我的“权限”。一位 friend 告诉我可以通过 httr
做到这一点,但我对此了解不多。
我真的不太了解编码,我将不胜感激任何帮助!
最佳答案
我已经写好了包googleway访问谷歌地图 API,您可以在其中指定您的 token key
For example
library(googleway)
key <- "your_api_key"
google_distance(origins = list("houston", "Dallas"),
destinations = list("waco, Texas", "San Antonio"),
key = key,
simplify = FALSE) ## use simplify = T to simplify to a data.frame
[1] "{"
[2] " \"destination_addresses\" : [ \"Waco, TX, USA\", \"San Antonio, TX, USA\" ],"
[3] " \"origin_addresses\" : [ \"Houston, TX, USA\", \"Dallas, TX, USA\" ],"
[4] " \"rows\" : ["
[5] " {"
[6] " \"elements\" : ["
[7] " {"
[8] " \"distance\" : {"
[9] " \"text\" : \"299 km\","
[10] " \"value\" : 298585"
[11] " },"
[12] " \"duration\" : {"
[13] " \"text\" : \"2 hours 51 mins\","
[14] " \"value\" : 10244"
[15] " },"
[16] " \"duration_in_traffic\" : {"
[17] " \"text\" : \"2 hours 52 mins\","
[18] " \"value\" : 10343"
[19] " },"
[20] " \"status\" : \"OK\""
[21] " },"
... etc
关于r - 如何在 R 代码中集成 Google 距离矩阵 API key ?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/36936878/