shiny leaflet mouseover popup

Question

I would like to build a shiny app that has a popup show up when the mouse goes over a shape/circle rather than the standard click

in particular i am trying to get the popup show as the mouse hovers over...and it disappears as the mouse moves away from it.

This page (https://rstudio.github.io/leaflet/shiny.html) would suggest i need to have something like an observeEvent({input$mymap_shape_mouseover},{showPopup()})

but not sure where to enter it or how to use it, so any help would be much appreciated.

Below is a simple random example...

    library(shiny)
    library(leaflet)
    library(data.table)


    uu <-  data.table(row_num=seq(100),
                    Latitude=c(52+cumsum(runif(100,-0.001,0.001))),
                    Longitude=c(1+cumsum(runif(100,-0.001,0.001)))
    )





  ui <- fluidPage(
    leafletOutput("mymap")
  )

  server <- function(input, output, session) {
    output$mymap <- renderLeaflet({
      leaflet() %>%
        addTiles() %>%
        addCircles(lng=uu$Longitude,
                   lat=uu$Latitude,
                   radius=2)
    })

    # Show a popup at the given location
    show_popup_on_mouseover <- function(id, lat, lng) {
      selected_point <- uu[row_num == id,]
      content <- as.character(selected_point$row_num)
      leafletProxy("mymap") %>% 
        addPopups(lng, lat, content)
    }


    # When circle is hovered over...show a popup
    observe({
      leafletProxy("mymap") %>% clearPopups()
      event <- input$mymap_shape_mouseover
      print(event)
      if (is.null(event)){
        return()
      } else {
        isolate({
          show_popup_on_mouseover(event$id, event$lat, event$lng)
        })
      }
    })


  }

  shinyApp(ui, server)

Answer 1

This is quite a challenge. And it cannot be fully resolved, I guess.

Here is the thing: If you want to use the mouse events on Shiny side to create and delete some popups, you cannot rely on the leaflet events you get.

In more detail: You were right to trigger the Popup on input$mymap_shape_mouseover. In your example, you also used the clearPopups function each time a new popup is created. This can be avoided by setting a shared layerId, like I use in my almost working example below, to ensure having only one popup open. Other than that, my example is logically mostly the same.

At first I thought one could bind the clearPopup function to the mouseout event on your circles, but there is a problem. Whenever you add a popup, the popup container will be directly under your cursor, and thus, mouseout fires, even if the curser still is above the marker/circle. So this results in flashing popups, being generated and immediately deleted, resulting in the mouse being on the circle again, thus rendering the popup again, and so on.

A possible fix would have been to take the input$mymap_popup_mouseover into account, but unfortunately, there is a bug in the leaflet package and the popup mouse events cannot be accessed. I added a comment to an issue on Github and Joe Chang immediately promised to look into this.

Closest one can get:

library(shiny)
library(leaflet)
library(data.table)

uu <-  data.table(
  row_num=seq(100),
  Latitude=c(52+cumsum(runif(100,-0.001,0.001))),
  Longitude=c(1+cumsum(runif(100,-0.001,0.001)))
)

ui <- fluidPage(
  leafletOutput("mymap")
)

server <- function(input, output, session) {
  output$mymap <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addCircles(lng = uu$Longitude, lat = uu$Latitude, radius = 2, layerId = uu$row_num)
  })

  # When circle is hovered over...show a popup
  observeEvent(input$mymap_shape_mouseover$id, {
    pointId <- input$mymap_shape_mouseover$id

    lat = uu[uu$row_num == pointId, Latitude]
    lng = uu[uu$row_num == pointId, Longitude]
    leafletProxy("mymap") %>% addPopups(lat = lat, lng = lng, as.character(pointId), layerId = "hoverPopup")
  })
}

shinyApp(ui, server)

EDIT: Cheap fix.

Another possibility is the workaround below. If you can live with popups being slightly offset, you can avoid the mouseover/mouseout problem. When rendering the popup above the circle, such that the popup container is fully outside of the circle, everything works fine. The offset calculation is purely by trial.

library(shiny)
library(leaflet)
library(data.table)

uu <-  data.table(
  row_num=seq(100),
  Latitude=c(52+cumsum(runif(100,-0.001,0.001))),
  Longitude=c(1+cumsum(runif(100,-0.001,0.001)))
)

ui <- fluidPage(
  leafletOutput("mymap")
)

server <- function(input, output, session) {

  radius = 3

  output$mymap <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addCircles(lng = uu$Longitude, lat = uu$Latitude, radius = radius, layerId = uu$row_num)
  })

  observeEvent(input$mymap_shape_mouseout$id, {
    leafletProxy("mymap") %>% clearPopups()
  })

  # When circle is hovered over...show a popup
  observeEvent(input$mymap_shape_mouseover$id, {
    pointId <- input$mymap_shape_mouseover$id
    lat = uu[uu$row_num == pointId, Latitude]
    lng = uu[uu$row_num == pointId, Longitude]
    offset = isolate((input$mymap_bounds$north - input$mymap_bounds$south) / (23 + radius + (18 - input$mymap_zoom)^2 ))

    leafletProxy("mymap") %>% addPopups(lat = lat + offset, lng = lng, as.character(pointId))
  })
}

shinyApp(ui, server)