[英]Calculate, decode and plot routes on map using leaflet and 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")
我想使用此数据在 map 上的 plot 路由。 这是我的 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)
但是,我得到的只是:
如何使用 leaflet 和 R 到 plot 使用原始数据(纬度,经度)的路线?
你必须做的:
OSRM
)googleway::decode_pl()
或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))
结果:
最后,您必须将所有内容都放在闪亮的服务器中...
我希望这有帮助!
另一种计算点之间路线的更有效方法是使用osrm包:R 和基于 OpenStreetMap 的路由服务 OSRM 之间的接口。 看这个例子:
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)
对于创建的 viaroute 函数。
使用“R.utils::withTimeout”而不是“R.utils::evalWithTimeout”,因为它现在已经不存在了。
我希望这有帮助
@Christoph 的代码很棒——尽管某些功能不再像最初编写的那样工作,可能是由于 R 随着时间的推移发生了重大变化。
正如@user7779697 上面指出的那样,需要更新viaroute() function 以适应对 R.utils 的代码更改,这些更改看到了evalWithTimeout的弃用,将其替换为withTimeout如下:
R.utils::withTimeout()
我还遇到了map_route() function 的问题,通过从内部 for 循环中删除大括号进行了纠正。
我在下面粘贴了与 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.