单击传单地图中的点作为闪亮图形的输入

Question

Using the example below, I am trying to figure out a way to add functionality to my shiny app such that the following works:

1. Click on a point on the map
2. This changes the plot according to station AND
3. Inputs the corresponding station into the "Click on Station" sidebar

Basically I'd like to be able either click on the map for a station OR input the station manually with a keyboard.

Is this possible with leaflet? I've seen references to using plotly which may be ultimate solution but I'd love to leaflet if possible in no small part because I have already done a lot of work with leaflet. This is similar to this question though there is working example here:

library(shiny)
library(leaflet)
library(shinydashboard)
library(ggplot2)
library(dplyr)

data("quakes")
shinyApp(
  ui = dashboardPage(title = "Station Lookup",
                     dashboardHeader(title = "Test"),
                     dashboardSidebar(
                       sidebarMenu(
                         menuItem("Data Dashboard", tabName = "datavis", icon = icon("dashboard")),
                         menuItem("Select by station number", icon = icon("bar-chart-o"),
                                  selectizeInput("stations", "Click on Station", choices = levels(factor(quakes$stations)), selected = 10, multiple = TRUE)
                         )
                       )
                     ),
                     dashboardBody(
                       tabItems(
                         tabItem(tabName = "datavis",
                                 h4("Map and Plot"),
                                 fluidRow(box(width= 4,  leafletOutput("map")),
                                          box(width = 8, plotOutput("plot")))
                         )
                       )
                     )
  ),

  server = function(input, output) {

    ## Sub data     
    quakes_sub <- reactive({

      quakes[quakes$stations %in% input$stations,]

    })  

    output$plot <- renderPlot({

      ggplot(quakes_sub(), aes(x = depth, y = mag))+
        geom_point()

    })


    output$map <- renderLeaflet({
      leaflet(quakes) %>% 
        addTiles() %>%
        addCircleMarkers(lng = ~long, lat = ~lat, layerId = ~stations, color = "blue", radius = 3) %>%
        addCircles(lng = ~long, lat = ~lat, weight = 1,
                   radius = 1, label = ~stations, 
                   popup = ~paste(stations, "<br>",
                                  depth, "<br>",
                                  mag)
        )

    })

  }
)

Answer 1

You can use input$map_marker_click and updateSelectInput() :

Edit: Added functionality that stations can be deleted from selectInput() as suggested by OP in the comments.

(Dont forget to add session to your sever function).

observeEvent(input$stations,{
  updateSelectInput(session, "stations", "Click on Station", 
                    choices = levels(factor(quakes$stations)), 
                    selected = c(input$stations))
})

observeEvent(input$map_marker_click, {
  click <- input$map_marker_click
  station <- quakes[which(quakes$lat == click$lat & quakes$long == click$lng), ]$stations
  updateSelectInput(session, "stations", "Click on Station", 
                    choices = levels(factor(quakes$stations)), 
                    selected = c(input$stations, station))
})

However, this functionality is partly overwritten by the popup event(?). As i see it there is an inner blue circle (darker blue) that if clicked produces the popup. However, the input$map_marker_click only works if you click the outer (light blue) circle. I would report it as a bug,...