[英]Calculate, decode and plot routes on map using leaflet and R
I have raw data which consists of lattitude and longitude of places The sample data is as follows:我有由地方的纬度和经度组成的原始数据样本数据如下:
EDIT (dput):编辑(输入):
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")
I want to plot routes on the map using this data.我想使用此数据在 map 上的 plot 路由。 This is my R code:
这是我的 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)
However, all I get is this:但是,我得到的只是:
How can I use leaflet and R to plot the routes using the raw data (lat, long)?如何使用 leaflet 和 R 到 plot 使用原始数据(纬度,经度)的路线?
What you have to do:你必须做的:
OSRM
)OSRM
)googleway::decode_pl()
or gepaf::decodePolyline()
googleway::decode_pl()
或gepaf::decodePolyline()
leaflet
)leaflet
) My approach is not optimized for anything, but it should do the job... (It is script in RStudio, therefore the print()
statements after 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:结果:
In the end, you have to put all that in your shiny server...最后,您必须将所有内容都放在闪亮的服务器中...
I hope that helps!我希望这有帮助!
Another more efficient way to calculate routes between points is with the osrm package: Interface Between R and the OpenStreetMap-Based Routing Service OSRM.另一种计算点之间路线的更有效方法是使用osrm包:R 和基于 OpenStreetMap 的路由服务 OSRM 之间的接口。 Look at this example:
看这个例子:
library(osrm)
library(leaflet)
df = data.frame(com = c("A", "B", "C"),
lon = c(31.043515, 31.029080, 31.002896),
lat = c(-29.778562, -29.795506, -29.836168),
time = as.POSIXct(c("2020-03-18 07:56:59","2020-03-18 12:28:58","2020-03-18 18:24:52")))
trips <- osrmTrip(df, returnclass="sf")
trip <- trips[[1]]$trip
leaflet(trip) %>%
addProviderTiles("Stamen.TonerLite", group = "OSM") %>%
addPolylines() %>%
addCircleMarkers(lat = df$lat,
lng = df$lon,
popup = paste(df$com,"-",format(df$time,"%H:%M:%S")),
color = "red",
stroke = FALSE,
radius = 8,
fillOpacity = 0.8)
For the viaroute function created.对于创建的 viaroute 函数。
Use "R.utils::withTimeout" instead of "R.utils::evalWithTimeout" because that is now defunct.使用“R.utils::withTimeout”而不是“R.utils::evalWithTimeout”,因为它现在已经不存在了。
I hope this helps我希望这有帮助
@Christoph's code is fantastic - although some of the functions no longer work as originally written, presumably due to breaking changes in R over time. @Christoph 的代码很棒——尽管某些功能不再像最初编写的那样工作,可能是由于 R 随着时间的推移发生了重大变化。
As @user7779697 points out above, the viaroute() function needs be updated to accommodate code changes to R.utils that saw deprecation of evalWithTimeout , replacing it with withTimeout as follows:正如@user7779697 上面指出的那样,需要更新viaroute() function 以适应对 R.utils 的代码更改,这些更改看到了evalWithTimeout的弃用,将其替换为withTimeout如下:
R.utils::withTimeout()
I also ran into issues with the map_route() function, corrected by removing the braces from the internal for loop.我还遇到了map_route() function 的问题,通过从内部 for 循环中删除大括号进行了纠正。
I've pasted the full updated code below which works with R Version 4.2.1 - I take no credit for this excellent work, only to get it back up and running with version changes:我在下面粘贴了与 R 版本 4.2.1 一起使用的完整更新代码 - 我不相信这项出色的工作,只是为了让它恢复并运行版本更改:
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::withTimeout({
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)) {
m <- addPolylines(map = m, lat = my_list[[i]]$lat, lng = my_list[[i]]$lng, color = "red", weight = 4)
}
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))
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.