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:
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.