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 для этого?

Answer 1

Я не верю, что вы можете вставлять downloadButtons / downloadLinks непосредственно в таблицу данных.Однако вы можете создавать скрытые ссылки на скачивание, которые запускаются ссылками, встроенными в вашу таблицу.Это дает тот же конечный результат.Для этого вы должны:

• Динамически генерировать кнопки downloadLinks / downloadButtons.
• Используйте 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)

Answer 2

Safari больше не поддерживает .click (), начиная с версии 12.0.Поэтому я адаптировал решение для скрытой ссылки от abanker с помощью dataTable / actionButton, описанного P Bucher , и обходного пути .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
      }
    })
  }
)

Answer 3

Поскольку каждая метка downloadLink должна соответствовать имени в выводе, я не думаю, что есть способ создать произвольный набор загрузок с использованием стандартных функций Shiny download *.

Я решил это с помощью DTи JavaScriptDT позволяет javascript быть связанным с датированными данными.Затем javascript может сказать Shiny отправить файл клиенту, а клиент может принудительно загрузить данные.

Я создал минимальный примерный список .Запустите в RStudio с:

runGist('b77ec1dc0031f2838f9dae08436efd35')