使用传单和 R 在地图上计算、解码和绘制路线

我有原始数据，其中包含地点的纬度和经度样本数据如下：

编辑（输出）：

structure(list(Lat = c(-33.9409444, -33.9335713, -33.9333906, 
-33.9297826), Lon = c(18.5001774, 18.5033218, 18.518719, 18.5209372
)), .Names = c("Lat", "Lon"), row.names = c(NA, 4L), class = "data.frame")

我想使用这些数据在地图上绘制路线。这是我的 R 代码：

library(RODBC)
library(leaflet)

ui <- fluidPage(
  titlePanel("South Africa & Lesotho"),
  mainPanel(
    leafletOutput("mymap")
  )
)

server <- function(input, output, session) {
  dbhandle <- odbcDriverConnect('driver={SQL Server};server=localhost\\SQLEXpress;database=OSM;trusted_connection=true')
  res <- sqlQuery(dbhandle, 'select Lat, Lon from OSM2 where Street is not null')
  output$mymap <- renderLeaflet({
    leaflet(res) %>%
      addTiles() %>%
      addPolylines(lat = ~Lat, lng = ~Lon)
  }) 
}

shinyApp(ui, server)

然而，我得到的只是这样：

如何使用传单和 R 使用原始数据（纬度、经度）绘制路线？

你必须做什么：

• 导入积分
• 计算点之间的所有路线（我使用OSRM)
• 从路线中提取路线几何形状（欣赏参考 https://stackoverflow.com/questions/32476218/how-to-decode-encoded-polylines-from-osrm-and-plotting-route-geometry看看那里的速度更新！）。感谢@SymbolixAU：您还可以使用googleway::decode_pl() or gepaf::decodePolyline()
• 在地图上显示所有内容（我使用leaflet)

我的方法没有针对任何事情进行优化，但它应该可以完成工作...... （它是 RStudio 中的脚本，因此print()之后的陈述leaflet.)

library(leaflet)
library(stringr)
library(bitops)

df <- structure(list(
  lat = c(-33.9409444, -33.9335713, -33.9333906, -33.9297826), 
  lng = c(18.5001774, 18.5033218, 18.518719, 18.5209372)),
  .Names = c("lat", "lng"), 
  row.names = c(NA, 4L), class = "data.frame")
nn <- nrow(df)

# Functions
# =========
viaroute <- function(lat1, lng1, lat2, lng2) {
  R.utils::evalWithTimeout({
    repeat {
      res <- try(
        route <- rjson::fromJSON(
          file = paste("http://router.project-osrm.org/route/v1/driving/",
                       lng1, ",", lat1, ";", lng2, ",", lat2,
                       "?overview=full", sep = "", NULL)))
      if (class(res) != "try-error") {
        if (!is.null(res)) {
          break
        }
      }
    }
  }, timeout = 1, onTimeout = "warning")
  return(res)
}

decode_geom <- function(encoded) {
  scale <- 1e-5
  len = 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) {
    # if (index == 80) browser()
    shift <- result <- 0
    repeat {
      b = as.integer(charToRaw(encoded[index])) - 63
      index <- index + 1
      result = bitOr(result, bitShiftL(bitAnd(b, 0x1f), shift))
      shift = shift + 5
      if (b < 0x20) break
    }
    dlat = ifelse(bitAnd(result, 1),
                  -(result - (bitShiftR(result, 1))),
                  bitShiftR(result, 1))
    lat = lat + dlat;

    shift <- result <- b <- 0
    repeat {
      b = as.integer(charToRaw(encoded[index])) - 63
      index <- index + 1
      result = bitOr(result, bitShiftL(bitAnd(b, 0x1f), shift))
      shift = shift + 5
      if (b < 0x20) break
    }
    dlng = ifelse(bitAnd(result, 1),
                  -(result - (bitShiftR(result, 1))),
                  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() {
  m <- leaflet() %>%
    addTiles(group = "OSM") %>%
    addProviderTiles("Stamen.TonerLite") %>%
    addLayersControl(
      baseGroups = c("OSM", "Stamen.TonerLite")
    )
  return(m)
}

map_route <- function(df, my_list) {
  m <- map()
  m <- addCircleMarkers(map = m,
                        lat = df$lat,
                        lng = df$lng,
                        color = "blue",
                        stroke = FALSE,
                        radius = 6,
                        fillOpacity = 0.8) %>%
    addLayersControl(baseGroups = c("OSM", "Stamen.TonerLite")) %>%
    {
      for (i in 1:length(my_list)) {
        . <- addPolylines(., lat = my_list[[i]]$lat, lng = my_list[[i]]$lng, color = "red", weight = 4)
      }
      return(.)
    }
  return(m)
}

# Main
# ======
m <- map()
m <- m %>% addCircleMarkers(lat = df$lat,
                       lng = df$lng,
                       color = "red",
                       stroke = FALSE,
                       radius = 10,
                       fillOpacity = 0.8)
print(m)

my_list <- list()
r <- 1
for (i in 1:(nn-1)) {
  for (j in ((i+1):nn)) {
    my_route <- viaroute(df$lat[i], df$lng[i],df$lat[j], df$lng[j])
    geom <- decode_geom(my_route$routes[[1]]$geometry)
    my_list[[r]] <- geom
    r <- r + 1
  }
}

print(map_route(df, my_list))

Result:

最后，你必须把所有这些都放在你闪亮的服务器中......
我希望这有帮助！