rstudio / leaflet

R Interface to Leaflet Maps

Home Page:http://rstudio.github.io/leaflet/

Geek Repo:Geek Repo

Github PK Tool:Github PK Tool

Feature Request:`removeEasyButton` function

warnes opened this issue · comments

I have a shiny app that uses leaflet, and I am using 'addEasyButton' to add a button that allows the user to restore the bounds that I set programmatically.

Unfortunately, there doesn't appear to be a way to remove or update a button created using addEasyButton, making it difficult to update the action that is triggered when the button is pressed.

The following code is a lightly modified version of the second example on https://rstudio.github.io/leaflet/shiny.html

It adds a call to addEasyButton that adds a button that changes the map bounds to enclose only the earthquakes that match the magnitude filter.

library(shiny)
library(leaflet)
library(RColorBrewer)
library(glue)

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                sliderInput("range", "Magnitudes", min(quakes$mag), max(quakes$mag),
                            value = range(quakes$mag), step = 0.1
                ),
                selectInput("colors", "Color Scheme",
                            rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
                ),
                checkboxInput("legend", "Show legend", TRUE)
  )
)

server <- function(input, output, session) {
  
  # Reactive expression for the data subsetted to what the user selected
  filteredData <- reactive({
    quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]
  })
  
  # This reactive expression represents the palette function,
  # which changes as the user makes selections in UI.
  colorpal <- reactive({
    colorNumeric(input$colors, quakes$mag)
  })
  
  output$map <- renderLeaflet({
    # Use leaflet() here, and only include aspects of the map that
    # won't need to change dynamically (at least, not unless the
    # entire map is being torn down and recreated).
    leaflet(quakes) %>% 
      addTiles() %>%
      fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
  })
  
  # Incremental changes to the map (in this case, replacing the
  # circles when a new color is chosen) should be performed in
  # an observer. Each independent set of things that can change
  # should be managed in its own observer.
  observe({
    pal <- colorpal()
    
    sized_data <- filteredData
    
    leafletProxy("map", data = filteredData()) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                 fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
      ##-- Changes start here --##
      ) %>%
      # removeEasyButton(id = "zoom-to-filtered") %>%  ## Wish: remove the previous easyButton ##
      addEasyButton(easyButton(
        icon="fa-rotate-right",
        title = "Zoom to filtered circles",
        id = "zoom-to-filtered",
        onClick = JS(
          glue(
            "
                function(btn, map) {{
                  var maxBounds = L.latLngBounds(
                      L.latLng({min(filteredData()$lat)}, {min(filteredData()$long)}), //Southwest
                      L.latLng({max(filteredData()$lat)}, {max(filteredData()$long)})  //Northeast
                  );
                  map.fitBounds(maxBounds);
                }}
              "
          )
        )
      ))
    ##-- Changes end here --##
    
  })
  
  # Use a separate observer to recreate the legend as needed.
  observe({
    proxy <- leafletProxy("map", data = quakes)
    
    # Remove any existing legend, and only if the legend is
    # enabled, create a new one.
    proxy %>% clearControls()
    if (input$legend) {
      pal <- colorpal()
      proxy %>% addLegend(position = "bottomright",
                          pal = pal, values = ~mag
      )
    }
  })
}

shinyApp(ui, server)

The problem is that each time the filters is changed, a new button is added to the map, and there doesn't appear to be any way to remove or update the previously created buttons, so the buttons accumulate (even though they have the same id):

If the call removeEasyButton was present, it could be added before the addEasyButton call to remove the old one.

Here is the map after changing the magnutitude slider 3 times:

Screenshot 2023-03-29 at 8 42 37 PM

I've found a workaround using shinyjs::runjs for this simple example. Modifying the filteredData observer to:

 # Incremental changes to the map (in this case, replacing the
  # circles when a new color is chosen) should be performed in
  # an observer. Each independent set of things that can change
  # should be managed in its own observer.
  observe({
    pal <- colorpal()
    
    sized_data <- filteredData
    
    ##-- Changes start here --##
    proxy <- leafletProxy("map", data = filteredData()) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
                 fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
      ) %>%
      # removeEasyButton(id = "zoom-to-filtered") %>%  ## Wish: remove the previous easyButton ##
      addEasyButton(easyButton(
        icon="fa-rotate-right",
        title = "Zoom to filtered circles",
        id = "zoom-to-filtered",
        onClick = JS(
          glue(
            "
                function(btn, map) {{
                  var maxBounds = L.latLngBounds(
                      L.latLng({min(filteredData()$lat)}, {min(filteredData()$long)}), //Southwest
                      L.latLng({max(filteredData()$lat)}, {max(filteredData()$long)})  //Northeast
                  );
                  map.fitBounds(maxBounds);
                }}
              "
          )
        )
      ))
    
    shinyjs::runjs("
             var zoomToFiltered = document.getElementById('zoom-to-filtered');
             zoomToFiltered.parentNode.removeChild(zoomToFiltered);
       ")
    
    proxy
    ##-- Changes end here --##
    
  })

This isn't really satisfactory since it relies on document.getElementById('zoom-to-filtered') returning the earliest defined element with the id 'zoom-to-filtered', and I'm not sure this is guaranteed.