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

2023年10月8日 221次阅读

我想建立一个闪亮的应用程序,当鼠标移过一个形状/圆圈而不是标准点击时弹出窗口

特别是当鼠标悬停在…时,我正试图获得弹出窗口…当鼠标远离它时它会消失.

这个页面(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)

最佳答案 这是一个相当大的挑战.我猜,它无法完全解决.

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

更详细：您在输入$mymap_shape_mouseover上触发Popup是正确的.在您的示例中,每次创建新的弹出窗口时,您还使用了clearPopups函数.这可以通过设置共享的layerId来避免,就像我在下面几乎工作的例子中使用的那样,以确保只打开一个弹出窗口.除此之外,我的例子在逻辑上基本相同.

起初我以为可以将clearPopup函数绑定到您圈子上的mouseout事件,但是有一个问题.无论何时添加弹出窗口,弹出容器都将直接位于光标下,因此,即使光标仍在标记/圆圈上方,mouseout也会触发.因此,这会导致闪烁弹出,生成并立即删除,导致鼠标再次出现在圆圈上,从而再次呈现弹出窗口,依此类推.

可能的修复方法是将输入$mymap_popup_mouseover考虑在内,但遗憾的是,传单包中存在一个错误,无法访问弹出鼠标事件.我在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)

编辑：廉价修复.

另一种可能性是下面的解决方法.如果您可以使用稍微偏移的弹出窗口,则可以避免鼠标悬停/鼠标悬停问题.当在圆圈上方渲染弹出窗口时,弹出容器完全位于圆圈之外,一切正常.偏移计算纯粹是通过试验.

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)
点赞