如何在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 中定义custompopup'i'的方式) >)..
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(小叶弹出窗口)中.我们添加一个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, "\n", "Button 1 is fully reactive.")
})
output$popup2 <- renderUI({
actionButton("Go2", "Go2")
})
observeEvent(input$Go2, {
text <<- paste0(text, "\n", "Button 2 is fully reactive.")
})
output$popup3 <- renderUI({
actionButton("Go3", "Go3")
})
observeEvent(input$Go3, {
text <<- paste0(text, "\n", "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屋！
