r - How to display (advanced) customed popups for leaflet in Shiny?

Question

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.

You can see what I can do in the project I created for this post on github, or directly in shinyapp.io here

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?

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!

Regards

Answer 1

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:

• Insert the popup UI element as character inside the leaflet standard popup field. As character means, it is no shiny.tag, but merely a normal div. E.g. the classic uiOutput("myID") becomes <div id="myID" class="shiny-html-output"><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.)

• 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.)

• 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
)

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.

Solving this has been a tough job, but I think it was worth the time, now that Leaflet maps got some extra utility. Have fun with this fix and please ask, if there are any questions about it!