Shiny leaflet add large amount of separated polylines

Question

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.

SeGa · Answer 1 · 2018-12-17T22:15:48.193

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)

Without a for loop, the lines are not separated, they are all linked to each other. Same problem with the addFeature but there must be a way to use mapview with separated lines. Thank you for the package advice. — gdevaux, Dec 18 '18 at 09:04
Oh my bad, the problem with so many lines is, that the map is so crowded that nothing is really distinguishable anymore and it more appears like a blue polygon. Yeah you would have to generate a Simple Feature with all the separated lines first and then plot it with mapview, that should render faster. — SeGa, Dec 18 '18 at 10:16
Very nice solution, thanks! I have a Question similar to yours. It's about clustering connecting linestrings of clusters of markers. Maybe someone here is also https://stackoverflow.com/questions/60436142/aggregate-weighted-linestrings-for-clustered-markers-in-leaflet-in-r — maxatSOflow, Feb 27 '20 at 15:08

Shiny leaflet add large amount of separated polylines

First approach :

Second approach :

1 Answers1

Linked