R Shiny - DataTable中的动态下载链接

Question

我是一名有用的助手，可以为您进行翻译。以下是您需要翻译的内容：

我想在闪亮的数据表中的每一行中添加一个下载链接。

目前我已经完成了：

server <- function(input, output) {

  v<-eventReactive(input$button,{
    temp<-data.frame(TBL.name=paste("Data ",1:10))
    temp<-cbind(
      temp,
      #Dynamically create the download and action links
      Attachments=sapply(seq(nrow(temp)),function(i){as.character(downloadLink(paste0("downloadData_",i),label = "Download Attachments"))})
    )
  })

  # Table of selected dataset ----
  output$table <- renderDataTable({
    v()
  }, escape = F)}

ui <- fluidPage(
  sidebarPanel(
    actionButton("button", "eventReactive")
  ),
  mainPanel(
    dataTableOutput("table")
  )
)

我在每一行的表格中都有下载链接。现在我想为每一行添加一个不同的文件位置。例如，每个下载链接将导致下载不同的zip文件夹。我可以使用downloadHandler吗？

- Jensxy

---

你有没有解决这个问题的运气？问题在于每一行都必须声明为一个输出，例如output$downloadData_1，output$downloadData_2等。有没有什么方法可以将此参数化？ - dk.

不，我没有解决这个问题。我认为没有办法将其参数化。 - Jensxy

Answer 1

我不认为您可以直接在数据表中嵌入下载按钮/下载链接。但是，您可以创建隐藏的下载链接，通过表格中嵌入的链接来触发它们，从而实现相同的结果。要这样做，您必须：

• 动态生成下载链接/下载按钮。
• 使用 CSS 将它们的可见性设置为隐藏。
• 在表格中嵌入普通链接/按钮。
• 将这些链接的 onClick 字段设置为触发相应的隐藏下载链接。

下面是一个使用 mtcars 数据集的示例代码：

library(tidyverse)
library(shiny)

ui <- fluidPage(
  tags$head(
    tags$style(HTML("

                    .hiddenLink {
                      visibility: hidden;
                    }

                    "))
    ),
  dataTableOutput("cars_table"),
  uiOutput("hidden_downloads")
)

server <- function(input, output, session) {

  data <- mtcars

  lapply(1:nrow(data), function(i) {
    output[[paste0("downloadData", i)]] <- downloadHandler(
       filename = function() {
         paste("data-", i, ".csv", sep="")
       },
       content = function(file) {
         write.csv(data, file)
       }
    )
  })

  output$hidden_downloads <- renderUI(
    lapply(1:nrow(data), function(i) {
      downloadLink(paste0("downloadData", i), "download", class = "hiddenLink")
    }
    )
  )


  output$cars_table <- renderDataTable({


    data %>%
      mutate(link = lapply(1:n(),
        function(i)
          paste0('<a href="#" onClick=document.getElementById("downloadData',i, '").click() >Download</a>')
            ))
  }, escape = F)


}

shinyApp(ui, server)

- abanker

---

你可以查看@Shrek Tan的数据表中生成响应式复选框。你也可以尝试为按钮做同样的事情。 - phili_b

Answer 2

由于每个 downloadLink 标签必须对应输出中的一个名称，我认为没有一种使用标准 Shiny download* 函数创建任意下载集合的方法。

我使用 DT 和 javascript 解决了这个问题。DT 允许将 javascript 与数据表相关联。然后，javascript 可以告诉 Shiny 将文件发送到客户端，并且客户端可以强制下载数据。

我创建了一个 minimal example gist。在 RStudio 中运行：

runGist('b77ec1dc0031f2838f9dae08436efd35')

- dk.

Answer 3

Safari自v12.0版本起不再支持.click()。因此，我采用了abanker的隐藏链接解决方案，并结合P Bucher描述的dataTable/actionButton和这里描述的.click()解决方法。以下是最终代码：

library(shiny)
library(shinyjs)
library(DT)

# Random dataset
pName <- paste0("File", c(1:20))

shinyApp(
  ui <- fluidPage( useShinyjs(),
                   DT::dataTableOutput("data"), 
                   uiOutput("hidden_downloads")   ),

  server <- function(input, output) {

    # Two clicks are necessary to make the download button to work
    # Workaround: duplicating the first click
    # 'fClicks' will track whether click is the first one
    fClicks <- reactiveValues()
    for(i in seq_len(length(pName)))       
      fClicks[[paste0("firstClick_",i)]] <- F        

    # Creating hidden Links
    output$hidden_downloads <- renderUI(
      lapply(seq_len(length(pName)), function(i) downloadLink(paste0("dButton_",i), label="")))

    # Creating Download handlers (one for each button)
    lapply(seq_len(length(pName)), function(i) {
      output[[paste0("dButton_",i)]] <- downloadHandler(
        filename = function() paste0("file_", i, ".csv"),
        content  = function(file) write.csv(c(1,2), file))
    })

    # Function to generate the Action buttons (or actionLink)
    makeButtons <- function(len) {
      inputs <- character(len)
      for (i in seq_len(len))  inputs[i] <- as.character(  
        actionButton(inputId = paste0("aButton_", i),  
                     label   = "Download", 
                     onclick = 'Shiny.onInputChange(\"selected_button\", this.id, {priority: \"event\"})'))
      inputs
    }

    # Creating table with Action buttons
    df <- reactiveValues(data=data.frame(Name=pName, 
                                         Actions=makeButtons(length(pName)), 
                                         row.names=seq_len(length(pName))))
    output$data <- DT::renderDataTable(df$data, server=F, escape=F, selection='none')

    # Triggered by the action button
    observeEvent(input$selected_button, {
      i <- as.numeric(strsplit(input$selected_button, "_")[[1]][2])
      shinyjs::runjs(paste0("document.getElementById('aButton_",i,"').addEventListener('click',function(){",
                            "setTimeout(function(){document.getElementById('dButton_",i,"').click();},0)});"))
      # Duplicating the first click
      if(!fClicks[[paste0("firstClick_",i)]])
      {
        click(paste0('aButton_', i))
        fClicks[[paste0("firstClick_",i)]] <- T
      }
    })
  }
)

- LeoR