R Shiny - 数据表中的动态下载链接

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 吗？

Answer 1

我不相信您可以将 downloadButtons/downloadLinks 直接嵌入数据表中。但是，您可以创建隐藏的下载链接，这些链接由表中嵌入的链接触发。这会产生相同的最终结果。为此，您必须：

• 动态生成downloadLinks/downloadButtons。
• 使用 css 将其可见性设置为隐藏。
• 在表格中嵌入普通链接/按钮
• 设置这些链接的onClick字段，触发对应的隐藏downloadLink。

这是使用 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)

Answer 2

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

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

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

runGist('b77ec1dc0031f2838f9dae08436efd35')

Answer 3

自 v12.0 起，Safari 不再支持 .click()。因此，我使用P Bucher 描述的dataTable/actionButton 和here 描述的.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
      }
    })
  }
)