Question

我正在使用 R shiny 来构建Web应用程序，其中一些正在利用优秀的传单功能。

我想创建一个自定义和高级弹出窗口，但我不知道如何继续。

您可以在 github 或直接在 shinyapp.io here 中查看我为此帖子创建的项目中可以执行的操作

弹出窗口越复杂，我的代码就越奇怪，因为我有点以一种奇怪的方式组合R和html（参见我在 server.R ）..

还有更好的方法吗？构建此类弹出窗口有哪些好方法？如果我打算根据点击的标记显示图表，我应该提前构建它们，还是可以“动态”构建它们？ 我该怎么做？

非常感谢您对此的看法，请在此处分享您的答案或直接更改我的github示例！

此致

Answer 1

我想这篇文章仍有一些相关性。所以这是我的解决方案如何将几乎任何可能的接口输出添加到传单弹出窗口。

我们可以通过以下步骤实现这一目标：

在宣传单标准弹出字段中插入弹出UI元素作为字符。正如字符的意思，它不是shiny.tag，而只是一个普通的div。例如。经典uiOutput("myID")变为<div id="myID" class="shiny-html-output"><div>。
将弹出窗口插入特殊div，宣传单 - 弹出式窗格。我们添加一个EventListener来监视其内容是否发生了变化。（注意：如果弹出窗口消失，则表示此div的所有子项都已删除，因此这不是可见性问题，而是存在问题。）
当一个孩子追加，即出现一个弹出窗口时，我们绑定弹出窗口内的所有闪亮输入/输出。因此，没有生命的uiOutput充满了它应该是的内容。（人们希望Shiny能够自动执行此操作，但它无法注册此输出，因为它由Leaflets后端填充。）
当弹出删除时，Shiny也无法取消绑定。这有问题，如果你再次打开弹出窗口，并抛出异常（重复ID）。从文档中删除后，它就不能再被绑定了。所以我们基本上将已删除的元素克隆到处置 - div，它可以正确地解除绑定，然后将其删除。

我创建了一个示例应用程序（我认为）显示了此变通办法的全部功能，我希望它设计得足够简单，任何人都可以适应它。这个应用程序的大部分是为show，所以请原谅它有无关的部分。

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知识，没有必要这样做。

解决这个问题是一项艰巨的任务，但我认为值得花时间，现在Leaflet地图有了额外的实用性。如果对此有任何疑问，请与我们讨论这个问题！

Answer 2

罗德（K. Rohde）的回答很棒，还应该使用@krlmlr提到的修改内容。

我想对K. Rohde提供的代码进行两个小改进（仍然要感谢K. Rohde提出困难的东西！）。这是代码，更改说明如下：

library(leaflet)
library(shiny)

ui <- fluidPage(
  tags$div(id = "garbage"),  # Copy this disposal-div
  leafletOutput("map"),
  div(id = "Showcase")
)

server <- function(input, output, session) {

  # --- Just for Show ---

  output$popup1 <- renderUI({
    actionButton("Go1", "Go1")
  })

  observeEvent(input$Go1, {
    insertUI("#Showcase", where = "beforeEnd",
             div("Button 1 is fully reactive."))
  })

  output$popup2 <- renderUI({
    actionButton("Go2", "Go2")
  })

  observeEvent(input$Go2, {
    insertUI("#Showcase", where = "beforeEnd", div("Button 2 is fully reactive."))
  })

  output$popup3 <- renderUI({
    actionButton("Go3", "Go3")
  })

  observeEvent(input$Go3, {
    insertUI("#Showcase", where = "beforeEnd", div("Button 3 is fully reactive."))
  })

  # --- End: Just for show ---

  # popupMaker 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({
    input$aaa
    leaflet() %>%
      addTiles() %>%
      addMarkers(lat = c(10, 20, 30),
                 lng = c(10, 20, 30),
                 popup = lapply(paste0("popup", 1:3), popupMaker)) %>%

      # Copy this part - it initializes the popups after the map is initialized
      htmlwidgets::onRender(
'function(el, x) {
  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];

        var garbageCan = document.getElementById("garbage");
        garbageCan.appendChild(popupNode);

        Shiny.unbindAll("#garbage");
        garbageCan.innerHTML = "";
      }
    }); 
  });

  var config = {childList: true};

  observer.observe(target, config);
}')
  })
}

shinyApp(ui, server)

两个主要更改：

仅当应用程序首次启动时初始化了传单地图时，原始代码才有效。但是，如果稍后对传单地图进行初始化，或者在初始不可见的选项卡中进行初始化，或者如果地图是动态创建的（例如，因为它使用了一些反应性值），则弹出窗口代码将无法工作。为了解决这个问题，需要在传单地图上调用的htmlwidgets:onRender()中运行javasript代码，如上面的代码所示。
这与传单无关，而是更多的通用常规做法：我一般不会使用makeReactiveBinding() + <<-。在这种情况下，它的用法正确，但是人们很容易滥用<<-而又不了解它的作用，因此我宁愿远离它。可以使用text <- reactiveVal()来代替它，这是一个简单的替代方法，我认为这是一个更好的方法。但是比在这种情况下更好的是，不使用反应性变量，而是像上面我一样使用insertUI()更简单。

如何在Shiny中显示（高级）传单的自定义弹出窗口？

2 个答案: