R Код gmapsdistance

Question

У меня есть следующий код, который используется для поиска времени в пути между двумя точками. Я использую vba для вызова скрипта, поэтому команда args отображается вверху, но для целей тестирования я просто устанавливаю переменные. Это работало до сегодняшнего дня (ничего не меняло), и теперь я получаю эту ошибку, когда запускаю строку результатов: Ошибка в rowXML [[dur]]: индекс за пределами.

Кто-нибудь знает, что может быть причиной этого или что это значит?

Код:

#install and load necessary packages 
#install.packages("gmapsdistance") 
#install.packages("devtools") 

args<-commandArgs(trailingOnly=T) 

library("gmapsdistance") 
library("devtools") 
devtools::install_github("rodazuero/gmapsdistance") 

#input variables from excel 
orig <- args[1] 
dest <- args[2] 
filePath <- args[3] 
api_key <- args[4] 

orig <- "London" 
dest <- "Paris" 
filePath <- "C:/Users/gabby/Documents/SeniorYear/SeniorDesign/TravelTimes/Travel_Times.csv" 
api_key <- "############################" 

set.api.key(api_key) 

#calls google maps and finds the time 
results = gmapsdistance(origin = c(orig, dest), destination = c(dest, orig), mode = "driving", traffic_model = "best_guess", 
         key = api_key, combinations = "pairwise", shape = "wide") 

#put results in a data frame 
results2 <- data.frame(results) 

#rename the column headings 
names(results2) <- c("Origin","Destination", "Time", "X1","X2","Distance","X3","X4","Status") 

#delete repeated origin/destination columns 
results2$X1 <- NULL 
results2$X2 <- NULL 
results2$X3 <- NULL 
results2$X4 <- NULL 

#convert seconds to minutes 
results2$Time <- results2$Time/60 

#convert meters to miles 
results2$Distance <- results2$Distance*0.000621371 

#add extra column and input the current date/time for documentation 
results2[,"Date"] <- NA 
results2[1,"Date"] <- format(Sys.time(), "%a %b %d %X %Y %Z") 

#write results2 to a csv file and save it in my folder 
write.csv(results2, file = filePath) 

Answer 1

Я получил ключ API, воспроизведенный вашу проблему, а затем прошел через исходный код линии базовую функцию в построчно.

Ошибка вызвано следующими причинами:

data$Time[i] = as(rowXML[[dur]][1L]$value[1L]$text, 
         "numeric") 

, так как объект dur содержит только следующее:

> dur 
[1] "duration"   "duration_in_traffic" 

rowXML[[dur]] Таким образом, бросает ошибку. Я не уверен, где указать пальцем, но очень часто изменения API быстрее, чем пакеты, построенные вокруг них.

Тем не менее, вы все равно можете использовать исходный код, чтобы получить свой результат, как и я. Это займет несколько строк кода, чтобы очистить результаты себя:

xmlChildren(results$row[[1L]]) 

$status 
<status>OK</status> 

$duration 
<duration> 
    <value>20185</value> 
    <text>5 hours 36 mins</text> 
</duration> 

$distance 
<distance> 
    <value>459271</value> 
    <text>459 km</text> 
</distance> 

$duration_in_traffic 
<duration_in_traffic> 
    <value>20957</value> 
    <text>5 hours 49 mins</text> 
</duration_in_traffic> 

attr(,"class") 
[1] "XMLInternalNodeList" "XMLNodeList" 

на ваш запрос в комментарии, вот немного больше о том, что я сделал, чтобы получить это.

Сначала возьмите аргументы из вызова этой функции и создайте из них объекты (т. Е. Просто запустите каждый аргумент как отдельную команду для создания объектов). Затем загрузите библиотеки XML и Rcurl. Кроме того, введите ключ API в объект с именем key.

После этого вы просто берете исходный код функции и запускаете ее по строкам, пропуская часть, где определен вызов функции. По пути есть небольшое количество неиспользуемых аргументов, которые вы можете просто создать и установить на "".

