在闪亮的应用程序中缓存或预渲染传单地图

Cache or pre render leaflet map in shiny app

我正在尝试使用 leaflet 和 运行 将 ~8000 个多边形映射到性能问题中。 当我在闪亮的应用程序中使用地图时,我想知道是否可以以某种方式缓存或预渲染地图。

请注意,在我的例子中,我有不同的多边形层,它们在 this approach 之后交换。

一个小的 MWE 应该是这样的:

数据可以从here

下载
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文件,并按需加载。请注意,我知道应用程序中地图的 width/height(此处设置为 700px)。但是像

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

map <- readRDS("renderedmap.rds")

# within server()
output$mymap <- map

不会带来任何性能提升。

或者,我尝试异步加载传单,以便应用程序的其他部分可以 rendered/interacted 但无济于事。

有什么解决或绕过这个问题的想法吗?

方法 1:最小化多边形

正如 Grzegorz T. 在评论中所暗示的那样,您可以更改基础多边形文件的精度。减小文件大小会使我计算机上的加载时间增加大约 3x

Visvalingam and Douglas-Peucker algorithms implemented in the 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

方法 2:将多边形渲染为点

点比多边形小得多。您可能会考虑获取每个多边形的质心并渲染它们。这在我的机器上渲染大约 1-2 秒,大约 50-100x 加速。

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

方法 3:将多边形渲染为聚类点

速度与方法 2 相似,但在演示中可能更清晰。

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

以下 2 种方法并不能完全回答您的问题,但与 leaflet::addPolygons 相比,它们绝对是性能更高的替代方法。

使用 Flatgeobuf 格式:

根据 leafem::addFgb 的描述:

Flatgeobuf can stream the data chunk by chunk so that rendering of the map is more or less instantaneous. The map is responsive while data is still loading so that popup queries, zooming and panning will work even though not all data has been rendered yet.

我认为数据集是线串,这就是为什么 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)