如何在 Shiny 中为传单显示(高级)自定义弹出窗口? [英] How to display (advanced) customed popups for leaflet in Shiny?
问题描述
我正在使用 R shiny 构建 Web 应用程序，其中一些正在利用出色的传单功能.
I am using R shiny to build web applications, and some of them are leveraging the great leaflet features.
我想创建一个自定义和高级弹出窗口，但我不知道如何进行.
I would like to create a customed and advanced popup, but I do not know how to proceed.
您可以在 github 上为这篇文章创建的项目中查看我可以做什么，或直接在 shinyapp.io 这里
You can see what I can do in the project I created for this post on github, or directly in shinyapp.io here
弹出窗口越复杂，我的代码就越奇怪，因为我正在以一种奇怪的方式组合 R 和 html(请参阅我在 server.R)..
The more complex the popup is, the weirdest my code is, as I am sort of combining R and html in a strange way (see the way I define my custompopup'i' in server.R)..
有更好的方法吗?构建此类弹出窗口的良好做法是什么?如果我计划根据单击的标记显示图表，我应该提前构建它们，还是可以即时"构建它们?我该怎么做?
Is there a better way to proceed? What are the good practices to build such popups? If I plan to display a chart depending on the marker being clicked, should I build them all in advance, or is that possible to build them 'on the fly'? How can I do that?
非常感谢您对此的看法，请不要犹豫在这里分享您的答案或直接更改我的 github 示例！
Many thanks in advance for your views on this, please do not hesitate to share your answer here or to directly change my github examples!
问候
推荐答案
我猜这篇文章还是有一定意义的.所以这是我关于如何将几乎所有可能的界面输出添加到传单弹出窗口的解决方案.
I guess this post still has some relevance. So here is my solution on how to add almost any possible interface output to leaflet popups.
我们可以通过以下步骤来实现:
We can achieve this doing the following steps:
在传单标准弹出字段中插入弹出 UI 元素作为字符.作为字符的意思，它不是
shiny.tag，而只是一个普通的div.例如.经典的uiOutput("myID")变成<div id="myID" class="shiny-html-output"><div>.
Insert the popup UI element as character inside the leaflet standard popup field. As character means, it is no
shiny.tag, but merely a normaldiv. E.g. the classicuiOutput("myID")becomes<div id="myID" class="shiny-html-output"><div>.
弹出窗口被插入到一个特殊的 div，leaflet-popup-pane.我们添加一个 EventListener 来监控其内容是否发生变化.(注意:如果弹窗消失，则意味着这个div的所有子元素都被移除了，所以这不是可见性的问题，而是存在的问题.)
Popups are inserted to a special div, the leaflet-popup-pane. We add an EventListener to monitor if its content changes. (Note: If the popup disappears, that means all children of this div are removed, so this is no question of visibility, but of existence.)
当一个孩子被附加，即出现一个弹出窗口时，我们将所有闪亮的输入/输出绑定到弹出窗口中.因此，毫无生气的 uiOutput 充满了应有的内容.(人们希望 Shiny 自动执行此操作，但它无法注册此输出，因为它是由 Leaflets 后端填充的.)
When a child is appended, i.e. a popup is appearing, we bind all shiny inputs/outputs inside the popup. Thus, the lifeless uiOutput is filled with content like it's supposed to be. (One would've hoped that Shiny does this automatically, but it fails to register this output, since it is filled in by Leaflets backend.)
当弹出窗口被删除时，Shiny 也无法解除绑定它.如果您再次打开弹出窗口并引发异常(重复 ID)，那就有问题了.一旦从文档中删除，就不能再解除绑定.所以我们基本上将删除的元素克隆到一个处置-div，在那里它可以被正确地解除绑定，然后将其永久删除.
When the popup is deleted, Shiny also fails to unbind it. Thats problematic, if you open the popup once again, and throws an exception (duplicate ID). Once it is deleted from the document, it cannot be unbound anymore. So we basically clone the deleted element to a disposal-div where it can be unbound properly and then delete it for good.
我创建了一个示例应用程序，(我认为)展示了此解决方法的全部功能，我希望它的设计足够简单，任何人都可以适应它.这个应用程序大部分是为了展示，所以请原谅它有不相关的部分.
I created a sample app that (I think) shows the full capabilities of this workaround and I hope it is designed easy enough, that anyone can adapt it. Most of this app is for show, so please forgive that it has irrelevant parts.
library(leaflet)
library(shiny)
runApp(
shinyApp(
ui = shinyUI(
fluidPage(
# Copy this part here for the Script and disposal-div
uiOutput("script"),
tags$div(id = "garbage"),
# End of copy.
leafletOutput("map"),
verbatimTextOutput("Showcase")
)
),
server = function(input, output, session){
# Just for Show
text <- NULL
makeReactiveBinding("text")
output$Showcase <- renderText({text})
output$popup1 <- renderUI({
actionButton("Go1", "Go1")
})
observeEvent(input$Go1, {
text <<- paste0(text, "
", "Button 1 is fully reactive.")
})
output$popup2 <- renderUI({
actionButton("Go2", "Go2")
})
observeEvent(input$Go2, {
text <<- paste0(text, "
", "Button 2 is fully reactive.")
})
output$popup3 <- renderUI({
actionButton("Go3", "Go3")
})
observeEvent(input$Go3, {
text <<- paste0(text, "
", "Button 3 is fully reactive.")
})
# End: Just for show
# Copy this part.
output$script <- renderUI({
tags$script(HTML('
var target = document.querySelector(".leaflet-popup-pane");
var observer = new MutationObserver(function(mutations) {
mutations.forEach(function(mutation) {
if(mutation.addedNodes.length > 0){
Shiny.bindAll(".leaflet-popup-content");
};
if(mutation.removedNodes.length > 0){
var popupNode = mutation.removedNodes[0].childNodes[1].childNodes[0].childNodes[0];
var garbageCan = document.getElementById("garbage");
garbageCan.appendChild(popupNode);
Shiny.unbindAll("#garbage");
garbageCan.innerHTML = "";
};
});
});
var config = {childList: true};
observer.observe(target, config);
'))
})
# End Copy
# Function is just to lighten code. But here you can see how to insert the popup.
popupMaker <- function(id){
as.character(uiOutput(id))
}
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addMarkers(lat = c(10, 20, 30), lng = c(10, 20, 30), popup = lapply(paste0("popup", 1:3), popupMaker))
})
}
), launch.browser = TRUE
)
注意:可能有人会想，为什么要从服务器端添加脚本.我遇到了，否则，添加 EventListener 会失败，因为 Leaflet 映射尚未初始化.我打赌有一些 jQuery 知识没有必要做这个技巧.
Note: One might wonder, why the Script is added from the server side. I encountered, that otherwise, adding the EventListener fails, because the Leaflet map is not initialized yet. I bet with some jQuery knowledge there is no need to do this trick.
解决这个问题是一项艰巨的工作，但我认为值得花时间，因为 Leaflet 地图有了一些额外的实用性.玩得开心，如果有任何问题，请询问！
这篇关于如何在 Shiny 中为传单显示(高级)自定义弹出窗口?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
