Jak uzyskać dane trasy ggmap do podążania ścieżką drogową

Question

Używam funkcji trasy ggmap do obliczania i wizualizacji setek tras przy użyciu danych DCC Capital Bikeshare. Z powodzeniem mogę to zrobić z jednym drobnym problemem, ścieżka trasy nie podąża drogami, szczególnie zakrzywionymi (patrz zrzut ekranu poniżej). Czy istnieje sposób na wyszukanie mojego kodu dla wszystkich bardziej szczegółowych ścieżek?

library(tidyverse) 
library(ggmap) 

# Example dataset 
feb_14 <- read.csv('https://raw.githubusercontent.com/smitty1788/Personal-Website/master/dl/CaBi_Feb_2017.csv', stringsAsFactors = FALSE) 

# Subset first 300 rows, keep start and end Lat/Long strings 
start<-c(feb_14[1:300, 14]) 
dest<-c(feb_14[1:300, 15]) 

# df of individual routes 
routes <- tibble(
    start, 
    dest) 

# Function to calculate route 
calculationroute <- function(startingpoint, stoppoint) { 
    route(from = startingpoint, 
     to = stoppoint, 
     mode = 'bicycling', 
     structure = "route")} 

# Calculate route path for all individual trips 
calculatedroutes <- mapply(calculationroute, 
          startingpoint = routes$start, 
          stoppoint = routes$dest, 
          SIMPLIFY = FALSE) 

# Unlist and merge in single dataframe 
do.call(rbind.data.frame, lapply(names(calculatedroutes), function(x) { 
    cbind.data.frame(route=x, calculatedroutes[[x]], stringsAsFactors=FALSE) 
})) -> long_routes 


# create map with routes 
basicmap <- get_map(location = 'washingtondc', 
        zoom = 13, 
        maptype = "toner-background", 
        source = "google", 
        color = "bw") 
basicmap <- ggmap(basicmap) 


basicmap + geom_path(data=long_routes, 
        aes(x=lon, y=lat, group=route), color = "red", 
        size=1, alpha = .4, lineend = "round") 

Answer 1

Odpowiedzią było umieścić funkcję decodeLine do do.call tworzyć długie trasy dataframe

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 
} 

calculatedroutes <- mapply(calculationroute, 
          startingpoint = routes$start, 
          stoppoint = routes$dest, 
          SIMPLIFY = FALSE) 

do.call(rbind.data.frame, lapply(names(calculatedroutes), function(x) { 
    cbind.data.frame(route = x, decodeLine(calculatedroutes[[x]]$routes[[1]]$overview_polyline$points), stringsAsFactors=FALSE) 
})) -> long_routes