Multiselect markers in leaflet/shiny/R

Question

I am trying to create a Leaflet map within a Shiny dashboard. On the map, I display several points (markers). I would like to have an option where I can draw a box and subsequently obtain the IDs of these markers in a dataframe on the dashboard.

I attempted to replicate the example created by Red Oak, but their source data is no longer available.

I also found this on GitHub, but I don't know how to implement this with the observeEvent option in the server.

Here is my source code:

library(shiny)
library(leaflet)
library(shinyjs)

# Create a simple dataframe with cities and their coordinates
cities_df <- data.frame(
  City = c("City A", "City B", "City C", "City D"),
  Latitude = c(0, 10, 20, -10),
  Longitude = c(0, 10, 20, -20)
)

ui <- fluidPage(
  leafletOutput("map"),
  useShinyjs(),
  textOutput("selected_cities")
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      setView(lng = 0, lat = 0, zoom = 2) %>%
      addMarkers(data = cities_df, lng = ~Longitude, lat = ~Latitude, label = ~City) %>%
      addDrawToolbar(targetGroup = 'draw')
  })

  observeEvent(input$map_draw_new_feature, {
    if (!is.null(input$map_draw_new_feature) && input$map_draw_new_feature$type == "rectangle") {
      feature <- input$map_draw_new_feature
      selected_markers <- leaflet::bbox_select(input$map_draw_features, feature)
      output$selected_cities <- renderText({
        paste("Selected cities:", selected_markers$label, collapse = ", ")
      })
    }
  })
}

shinyApp(ui, server)

Answer 1

A few things to note: The Github link is to a pull request, but there has never been a leaflet::bbox_select function actually added to {leaflet}. addDrawToolbar is from {leaflet.extras} not {leaflet} (you haven't imported this in your example). useShinyjs() isn't doing anything.

This is one way to do what you want:

  observe({
    coords <- unlist(input$map_draw_new_feature$geometry$coordinates)
    xy <- as.data.frame(matrix(c(coords[c(TRUE,FALSE)], coords[c(FALSE,TRUE)]), ncol=2))
    colnames(xy) <- c('longitude', 'latitude')
    selected_markers <- cities_df[cities_df$Latitude > min(xy$latitude) &
                                  cities_df$Latitude < max(xy$latitude) &
                                  cities_df$Longitude > min(xy$longitude) &
                                  cities_df$Longitude < max(xy$longitude),]
      output$selected_cities <- renderText({
        paste("Selected cities:", selected_markers$City, collapse = ", ")
      })
  }) %>% bindEvent(input$map_draw_new_feature)

The observe() %>% bindEvent() is only necessary in order to have the output inside the observe and if you store xy somehow, then you can just use observeEvent(input$map_draw_new_feature) instead.