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

Question

使用下面的示例，我试图找出一种向我闪亮的应用程序添加功能的方法，以便执行以下操作：

1. 单击地图上的一个点
2. 这会根据车站 AND 改变情节
3. 将相应的电台输入到“点击电台”侧边栏中

基本上我希望能够点击地图上的车站或用键盘手动输入车站。

这可以用传单吗？我已经看到使用 plotly 的参考资料，这可能是最终的解决方案，但如果可能的话，我很乐意在不小的部分发布传单，因为我已经对传单做了很多工作。尽管这里有工作示例，但这与此问题类似：

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

您可以使用input$map_marker_click和updateSelectInput()：

编辑：添加了可以按照selectInput()OP 在评论中的建议删除电台的功能。

（不要忘记添加session到您的服务器功能）。

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))
})

但是，此功能部分被弹出事件（？）覆盖。正如我所看到的，有一个内部蓝色圆圈（深蓝色），如果点击它会产生弹出窗口。但是，input$map_marker_click只有单击外部（浅蓝色）圆圈时才有效。我会把它报告为一个错误，...