单击传单地图中的点作为闪亮的情节的输入 [英] Click on points in a leaflet map as input for a plot in shiny

问题描述

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

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. 点击地图上的一个点
2. 这会根据站点AND更改地块
3. 将相应的电台输入到"Click on Station"侧边栏中

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

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

传单可以吗?我已经看到了使用plotly的参考，这可能是最终的解决方案，但是我希望在可能的情况下尽可能多地散发传单，因为我已经在散发传单方面做了很多工作.尽管这里有可行的示例，但这类似于问题 :

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

    })

  }
)

推荐答案

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

增加了功能，可以按照OP在注释中的建议从selectInput()中删除电台.

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

(不要忘记将session添加到您的服务器功能中).

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

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

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,...

这篇关于单击传单地图中的点作为闪亮的情节的输入的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！