问题
I have the following code used to find the travel time between two locations. I am using vba to call the script which is why the command args shows up at the top but for testing purposes I am just setting the variables. This was working until today (didn't change anything) and now I keep getting this error once i run the results line: Error in rowXML[[dur]] : subscript out of bounds.
Does anyone have any idea what could be causing this or what it means?
Code:
#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)
回答1:
I obtained an API key, reproduced your problem, and then stepped through the underlying function's source code line by line.
The error is caused by the following:
data$Time[i] = as(rowXML[[dur]][1L]$value[1L]$text,
"numeric")
because the object dur contains only the following:
> dur [1] "duration" "duration_in_traffic"
Thus rowXML[[dur]] throws the error. I'm not sure where to point the finger, but very often API's change faster than the packages built around them.
Nevertheless, you can still use the source code to get your result, as I did. It just takes a few more lines of code to clean up the results yourself:
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"
Per your request in the comment, here's a bit more about what I did to get this.
First, take the arguments from the call to this function and create objects out of them (i.e. just run each argument as an individual command to create the objects). Next, load the XML and Rcurl libraries. Also, put your API key in an object called key.
After that you just take the source code of the function and run it line by line, skipping the part where the function call is defined. Along the way there are a small number of unused arguments which you can just create and set to "".
# 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)
回答2:
If you're not constrained to using gmapsdistance, my googleway package will give you the same results. The only difference is currently you have to specify the 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
来源：https://stackoverflow.com/questions/41133859/r-code-gmapsdistance