有没有办法在单独的框中显示 R Leaflet 标签值？

Question

在 JS Leaflet 页面，当鼠标悬停在某个州上时，人口密度会显示在右上角的面板中。有没有办法使用 R 在 Leaflet 中创建类似的盒子？

我使用 Shiny 包中的

absolutePanel()

创建了一个单独的面板，但只能一次打印出所有数据，而不能在将鼠标悬停在某个位置上时打印出。

代码：

    ui <- fillPage(tags$head(includeCSS("./shiny/www/styles.css")),
              title = "National Parks I've Visited",
              bootstrap = TRUE,
              leafletOutput("map", width = "100%", height = "100%"),
              absolutePanel(id = "info-panel",
                            class = "panel panel-default",
                            bottom = 75, 
                            left = 55, 
                            width = 250, 
                            fixed = TRUE, 
                            draggable = TRUE, 
                            height = "auto",
                p(id = "info", class="info-title", "National Park Data"),
                textOutput("demo_text", container = tags$h3)))

server <- function(input, output) {
  output$map <- renderLeaflet({
    leaflet() %>%
  addPolygons(data = usa_base,
    smoothFactor = 0.2,
    fillColor = "#808080",
    stroke = TRUE,
    weight = 0.5,
    opacity = 0.5,
    color = "#808080",
    highlightOptions = highlightOptions(
      weight = 0.5,
      color = "#000000",
      fillOpacity = 0.7,
      bringToFront = FALSE),
    group = "Base Map") %>%  
  addPolygons(data = nps,
    smoothFactor = 0.2,                 
    fillColor =  ~nps_color(type),
    fillOpacity = 1,
    stroke = TRUE,
    weight = 0.2,     
    opacity = 0.5,                       
    color = "#354f52",             
    highlight = highlightOptions(
      weight = 3,
      color = "#fff",
      fillOpacity = 0.8,
      bringToFront = TRUE),
    group = "National Parks")  %>%
  addLayersControl(
    baseGroups = "Base Map",
    overlayGroups = "National Parks",
    options = layersControlOptions(collapsed = FALSE))  %>% 
  addLegend(pal = nps_color,
            values = nps$type,
            position = "bottomright",
            title = "National Land by Type")
  })
  output$demo_text <- renderText ({
    sprintf("%s is a %s. I have %s there.", nps$PARKNAME, nps$type, nps$visited)
  })
}

数据： 来自国家公园管理局的国家公园数据 来自美国人口普查的 USA Shapefile

Answer 1

解决方案是使用

input$map_shape_mouseover$id

，它为您提供鼠标悬停的多边形的 ID。

您还有其他类似的输入，例如

map_shape_click

（为您提供您单击的多边形的 ID 和纬度）、

map_click

（为您提供您在地图上单击的点的坐标）、

map_marker_click

（为您提供您点击的标记的 ID 和纬度）等...

请注意，您的代码不可重现。

这是使用 States 数据集和 choropleth 示例地图的解决方案。

数据可用 here 作为 geojson，我使用在线 geojson 到 shp 转换器将其转换为 SHP。

library(rgdal)
library(shiny)
library(leaflet)

states <- readOGR("data/us-states-polygon.shp")

bins <- c(0, 10, 20, 50, 100, 200, 500, 1000, Inf)
pal <- colorBin("YlOrRd", domain = states$density, bins = bins)

ui <- fillPage(
  title = "National Parks I've Visited",
  bootstrap = TRUE,
  #CSS for the top right panel
  tags$head(
    tags$style(HTML("
      #affichage_infos_commune {
        margin:auto;
        margin-bottom:0px;
        margin-top:0px;
        padding:0px;
        background-color:rgba(255, 255, 255, 0.8);
        border-radius: 10px;
        z-index:1600 !important;
        }"))),
  leafletOutput("map", width = "100%", height = "100%"),
  # top right panel
  absolutePanel(
    id        = "affichage_infos_commune",
    top       = '5px',
    right     = '5px',
    width     = '200px',
    fixed     = TRUE,
    draggable = FALSE,
    fluidRow(
      column(
        width = 12,
        align = "center",
        style = "height:45px",
        textOutput("texte")
      )
    )
  )
 )

server <- function(input, output) {
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addPolygons(
        data = states,
        layerId = ~name, # give each polygon an ID which is state name
        fillColor = ~pal(density),
        weight = 2,
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7,
        highlightOptions = highlightOptions(
          weight = 5,
          color = "#666",
          dashArray = "",
          fillOpacity = 0.7,
          bringToFront = TRUE),
        )
  })

 # you can customise the output as HTML to get state in bold or a linebreak if you want
 output$texte <- renderText({
   current_state = input$map_shape_mouseover$id # get state name we are hovering
   if(is.null(current_state)){
  return("Hover over a state")
} else{
  return(paste(current_state, ":", states@data[states$name==current_state, 'density'], "people / mi2"))
  }
 })
}

shinyApp(ui, server)