单击传单地图中的点作为闪亮绘图的输入 [英] 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. 将对应的电台输入到点击电台"侧边栏

基本上，我希望能够在地图上单击车站或使用键盘手动输入车站.

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

传单可以做到这一点吗?我已经看到使用 plotly 的参考，这可能是最终的解决方案，但如果可能的话，我很想在很大程度上宣传传单，因为我已经在传单方面做了很多工作.这类似于这个question 虽然这里有工作示例:

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

但是，弹出事件 (?) 会部分覆盖此功能.正如我所看到的，有一个内部蓝色圆圈(深蓝色)，如果单击它会产生弹出窗口.但是，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屋！