How to add a downloadButton in a popup? - r

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: ",
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!

Answer 1

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: ",
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)

Answer 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: ",
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)

Answer 3

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: ",
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');
});
}"))
})