以编程方式触发 R 传单中的标记鼠标单击事件以获得闪亮效果

我的问题与此相同：在 R 传单中触发标记鼠标单击事件以获得闪亮效果 https://stackoverflow.com/questions/56962857/trigger-marker-mouse-click-event-in-r-leaflet-for-shiny但我没有足够的代表来添加评论，并且编辑队列已“满”，因此我无法将我的想法添加到原始问题中。不确定这是否违反社区规则/最佳实践，如果违反，请删除！对下面冗长的描述表示歉意，但我想我可能已经接近了 javascript 或闪亮的大师可以立即修复的解决方案！或者，我完全找错了树。谢谢阅读！

当我在 R 闪亮 Web 应用程序中的 DT 数据表中选择一行时，我想触发 Leaflet 地图标记单击事件。

这是一个最小示例应用程序，作为添加此功能的基础：

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

# create js function that triggers a click on a button 'buttona'
jsCode <- 'shinyjs.buttonClick = (function() {
           $("#buttona").click();
           });'

df <- tibble::tibble(id = c(1,2,3,4,5),
                     label = c('One','Two','Three','Four','Five'),
                     lat = c(50,55,60,65,70), lng = c(0,5,-5,10,-10)
                     )

ui <- fluidPage(
    # new lines to enable shinyjs and import custom js function
    shinyjs::useShinyjs(),
    shinyjs::extendShinyjs(text = jsCode, functions = c('buttonClick')),

    leaflet::leafletOutput('map'),
    DT::DTOutput('table'),
    shiny::actionButton('buttona',"Button A") # new button
)

server <- function(input, output, session) {
    
    output$map <- leaflet::renderLeaflet({
        leaflet::leaflet(options = leaflet::leafletOptions(minZoom = 3,maxZoom = 10)) %>%
            leaflet::setView(lng = 10,lat = 60,zoom = 3) %>%
            leaflet::addProviderTiles(provider = leaflet::providers$Esri.OceanBasemap) %>%
            leaflet::addMarkers(data = df,
                                layerId = ~id,
                                group = 'group1',
                                label = ~label,
                                lat = ~lat,
                                lng = ~lng,
                                popup = ~paste("<h3>More Information</h3>",
                                               "<b>Title:</b>",label,sep =" "))
    })
    output$table <- DT::renderDT(df,
                                 selection = 'single',
                                 rownames = FALSE,
                                 editable = FALSE
    )

    # observer looking for datatable row selection and triggering js function
    observeEvent(input$table_rows_selected,{
        shinyjs::js$buttonClick()
    })

    # observer looking for button click to trigger modal
    observeEvent(input$buttona,{
        showModal(
            modalDialog(title = "Test",
                        size = 'm',
                        h1("Test")
                        
            )
        )
    })
    
}

# Run the application 
shinyApp(ui = ui, server = server)

我尝试过的事情：

闪亮的js和javascript

我已经能够成功使用shinyjs包通过按钮创建类似的功能（参见上面的示例应用程序），但是当我尝试对标记做同样的事情时，我只是没有js知识来找到正确的元素。通过在 chrome 的 js 控制台中浏览，我可以手动找到它们，但它们位于 iframe 内，我不知道如何以编程方式定位目标，而且该位置中有一个随机字符串，例如jQuery351022343796258432992。 通过 chrome js 控制台使用手动定位（在此之前，我需要使用“元素”选项卡在 iframe 中选择 #document），我可以使用以下几行触发我想要的点击事件：

var mymap = document.getElementsByClassName('leaflet');
var els = mymap.map.jQuery351022343796258432992.leafletMap.layerManager._byGroup.group1;
els[0].fire('click'); //note this is the leaflet.js to trigger a marker click event

闪亮小部件

使用中可能有一些东西shinywidgets::onRender根据本页底部的传单文档https://rstudio.github.io/leaflet/morefeatures.html https://rstudio.github.io/leaflet/morefeatures.html，但我不知道在这种情况下具体如何实现。

再次感谢您的阅读！

使用JS的解决方案

访问 Map 对象后，您需要迭代所有图层以查找具有特定 id 的标记。

我修改了你调用的JS函数shinyjs迭代所有层并触发事件click在与 id 匹配的标记上。为了避免每次都寻找Map对象，渲染后使用Map对象进行检索htmlwidgets::onRender功能。作为替代方案shinyjs， 您可以使用runjs执行该函数（不在下面的代码中）。

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

