Блестящие листовки добавить большое количество разделенных полилиний - PullRequest
Новая
       20

Блестящие листовки добавить большое количество разделенных полилиний

0 голосов
/ 17 декабря 2018

У меня есть набор из 200 тыс. Строк, содержащий координаты отправлений и пунктов назначения.У меня есть блестящее приложение R с картой листовки для отображения кругов на этих координатах, которая работает очень хорошо, несмотря на большое количество координат.

Вот упрощенный пример данных.Каждая строка содержит идентификатор путешествия, широту и долготу пункта отправления, широту и долготу пункта назначения. 

  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

Теперь моя цель состоит в том, чтобы добавить строки между каждым пунктом отправления и пунктом назначения, то есть 200 тыс. Строк.

Я попробовал несколько идей на выборке из 1000 строк, но это всегда занимает слишком много времени, и показ 200 тыс. Строк занял бы часы.

Первый подход:

A дляцикл в функции addPolylines 

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)

Второй подход:

Создание объекта spatiallines 

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)

Каждый случай занимает несколько секунд с 1000 строками.Я могу быстро добавить круги с линиями 200k, но большая проблема заключается в добавлении линий.

1 Ответ

0 голосов
/ 18 декабря 2018

Почему вы используете цикл for для циклического прохождения каждой строки, а не просто выводите весь фрейм данных сразу?Это уже намного быстрее, но с 200 тыс. Строк рендеринг все равно будет «медленным».

  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 ++ для внутреннего использования.

Я думаю, что эта функция исчезла и, надеюсь, теперь реализована в addFeatures.Это должно быть несколько быстрее, чем с чистой листовкой. 

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)
...