r - 如何在弹出窗口中添加下载按钮？

Question

我目前正在开发一个 R Shiny 应用程序，我在 map 上绘制服务提供商的 map ，当我单击特定标记时，我会弹出一个包含附加信息的窗口，我想在该弹出窗口中包含一个 downloadButton。不幸的是，当我调用 downloadHandler 时它不起作用，我正在下载一个名为 qwe_download.html 的 html 文件。但是，如果我将 downloadButton 放在弹出窗口之外(即在 ui 中)，那么它就可以工作。是否可以在传单弹出窗口中使用下载按钮？

我不能分享原始代码，因为它非常敏感，但您可以在下面找到我正在努力实现的目标。

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)

请注意，observeEvent block 只是让我检查我的代码是否过滤了正确的选择。

希望这是有道理的。

谢谢!

Answer 1

将下载按钮放入弹出窗口后，您需要自己绑定(bind)它们。

请参阅this Joe Cheng 的相关回答。

Here您可以找到一些关于如何在传单弹出窗口中 bindAll 自定义输入的很好的答案。

这就是如何根据您的特定要求应用这些答案:

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)