如何使用 downloadHandler 在闪亮的数据表中创建下载按钮？

Question

我在闪亮的数据表的每一行中创建了下载按钮，如here 所示。该表位于闪亮模块之一内。我想知道在为任何下载按钮使用downloadHandler 时应该将哪个 id 附加到输出？我在下面的代码中显示了 XXXXXXXXXXXX 的可疑值。

library(shiny)
library(DT)
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable


## module UI
test_data_table_ui  <- function(id){
  ns <- NS(id)
  tagList(
    DT::dataTableOutput(outputId = ns("my_data_table"))
  )

}

## module server
test_data_table_server <- function(input, output, session ){
  ns = session$ns

  myValue <- reactiveValues(check = '')

  shinyInput <- function(FUN, len, id, ns, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(ns(id), i), ...))
    }
    inputs
  }


  my_data_table <- reactive({
    tibble::tibble(
      Name = c('Dilbert', 'Alice', 'Wally', 'Ashok', 'Dogbert'),
      Motivation = c(62, 73, 3, 99, 52),
      Actions = shinyInput(downloadButton, 
                           5,
                           'button_',
                           ns = ns,
                           label = "Download",
                           onclick = sprintf("Shiny.setInputValue('%s', this.id)",ns("select_button"))
      )
    )
  })



  # output$XXXXXXXXXXXX <- downloadHandler(
  #   filename = function() {
  #     paste('data-', Sys.Date(), '.txt', sep='')
  #   },
  #   content = function(file) {
  #     readr::write_delim(x = mpg, path = file, delim = "\t")
  #   }
  # )


  observeEvent(input$select_button, {
    print(input$select_button)
  })


  output$my_data_table <- DT::renderDataTable({
    return(my_data_table())
  }, escape = FALSE)



}


ui <- fluidPage(
  test_data_table_ui(id = "test_dt_inside_module")
)

server <- function(input, output, session) {
  callModule(module = test_data_table_server , id = "test_dt_inside_module")
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:3059

^{由reprex package (v0.3.0) 于 2019 年 9 月 17 日创建}

Answer 1

它是这样工作的：

library(shiny)
library(DT)

## module UI
test_data_table_ui  <- function(id){
  ns <- NS(id)
  tagList(
    DT::dataTableOutput(outputId = ns("my_data_table"))
  )
}

## module server
test_data_table_server <- function(input, output, session ){
  ns = session$ns

  myValue <- reactiveValues(check = '')

  shinyInput <- function(FUN, len, id, ns, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(ns(id), i), ...))
    }
    inputs
  }


  my_data_table <- reactive({
    tibble::tibble(
      Name = c('Dilbert', 'Alice', 'Wally', 'Ashok', 'Dogbert'),
      Motivation = c(62, 73, 3, 99, 52),
      Actions = shinyInput(downloadButton, 
                           5,
                           'button_',
                           ns = ns,
                           label = "Download",
                           onclick = sprintf("Shiny.setInputValue('%s', this.id)",ns("select_button"))
      )
    )
  })


  lapply(1:5, function(i){
    output[[paste0("button_",i)]] <- downloadHandler(
      filename = function() {
        paste('data-', Sys.Date(), '.txt', sep='')
      },
      content = function(file) {
        readr::write_delim(x = iris, path = file, delim = "\t")
      }
    )
  })

  observeEvent(input$select_button, {
    print(input$select_button)
  })


  output$my_data_table <- DT::renderDataTable({
    datatable(my_data_table(), escape = FALSE, 
              options = 
                list(
                  preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                  drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
                )
    )
  })
}

ui <- fluidPage(
  test_data_table_ui(id = "test_dt_inside_module")
)

server <- function(input, output, session) {
  callModule(module = test_data_table_server , id = "test_dt_inside_module")
}

shinyApp(ui, server)