Select polygon by clicking on map, changing item selected via dropdown

[williaml]

Is there a way to click on a polygon on a map in a shiny app to select an item, thus changing the item already selected in the dropdown? Ideally, the polygon selected will change the input$name.

In the code below, I have just tested the observeEvent function, but couldn't work out how to do what I want. The coordinates are just to see the output.

Example:

library(shiny)
library(sf)
library(tmap)
library(tidyverse)
library(leaflet)

# data in the sf package
nc <- st_read(system.file("shape/nc.shp", package="sf")) %>% 
    select(NAME, AREA)

nc_names <- nc %>% 
    st_set_geometry(NULL) %>% 
    distinct(NAME) %>%
    pull()

# Define UI for application that draws a histogram
ui <- fluidPage(    
    # Generate a row with a sidebar
    sidebarLayout(      
        # Define the sidebar with one input
        sidebarPanel(
            selectInput("name",
                        "name",
                        nc_names
            )
        ),
        # Create a spot for the barplot
        mainPanel(
            mainPanel(tmapOutput("map") )
        )
    )
)

server <- function(input, output) {
    
    # filter polygon for map based on location selected
    shp_selected <- reactive({
        req(input$name)
            nc %>% filter(NAME == input$name)       
    })
    
    output$map <- renderTmap({
        tmap_mode("view")
        tm_shape(nc) + 
            tm_polygons() + 
            tm_shape(shp_selected()) + 
            tm_fill(col = "blue", alpha = 0.3)
        
    })
    
    # just testing here
    observeEvent(input$map_shape_click, {
        p <- input$map_shape_click # map because that is the name of the output
        text <- paste("lat ", p$lat," lon ", p$lng) # shows lat/lon in console
        print(text)
    }) 
    
}

shinyApp(ui, server)

[jlacko]

Yes, there is. But if I was doing it I would be using {leaflet} directly.

It allows to include a layerId field in your polygons object; value of which will be returned in event$Id of the input$map_shape_click event.

For a working example - it sort of mixes clicks on polygon and points, but these have separate handlers - map_shape_click for polygon and map_marker_click for marker, and so can be easily separated - consider this linked answer Shiny: Using multiple exclusive reactiveValues for filtering dataset

[williaml]

Thanks @jlacko I have changed it to use leaflet and now it prints the NAME upon clicking on the map. Do you know how I can change the dropdown to be the same as what is selected in the map?

library(shiny)
library(sf)
library(tidyverse)
library(leaflet)

# data in the sf package
nc <- st_read(system.file("shape/nc.shp", package="sf")) %>% 
    select(NAME, AREA)

# unique names
nc_names <- nc %>% 
    st_set_geometry(NULL) %>% 
    distinct(NAME) %>%
    pull()

# Define UI for application that draws a histogram
ui <- fluidPage(    
    # Generate a row with a sidebar
    sidebarLayout(      
        # Define the sidebar with one input
        sidebarPanel(
            selectInput("name",
                        "name",
                        nc_names
            )
        ),
        # Create a spot for the barplot
        mainPanel(
            mainPanel(leafletOutput("map") )
        )
    )
)

server <- function(input, output) {
    
    # filter polygon for map based on location selected
    shp_selected <- reactive({
        req(input$name)
        nc %>% filter(NAME == input$name)       
    })
    
    output$map <- renderLeaflet({
        leaflet() %>% 
            addProviderTiles("Stamen.TonerHybrid") %>% 
            addPolygons(data = nc, 
                        fillColor = NULL, 
                        color = "grey",
                        weight = 0.1,
                        layerId = ~NAME) %>% 
            addPolygons(data = shp_selected(), 
                        fillColor = "blue", 
                        color = "grey",
                        fillOpacity = 0.5,
                        layerId = ~NAME)
        
    })
    
    #click on polygon
    observe({ 
        event <- input$map_shape_click
        print(event$id)
        
    })
    
    # map selection - not sure if this is the way to do it - still needs to be assigned to be the same as the dropdown
    output$map_selection <- reactive({
        req(event$id)
        event$id
    })
    
}

shinyApp(ui, server)

[williaml]

Got it.

    #click on polygon
    observe({ 
        event <- input$map_shape_click
        print(event$id)
        
        updateSelectInput(session,
                          inputId = "name",
                          label = "name",
                          choices = nc_names,
                          selected = event$id)
        
    })

Thanks.