markercluster 是否与 leafletProxy() 和选项 iconCreateFunction 一起工作？

Question

我是不是做错了什么，或者为什么下面的例子不起作用？我正在尝试使用选项 iconCreateFunction 使传单 markercluster 插件在 R Shiny 应用程序中与 leafletProxy() 一起使用。插件是否无法使用leafletProxy()向地图添加自定义图标标记？

当我在下面的示例中按下第一个按钮并缩小时，我收到一条错误消息：

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

我试图从 markercluster 文档中复制 the original example：

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)

包版本：

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

浏览器版本：Firefox Quantum 57.0.1（64 位）

Answer 1

修改后的解决方案

在 leafletProxy 中使用时 iconCreateFunction 的行为绝对是 flakey。虽然我认为某些浏览器中存在缓存，因此很难进行视觉跟踪。

为了消除您遇到的 javascript 错误，重要的是应用 layerId 和 clusterId 值以及使用 removeMarker 代替 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)

在浏览器中

No other javascript errors were noted.

Answer 2

为了遵循 Kevin 的回答，将 clusterId 修改为矢量可使 leafletProxy 版本适用于我。不确定这是否会导致意想不到的后果...

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)

Answer 3

对于正在为此苦苦挣扎的任何其他人，该错误最近已得到解决： https://github.com/rstudio/leaflet/pull/696

您需要使用 github 重新安装传单：

remotes::install_github("rstudio/leaflet")

然后重启R。

markercluster 是否与 leafletProxy() 和选项 iconCreateFunction 一起工作？

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

javascript

r

leaflet

shiny

leaflet.markercluster

修改后的解决方案

app.R

在浏览器中