在Shiny应用程序中缓存或预渲染Leaflet地图

Question

在Shiny应用程序中缓存或预渲染Leaflet地图

rshinyleafletr-leaflet

12

我正在尝试使用 Leaflet 绘制大约 8000 个多边形时遇到性能问题。由于我在 Shiny 应用中使用该地图，我想知道是否有可能以某种方式缓存或预渲染地图。

请注意，在我的情况下，我有不同层次的多边形，可按照此方法进行交换。

一个小的 MWE 如下：

数据可以从这里下载

library(shiny)
library(leaflet)
library(sf)

## Download Shapefile
file <- "plz-gebiete.shp"

if (!file.exists(file)) {
  url <- "https://www.suche-postleitzahl.org/download_files/public/plz-gebiete.shp.zip"
  zipfile <- paste0(file, ".zip")
  download.file(url, zipfile)
  unzip(zipfile)
}

df <- st_read(file, options = "ENCODING=UTF-8")

# If possible: pre-render the map here!

library(shiny)

ui <- fluidPage(
  leafletOutput("mymap", width = "700px", height = "700px")
)

server <- function(input, output, session) {
  output$mymap <- renderLeaflet({
    leaflet() %>% 
      addTiles() %>% 
      addPolygons(data = df, weight = 1, color = "black")
  })
}

shinyApp(ui, server)

在我的计算机上，渲染该地图及其多边形需要大约16秒。

如果可能的话，我想预先渲染地图一次，将其保存为.rds文件，并按需加载。请注意，我知道应用程序中地图的宽度/高度（这里设置为700像素）。但是类似以下的内容：

map <- renderLeaflet({leaflet() %>% ...})
saveRDS(map, "renderedmap.rds")

map <- readRDS("renderedmap.rds")

# within server()
output$mymap <- map

不会产生任何性能提升。

另外，我尝试异步加载leaflet，以便可以渲染/交互应用程序的其他部分，但是没有成功。

有什么解决或规避这个问题的方法吗？

- David

您可以更改精度。将精度降低到0.001可将文件大小减少至34MB，将精度降低到0.01并保存为json格式则约为6MB。因此，您可以自行决定是否需要非常精确的地图。 - Grzegorz T.

1

你可以尝试使用leafgl或者leafem::addFgb，它们都使用高效的Flatgeobuf格式。 - SeGa

我已经研究了leafgl，但没有找到重新着色多边形的有效解决方案。addFgb看起来是一个不错的解决方案。您介意发布一个完整的示例吗？ - David

2个回答

4

方法一：减少多边形

正如Grzegorz T.的评论中所示，您可以更改底层多边形文件的精度。在我的计算机上，减小文件大小将加载时间提高了约3倍。

Visvalingam和Douglas-Peucker算法实现在rmapshaper包中，通过迭代用于定义多边形的点并删除“多余点”来简化多边形，同时仍然“保持形状”。

library(rmapshaper)

# baseline object size
object.size(df)/1e6  # 61. MB

# simplyfy the spatial object
# `keep_shapes=T` ensures no polygons are dropped
df2 <- ms_simplify(df, keep_shapes = TRUE)
object.size(df2)/1e6 # 11.8 MB

# decreasing the percentage of points to keep from 5% (default) to 1% 
# doesn't result in significantly smaller object size, but still
# improves the loading speed
df3 <- ms_simplify(df, keep = 0.01, keep_shapes = TRUE)
object.size(df3)/1e6 # 9.8 MB

方法二：将多边形渲染为点

点比多边形小得多。您可以考虑取每个多边形的质心并进行渲染。这样在我的计算机上大约需要1-2秒，速度提升了约 50-100倍。

library(tidyverse)
pts <- st_centroid(df) %>% 
  st_geometry() %>% 
  do.call(rbind, .) %>% 
  as_tibble() %>% 
  setNames(c("lng","lat"))

server <- function(input, output, session) {
  output$mymap <- renderLeaflet({
    leaflet(pts) %>% 
      addTiles() %>% 
      addCircleMarkers(radius = 1)
  })
}

方法三：将多边形渲染为聚合点

与方法二相似的速度，但呈现可能更加清晰。

server <- function(input, output, session) {
  output$mymap <- renderLeaflet({
    leaflet(pts) %>% 
      addTiles() %>% 
      addMarkers(clusterOptions = markerClusterOptions())
  })
}

- Rich Pauloo

1

这些都是一些有价值的方法，尤其是第一个。我对rmapshaper及其依赖项感到有些害怕，但似乎它很值得。如果有人有实际预渲染地图的选项，我会再等一会儿。 - David

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- SeGa · Accepted Answer

以下两种方法并不能确切回答你的问题，但它们绝对比leaflet::addPolygons更具性能的替代方案。 使用Flatgeobuf格式： 根据leafem::addFgb的描述：

Flatgeobuf可以逐块流式传输数据，以便地图的渲染几乎是即时的。在数据仍在加载时，地图是响应式的，因此弹出式查询、缩放和平移将正常工作，即使并非所有数据都已呈现。

我认为数据集是线串，这就是为什么fillColor似乎被忽略了。

library(leaflet)
library(leafem)
library(shiny)

# via URL (data around 13mb)
url = "https://raw.githubusercontent.com/bjornharrtell/flatgeobuf/3.0.1/test/data/UScounties.fgb"

ui <- fluidPage(
  leafletOutput("mymap", width = "700px", height = "700px")
)

server <- function(input, output, session) {
  output$mymap <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      leafem:::addFgb(
        url = url, group = "counties",
        label = "NAME", popup = TRUE,
        fillColor = "blue", fillOpacity = 0.6,
        color = "black", weight = 1) %>%
      addLayersControl(overlayGroups = c("counties")) %>%
      setView(lng = -105.644, lat = 51.618, zoom = 3)
  })
}

shinyApp(ui, server)

使用 leafgl（WebGL 渲染器）：

library(sf)
library(shiny)
library(leaflet)
library(leafgl)

plz <- st_read("C:/Users/user/Downloads/plz-gebiete.shp", layer = "plz-gebiete")

ui <- fluidPage(
  leafletOutput("mymap", width = "700px", height = "700px")
)

server <- function(input, output, session) {
  output$mymap <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addGlPolygons(data = plz, color = ~plz, popup = "note", group = "plz") %>% 
      addLayersControl(overlayGroups = "plz")
  })
}

shinyApp(ui, server)