传单热图上的点击能力答案

【问题标题】：Click-on ability on leaflet heatmap传单热图上的点击能力
【发布时间】：2020-09-16 11:42:31
【问题描述】：

我有一个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)

【问题讨论】：

也许有帮助，不是DTOutput，而是tableOutput stackoverflow.com/questions/39874318/…
我根据您的评论更新了我的代码，但我得到一个空表

标签： r shiny leaflet

【解决方案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

【讨论】：