如何让ggmap路径数据遵循道路路径

How*_*ith 9 r

我正在使用ggmap route函数来计算和显示使用DC Capital Bikeshare数据的数百条路线.我成功地解决了一个小问题,路线不跟随道路,特别是弯曲的道路(见下面的截图).有没有办法将我的代码调到所有更详细的路径?

在此输入图像描述

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")
Run Code Online (Sandbox Code Playgroud)

How*_*ith 1

答案是将decodeLine函数放入do.call中以创建长路线数据帧

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
Run Code Online (Sandbox Code Playgroud)