以编程方式触发 R 传单中的标记鼠标单击事件以获得闪亮
Programatically trigger marker mouse click event in R leaflet for shiny
我的问题与这个问题相同：Trigger marker mouse click event in R leaflet for shiny 但我没有足够的代表来添加评论，编辑队列是 'full' 所以我无法将我的想法添加到原来的问题。不确定这是否违反社区 rules/best 惯例，如果违反请删除！为下面冗长的描述道歉，但我想我可能接近 javascript 或闪亮的大师可以立即修复的解决方案！或者，我完全找错了树。感谢阅读！
当我在我的 R shiny web 应用程序中 select 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)
我尝试过的事情：
shinyjs 和 javascript
我已经能够成功地使用 shinyjs 包通过按钮创建类似的功能（参见上面的示例应用程序），但是当我尝试对标记做同样的事情时，我只是没有 js 知识找到正确的元素。通过在 chrome 的 js 控制台中浏览，我可以手动找到它们，但它们在一个 iframe 中，我不知道如何以编程方式定位，而且该位置有一个随机字符串，例如jQuery351022343796258432992。
通过 chrome js 控制台使用手动定位（在此之前，我需要使用 'Elements' 选项卡来 select 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
闪亮的小部件
根据本页底部的传单文档 https://rstudio.github.io/leaflet/morefeatures.html，使用 shinywidgets::onRender 可能会有一些问题，但我不知道如何在这种情况下实施它。
再次感谢阅读！
使用 JS 的解决方案
访问地图对象后，您需要遍历所有图层以找到具有特定 id 的标记。
我修改了您使用 shinyjs 调用的 JS 函数以遍历所有层并在与 id 匹配的标记上触发事件 click。为避免每次都查找 Map 对象，在渲染后使用 htmlwidgets::onRender 函数检索 Map 对象。作为 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 代理的解决方案
每当用户在 table 中选择一行时，只需添加一个新的弹出窗口。重要的是使用相同的 layerId 来自动更新可能已经在地图上的弹出窗口。此外，由于弹出窗口将放置在标记 lat 和 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)
我的问题与这个问题相同：Trigger marker mouse click event in R leaflet for shiny 但我没有足够的代表来添加评论，编辑队列是 'full' 所以我无法将我的想法添加到原来的问题。不确定这是否违反社区 rules/best 惯例，如果违反请删除！为下面冗长的描述道歉，但我想我可能接近 javascript 或闪亮的大师可以立即修复的解决方案！或者，我完全找错了树。感谢阅读！
当我在我的 R shiny web 应用程序中 select 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)
我尝试过的事情：
shinyjs 和 javascript
我已经能够成功地使用 shinyjs 包通过按钮创建类似的功能（参见上面的示例应用程序），但是当我尝试对标记做同样的事情时，我只是没有 js 知识找到正确的元素。通过在 chrome 的 js 控制台中浏览，我可以手动找到它们，但它们在一个 iframe 中，我不知道如何以编程方式定位，而且该位置有一个随机字符串，例如jQuery351022343796258432992。
通过 chrome js 控制台使用手动定位（在此之前，我需要使用 'Elements' 选项卡来 select 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
闪亮的小部件
根据本页底部的传单文档 https://rstudio.github.io/leaflet/morefeatures.html，使用 shinywidgets::onRender 可能会有一些问题，但我不知道如何在这种情况下实施它。
再次感谢阅读！
使用 JS 的解决方案
访问地图对象后，您需要遍历所有图层以找到具有特定 id 的标记。
我修改了您使用 shinyjs 调用的 JS 函数以遍历所有层并在与 id 匹配的标记上触发事件 click。为避免每次都查找 Map 对象，在渲染后使用 htmlwidgets::onRender 函数检索 Map 对象。作为 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 代理的解决方案
每当用户在 table 中选择一行时，只需添加一个新的弹出窗口。重要的是使用相同的 layerId 来自动更新可能已经在地图上的弹出窗口。此外，由于弹出窗口将放置在标记 lat 和 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)