Search code examples
javascriptcssrleafletr-leaflet

Clustered leaflet markers with sum (not count) totals: how to get consistent round red shape and label format like in unclustered markers


I would like to modify the behavior of leaflet grouping feature to total on grouping and preserve a round red bubble shape dependent on value.

My data contains columns:

lon lat sales_ytd

I would like to cluster data depending on zoom using clusterOptions = markerClusterOptions(iconCreateFunction=JS(sum.formula))

Here is my function. I do not know JS but I tried numerous examples and the function works by summing up the grouped values.

 sum.formula  = JS("function (cluster) {    
        var markers = cluster.getAllChildMarkers();
        var sum = 0; 
        for (i = 0; i < markers.length; i++) {
          sum += Number(markers[i].options.mag);
    //      sum += 1;
        }
          var size = sum/30000;

        return new L.DivIcon({ html:  sum ,  iconSize: L.point(size, size)});
      }")

Evidently L.DivIcon() returns a square... is there a way for it to return round red bubble?

Then I am trying using it in a shiny app (R code).

renderLeaflet({
  leaflet(df_summary_towns()) %>% 
  addTiles() %>%
  addCircleMarkers(
    radius = ~sales_ytd/30000,
    color = 'red',
    stroke = FALSE, 
    fillOpacity = 0.5,
    options = markerOptions(mag = ~ sales_ytd),
    clusterOptions = markerClusterOptions(iconCreateFunction=JS(sum.formula))
  ) %>% 
    addLabelOnlyMarkers(
      ~lon, ~lat, 
      options = markerOptions(mag = ~ sales_ytd),
      label =  ~scales::number(sales_ytd),
      labelOptions = labelOptions(noHide = T, direction = 'center', textOnly = T),
      clusterOptions = markerClusterOptions(iconCreateFunction=JS(sum.formula)))
})

Grouped markers

The grouping somewhat works, the values are totaled for clustered data and if I click them, leaflet zooms and show individual points (nice red circles with values inside). But the grouped markers are white squares and not round red circles like the individual points. Also I do not know how to achieve consistent formatting for numbers. In R it is easy but the definition of grouped markers is now in JS. How can it be achieved: consistent shape, color and size dependent on value in both ungrouped and grouped markers and consistent number formats? One can also see I tried normalizing the size in R, and I divided size/1000 in JS - I did not know how to pass the sum of the data.frame column to JS.


Solution

  • You could try tweaking the custom sum.formula function to add a CSS class to the marker that you can then customise, as well as format the number to add thousand separators.

    I have added a MWE example below, I have added the custom-cluster-icon class to the icons, and formatted the numbers using the regexp in this post.

    The CSS included in the header of the shiny page, as well as added in line in the sum.formula output helps center the labels, and add the red marker circles.

    library(leaflet)
    library(shiny)
    
    #dummy data for example
    df_summary_towns=quakes
    df_summary_towns$sales_ytd=sample(2000:5000,1000)
    
    sum.formula  = JS("function (cluster) {    
        var markers = cluster.getAllChildMarkers();
        var sum = 0; 
        for (i = 0; i < markers.length; i++) {
          sum += Number(markers[i].options.mag);
        }
          var size = sum/10000;
          var formatted_number = Math.round(sum).toString().replace(/\\B(?=(\\d{3})+(?!\\d))/g, ' ');
    
        return new L.DivIcon({ className: 'custom-cluster-icon', html: '<div style=\"line-height:'+size+'px; white-space: nowrap;\">'+formatted_number+'</div>'   , iconSize: L.point(size, size) });
      }")
    
    
    ui <- fluidPage(
      tags$head(
        tags$style(HTML("
          .custom-cluster-icon {
            background: rgba(255, 0, 0, 0.3);
            border-radius: 50%;
            text-align: center;
          }
          "))
      ),
      leafletOutput("mymap")
    )
    
    server <- function(input, output, session) {
    
      points <- eventReactive(input$recalc, {
        cbind(rnorm(40) * 2 + 13, rnorm(40) + 48)
      }, ignoreNULL = FALSE)
    
      output$mymap <- renderLeaflet({
        leaflet(df_summary_towns) %>% 
          addTiles() %>%
          addCircleMarkers(
            radius = ~sales_ytd/10000,
            color = 'red',
            stroke = FALSE, 
            fillOpacity = 0.5,
            options = markerOptions(mag = ~ sales_ytd, min_sales =  ~min(sales_ytd), max_sales = ~ max(sales_ytd)),
            clusterOptions = markerClusterOptions(iconCreateFunction=JS(sum.formula))
          ) %>% 
          addLabelOnlyMarkers(
            ~long, ~lat, 
            options = markerOptions(mag = ~ sales_ytd),
            label =  ~scales::number(sales_ytd),
            labelOptions = labelOptions(noHide = T, direction = 'center', textOnly = T),
            clusterOptions = markerClusterOptions(iconCreateFunction=JS(sum.formula)))
      })
    }
    
    shinyApp(ui, server)