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)

Answer 1

这是一个相当大的挑战。我猜，它无法完全解决。

这就是：如果你想在Shiny一侧使用鼠标事件来创建和删除一些弹出窗口，你就不能依赖你得到的传单事件。

更详细：您在input$mymap_shape_mouseover上触发弹出窗口是正确的。在您的示例中，每次创建新弹出窗口时，您还使用了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)

闪亮的传单鼠标悬停弹出窗口

1 个答案: