R 代码 gmapsdistance [英] R Code gmapsdistance

查看:12
本文介绍了R 代码 gmapsdistance的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我有以下代码用于查找两个位置之间的旅行时间.我正在使用 vba 调用脚本,这就是为什么命令 args 显示在顶部,但出于测试目的,我只是设置变量.这一直工作到今天(没有改变任何东西),现在我在运行结果行后不断收到此错误: rowXML[[dur]] 中的错误:下标越界.

有没有人知道是什么导致了这种情况或意味着什么?

代码:

#install 并加载必要的包#install.packages("gmapsdistance")#install.packages("devtools")args<-commandArgs(trailingOnly=T)图书馆(gmapsdistance")图书馆(开发工具")devtools::install_github("rodazuero/gmapsdistance")#从excel输入变量原点 <- args[1]dest <- 参数[2]文件路径 <- args[3]api_key <- 参数[4]原点<-伦敦"dest <-巴黎"filePath <- "C:/Users/gabby/Documents/SeniorYear/SeniorDesign/TravelTimes/Travel_Times.csv"api_key <- "##########################set.api.key(api_key)#调用谷歌地图并找到时间结果 = gmapsdistance(origin = c(orig, dest), destination = c(dest, orig), mode = "driving", traffic_model = "best_guess",键 = api_key,组合 =成对",形状 =宽")#put 结果在一个数据框中结果2 <- data.frame(结果)#重命名列标题名称(结果2)<- c(起点",目的地",时间",X1",X2",距离",X3",X4",状态")#删除重复的起点/终点列结果2$X1 <- NULL结果2$X2 <- NULL结果2$X3 <- NULL结果2$X4 <- NULL#将秒转换为分钟结果2$时间<-结果2$时间/60#将米转换为英里results2$Distance <- results2$Distance*0.000621371#添加额外的列并输入文档的当前日期/时间结果 2[,日期"] <- NA结果2[1,"日期"] <-格式(Sys.time(), "%a %b %d %X %Y %Z")#将 results2 写入 csv 文件并将其保存在我的文件夹中write.csv(results2, file = filePath)

解决方案

我得到了一个 API 密钥,复现了你的问题,然后一行一行地遍历了底层函数的源代码.

错误是由以下原因引起的:

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

因为对象 dur 只包含以下内容:

<块引用>

<代码>>持续时间[1] "duration" "duration_in_traffic"

因此 rowXML[[dur]] 抛出错误.我不知道该指出哪里,但 API 的变化速度通常比围绕它们构建的包更快.

尽管如此,您仍然可以像我一样使用源代码来获得结果.自己清理结果只需要多几行代码:

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

<块引用>

$status<状态>确定</状态>$duration<持续时间><value>20185</value><text>5 小时 36 分钟</text></持续时间>$距离<距离><value>459271</value><text>459 公里</text></距离>$duration_in_traffic<duration_in_traffic><value>20957</value><text>5 小时 49 分钟</text></duration_in_traffic>attr(,"类")[1] "XMLInternalNodeList" "XMLNodeList"

根据您在评论中的要求,这里有更多关于我做了什么来得到这个的信息.

首先,从对该函数的调用中获取参数并从中创建对象(即,只需将每个参数作为单独的命令运行以创建对象).接下来,加载 XMLRcurl 库.此外,将您的 API 密钥放在名为 key 的对象中.

之后,您只需获取函数的源代码并逐行运行,跳过定义函数调用的部分.在此过程中,您可以创建少量未使用的参数并将其设置为 "".

<块引用>

