第一种方法：

Question

我有20万行数据集，其中包含出发地和目的地的坐标。我有一个R闪亮的应用程序，带有传单地图，可以显示这些齿孔上的圆圈，尽管有大量齿孔，但效果很好。

这是数据的简化示例。每行都包含旅行ID，出发地的纬度和经度，目的地的纬度和经度。

  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万行。

我在1000行样本中尝试了几种方法，但总会花费太多时间，而显示200k行将花费数小时。

第一种方法：

addPolylines函数上的for循环

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)

第二种方法：

创建空间线对象

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线的圆，但是最大的问题是添加线。

Answer 1

为什么要使用for循环遍历每一行，而不仅仅是立即绘制整个数据帧？这已经快得多了，但是使用20万行，渲染仍将“缓慢”。

embedded

也许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）的功能，并且内部使用了相当多的C ++。

我认为该功能已消失，希望现在可以在addLargeFeatures中实现。这应该比使用纯传单快一些。

addFeatures

闪亮的传单添加了大量分离的折线

第一种方法：

第二种方法：

1 个答案: