Open
Description
I'm working on a shiny app that render 30-100k polylines and leafgl blows standard leaflet out of the water on render time. However, this map is intended to be interactive, and I'd like to be able to update the colors via leafletProxy without re-rendering the map.
There's no feature of this sort in vanilla leaflet but there is a workaround in a proposed commit covered here (rstudio/leaflet#496) and here (rstudio/leaflet#598) that works well. Rendering all my shapes is very slow the first time, but then simply updating the colors using this method is very fast. I'd love to to be able to update the color of my shapes using leafgl instead. Working reprex below.
library(shiny)
library(sf)
library(leaflet)
library(leafgl)
data <- gadmCHE %>%
as("SpatialLinesDataFrame") %>%
st_as_sf() %>%
st_cast("LINESTRING")
setShapeStyle <- function( map, data = getMapData(map), layerId,
stroke = NULL, color = NULL,
weight = NULL, opacity = NULL,
fill = NULL, fillColor = NULL,
fillOpacity = NULL, dashArray = NULL,
smoothFactor = NULL, noClip = NULL,
options = NULL
){
options <- c(list(layerId = layerId),
options,
filterNULL(list(stroke = stroke, color = color,
weight = weight, opacity = opacity,
fill = fill, fillColor = fillColor,
fillOpacity = fillOpacity, dashArray = dashArray,
smoothFactor = smoothFactor, noClip = noClip
)))
options <- evalFormula(options, data = data)
options <- do.call(data.frame, c(options, list(stringsAsFactors=FALSE)))
layerId <- options[[1]]
style <- options[-1]
leaflet::invokeMethod(map, data, "setStyle", "shape", layerId, style);
}
ui <- fluidPage(
tags$head(
tags$script(HTML(
'
window.LeafletWidget.methods.setStyle = function(category, layerId, style){
var map = this;
if (!layerId){
return;
} else if (!(typeof(layerId) === "object" && layerId.length)){ // in case a single layerid is given
layerId = [layerId];
}
//convert columnstore to row store
style = HTMLWidgets.dataframeToD3(style);
//console.log(style);
layerId.forEach(function(d,i){
var layer = map.layerManager.getLayer(category, d);
if (layer){ // or should this raise an error?
layer.setStyle(style[i]);
}
});
};
'
))
),
fluidRow(
column(width=6,offset=0,leafletOutput("map")),
column(width=6,offset=0,leafletOutput("glMap"))
),
radioButtons("color", "Color", choices = c("blue", "red"))
)
server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet(data) %>%
addPolylines(data=data,layerId = as.character(1:nrow(data)))
})
output$glMap <- renderLeaflet({
leaflet(data) %>%
addGlPolylines(data=data,layerId = as.character(1:nrow(data)))
})
observe({
leafletProxy("map", data = data) %>%
setShapeStyle(layerId = as.character(1:nrow(data)), color = input$color)
})
observe({
leafletProxy("glMap", data = data) %>%
setShapeStyle(layerId = as.character(1:nrow(data)), color = input$color)
})
}
shinyApp(ui, server)