我想建立一个闪亮的应用程序,当鼠标移过一个形状/圆圈而不是标准点击时弹出窗口
特别是当鼠标悬停在…时,我正试图获得弹出窗口…当鼠标远离它时它会消失.
这个页面(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)