Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Does markercluster work together with leafletProxy() and option iconCreateFunction?

Am I doing something wrong, or why does the below example not work? I am trying to make leaflet markercluster plugin work with leafletProxy() in an R Shiny app, using the option iconCreateFunction. Is the plugin not capable of adding customized icon markers to the map using leafletProxy()?

When I press the first button and zoom out in below example, I get an error saying:

TypeError: this._group.options.iconCreateFunction is not a function

enter image description here

I tried to copy the original example from the markercluster documentation:

library(shiny)
library(dplyr)
library(leaflet)

ui <- fluidPage(
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    sidebarPanel(
      actionButton(inputId = "my_button1",
                   label = "Use leafletProxy()"),
      actionButton(inputId = "my_button2",
                   label = "Use renderLeaflet()")
    ),
    mainPanel(
      leafletOutput(
        outputId = "map",
        width = "100%",
        height = "300px"
      )
    )
  )
)

server <- function(input, output, session) {

  some_data <- data.frame(
    "lon"=c(4.905167,4.906357,4.905831),
    "lat"=c(52.37712,52.37783,52.37755),
    "number_var"=c(5,9,7),
    "name"=c("Jane","Harold","Mike"),
    stringsAsFactors = F
  )

  output$map <- renderLeaflet({
    return(
      leaflet(data = some_data[0,]) %>%
         addProviderTiles(providers$CartoDB.Positron) %>%
        fitBounds(
          min(some_data$lon),
          min(some_data$lat),
          max(some_data$lon),
          max(some_data$lat)
        ) %>%
        addMarkers(
          lng = ~lon,
          lat = ~lat,
          clusterOptions = markerClusterOptions(
            iconCreateFunction = JS(paste0("function(cluster) {",
                                           "return new L.DivIcon({",
                                           "html: '<div style=\"background-color:rgba(77,77,77,0.5)\"><span>' + cluster.getChildCount() + '</div><span>',",
                                           "className: 'marker-cluster'",
                                           "});",
                                           "}"))



          )
        )
    )
  })

  observeEvent(input$my_button1,{
      leafletProxy(mapId = "map",
                   session = session,
                   data = some_data) %>%
        addProviderTiles(providers$CartoDB.Positron) %>%
        clearMarkerClusters() %>%
        clearMarkers() %>%
        fitBounds(
          min(some_data$lon),
          min(some_data$lat),
          max(some_data$lon),
          max(some_data$lat)
        ) %>%
        addMarkers(
          lng = ~lon,
          lat = ~lat,
          clusterOptions = markerClusterOptions(
            iconCreateFunction = JS(paste0("function(cluster) {",
                                           "console.log('Here comes cluster',cluster); ",
                                           "return new L.DivIcon({",
                                           "html: '<div style=\"background-color:rgba(77,77,77,0.5)\"><span>' + cluster.getChildCount() + '</div><span>',",
                                           "className: 'marker-cluster'",
                                           "});",
                                           "}"))
          )
        )
  })

  observeEvent(input$my_button2,{
    output$map <- renderLeaflet({

      leaflet(data = some_data) %>%
        addProviderTiles(providers$CartoDB.Positron) %>%
        fitBounds(
          min(some_data$lon),
          min(some_data$lat),
          max(some_data$lon),
          max(some_data$lat)
        ) %>%
        addMarkers(
          lng = ~lon,
          lat = ~lat,
          clusterOptions = markerClusterOptions(
            iconCreateFunction = JS(paste0("function(cluster) {",
                                           "console.log('Here comes cluster',cluster); ",
                                           "return new L.DivIcon({",
                                           "html: '<div style=\"background-color:rgba(77,77,77,0.5)\"><span>' + cluster.getChildCount() + '</div><span>',",
                                           "className: 'marker-cluster'",
                                           "});",
                                           "}"))
          )
        )
    })
  })
}

shinyApp(ui = ui, server = server)

Package versions:

dplyr_0.7.4
leaflet_1.1.0
shiny_1.0.5
R version 3.4.3 (2017-11-30)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 16.04.3 LTS

Browser version: Firefox Quantum 57.0.1 (64-bit)

enter image description here

like image 582
nilsole Avatar asked Dec 21 '17 10:12

nilsole


3 Answers

To follow Kevin's answer, modifying the clusterId to a vector gets the leafletProxy version to work for me. Not sure if this causes unintended consequences though...

app.R

library(shiny)
library(dplyr)
library(leaflet)

ui <- fluidPage(
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    sidebarPanel(
      actionButton(inputId = "my_button1",
                   label = "Use leafletProxy()"),
      actionButton(inputId = "my_button2",
                   label = "Use renderLeaflet()")
    ),
    mainPanel(
      leafletOutput(
        outputId = "mymap",
        width = "100%",
        height = "300px"
      ))
  ))

