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

Question

使用下面的示例，我试图找到一种向我的闪亮应用程序添加功能的方法，从而可以实现以下目的：

1. 点击地图上的一个点
2. 这将根据测站AND更改图
3. 将相应的站点输入到“ Click on Station”侧边栏中

基本上，我希望可以在地图上单击某个站点，或者可以使用键盘手动输入该站点。

传单可以吗？ 我已经看到了使用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() ：

编辑：添加了功能，可以按照OP在注释中从selectInput()删除站的功能。

（不要忘记添加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))
})

但是，此功能会被popup event（？）部分覆盖。 如我所见，有一个内部蓝色圆圈（深蓝色），如果单击它会产生弹出窗口。 但是，仅在单击外部（浅蓝色）圆圈时， input$map_marker_click才有效。 我将其报告为错误，...