Question

使用下面的示例，我试图找到一种方法来为我的闪亮应用添加功能，以便以下工作：

点击地图上的某个点
根据电台和
将相应的电台输入“点击电台”侧栏

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

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

编辑：添加了可以根据评论中的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))
})

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

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

1 个答案: