Как отображать (расширенные) настраиваемые всплывающие окна для листовки в Shiny?

Ответ 1

Я думаю, этот пост все еще имеет некоторое значение. Итак, вот мое решение на , как добавить практически любой возможный вывод интерфейса в всплывающие окна листовок.

Мы можем добиться этого, выполнив следующие шаги:

• Вставьте всплывающий элемент пользовательского интерфейса в качестве символа внутри всплывающего окна стандартного листа. Как символ означает, что это не shiny.tag, а просто нормальный div. Например. классический uiOutput("myID") становится <div id="myID" class="shiny-html-output"><div>.

• Всплывающие окна вставляются в специальную div, панель всплывающих окон. Мы добавляем EventListener для отслеживания изменений его содержимого. ( Примечание: Если всплывающее окно исчезает, это означает, что все дочерние элементы этого div удалены, поэтому это не вопрос видимости, а существования.)

• Когда дочерний элемент добавлен, то есть появляется всплывающее окно, мы связываем все блестящие входы/выходы внутри всплывающего окна. Таким образом, безжизненный uiOutput заполняется содержимым, каким оно должно быть. (Можно было бы надеяться, что Shiny сделает это автоматически, но он не сможет зарегистрировать этот вывод, так как он заполнен бэкэндом Leaflets.)

• Когда всплывающее окно удалено, Shiny также не может отключить. Это проблематично, если вы снова откроете всплывающее окно и выбрасываете исключение (дублирующийся идентификатор). Как только он удаляется из документа, он больше не может быть отсоединен. Таким образом, мы в основном клонируем удаленный элемент в распоряжение - div, где он может быть правильно отсоединен, а затем удалять его навсегда.

Я создал пример приложения, которое (я думаю) показывает полные возможности этого обходного пути, и я надеюсь, что он разработан достаточно просто, чтобы любой мог его адаптировать. Большая часть этого приложения предназначена для шоу, поэтому, пожалуйста, простите, что у него есть нерелевантные части.

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
)

Примечание.. Интересно, почему Script добавляется со стороны сервера. Я столкнулся с тем, что в противном случае добавление EventListener не удастся, поскольку карта Leaflet еще не инициализирована. Бьюсь об заклад, с некоторыми знаниями jQuery нет необходимости делать этот трюк.

Решение этой проблемы было трудным делом, но я думаю, что это стоило времени, теперь, когда карты Leaflet получили дополнительную полезность. Получайте удовольствие от этого исправления и, пожалуйста, спросите, есть ли какие-либо вопросы об этом!

Ответ 2

Ответ от К.Рохде великолепен, и упоминание @krlmlr также следует использовать.

Я хотел бы предложить два небольших улучшения по сравнению с кодом, который предоставил К. Роде (полная заслуга в том, что К. Роде придумал сложный материал!). Вот код, и объяснение изменений придет после:

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)

Два основных изменения:

1. Исходный код будет работать только в том случае, если карта листовок инициализируется при первом запуске приложения. Но если карта листовок инициализируется позже, или внутри вкладки, которая изначально не видна, или если карта создается динамически (например, потому что она использует какое-то реактивное значение), тогда код всплывающих окон работать не будет. Чтобы это исправить, код javasript должен быть запущен в htmlwidgets:onRender() который htmlwidgets:onRender() на листовой карте, как вы можете видеть из кода выше.

2. makeReactiveBinding() не в листовке, а скорее в общей хорошей практике: я бы не использовал makeReactiveBinding() + <<- как правило. В этом случае он используется правильно, но людям легко злоупотреблять <<- не понимая, что он делает, поэтому я предпочитаю держаться от него подальше. Легкой заменой для этого может быть использование text <- reactiveVal(), что, на мой взгляд, будет лучшим подходом. Но даже лучше, чем в этом случае, вместо того, чтобы использовать реактивную переменную, проще просто использовать insertUI() как я делал выше.