R 传单 - 在已打开弹出窗口的 map 上添加新标记

标签 r shiny leaflet popup marker

我有一个 Shiny 的应用程序,显示 传单 map .该应用程序的一项功能允许用户在 map 上添加新的地理标记。然而,我想在 map 上添加此类标记后立即打开该标记的弹出窗口 ,但始终保持使用“x”按钮或单击 map 关闭它的可能性。
我已阅读 leaflet documentation 的“标记”指南(“从层继承的弹出方法”小节,非常详细的指南显然在 R 语言中不可用)我找到了这个选项 openPopup() .不幸的是,这似乎不适用于我的代码。这是一个简单的例子:

library(leaflet)

leaflet() %>% 
  addTiles() %>% 
  addMarkers(lng = -100,
             lat = 50,
             popup = "ALE",
             options = popupOptions(openPopup = TRUE))
预期行为是此 online tool 中显示的行为使用传单。请尝试搜索地址并查看新标记是否立即打开了自己的弹出窗口。
在此先感谢您的帮助!

最佳答案

代码
我想需要一些 JavaScript,因为界面似乎不支持此功能。
下面是一个工作 Shiny 的例子:

library(shiny)
library(leaflet)
library(shinyjs)

js_save_map_instance <- HTML(
   paste(
      "var mapsPlaceholder = [];",
      "L.Map.addInitHook(function () {",
      "   mapsPlaceholder.push(this); // Use whatever global scope variable you like.",
      "});", sep = "\n"
   )
)

js_open_popup <- HTML(
   paste("function open_popup(id) {",
         "   console.log('open popup for ' + id);",
         "   mapsPlaceholder[0].eachLayer(function(l) {",
         "      if (l.options && l.options.layerId == id) {",
         "         l.openPopup();",
         "      }",
         "   });",
         "}", sep = "\n"
   )
)

ui <- fluidPage(
   tags$head(
      tags$script(type = "text/javascript",
                  js_save_map_instance,
                  js_open_popup),
      useShinyjs()
   ),
   wellPanel(
      fluidRow(
         sliderInput("lng", "Longitude:", 10, 60, 35, 0.01),
         sliderInput("lat", "Latitude:", 35, 75, 42.5, 0.01),
         actionButton("add", "Add Marker")
      )
   ),
   fluidRow(
      leafletOutput("map")
   )
)

server <- function(input, output, session) {
   map <- leaflet() %>% 
      addTiles() %>%
      fitBounds(10, 35, 60, 75)
   
   output$map <- renderLeaflet(
      map
   )
   
   observeEvent(input$add, {
      id <- paste0("marker", input$add)
      leafletProxy("map") %>%
         addMarkers(input$lng, input$lat, id,
                    "mymarkers", 
                    popup = sprintf("%.2f / %.2f: %s", input$lng, input$lat, 
                                    id))
      runjs(sprintf("setTimeout(() => open_popup('%s'), 10)", id))
   })
}

shinyApp(ui, server)
评论
  • leaflet.js不提供开箱即用的功能来在初始化后检索 map 实例。因此,我们必须使用一种解决方法在初始化时显式保存 map 。这是在存储在 js_save_map_instance 中的 JS 代码中完成的。 .这个想法取自 Find Leaflet map object after initialisation .
  • 我们创建了一个 JS 函数,它使用我们想要打开弹出窗口的标记的 id。在这个函数中,我们取数组的第一个元素,其中存储了所有 map 实例(如果页面上应该有多个传单 map ,则需要进行调整。
  • 在这个 map 实例上,我们可以遍历所有图层,如果 layerId等于我们要找的那个,我们可以拨打openPopup在这一层。 (注意,理想情况下,我们可以直接访问该层(同样,我在 API 中没有找到任何函数),我们可以使用私有(private) _layer 属性,但由于它是私有(private)的,我使用循环方法。)
  • 剩下的就是拨打open_popupshiny 上的正确位置边。我需要添加一个小的延迟以避免我们在添加标记之前调用该函数。

  • 结果
    Popup on creation

    关于R 传单 - 在已打开弹出窗口的 map 上添加新标记,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/66240941/

    相关文章:

    r - 如何使用 R 中的 Leaflet 可视化多条路线

    javascript - HTMLWidget : Shiny app run well in Rstudio but Not on Shiny-Server

    R Shiny : reload a . Rda 文件在一天中的特殊时间 Shiny

    mysql - 如何将完成的多边形点 leaflet.draw 保存到 mysql 表

    r - 根据其他列中值的大小创建新变量

    r - Shiny :更改另一个输入时重新启动/中断输出渲染

    javascript - Leaflet 标记弹出窗口中的缓存破坏

    r - 如何在 R 中使用诺基亚 HERE API

    r - R查找月份的最后一个工作日

    R 根据一个数据集中的列信息/条件将行值替换为其他行?