闪亮的leaflet鼠标悬停弹出窗口

Question

我想建立一个闪亮的应用程序，当鼠标悬停在形状/圆上时，弹出窗口而不是标准点击。

特别地，我试图让弹出窗口在鼠标悬停时显示...并且当鼠标移开时消失。

此页面(https://rstudio.github.io/leaflet/shiny.html)会建议我需要像observeEvent({input$mymap_shape_mouseover},{showPopup()})这样的东西。

但不确定在哪里输入它或如何使用它，所以任何帮助将不胜感激。

以下是一个简单的随机示例...

    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)

- h.l.m

Answer 1

这是一个相当具有挑战性的问题，我想它无法完全解决。

问题在于：如果您想在Shiny端使用鼠标事件创建和删除一些弹出窗口，则不能依赖于您获得的leaflet事件。

更详细地说：您正确地在mymap_shape_mouseover上触发了Popup。在您的示例中，您还每次创建新的弹出窗口时都使用clearPopups函数。通过设置共享的layerId（就像我在下面的几乎工作示例中使用的那样），可以避免这种情况，以确保只有一个弹出窗口处于打开状态。除此之外，我的示例在逻辑上大多相同。

起初，我认为可以将clearPopup函数绑定到您的圆形上的mouseout事件，但存在问题。每当您添加弹出窗口时，弹出窗口容器将直接位于光标下方，因此，即使光标仍在标记/圆形上方，mouseout也会触发。因此，这会导致闪烁的弹出窗口被生成并立即删除，结果鼠标又回到圆圈上，从而再次呈现弹出窗口，如此往复。

一个可能的修复方法是考虑input>mymap_popup_mouseover，但不幸的是，leaflet包存在一个错误，无法访问弹出窗口鼠标事件。我在Github上添加了一条评论，并且Joe Chang立即承诺解决此问题。

最接近的方法：

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)

编辑：便宜的解决方法。

另一种可能性是下面的解决方法。如果你可以接受弹出窗口略微偏移，你可以避免mouseover/mouseout问题。当将弹出窗口渲染在圆形上方时，使得弹出窗口容器完全位于圆形外部，一切都正常工作。偏移量的计算纯属试验。

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) 

- K. Rohde