问题
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.
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
Now my goal is to add lines between each departure and destination, so 200k lines.
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.
First approach :
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)
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.
回答1:
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
})
Maybe mapview might be helpful with that, as it once had a function which handled large datasets (addLargeFeatures) and uses quite some C++ internally.
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)
来源：https://stackoverflow.com/questions/53813758/shiny-leaflet-add-large-amount-of-separated-polylines