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

Dav*_*vid 10 r leaflet shiny r-leaflet

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

请注意,在我的情况下,我有不同的多边形层,它们按照这种方法进行交换。

一个小的 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)
Run Code Online (Sandbox Code Playgroud)

在我的机器上用多边形渲染地图大约需要 16 秒。

如果可能,我想预渲染一次地图,将其另存为.rds文件,然后按需加载。请注意,我知道应用程序中地图的宽度/高度(此处设置为 700 像素)。但像

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

map <- readRDS("renderedmap.rds")

# within server()
output$mymap <- map
Run Code Online (Sandbox Code Playgroud)

不会带来任何性能提升。

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

任何想法如何解决或绕过这个问题?

SeG*_*eGa 5

以下 2 种方法不能完全回答您的问题,但与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)
Run Code Online (Sandbox Code Playgroud)

使用leafgl(WebGL-Renderer):

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)
Run Code Online (Sandbox Code Playgroud)