Поиск маршрута ggmap - не остается на дорогах

Похоже, вы на самом деле не получаете требуемые полилинии из route(), так как параметр output= по умолчанию имеет значение simple. Вероятно, вам нужно изменить его на all, как показано ниже, и начать декодирование полилиний.

Ниже приведено одно решение, основанное на функции decodeLine(), взятой из здесь. Их решение состоит в том, чтобы определить пользовательскую функцию, которая декодирует полилинии, а затем отображает все, что она декодировала.

library(ggmap)
library(leaflet)
way1txt <- "Tinsletown, Vancouver, BC"
way2txt <- "Science World, Vancouver, BC"

route_all <- route(way1txt, way2txt, structure = "route",
                   output = "all")

# Custom decode function
# Taken from http://s4rdd.blogspot.com/2012/12/google-maps-api-decoding-polylines-for.html

decodeLine <- function(encoded){
  require(bitops)

  vlen <- nchar(encoded)
  vindex <- 0
  varray <- NULL
  vlat <- 0
  vlng <- 0

  while(vindex < vlen){
    vb <- NULL
    vshift <- 0
    vresult <- 0
    repeat{
      if(vindex + 1 <= vlen){
        vindex <- vindex + 1
        vb <- as.integer(charToRaw(substr(encoded, vindex, vindex))) - 63  
      }

      vresult <- bitOr(vresult, bitShiftL(bitAnd(vb, 31), vshift))
      vshift <- vshift + 5
      if(vb < 32) break
    }

    dlat <- ifelse(
      bitAnd(vresult, 1)
      , -(bitShiftR(vresult, 1)+1)
      , bitShiftR(vresult, 1)
    )
    vlat <- vlat + dlat

    vshift <- 0
    vresult <- 0
    repeat{
      if(vindex + 1 <= vlen) {
        vindex <- vindex+1
        vb <- as.integer(charToRaw(substr(encoded, vindex, vindex))) - 63        
      }

      vresult <- bitOr(vresult, bitShiftL(bitAnd(vb, 31), vshift))
      vshift <- vshift + 5
      if(vb < 32) break
    }

    dlng <- ifelse(
      bitAnd(vresult, 1)
      , -(bitShiftR(vresult, 1)+1)
      , bitShiftR(vresult, 1)
    )
    vlng <- vlng + dlng

    varray <- rbind(varray, c(vlat * 1e-5, vlng * 1e-5))
  }
  coords <- data.frame(varray)
  names(coords) <- c("lat", "lon")
  coords
}


route_df <- decodeLine( route_all$routes[[1]]$overview_polyline$points )


# Map using Leaflet R
m = leaflet() %>% addTiles()
m = m %>% addPolylines(route_df$lon, route_df$lat, fill = FALSE)
m = m %>% addPopups(route_df$lon[1], route_df$lat[1], 'Origin')
m = m %>% addPopups(route_df$lon[length(route_df$lon)], 
                    route_df$lat[length(route_df$lon)], 'Destination')
m

И я получаю это:

Для справки, есть еще одна функция decodeLine здесь, написанная @diegovalle.

Вы можете использовать мой пакет googleway

• получить указания
• декодировать полилинию (если требуется)
• построить маршрут на карте Google либо в виде закодированной полилинии, либо в виде декодированных точек

library(googleway)

apiKey <- 'your_api_key'
mapKey <- 'your_maps_api_key'

res <- google_directions(origin = "Tinsletown, Vancouver, BC", 
                        destination = "Science World, Vancouver, BC",
                        key = apiKey)

Полилиния находится в res$routes$overview_polyline$points

Вы можете декодировать полилинию, если хотите

pl <- res$routes$overview_polyline$points
decode_pl(pl)
#         lat       lon
# 1  49.28025 -123.1076
# 2  49.27969 -123.1076
# 3  49.27823 -123.1076
# 4  49.27711 -123.1077
# 5  49.27707 -123.1043

Но вам не нужно, вы можете построить линию напрямую

df <- data.frame(polyline = pl)

google_map(key = mapKey, search_box = T) %>%
    add_polylines(data = df, polyline = "polyline")

Примечание

• Похоже, что источник не существует или был перемещен после того, как был задан вопрос.