闪亮的传单添加了大量分离的折线 [英] Shiny leaflet add large amount of separated polylines
问题描述
我有20万行数据集，其中包含出发地和目的地的坐标.我有一个R闪亮的应用程序，带有传单地图，可以显示这些齿孔上的圆圈，尽管有大量齿孔，但效果很好.
I have a 200k lines dataset containing coordonates of departures and destinations. I have a R shiny app with a leaflet map to show circles on these coordonates, which works very well despite the large amount of coordonates.
这是数据的简化示例.每行都包含旅行ID，出发地的纬度和经度，目的地的纬度和经度.
Here is a simplified example of the data. Each line contains the travel id, latitude and longitude of the departure, latitude and longitude of the destination.
id lat_begin lat_end lng_begin lng_end
1 1 46.49 46.27 2.65 7.66
2 2 45.94 49.24 7.94 0.76
3 3 48.07 49.50 2.05 2.61
4 4 46.98 48.94 0.80 5.76
5 5 46.94 48.82 7.36 6.40
6 6 47.37 48.52 5.83 7.00
现在我的目标是在每个出发地和目的地之间添加行，因此有20万行.
Now my goal is to add lines between each departure and destination, so 200k lines.
我在1000行样本中尝试了几种方法，但总会花费太多时间，而显示200k行将花费数小时.
I tried several ideas on a 1000 lines sample, but it always takes way too much time and showing the 200k lines would take hours.
addPolylines函数上的for循环
A for loop on the addPolylines function
library(dplyr)
library(shiny)
library(leaflet)
n = 1000 # small number of lines
data_dots = data.frame(id = 1:n,
lat_begin = round(runif(n,45,50),2),
lat_end = round(runif(n,45,50),2),
lng_begin = round(runif(n,0,8),2),
lng_end = round(runif(n,0,8),2))
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output) {
# Initiate the map
output$map <- renderLeaflet({
myMap = leaflet() %>%
addTiles(options = providerTileOptions(noWrap = TRUE)) %>%
setView(lng=3.07381,lat=45.7829,zoom=5) %>%
# add dots
addCircles(data = data_dots, ~c(lng_begin,lng_end) , ~c(lat_begin,lat_end),
stroke=FALSE, fillOpacity = 0.7)
# add lines
for(i in 1:n){
myMap = myMap %>%
addPolylines(data = data_dots[i,],
lng= ~ c(lng_begin, lng_end),
lat= ~ c(lat_begin, lat_end),
color = 'blue',
weight = 1)
}
myMap
# also tried with apply
# lapply(data_dots$id,
# function(x) {
# addPolylines(myMap,
# data = data_dots[data_dots$id == x, ],
# lng = ~c(lng_begin, lng_end),
# lat = ~c(lat_begin, lat_end),
# color = 'blue',
# weight = 1)
# })
# myMap
})
}
shinyApp(ui = ui, server = server)
第二种方法:
创建空间线对象
Second approach :
Creating a spatiallines object
library(dplyr)
library(shiny)
library(leaflet)
library(maptools)
library(sp)
n = 1000
data_dots = data.frame(id = 1:n,
lat_begin = round(runif(n,45,50),2),
lat_end = round(runif(n,45,50),2),
lng_begin = round(runif(n,0,8),2),
lng_end = round(runif(n,0,8),2))
begin <- data_dots %>%
select(id, lat_begin, lng_begin) %>%
rename(latitude = lat_begin, longitude = lng_begin)
end <- data_dots %>%
select(id, lat_end, lng_end) %>%
rename(latitude = lat_end, longitude =lng_end)
data_lines = bind_rows(begin, end)
# make data_lines a spatialdataframe
coordinates(data_lines) <- c('longitude', 'latitude')
# create a list per id
id_list <- sp::split(data_lines, data_lines[['id']])
id <- 1
#for each id, create a line that connects all points with that id
for ( i in id_list ) {
event.lines <- SpatialLines( list( Lines( Line( i[1]@coords ), ID = id ) ),
proj4string = CRS( "+init=epsg:4326" ) )
if ( id == 1 ) {
sp_lines <- event.lines
} else {
sp_lines <- spRbind( sp_lines, event.lines )
}
id <- id + 1
}
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output) {
# Initiate the map
output$map <- renderLeaflet({
myMap = leaflet() %>%
addTiles(options = providerTileOptions(noWrap = TRUE)) %>%
setView(lng=3.07381,lat=45.7829,zoom=5) %>%
# add dots
addCircles(data = data_dots, ~c(lng_begin,lng_end) , ~c(lat_begin,lat_end),
stroke=FALSE, fillOpacity = 0.7) %>%
# add lines
addPolylines(data = sp_lines)
})
shinyApp(ui = ui, server = server)
每种情况用几千行需要几秒钟的时间.我可以快速添加200k线的圆，但是最大的问题是添加线.
Each case takes a few seconds with 1000 lines. I can quickly add circles with the 200k lines, but the big problem is with adding the lines.
推荐答案
为什么使用for循环遍历每一行，而不仅仅是一次绘制整个数据帧?这已经快得多了，但是如果有20万行，渲染仍然会慢".
Why do you use a for loop to loop through every row and not just plot the whole data frame at once? That is already much faster, but with 200k lines, rendering will still be "slow".
output$map <- renderLeaflet({
myMap = leaflet() %>%
addTiles(options = providerTileOptions(noWrap = TRUE)) %>%
setView(lng=3.07381,lat=45.7829,zoom=5) %>%
# add dots
addCircles(data = data_dots, ~c(lng_begin,lng_end) , ~c(lat_begin,lat_end),
stroke=FALSE, fillOpacity = 0.7) %>%
addPolylines(data = data_dots,
lng= ~ c(lng_begin, lng_end),
lat= ~ c(lat_begin, lat_end),
color = 'blue',
weight = 1)
myMap
})
也许mapview可能对此有所帮助，因为它曾经具有一个处理大型数据集(addLargeFeatures)的功能，并在内部使用了相当多的C ++.
Maybe mapview might be helpful with that, as it once had a function which handled large datasets (addLargeFeatures) and uses quite some C++ internally.
我认为该功能消失了，希望现在可以在addFeatures中实现.这应该比使用纯传单快一些.
I think that function disappeared and is hopefully now implemented into addFeatures. This should be somewhat faster than with pure leaflet.
library(dplyr)
library(shiny)
library(leaflet)
library(mapview)
library(sf)
n = 10000 # small number of lines
data_dots = data.frame(id = 1:n,
lat_begin = round(runif(n,45,50),2),
lat_end = round(runif(n,45,50),2),
lng_begin = round(runif(n,0,8),2),
lng_end = round(runif(n,0,8),2))
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output) {
# Initiate the map
output$map <- renderLeaflet({
data_dots_sf_begin <- data_dots %>%
st_as_sf(coords=c("lng_begin", "lat_begin"))
data_dots_sf_end <- data_dots %>%
st_as_sf(coords=c("lng_end", "lat_end"))
data_dots_sf <- st_combine(cbind(data_dots_sf_begin, data_dots_sf_end)) %>%
st_cast("LINESTRING")
st_crs(data_dots_sf) <- 4326
leaflet() %>%
addTiles(options = providerTileOptions(noWrap = TRUE)) %>%
addFeatures(data = data_dots_sf,
color = 'blue',
weight = 1)
})
}
shinyApp(ui = ui, server = server)
这篇关于闪亮的传单添加了大量分离的折线的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
