2

如前所述：它甚至在时间上相差 2 倍！这怎么可能？我发现了这个问题，但它似乎仍然存在？

事实证明，高速公路仅在方向上行驶（参见传单地图map_route。我错过了什么吗？

这是一个可重现的示例：

wd <- getwd()
setwd("C:/OSRM_API5")
shell(paste0("osrm-routed ", "switzerland-latest.osrm", " >nul 2>nul"), wait = F)
Sys.sleep(3) # OSRM needs time
setwd(wd)

k1 <- 46.99917
k2 <- 8.610048
k3 <- 47.05398
k4 <- 8.530232
r1 <- viaroute5_2(k1, k2, k3, k4)
r1$routes[[1]]$duration
# [1] 598.2
geometry <- decode_geom(r1$routes[[1]]$geometry, 5)
map_route(geometry)

r2 <- viaroute5_2(k3, k4,k1, k2)
r2$routes[[1]]$duration
# [1] 1302
geometry <- decode_geom(r2$routes[[1]]$geometry, 5)
map_route(geometry)
shell("TaskKill /F /IM osrm-routed.exe >nul 2>nul")

以下是您需要的功能：

viaroute5_2 <- function(lat1, lng1, lat2, lng2) {
  # address <- "http://localhost:5000" # this should work without a  local server
  address <- "http://localhost:5000"
  request <- paste(address, "/route/v1/driving/",
                   lng1, ",", lat1, ";", lng2, ",", lat2,
                   "?overview=full", sep = "", NULL)

  R.utils::withTimeout({
    repeat {
      res <- try(
        route <- rjson::fromJSON(
          file = request))
      if (class(res) != "try-error") {
        if (!is.null(res)) {
          break
        } else {
          stop("???")
        }
      }
    }
  }, timeout = 1, onTimeout = "warning")

  if (res$code == "Ok") {
    return(res)
  } else {
    t_guess <- 16*60
    warning("Route not found: ", paste(lat1, lng1, lat2, lng2, collapse = ", "),
            ". Time set to ", t_guess/60 , " min.")
  }
}

decode_geom <- function(encoded, precision = stop("a numeric, either 5 or 6")) {
  if (precision == 5) {
    scale <- 1e-5
  } else if (precision == 6) {
    scale <- 1e-6
  } else {
    stop("precision not set to 5 or 6")
  }
  len = stringr::str_length(encoded)
  encoded <- strsplit(encoded, NULL)[[1]]
  index = 1
  N <- 100000
  df.index <- 1
  array = matrix(nrow = N, ncol = 2)
  lat <- dlat <- lng <- dlnt <- b <- shift <- result <- 0

  while (index <= len) {
    shift <- result <- 0
    repeat {
      b = as.integer(charToRaw(encoded[index])) - 63
      index <- index + 1
      result = bitops::bitOr(result, bitops::bitShiftL(bitops::bitAnd(b, 0x1f), shift))
      shift = shift + 5
      if (b < 0x20) break
    }
    dlat = ifelse(bitops::bitAnd(result, 1),
                  -(result - (bitops::bitShiftR(result, 1))),
                  bitops::bitShiftR(result, 1))
    lat = lat + dlat;

    shift <- result <- b <- 0
    repeat {
      b = as.integer(charToRaw(encoded[index])) - 63
      index <- index + 1
      result = bitops::bitOr(result, bitops::bitShiftL(bitops::bitAnd(b, 0x1f), shift))
      shift = shift + 5
      if (b < 0x20) break
    }
    dlng = ifelse(bitops::bitAnd(result, 1),
                  -(result - (bitops::bitShiftR(result, 1))),
                  bitops::bitShiftR(result, 1))
    lng = lng + dlng

    array[df.index,] <- c(lat = lat * scale, lng = lng * scale)
    df.index <- df.index + 1
  }

  geometry <- data.frame(array[1:df.index - 1,])
  names(geometry) <- c("lat", "lng")
  return(geometry)
}

map <- function() {
  library(leaflet)
  m <- leaflet() %>%
    addTiles() %>%
    addProviderTiles(providers$OpenStreetMap, group = "OSM") %>%
    addProviderTiles(providers$Stamen.TonerLite, group = "Toner Lite") %>%
    addLayersControl(baseGroups = c("OSM", "Toner Lite"))
  return(m)
}

map_route <- function(geometry) { # Which parameters make sence? osrm inside or outside?
  m <- map()
  m <- addCircleMarkers(map = m,
                        lat = geometry$lat[1],
                        lng = geometry$lng[1],
                        color = imsbasics::fhs(),
                        popup = paste("Source"),
                        stroke = FALSE,
                        radius = 6,
                        fillOpacity = 0.8) %>%
    addCircleMarkers(lat = geometry$lat[nrow(geometry)],
                     lng = geometry$lng[nrow(geometry)],
                     color = imsbasics::fhs(),
                     popup = paste("Destination"),
                     stroke = FALSE,
                     radius = 6,
                     fillOpacity = 0.8) %>%
    addPolylines(lat = geometry$lat, lng = geometry$lng, color = "red", weight = 4) %>%
    addLayersControl(baseGroups = c("OSM", "Stamen.TonerLite"))
  return(m)
}
4

1 回答 1

3

答案是：因为 OSRM 默认搜索最近的点并从该点搜索一条路线。如果您的坐标在高速公路的北边，OSRM 只会向西行驶（考虑到您像我们在欧洲一样在右侧行驶......）。

因此，在您的示例中，upleft 点位于高速公路以北一点，因此当从该点进行搜索时，OSRM 需要绕道而行。

以下示例显示了这一点：

osrmr::run_server("switzerland-latest", "C:/OSRM_API5")

lat1 <- 46.99917
lng1 <- 8.610048
lat2 <- 47.05398
lng2 <- 8.530232

res1 <- osrmr::viaroute(lat1, lng1, lat2, lng2, instructions = TRUE, api_version = 5, localhost = TRUE)
res2 <- osrmr::viaroute(lat2, lng2, lat1, lng1, instructions = TRUE, api_version = 5, localhost = TRUE)
res1$routes[[1]]$duration
# [1] 598.2
res2$routes[[1]]$duration
# [1] 1302
map_route(decode_geom(res1$routes[[1]]$geometry, 5))
map_route(decode_geom(res2$routes[[1]]$geometry, 5))


lat1 <- 46.99917
lng1 <- 8.610048
lat2 <- 47.051 # setting that point a bit more south changes the results to the opposite..
lng2 <- 8.530232

res1 <- osrmr::viaroute(lat1, lng1, lat2, lng2, instructions = TRUE, api_version = 5, localhost = TRUE)
res2 <- osrmr::viaroute(lat2, lng2, lat1, lng1, instructions = TRUE, api_version = 5, localhost = TRUE)
res1$routes[[1]]$duration
# [1] 1307.5
res2$routes[[1]]$duration
# [1] 592.7
map_route(decode_geom(res1$routes[[1]]$geometry, 5))
map_route(decode_geom(res2$routes[[1]]$geometry, 5))

osrmr::quit_server()

如您所见，将第二个点设置得稍微靠南一点会使结果反转。现在另一种方式需要更长的时间。

正如此处所讨论的，该radiuses选项可能会为该问题提供解决方案。但是，我无法弄清楚如何在您的示例中使用它..

或者也许（更简单..）您想计算两个方向并取较短的duration？

什么是最好的真的取决于你的算法问题..

于 2018-06-05T10:19:44.940 回答