传单热图上的点击能力

Question

我有一个

shiny

应用程序，它显示

leaflet

热图。我想知道是否可以单击地图上的某个点并获取下面数据表中数据框的相对行。

library(shiny)
library(DT)
library(leaflet)
library(leaflet.extras)
# ui object

ui <- fluidPage(
    titlePanel(p("Spatial app", style = "color:#3474A7")),
    sidebarLayout(
        sidebarPanel(
            
        ),
        
        mainPanel(
            leafletOutput("map"),
            tableOutput("myTable")

        )
    )
)

# server()
server <- function(input, output, session) {
    data <- reactiveValues(clickedMarker=NULL)
    
    output$map<-renderLeaflet({
        leaflet(quakes) %>%
            addProviderTiles(providers$CartoDB.DarkMatter) %>%
            setView( 178, -20, 5 ) %>%
            addHeatmap(
                lng = ~long, lat = ~lat, intensity = ~mag,
                blur = 20, max = 0.05, radius = 15
            ) %>% 
            addCircleMarkers(lng = quakes$long, lat = quakes$lat, layerId = quakes$depth,
                             fillOpacity = 0, weight = 0,
                             popup = paste("Depth:", quakes$depth, "<br>",
                                           "Stations:", quakes$stations),
                             labelOptions = labelOptions(noHide = TRUE)) 
    })
    
    # observe the marker click info and print to console when it is changed.
    observeEvent(input$map_marker_click,{
        print("observed map_marker_click")
        data$clickedMarker <- input$map_marker_click
        print(data$clickedMarker)
        output$myTable <- renderTable({
            return(
                subset(quakes,depth == data$clickedMarker$depth)
            )
        })
    })
    
}

# shinyApp()
shinyApp(ui = ui, server = server)

Answer 1

作为我评论的更新，我认为问题是，当您尝试在最后对数据集进行子集化时，您尝试匹配的行实际上是

$id

而不是

$depth

- 我认为这是因为当您调用

layerId = quakes$depth

它会创建一个

id

来匹配。

我认为这符合你的要求：

library(shiny)
library(DT)
library(leaflet)
library(leaflet.extras)
# ui object

ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      
    ),
    
    mainPanel(
      leafletOutput("map"),
      tableOutput("myTable")
      
    )
  )
)

# server()
server <- function(input, output, session) {
  data <- reactiveValues(clickedMarker=NULL)
  
  output$map<-renderLeaflet({
    leaflet(quakes) %>%
      addProviderTiles(providers$CartoDB.DarkMatter) %>%
      setView( 178, -20, 5 ) %>%
      addHeatmap(
        lng = ~long, lat = ~lat, intensity = ~mag,
        blur = 20, max = 0.05, radius = 15
      ) %>% 
      addCircleMarkers(lng = quakes$long, lat = quakes$lat, layerId = quakes$depth,
                       fillOpacity = 0, weight = 0,
                       popup = paste("Depth:", quakes$depth, "<br>",
                                     "Stations:", quakes$stations),
                       labelOptions = labelOptions(noHide = TRUE)) 
  })
  
  # observe the marker click info and print to console when it is changed.
  observeEvent(input$map_marker_click,{
    print("observed map_marker_click")
    data$clickedMarker <- input$map_marker_click
    print(data$clickedMarker)
    output$myTable <- renderTable({
      return(
        subset(quakes, depth == data$clickedMarker$id)
      )
    })
  })
  
}

# shinyApp()
shinyApp(ui = ui, server = server)

给予：

如果检查控制台输出，您将看到

id

子集（不是

depth

）：

[1] "observed map_marker_click"
$id
[1] 46

$.nonce
[1] 0.3895379

$lat
[1] -13.66

$lng
[1] 172.23