# function (origin, destination,组合 = "all", mode, key = #get.api.key(),# 形状 = "宽", 避免 = "", 出发 = "现在", dep_date = "",# dep_time = "", traffic_model = "best_guess", 到达 = "",# arr_date = "", arr_time = "") # 不要运行这个

 if (!(mode %in% c("driving", "walking", "bicycling", "transit"))) {stop("无法识别交通方式.方式应为"之一,‘骑自行车’、‘过境’、‘开车’、‘步行’")if (!(combinations %in% c("all", "pairwise"))) {stop("无法识别起点和目的地之间的组合.组合应为"之一,'全部','成对'")}if (!(避免 %in% c("", "tolls", "highways", "ferries", "indoor"))) {stop("避免无法识别参数.避免应该是其中之一",‘收费’、‘公路’、‘渡轮’、‘室内’")}if (!(traffic_model %in% c("best_guess", "pessimistic", "optimistic"))) {stop("无法识别交通模型.交通模型应该是"之一,"'best_guess', '悲观', '乐观'")}秒 = "现在"seconds_arrival = ""UTCtime = strptime("1970-01-01 00:00:00", "%Y-%m-%d %H:%M:%OS",tz = "格林威治标准时间")min_secs = round(as.numeric(difftime(as.POSIXlt(Sys.time(),"GMT"), UTCtime, units = "secs")))if (dep_date != "" && dep_time != "") {离开 = strptime(paste(dep_date, dep_time), "%Y-%m-%d %H:%M:%OS",tz = "格林威治标准时间")seconds = round(as.numeric(difftime(depart, UTCtime,单位 = "秒")))}如果(出发!=现在"){秒 = 出发}如果(出发!=现在"&&出发< min_secs){stop("出发时间一定是在未来的某个时间!")}if (dep_date != "" && dep_time == "") {stop("您还应该以 HH:MM:SS UTC 格式指定出发时间")}if (dep_date == "" && dep_time != "") {stop("您还应该以 YYYY-MM-DD UTC 格式指定出发日期")}if (dep_date != "" && dep_time != "" && seconds < min_secs) {stop("出发时间一定是在未来的某个时间!")}if (arr_date != "" && arr_time != "") {arriv = strptime(paste(arr_date, arr_time), "%Y-%m-%d %H:%M:%OS",tz = "格林威治标准时间")seconds_arrival = round(as.numeric(difftime(arriv, UTCtime,单位 = "秒")))}如果(到达!="){seconds_arrival = 到达}如果(到达!="&&到达< min_secs){stop("到达时间一定是在未来的某个时间!")}if (arr_date != "" && arr_time == "") {stop("您还应该以 HH:MM:SS UTC 格式指定到达时间")}if (arr_date == "" && arr_time != "") {stop("您还应该以 YYYY-MM-DD UTC 格式指定到达日期")}if (arr_date != "" && arr_time != "" && seconds_arrival <min_secs) {stop("到达时间一定是在未来的某个时间!")}if ((dep_date != "" || dep_time != "" || 出发!= "now") &&(arr_date != "" || arr_time != "" || 到达 != "")) {stop("不能输入出发到达时间,一次只能输入一个.")}if (combinations == "pairwise" && length(origin) != length(destination)) {stop("使用选项时起始向量和目标向量的大小必须相同:组合=='成对'")}如果(组合==所有"){数据 = expand.grid(or = origin, de = destination)}否则如果(组合==成对"){数据 = data.frame(或 = 原点,de = 目的地)}n = 暗淡(数据)n = n[1]数据$时间 = NA数据$距离 = NA数据$状态=确定"避免msg = ""如果(避免!="){避免msg = paste0(&避免=",避免)}for (i in 1:1:n) {url = paste0("maps.googleapis.com/maps/api/distancematrix/xml?origins=",data$or[i], "&destinations=", data$de[i], "&mode=",模式, "&sensor=", "false", "&units=metric", "&departure_time=",秒,&traffic_model=",traffic_model,avoidmsg)如果 (!is.null(key)) {key = gsub(" ", "", key)url = paste0("https://", url, "&key=", key)}别的 {url = paste0("http://", url)}网页XML = xmlParse(getURL(url))结果 = xmlChildren(xmlRoot(webpageXML))request.status = as(unlist(results$status[[1]]), "character")if (!is.null(results$error_message)) {stop(paste(c("Google API 返回错误:", xmlValue(results$error_message)),sep = ""))}if (request.status == "REQUEST_DENIED") {set.api.key(NULL)data$status[i] = "REQUEST_DENIED"}rowXML = xmlChildren(results$row[[1L]])状态 = as(rowXML$status[1]$text, "character")如果(状态==ZERO_RESULTS"){data$status[i] = "ROUTE_NOT_FOUND"}如果(状态==NOT_FOUND"){data$status[i] = "PLACE_NOT_FOUND"}如果(状态==OVER_QUERY_LIMIT"){stop("您已经超出了今天的 API 请求分配.")}if (data$status[i] == "OK") {data$Distance[i] = as(rowXML$distance[1]$value[1]$text,数字")dur = grep("duration", names(rowXML), value = TRUE)数据$时间[i] = as(rowXML[[dur]][1L]$value[1L]$text,数字")}}datadist = data[c("or", "de", "Distance")]datatime = data[c("or", "de", "Time")]datastat = data[c("or", "de", "status")]如果 (n > 1) {如果(形状==宽"&&组合==所有"){距离 = reshape(datadist, timevar = "de", idvar = c("or"),方向 = "宽")Time = reshape(datatime, timevar = "de", idvar = c("or"),方向 = "宽")stat = reshape(datastat, timevar = "de", idvar = c("or"),方向 = "宽")}别的 {距离 = datadist时间 = 数据时间统计 = 数据统计}}别的 {距离 = 数据$距离[i]时间 = 数据$时间[i]统计=数据$状态[i]}输出 = 列表(时间 = 时间,距离 = 距离,状态 = 统计)

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)

解决方案

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)

这篇关于R 代码 gmapsdistance的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