How to add a downloadButton in a popup?

Question

I'm currently developing an R Shiny application where I'm mapping services providers on a map and when I click on a specific marker I have a popup with additional information and I would like to include a downloadButton in that popup. Unfortunately when I'm calling the downloadHandler it doesn't work and I'm downloading a html file called qwe_download.html. But if I put the downloadButton outside the popup (i.e. in the ui) then it works. Is it possible to use a downloadButton inside a leaflet popup?

I can't share the original code as it is quite sensitive but you can find below what I'm trying to achieve.

library('leaflet')
library('shinydashboard')



id <- c(1, 2, 3)
lat <- c(10.01, 10.6, 10.3)
long <- c(0.2, 0.3, 0.4)
name <- c('test1', ' test2', 'test3')
test <- data_frame(id, lat, long, name)


#User interface

header <- dashboardHeader(title = 'Title', titleWidth = 900)

sidebar <- dashboardSidebar(
  width = 300)

body <- dashboardBody(
  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
  leafletOutput("map")
)

ui <- dashboardPage(header, sidebar, body)



server <- function(input, output, session) {
  
  data <- reactiveValues(clickedMarker=NULL)  
  
  output$map <- renderLeaflet({
    
    mymap <- leaflet() %>%
      addTiles() %>%
      addMarkers(data = test, lng = long, lat = lat, layerId = id,
                 popup = paste0(
                   "<div>",
                   "<h3>",
                   "Name:&nbsp;",
                   test$name,
                   downloadButton(outputId = "dlData",label =  "Download Details"),
                   "</div>"))
    
    observeEvent(input$map_marker_click,{
      print("observed map_marker_click")
      data$clickedMarker <- input$map_marker_click
      print(data$clickedMarker)
      x <- filter(test, id == data$clickedMarker$id)
      view(x)})
    
    data_react <- reactive({
      data_table <- filter(test, test$id == data$clickedMarker$id)
    })
    
    
    
    
    output$dlData <- downloadHandler(
      filename = "dataset.csv",
      content = function(file) {
        write.csv(data_react(), file)
      }
    )
    
   
    
    mymap
  })
  
}


# Run app ----
shinyApp(ui, server)

Note that the observeEvent block was just there for me to check if my code was filtering the right selection.

Hope this makes sense.

Thanks!

ismirsehregal · Answer 1 · 2021-10-07T08:59:08.477

You need to bind the downloadButtons yourself after placing them in the popup.

Please see this related answer from Joe Cheng.

Here you can find some great answers on how to bindAll custom inputs in a leaflet popup.

And this is how to apply those answers regarding your particular requirements:

library('leaflet')
library('shinydashboard')

id <- c(1, 2, 3)
lat <- c(10.01, 10.6, 10.3)
long <- c(0.2, 0.3, 0.4)
name <- c('test1', ' test2', 'test3')
test <- data.frame(id, lat, long, name)

header <- dashboardHeader(title = 'Title', titleWidth = 900)

sidebar <- dashboardSidebar(width = 300)

body <- dashboardBody(
  tags$div(id = "garbage"),
  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
  leafletOutput("map")
)

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output, session) {
  data <- reactiveValues(clickedMarker = NULL)
  
  output$map <- renderLeaflet({
    mymap <- leaflet() %>%
      addTiles() %>%
      addMarkers(
        data = test,
        lng = long,
        lat = lat,
        layerId = id,
        popup = sprintf(
          paste0(
            "<div>",
            "<h3>",
            "Name:&nbsp;",
            test$name,
            br(),
            downloadButton(outputId = "dlData%s", label =  "Download Details"),
            "</div>"
          ),
          id
        )
      ) %>% 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);
            }'
      )
  })
  
  observeEvent(input$map_marker_click,{
    print("observed map_marker_click")
    data$clickedMarker <- input$map_marker_click
    print(data$clickedMarker)
    x <- filter(test, id == data$clickedMarker$id)
    })
  
  data_react <- reactive({
    data_table <- filter(test, test$id == data$clickedMarker$id)
  })
  
  lapply(id, function(i) {
    output[[paste0("dlData", i)]] <- downloadHandler(
      filename = "dataset.csv",
      content = function(file) {
        write.csv(data_react(), file)
      }
    )
  })
  
}

shinyApp(ui, server)

Many thanks for your answer. It worked perfectly. I just would like to understand why it worked and what we're doing especially in the `htmlwidgets::onRender` and why we created a garbage `div`. — Nusta, Oct 07 '21 at 18:03
The `onRender` / `bindAll` part is described in the answers I linked (quite detailed). The only difference regarding your question was the need to provide a `downloadHandler` for each button. — ismirsehregal, Oct 07 '21 at 18:23

Stéphane Laurent · Answer 2 · 2021-10-08T11:37:14.450

2

The download button is not binded to Shiny. You can use the pointerenter event to run Shiny.bindAll() and the pointerleave event to run Shiny.unbindAll():

library('leaflet')
library('shinydashboard')
library(shiny)
library(dplyr)

