Skip to content

How to update polyline/polygon color without re-render #85

Open
@courtwarr

Description

@courtwarr

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)

Metadata

Metadata

Assignees

No one assigned

    Labels

    wontfixThis will not be worked on

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions