Shiny模块中实现DT外置多格式下载按钮（禁用server=FALSE）

• 需求：在Shiny应用中为用户提供CSV、Excel、PDF三种格式的完整数据下载选项，希望做成包含3个按钮的下载控件。
• 限制：数据量过大，无法使用server = FALSE参数。
• 问题：参考相关实现尝试复现，但因使用Shiny模块写法导致失败，JS部分未成功关联下载功能，仅能下载CSV，且自定义的下载按钮标签不显示。

测试代码 #

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(datamods)


module1_ui <- function(id) {
  ns <- NS(id)
  
  tabPanel(
    title = "tab title",
    
    fluidRow(
      column(width = 3, 
             filter_data_ui(ns("filtering"))),
      column(width = 9, 
             downloadButton(ns("download1"), ""), # 无标签：该按钮将被隐藏
             DT::DTOutput(outputId = ns("table"))
             )
      )
    )
}

module1_server <- function(id, r_global) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    row_filter_vars <- reactive({
      list(
        Sepal.Length = "Sepal.Length",
        Sepal.Width = "Sepal.Width",
        Petal.Length = "Petal.Length",
        Petal.Width = "Petal.Width",
        Species = "Species"
      )
    })
    
    data <- reactive({
      iris
    })
    
    res_filter <- filter_data_server(id = "filtering",
                                     data = data,
                                     vars = row_filter_vars)
    
    observeEvent(res_filter$filtered(), {
      updateProgressBar(
        session = session,
        id = "pbar",
        value = nrow(res_filter$filtered()),
        total = nrow(data())
      )
    })
    
    
    callback <- JS(
      "var a = document.createElement('a');",
      "$(a).addClass('dt-button');",
      "a.href = document.getElementById('download1').href;",
      "a.download = '';",
      "$(a).attr('target', '_blank');",
      "$(a).text('Download');",
      "$('div.dwnld').append(a);",
      "$('#download1').hide();"
    )
    
    output$table <- renderDT(
      datatable(
        data = res_filter$filtered(),
        callback = callback,
        extensions = 'Buttons',
        options = list(dom = 'B<"dwnld">frtip',
                       buttons = list())
      )
    )

   output$download1 <- downloadHandler(
      filename = function() {
        paste("data-", Sys.Date(), ".csv", sep="")
      },
      content = function(file) {
        write.csv(iris, file)
      }
    )
  })
}



#________________________________________________________________
#                          主 UI                           ----
#________________________________________________________________
app_ui <- function(request) {
  tagList(navbarPage(id = "main_menu", "My app",
                     module1_ui("mod1")))
}

#________________________________________________________________
#                        主 SERVER                         ----
#________________________________________________________________
app_server <- function(input, output, session) {
  r_global <- reactiveValues(data = NULL)
  
  module1_server(id = "mod1", r_global = r_global)
}


shinyApp(ui = app_ui, server = app_server)

补充尝试的回调代码 #

callback <- JS(
      "var a = document.createElement('a');",
      "$(a).addClass('dt-button');",
      sprintf("a.href = document.getElementById$('%s').href", ns("download1")),
      "a.download = '';",
      "$(a).attr('target', '_blank');",
      "$(a).text('DOWNLOAD');",
      "$('div.dwnld').append(a);",
      sprintf("$('#%s').hide();", ns("download1"))
    )

内容的提问来源于stack exchange，提问作者nimliug