r - 单击传单 map 中的点作为 Shiny 绘图的输入

Question

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

点击 map 上的一个点

这会根据站 AND

更改图

在“点击电台”侧边栏输入对应电台

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

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

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仅当您单击外部(浅蓝色)圆圈时才有效。我会把它报告为一个错误，...