server <- function(input, output, session) {

  some_data <- data.frame(
    lon = c(4.905167, 4.906357, 4.905831),
    lat = c(52.37712, 52.37783, 52.37755),
    number_var = c(5, 9, 7),
    name = c("Jane", "Harold", "Mike"),
    stringsAsFactors = FALSE
  )

  marker_js <- JS("function(cluster) {
                  var html = '<div style=\"background-color:rgba(77,77,77,0.5)\"><span>' + cluster.getChildCount() + '</div><span>'
                  return new L.DivIcon({html: html, className: 'marker-cluster'});
}")

  output$mymap <- renderLeaflet({

    leaflet(some_data) %>%
      addProviderTiles(providers$CartoDB.Positron) %>%
      fitBounds(
        ~min(lon),
        ~min(lat),
        ~max(lon),
        ~max(lat)
      ) %>%
      addMarkers(
        layerId = "mylayer",
        clusterId = "mycluster",
        lng = ~lon,
        lat = ~lat,
        clusterOptions = markerClusterOptions(
          iconCreateFunction = marker_js
        )
      )

  })

  observeEvent(input$my_button1, {

    leafletProxy("mymap", data = some_data) %>%
      removeMarker(layerId = "mylayer") %>%
      clearTiles %>%
      addProviderTiles(providers$CartoDB.Positron) %>%
      fitBounds(
        ~min(lon),
        ~min(lat),
        ~max(lon),
        ~max(lat)
      ) %>%
      addMarkers(
        layerId = "mylayer",
        clusterId = ~name,
        lng = ~lon,
        lat = ~lat,
        clusterOptions = markerClusterOptions(
          iconCreateFunction = marker_js
        )
      )

  })

  observeEvent(input$my_button2,{

    output$mymap <- renderLeaflet({

      leaflet(some_data) %>%
        addProviderTiles(providers$CartoDB.Positron) %>%
        fitBounds(
          ~min(lon),
          ~min(lat),
          ~max(lon),
          ~max(lat)
        ) %>%
        addMarkers(
          layerId = "mylayer",
          clusterId = "mycluster",
          lng = ~lon,
          lat = ~lat,
          clusterOptions = markerClusterOptions(
            iconCreateFunction = marker_js
          )
        )
    })

  })

  }

shinyApp(ui = ui, server = server)
like image 83
whatamidoing Avatar answered Nov 19 '22 03:11

whatamidoing


Revised solution

The behaviour of iconCreateFunction is definitely flakey when used within leafletProxy. Although I think there is caching in some browsers making it difficult to track visually.

In order to eliminate the javascript error you were experiencing, it is important to apply layerId and clusterId values as well as using removeMarker in lieu of clearMarkers.

N.B. A strange side-effect of my solution is that a marker is dropped when re-drawn, I'm getting a bit tired and will have another look later. That problem may or may not be trivial.

app.R

library(shiny)
library(dplyr)
library(leaflet)

ui <- fluidPage(
  titlePanel("Hello Shiny!"),
  sidebarLayout(
    sidebarPanel(
      actionButton(inputId = "my_button1",
                   label = "Use leafletProxy()"),
      actionButton(inputId = "my_button2",
                   label = "Use renderLeaflet()")
    ),
    mainPanel(
      leafletOutput(
        outputId = "mymap",
        width = "100%",
        height = "300px"
    ))
))

server <- function(input, output, session) {

  some_data <- data.frame(
    lon = c(4.905167, 4.906357, 4.905831),
    lat = c(52.37712, 52.37783, 52.37755),
    number_var = c(5, 9, 7),
    name = c("Jane", "Harold", "Mike"),
    stringsAsFactors = FALSE
  )

  marker_js <- JS("function(cluster) {
                  var html = '<div style=\"background-color:rgba(77,77,77,0.5)\"><span>' + cluster.getChildCount() + '</div><span>'
                  return new L.DivIcon({html: html, className: 'marker-cluster'});
                  }")

  output$mymap <- renderLeaflet({

    leaflet(some_data) %>%
      addProviderTiles(providers$CartoDB.Positron) %>%
      fitBounds(
        ~min(lon),
        ~min(lat),
        ~max(lon),
        ~max(lat)
      ) %>%
      addMarkers(
        layerId = "mylayer",
        clusterId = "mycluster",
        lng = ~lon,
        lat = ~lat,
        clusterOptions = markerClusterOptions(
          iconCreateFunction = marker_js
        )
      )

  })

  observeEvent(input$my_button1, {

    leafletProxy("mymap", data = some_data) %>%
      removeMarker(layerId = "mylayer") %>%
      clearTiles %>%
      addProviderTiles(providers$CartoDB.Positron) %>%
      fitBounds(
        ~min(lon),
        ~min(lat),
        ~max(lon),
        ~max(lat)
      ) %>%
      addMarkers(
        layerId = "mylayer",
        clusterId = "mycluster",
        lng = ~lon,
        lat = ~lat,
        clusterOptions = markerClusterOptions(
          iconCreateFunction = marker_js
        )
      )

  })

  observeEvent(input$my_button2,{

    output$mymap <- renderLeaflet({

      leaflet(some_data) %>%
        addProviderTiles(providers$CartoDB.Positron) %>%
        fitBounds(
          ~min(lon),
          ~min(lat),
          ~max(lon),
          ~max(lat)
        ) %>%
        addMarkers(
          layerId = "mylayer",
          clusterId = "mycluster",
          lng = ~lon,
          lat = ~lat,
          clusterOptions = markerClusterOptions(
            iconCreateFunction = marker_js
          )
        )
    })

  })

}

shinyApp(ui = ui, server = server)

in-browser

enter image description here

No other javascript errors were noted.

like image 1
Kevin Arseneau Avatar answered Nov 19 '22 02:11

Kevin Arseneau


For anyone else who is struggling with this, the bug has been recently solved: https://github.com/rstudio/leaflet/pull/696

You need to reinstall leaflet from github using:

remotes::install_github("rstudio/leaflet")

and then restart R.

like image 1
Sacha Ruzzante Avatar answered Nov 19 '22 01:11

Sacha Ruzzante