# function (origin, destination, combinations = "all", mode, key = #get.api.key(), 
#    shape = "wide", avoid = "", departure = "now", dep_date = "", 
#    dep_time = "", traffic_model = "best_guess", arrival = "", 
#    arr_date = "", arr_time = "") # don't run this 

if (!(mode %in% c("driving", "walking", "bicycling", "transit"))) { 
    stop("Mode of transportation not recognized. Mode should be one of ", 
     "'bicycling', 'transit', 'driving', 'walking' ") 

    if (!(combinations %in% c("all", "pairwise"))) { 
    stop("Combinations between origin and destination not recognized. Combinations should be one of ", 
     "'all', 'pairwise' ") 
    } 
    if (!(avoid %in% c("", "tolls", "highways", "ferries", "indoor"))) { 
    stop("Avoid parameters not recognized. Avoid should be one of ", 
     "'tolls', 'highways', 'ferries', 'indoor' ") 
    } 
    if (!(traffic_model %in% c("best_guess", "pessimistic", "optimistic"))) { 
    stop("Traffic model not recognized. Traffic model should be one of ", 
     "'best_guess', 'pessimistic', 'optimistic'") 
    } 
    seconds = "now" 
    seconds_arrival = "" 
    UTCtime = strptime("1970-01-01 00:00:00", "%Y-%m-%d %H:%M:%OS", 
        tz = "GMT") 
    min_secs = round(as.numeric(difftime(as.POSIXlt(Sys.time(), 
                "GMT"), UTCtime, units = "secs"))) 
    if (dep_date != "" && dep_time != "") { 
    depart = strptime(paste(dep_date, dep_time), "%Y-%m-%d %H:%M:%OS", 
         tz = "GMT") 
    seconds = round(as.numeric(difftime(depart, UTCtime, 
             units = "secs"))) 
    } 
    if (departure != "now") { 
    seconds = departure 
    } 
    if (departure != "now" && departure < min_secs) { 
    stop("The departure time has to be some time in the future!") 
    } 
    if (dep_date != "" && dep_time == "") { 
    stop("You should also specify a departure time in the format HH:MM:SS UTC") 
    } 
    if (dep_date == "" && dep_time != "") { 
    stop("You should also specify a departure date in the format YYYY-MM-DD UTC") 
    } 
    if (dep_date != "" && dep_time != "" && seconds < min_secs) { 
    stop("The departure time has to be some time in the future!") 
    } 
    if (arr_date != "" && arr_time != "") { 
    arriv = strptime(paste(arr_date, arr_time), "%Y-%m-%d %H:%M:%OS", 
        tz = "GMT") 
    seconds_arrival = round(as.numeric(difftime(arriv, UTCtime, 
               units = "secs"))) 
    } 
    if (arrival != "") { 
    seconds_arrival = arrival 
    } 
    if (arrival != "" && arrival < min_secs) { 
    stop("The arrival time has to be some time in the future!") 
    } 
    if (arr_date != "" && arr_time == "") { 
    stop("You should also specify an arrival time in the format HH:MM:SS UTC") 
    } 
    if (arr_date == "" && arr_time != "") { 
    stop("You should also specify an arrival date in the format YYYY-MM-DD UTC") 
    } 
    if (arr_date != "" && arr_time != "" && seconds_arrival < 
     min_secs) { 
    stop("The arrival time has to be some time in the future!") 
    } 
    if ((dep_date != "" || dep_time != "" || departure != "now") && 
     (arr_date != "" || arr_time != "" || arrival != "")) { 
    stop("Cannot input departure and arrival times. Only one can be used at a time. ") 
    } 
    if (combinations == "pairwise" && length(origin) != length(destination)) { 
    stop("Size of origin and destination vectors must be the same when using the option: combinations == 'pairwise'") 
    } 
    if (combinations == "all") { 
    data = expand.grid(or = origin, de = destination) 
    } 
    else if (combinations == "pairwise") { 
    data = data.frame(or = origin, de = destination) 
    } 
    n = dim(data) 
    n = n[1] 
    data$Time = NA 
    data$Distance = NA 
    data$status = "OK" 
    avoidmsg = "" 
    if (avoid != "") { 
    avoidmsg = paste0("&avoid=", avoid) 
    } 











    for (i in 1:1:n) { 
    url = paste0("maps.googleapis.com/maps/api/distancematrix/xml?origins=", 
       data$or[i], "&destinations=", data$de[i], "&mode=", 
       mode, "&sensor=", "false", "&units=metric", "&departure_time=", 
       seconds, "&traffic_model=", traffic_model, avoidmsg) 
    if (!is.null(key)) { 
     key = gsub(" ", "", key) 
     url = paste0("https://", url, "&key=", key) 
    } 
    else { 
     url = paste0("http://", url) 
    } 
    webpageXML = xmlParse(getURL(url)) 
    results = xmlChildren(xmlRoot(webpageXML)) 
    request.status = as(unlist(results$status[[1]]), "character") 
    if (!is.null(results$error_message)) { 
     stop(paste(c("Google API returned an error: ", xmlValue(results$error_message)), 
       sep = "")) 
    } 
    if (request.status == "REQUEST_DENIED") { 
     set.api.key(NULL) 
     data$status[i] = "REQUEST_DENIED" 
    } 
    rowXML = xmlChildren(results$row[[1L]]) 
    Status = as(rowXML$status[1]$text, "character") 
    if (Status == "ZERO_RESULTS") { 
     data$status[i] = "ROUTE_NOT_FOUND" 
    } 
    if (Status == "NOT_FOUND") { 
     data$status[i] = "PLACE_NOT_FOUND" 
    } 
    if (Status == "OVER_QUERY_LIMIT") { 
     stop("You have exceeded your allocation of API requests for today.") 
    } 
    if (data$status[i] == "OK") { 
     data$Distance[i] = as(rowXML$distance[1]$value[1]$text, 
          "numeric") 
     dur = grep("duration", names(rowXML), value = TRUE) 
     data$Time[i] = as(rowXML[[dur]][1L]$value[1L]$text, 
         "numeric") 
    } 
    } 


    datadist = data[c("or", "de", "Distance")] 
    datatime = data[c("or", "de", "Time")] 
    datastat = data[c("or", "de", "status")] 
    if (n > 1) { 
    if (shape == "wide" && combinations == "all") { 
     Distance = reshape(datadist, timevar = "de", idvar = c("or"), 
         direction = "wide") 
     Time = reshape(datatime, timevar = "de", idvar = c("or"), 
        direction = "wide") 
     Stat = reshape(datastat, timevar = "de", idvar = c("or"), 
        direction = "wide") 
    } 
    else { 
     Distance = datadist 
     Time = datatime 
     Stat = datastat 
    } 
    } 
    else { 
    Distance = data$Distance[i] 
    Time = data$Time[i] 
    Stat = data$status[i] 
    } 
    output = list(Time = Time, Distance = Distance, Status = Stat) 

Answer 2

Если вы не ограничены в использовании gmapsdistance, мой googleway пакет даст вам те же результаты. Единственное различие заключается в том, что вы должны указать departure_time.

library(googleway) 

orig <- "London" 
dest <- "Paris" 
api_key <- "your_api_key" 

result <- google_distance(origin = c(orig, dest), destination = c(orig, dest), 
         mode = "driving", 
         traffic_model = "best_guess", 
         departure_time = Sys.time() + 60, 
         key = api_key) 


result$rows$elements 
# [[1]] 
# distance.text distance.value duration.text duration.value status 
# 1   1 m    0   1 min    0  OK 
# 2  459 km   459271 5 hours 36 mins   20185  OK 
# 
# [[2]] 
# distance.text distance.value duration.text duration.value status 
# 1  470 km   470366 5 hours 25 mins   19484  OK 
# 2   1 m    0   1 min    0  OK