Select multiple items using map_click in leaflet, linked to selectizeInput in shiny app

I would like to create a where you can select multiple polygons and this will update the selectizeInput() in a shiny app. This would including removing a selected polygon, when it is removed in the selectizeInput().

I have slightly changed/updated the code from the answer here (use of sf instead of sp and more dplyr where I could work out what the base R was).

I have previously tried to link the polygon to the selectizeInput by creating a reactive polygon, but I couldn't work out how to select multiple polygons. That did however change the polygon, when the selectizeInput was updated.

Any ideas on how to make this work?

This is the code with a test dataset. Polygons get clicked when added, but not removed from the map (though they are from the selectizeInput(). Polygons are not removed when they are removed from the selectizeInput.

library(shiny)
library(leaflet)
library(sf)
library(dplyr)

#load shapefile
nc <- st_read(system.file("shape/nc.shp", package="sf")) %>%
  st_transform(4326)

shinyApp(
  ui = fluidPage(
    
    "Update selectize input by clicking on the map",
    
    leafletOutput("map"),
    "I would like the selectize input to update to show all the locations clicked,",
    "but also when items are removed here, they are removed on the map too, so linked to the map.",
    selectizeInput(inputId = "clicked_locations",
                   label = "Clicked",
                   choices = nc$NAME,
                   selected = NULL,
                   multiple = TRUE)
  ),
  
  server <- function(input, output, session){
    
    #create empty vector to hold all click ids
    clicked_ids <- reactiveValues(ids = vector())
    
    #initial map output
    output$map <- renderLeaflet({
      leaflet() %>%
        addTiles() %>%
        addPolygons(data = nc,
                    fillColor = "white",
                    fillOpacity = 0.5,
                    color = "black",
                    stroke = TRUE,
                    weight = 1,
                    layerId = ~NAME,
                    group = "regions",
                    label = ~NAME)
    }) #END RENDER LEAFLET
    
    observeEvent(input$map_shape_click, {
      
      #create object for clicked polygon
      click <- input$map_shape_click
      
      #define leaflet proxy for second regional level map
      proxy <- leafletProxy("map")
      
      #append all click ids in empty vector
      clicked_ids$ids <- c(clicked_ids$ids, click$id) # name when clicked, id when unclicked
      
      #shapefile with all clicked polygons - original shapefile subsetted by all admin names from the click list
      clicked_polys <- nc %>%
        filter(NAME %in% clicked_ids$ids)
      
      #if the current click ID [from CNTY_ID] exists in the clicked polygon (if it has been clicked twice)
      if(click$id %in% clicked_polys$CNTY_ID){
        
        #define vector that subsets NAME that matches CNTY_ID click ID - needs to be different to above
        name_match <- clicked_polys$NAME[clicked_polys$CNTY_ID == click$id]
        
        #remove the current click$id AND its name match from the clicked_polys shapefile
        clicked_ids$ids <- clicked_ids$ids[!clicked_ids$ids %in% click$id]
        clicked_ids$ids <- clicked_ids$ids[!clicked_ids$ids %in% name_match]
        
        # just to see
        print(clicked_ids$ids)
        
        # update
        updateSelectizeInput(session,
                             inputId = "clicked_locations",
                             label = "",
                             choices = nc$NAME,
                             selected = clicked_ids$ids)
        
        #remove that highlighted polygon from the map
        proxy %>% removeShape(layerId = click$id)
        
      } else {
        
        #map highlighted polygons
        proxy %>% addPolygons(data = clicked_polys,
                              fillColor = "red",
                              fillOpacity = 0.5,
                              weight = 1,
                              color = "black",
                              stroke = TRUE,
                              layerId = clicked_polys$CNTY_ID)
        
        # just to see
        print(clicked_ids$ids)
        
        # update
        updateSelectizeInput(session,
                             inputId = "clicked_locations",
                             label = "",
                             choices = nc$NAME,
                             selected = clicked_ids$ids)
        
      } #END CONDITIONAL
    }) #END OBSERVE EVENT
  }) #END SHINYAPP

Using the original dataset though, the polygon issue is fixed, but the linking of the polygons, when the selectizeInput is updated doesn't work.

Changes:

  • library(raster) # add this for the dataset
  • spatial data used ---
  • rwa_raw <- getData("GADM", country = "RWA", level = 1)
  • rwa <- st_as_sf(rwa_raw) # converted to sf to test it
  • change in columns of data as we use nc instead of rwa. So NAME and CNTY_ID in nc instead of NAME_1 and GID_1 in rwa.
# https://stackoverflow.com/questions/41104576/changing-styles-when-selecting-and-deselecting-multiple-polygons-with-leaflet-sh
library(raster)
library(shiny)
library(leaflet)
library(sf)
library(dplyr)

#load shapefile
rwa_raw <- getData("GADM", country = "RWA", level = 1)
rwa <- st_as_sf(rwa_raw)

shinyApp(
  ui = fluidPage(

    "Update selectize input by clicking on the map",

    leafletOutput("map"),
    "I would like the selectize input to update to show all the locations clicked,",
    "but also when items are removed here, they are removed on the map too, so linked to the map.",
    selectizeInput(inputId = "clicked_locations",
                   label = "Clicked",
                   choices = rwa$NAME_1,
                   selected = NULL,
                   multiple = TRUE)
  ),

  server <- function(input, output, session){

    #create empty vector to hold all click ids
    clicked_ids <- reactiveValues(ids = vector())

    #initial map output
    output$map <- renderLeaflet({
      leaflet() %>%
        addTiles() %>%
        addPolygons(data = rwa,
                    fillColor = "white",
                    fillOpacity = 0.5,
                    color = "black",
                    stroke = TRUE,
                    weight = 1,
                    layerId = ~NAME_1,
                    group = "regions",
                    label = ~NAME_1)
    }) #END RENDER LEAFLET

    observeEvent(input$map_shape_click, {

      #create object for clicked polygon
      click <- input$map_shape_click

      #define leaflet proxy for second regional level map
      proxy <- leafletProxy("map")

      #append all click ids in empty vector
      clicked_ids$ids <- c(clicked_ids$ids, click$id) # name when clicked, id when unclicked

      #shapefile with all clicked polygons - original shapefile subsetted by all admin names from the click list
      clicked_polys <- rwa %>%
        filter(NAME_1 %in% clicked_ids$ids)

      #if the current click ID [from GID_1] exists in the clicked polygon (if it has been clicked twice)
      if(click$id %in% clicked_polys$GID_1){

        #define vector that subsets NAME that matches GID_1 click ID - needs to be different to above
        name_match <- clicked_polys$NAME_1[clicked_polys$GID_1 == click$id]

        #remove the current click$id AND its name match from the clicked_polys shapefile
        clicked_ids$ids <- clicked_ids$ids[!clicked_ids$ids %in% click$id]
        clicked_ids$ids <- clicked_ids$ids[!clicked_ids$ids %in% name_match]

        # just to see
        print(clicked_ids$ids)

        # update
        updateSelectizeInput(session,
                             inputId = "clicked_locations",
                             label = "",
                             choices = rwa$NAME_1,
                             selected = clicked_ids$ids)

        #remove that highlighted polygon from the map
        proxy %>% removeShape(layerId = click$id)

      } else {

        #map highlighted polygons
        proxy %>% addPolygons(data = clicked_polys,
                              fillColor = "red",
                              fillOpacity = 0.5,
                              weight = 1,
                              color = "black",
                              stroke = TRUE,
                              layerId = clicked_polys$GID_1)

        # just to see
        print(clicked_ids$ids)

        # update
        updateSelectizeInput(session,
                          inputId = "clicked_locations",
                          label = "",
                          choices = rwa$NAME_1,
                          selected = clicked_ids$ids)

      } #END CONDITIONAL
    }) #END OBSERVE EVENT
  }) #END SHINYAPP

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.