Cache or pre render leaflet map in shiny app

Question

I am trying to map ~8000 polygons using leaflet and run into performance issues. As I am using the map within a shiny app, I was wondering if its possible to somehow cache or pre-render the map.

Note that in my case, I have different layers of polygons that are swapped following this approach.

A small MWE would be this:

The data can be downloaded from 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)

It takes around 16 seconds on my machine to render the map with the polygons.

If possible, I would like to pre-render the map once, save it as an .rds file, and load it on demand. Note that I know the width/height of the map within the app (here set to 700px). But something like

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

map <- readRDS("renderedmap.rds")

# within server()
output$mymap <- map

does not result in any performance gains.

Alternatively, I have tried to load the leaflet asynchronously so that other parts of the app can be rendered/interacted with but to no avail.

Any ideas how to solve or circumnavigate this problem?

Answer 1

The 2 following approaches dont exactly answer your question, but they are definitly more performant alternatives compared to leaflet::addPolygons.

Using Flatgeobuf Format:

Based on the description from 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.

I think the dataset are linestrings, that is why fillColor seems to be ignored.

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)

---

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

Answer 2

Approach 1: minimize polygons

As hinted in the comment by Grzegorz T., you can change the precision of the underlying polygon file. Reducing the file size increased load time by around 3x on my computer.

The Visvalingam and Douglas-Peucker algorithms implemented in the rmapshaper package simplifies polygons by iterating over the points used to define the polyons and removing "extraneous points" while still "maintaining the shape".

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

Approach 2: render polygons as points

Points are much smaller than polygons. You might consider taking the centroid of each polygon and rendering those. This renders in about 1-2s on my machine, about a 50-100x speedup.

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

Approach 3: render polygons as clustered points

Similar speed to approach 2, but potentially cleaner in presentation.

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