簡體   English   中英

如何在 R 代碼中集成 Google 距離矩陣 API 密鑰?

[英]How to integrate Google Distance Matrix API key in R code?

我已經在谷歌注冊以獲得更多的行駛時間距離請求。 但是,Google 不會自動獲取每天運行 2500 多個查詢的“權限”。 此外, mapdist()沒有集成 API 密鑰的參數。

我設法通過 Google 控制台獲得了一個 API 密鑰。

我嘗試修改原始代碼添加密鑰並更改第 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)

我覺得我必須將此密鑰集成到 R 上的代碼中,以便 Google 獲取我的“權限”。 一個朋友告訴我我可以通過httr做到這httr但我對此httr 我真的不太了解編碼,我會很感激任何幫助!

我已經編寫了包googleway來訪問谷歌地圖 API,您可以在其中指定您的令牌密鑰

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

我修改了核心代碼(比我在命令之前運行)如下:

#' Compute map distances using Google
#'
#' Compute map distances using Google Maps. Note that in most cases
#' by using this function you are agreeing to the Google Maps API
#' Terms of Service at https://developers.google.com/maps/terms.
#'
#' @param from name of origin addresses in a data frame (vector
#'   accepted)
#' @param to name of destination addresses in a data frame (vector
#'   accepted)
#' @param output amount of output
#' @param mode driving, bicycling, or walking
#' @param messaging turn messaging on/off
#' @param sensor whether or not the geocoding request comes from a
#'   device with a location sensor
#' @param language language
#' @param override_limit override the current query count
#'   (.GoogleDistQueryCount)
#' @return a data frame (output="simple") or all of the geocoded
#'   information (output="all")
#' @author David Kahle \email{david.kahle@@gmail.com}
#' @details if parameters from and to are specified as geographic
#'   coordinates, they are reverse geocoded with revgeocode.  note
#'   that the google maps api limits to 2500 element queries a day.
#' @seealso
#' \url{http://code.google.com/apis/maps/documentation/distancematrix/}
#'
#' @export
#' @examples
#'
#' \dontrun{ online queries draw R CMD check times
#'
#' mapdist("waco, texas", "houston, texas")
#'
#' from <- c("houston, texas", "dallas")
#' to <- "waco, texas"
#' mapdist(from, to)
#' mapdist(from, to, mode = "bicycling")
#' mapdist(from, to, mode = "walking")
#'
#' from <- c("houston", "houston", "dallas")
#' to <- c("waco, texas", "san antonio", "houston")
#' mapdist(from, to)
#'
#'
#' # geographic coordinates are accepted as well
#' (wh <- as.numeric(geocode("the white house, dc")))
#' (lm <- as.numeric(geocode("lincoln memorial washington dc")))
#' mapdist(wh, lm, mode = "walking")
#' distQueryCheck()
#'
#' }
#'
mapdist <- function(from, to, mode = c("driving","walking","bicycling"),
  output = c("simple","all"), messaging = FALSE, sensor = FALSE,
  language = "en-EN", override_limit = FALSE, key)
{

  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("https://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)
}

然后我可以通過添加鍵名“1234”來修改mapdist()命令,如下所示:

# create your own 'from' and 'to' variables 
from <- drivetime$gp_postcode
to <- drivetime$h_postcode

    result <- vector("list")
    for (i in 1:nrow(drivetime)) { # could be 1:nrow(drivetime)
      result[[i]] <- mapdist(from[i], to[i], mode = "driving", override_limit = TRUE, key="1234") 
      Sys.sleep(0.5)
    }
    results <- dput(result)
    res_df <- do.call(rbind, results)

您可以在此處查看查詢次數和計費情況

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM