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，这些链接由表中嵌入的链接触发。这将产生相同的最终结果。为此，您必须：

动态生成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修改了abanker的隐藏链接解决方案，而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) {

    # 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)});"))
      # # Follows an optional workaround if 2 clicks are necessary
      # # It doesn't work if running your app from Mac RStudio-Desktop, but works from Safari
      # click(paste0('aButton_', i)) 
    })
  }
)

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

3 个答案: