Is there a way to display R Leaflet label values in a separate box?

Question

On the JS Leaflet page the population density is shown in a panel in the upper right hand corner when a state is hovered over. Is there a way to create a similar box in Leaflet using R?

I created a separate panel using absolutePanel() from the Shiny package, but have only been able to print out all the data at once instead of when a location is hovered over.

Code:

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

Data: National Park Data from the National Park Service USA Shapefile from the United States Census

Answer 1

The solution is to use input$map_shape_mouseover$id, which gives you the ID of the polygon your mouse is hovering.

You have other similar inputs such as map_shape_click (give you the ID and lat long of the polygon you clicked), map_click (gives you the coordinates of the point you click on the map), map_marker_click (gives you the ID and lat long of the marker you clicked) etc ...

Please note that your code is NOT reproducible.

Here is a solution using the States dataset and choropleth example map.

Data is available here as geojson that I converted to SHP using an online geojson to shp converter.

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)