# create js function that triggers a click on a marker selected by a row in a DT
jsCode <- 'shinyjs.markerClick = function(id) {
              map.eachLayer(function (layer) {
                if (layer.options.layerId == id) {
                  layer.fire("click");
                }
              })
           };'

df <- tibble::tibble(id = c(1,2,3,4,5),
                     label = c('One','Two','Three','Four','Five'),
                     lat = c(50,55,60,65,70), lng = c(0,5,-5,10,-10)
)

ui <- fluidPage(
  # new lines to enable shinyjs and import custom js function
  shinyjs::useShinyjs(),
  shinyjs::extendShinyjs(text = jsCode, functions = c('markerClick')),
  
  leaflet::leafletOutput('map'),
  DT::DTOutput('table'),
  shiny::actionButton('buttona',"Button A") # new button
)

server <- function(input, output, session) {
  
  output$map <- leaflet::renderLeaflet({
    m <- leaflet::leaflet(options = leaflet::leafletOptions(minZoom = 3,maxZoom = 10)) %>%
      leaflet::setView(lng = 10,lat = 60,zoom = 3) %>%
      leaflet::addProviderTiles(provider = leaflet::providers$Esri.OceanBasemap) %>%
      leaflet::addMarkers(data = df,
                          layerId = ~id,
                          group = 'group1',
                          label = ~label,
                          lat = ~lat,
                          lng = ~lng,
                          popup = ~paste("<h3>More Information</h3>",
                                         "<b>Title:</b>",label,sep =" "))
    
    # assign the leaflet object to variable 'map'
    m <- m %>% 
      htmlwidgets::onRender("
          function(el, x) {
            map = this;
          }"
      )                                         
    
  })
  output$table <- DT::renderDT(df,
                               selection = 'single',
                               rownames = FALSE,
                               editable = FALSE
  )
  
  # observer looking for datatable row selection and triggering js function
  observeEvent(input$table_rows_selected,{
    rowIndex <- input$table_rows_selected
    df$id[rowIndex]
    shinyjs::js$markerClick(df$id[rowIndex])
  })
  
  # observer looking for button click to trigger modal
  observeEvent(input$buttona,{
    showModal(
      modalDialog(title = "Test",
                  size = 'm',
                  h1("Test")
                  
      )
    ) 
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

使用Leaflet代理的解决方案

每次用户选择表中的一行时，只需添加一个新的弹出窗口。使用相同的内容很重要layerId自动更新地图上可能已有的弹出窗口。另外，由于弹出窗口将放置在标记上lat and lng，有必要使用调整像素的相对位置offset.

library(shiny)
library(leaflet)

df <- tibble::tibble(id = c(1,2,3,4,5),
                     label = c('One','Two','Three','Four','Five'),
                     lat = c(50,55,60,65,70), lng = c(0,5,-5,10,-10)
)

ui <- fluidPage( 
  leaflet::leafletOutput('map'),
  DT::DTOutput('table')
)

server <- function(input, output, session) {
  
  output$map <- leaflet::renderLeaflet({
    m <- leaflet::leaflet(options = leaflet::leafletOptions(minZoom = 3,maxZoom = 10)) %>%
      leaflet::setView(lng = 10,lat = 60,zoom = 3) %>%
      leaflet::addProviderTiles(provider = leaflet::providers$Esri.OceanBasemap) %>%
      leaflet::addMarkers(data = df,
                          layerId = ~id,
                          group = 'group1',
                          label = ~label,
                          lat = ~lat,
                          lng = ~lng,
                          popup = ~paste("<h3>More Information</h3>",
                                         "<b>Title:</b>",label,sep =" "))
    
  })
  
  output$table <- DT::renderDT(df,
                               selection = 'single',
                               rownames = FALSE,
                               editable = FALSE
  )
  
  # observer looking for datatable row selection and use leaflet proxy to add a popup
  observeEvent(input$table_rows_selected,{
    rowIndex <- input$table_rows_selected
    df$id[rowIndex]
    proxy <- leafletProxy("map")
    addPopups(
      proxy,
      lng = df$lng[rowIndex],
      lat =df$lat[rowIndex],
      popup = paste("<h3>More Information</h3>",
                    "<b>Title:</b>",df$label[rowIndex],sep =" "),
      layerId = "popup",
      options  = popupOptions(offset = list (x = 0, y = -26))
    )
  })
}

shinyApp(ui = ui, server = server)