id <- c(1, 2, 3)
lat <- c(10.01, 10.6, 10.3)
long <- c(0.2, 0.3, 0.4)
name <- c('test1', ' test2', 'test3')
test <- tibble(id, lat, long, name)

js <- "$('body').on('pointerenter', '#dlData', function(){Shiny.bindAll('#dwnld');}).on('pointerleave', '#dlData', function(){Shiny.unbindAll('#dwnld');})"

header <- dashboardHeader(title = 'Title', titleWidth = 900)

sidebar <- dashboardSidebar(
  width = 300)

body <- dashboardBody(
  useShinyjs(),
  tags$script(HTML(js)),
  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
  leafletOutput("map")
)

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output, session) {
  
  data <- reactiveValues(clickedMarker=NULL)  
  
  
  output$map <- renderLeaflet({
    
    mymap <- leaflet() %>%
      addTiles() %>%
      addMarkers(
        data = test, lng = long, lat = lat, layerId = id,
        popup = paste0(
          "<div id='dwnld'>",
          "<h3>",
          "Name:&nbsp;",
          test$name,
          "</h3>",
          downloadButton(
            outputId = "dlData", label = "Download Details"
          ),
          "</div>")) 
    mymap
  })
  
  observeEvent(input$map_marker_click,{
    data$clickedMarker <- input$map_marker_click
  })
  
  data_react <- reactive({
    filter(test, id == data$clickedMarker$id)
  })
  
  output$dlData <- downloadHandler(
    "dataset.csv",
    content = function(file) {
      write.csv(data_react(), file)
    })

}

# Run app ----
shinyApp(ui, server)

edited Oct 08 '21 at 11:37

answered Oct 07 '21 at 08:17

Stéphane Laurent

75,186
15
119
225

Hi Stéphane, this is far more readable than @K.Rohde's approach, however, it throws JS errors in the console `Uncaught Duplicate binding for ID dlData` due to the missing unbind as mentioned [here](https://stackoverflow.com/a/36418876/9841389). – ismirsehregal Oct 07 '21 at 08:53
By creating 3 downloadButtons, do you mean one per data point? So if my original dataset has 450 data points how would I need to approach this? – Nusta Oct 07 '21 at 17:35
@Nusta in my answer there is a downloadButton and a downloadHandler for each datapoint - see the `lapply` call. – ismirsehregal Oct 07 '21 at 18:34
@Nusta I've just modified my answer. I put the `unbind` in the download handler. This works. There's no need of multiple download handlers. – Stéphane Laurent Oct 07 '21 at 22:00
@StéphaneLaurent this way only one of the three buttons works - always the first button clicked (In the end I'm also only copying the same downloadHandler to the correct output). – ismirsehregal Oct 08 '21 at 07:00
@ismirsehregal Which three buttons? I tested it yesterday for several cities and it worked. – Stéphane Laurent Oct 08 '21 at 07:23
If you don't mind I'll edit and share a gif - feel free to remove it. – ismirsehregal Oct 08 '21 at 07:25
1

@ismirsehregal Thanks. I'm surprised since it worked yesterday. Gonna check again. – Stéphane Laurent Oct 08 '21 at 07:32
@ismirsehregal Ah yes, it works only if you don't go directly from a city to another one. – Stéphane Laurent Oct 08 '21 at 07:43
That makes sense - then there are no duplicated buttons. – ismirsehregal Oct 08 '21 at 07:48
Another point which might be not ideal, is the fact that `unbindAll` won't get called if the user opens the popup but doesn't click on the downloadButton. – ismirsehregal Oct 08 '21 at 08:01
@ismirsehregal Please see my answer. I totally changed the method. – Stéphane Laurent Oct 08 '21 at 11:37
Thats running fine - a good alternative! – ismirsehregal Oct 08 '21 at 11:41

score 1 · Answer 3 · answered Oct 08 '21 at 12:07

To add a summarizing answer, what we need to do:

Call Shiny.[un]bindAll in the "right" moment.
The "right" moment is apparently once the popup is added / removed from the DOM.
Non working downloads can happen as a result of re-using the same id (unfortunately I could not identify a pattern and I thought that unbinding helps, but it does not). Thus, to play it safe creating unique download handlers should avoid this behaviour.

Having said that, the IMHO cleanest option to call Shiny.bindAll() is in response to the popupopen event:

output$map <- renderLeaflet({
      
      mymap <- leaflet() %>%
         addTiles() %>%
         addMarkers(
            data = test, lng = long, lat = lat, layerId = id,
            popup = paste0(
               "<div id='dwnld'>",
               "<h3>",
               "Name:&nbsp;",
               test$name,
               downloadButton(outputId = "dlData",label = "Download Details"),
               "</div>")) 
      mymap %>% htmlwidgets::onRender(HTML("
         function(el, x) {
            this.on('popupopen', function() {
               Shiny.bindAll('#dwnld');
            });
            this.on('popupclose', function() {
               Shiny.unbindAll('#dwnld');
            });
         }"))
   })

How to add a downloadButton in a popup?

3 Answers3