如何使 RShiny 中的下载按钮起作用，以便它可以显示下载输出？

Question

该系统是一个审核样本选择系统，我在其中使用 RStudio 开发该系统。系统行为如下：

1. 用户上传 Excel 文件或 PDF 文件。
2. 用户需要在两个单选按钮之间进行选择，一个是“低风险”，另一个是“高风险”。
3. 用户点击“提交”按钮。
4. 系统会根据文件中表格的行数自动选择一定数量的审计样本。
5. 在“低风险”和“高风险”之间选择的审计样本数量不同。
6. 系统显示选定的审计样本。

7. 用户可以下载显示的选定审计样本。

   library(shiny)
   library(xlsx)
   library(xlsxjars)
   library(rJava)
   library(pdftools)
   library(tabulizer)
   
   ui <- fluidPage(
    titlePanel("Audit Sample Selection System"),
    sidebarLayout(
    sidebarPanel(
     fileInput("file1", "Choose file", accept = c(".xlsx", ".pdf")),
     radioButtons("select", "Level of Risk", choices=list("Low Risk" = "low","High Risk" = "high")),
     actionButton("submit", "Submit")
    ),
    mainPanel(
    tableOutput("contents"),
    downloadButton("download", "Download")
    )
   )
   )
   
   server <- function(input, output){
   
   mydf <- eventReactive(input$submit, {
   
   # check for required values (for truthfulness)/ensure the values are available 
   req(input$select)
   req(input$file1)
   
   inFile <- input$file1
   
   if (grepl("*.xlsx",inFile[1]) == TRUE){
    file.rename(inFile$datapath, paste(inFile$datapath, ".xlsx", sep = ""))          
    wb <- read.xlsx(paste(inFile$datapath, ".xlsx", sep = ""), 1)
   
    nrow(wb) -> rows
    if (input$select == "low") {
    # sample for low risk (xlsx)
    if (rows == 1) {
     outdf <- wb[sample(rows, 1), ]
    } else 
     if (rows >= 2 & rows <= 4) {
       outdf <- wb[sample(rows, 1), ]
     } else 
       if (rows >= 5 & rows <= 12) {
         outdf <- wb[sample(rows, 2), ]
       } else 
         if (rows >= 13 & rows <= 52) {
           outdf <- wb[sample(rows, 5), ]
         } else
           if (rows >= 53 & rows <= 365) {
             outdf <- wb[sample(rows, 15), ]
           } else
             if (rows > 365) {
               outdf <- wb[sample(rows, 25), ]
             }
    } else {
   # sample for high risk (xlsx)
   if (rows == 1) {
     outdf <- wb[sample(rows, 1), ]
   } else 
     if (rows >= 2 & rows <= 4) {
       outdf <- wb[sample(rows, 2), ]
     } else 
       if (rows >= 5 & rows <= 12) {
         outdf <- wb[sample(rows, 3), ]
       } else 
         if (rows >= 13 & rows <= 52) {
           outdf <- wb[sample(rows, 8), ]
         } else
           if (rows >= 53 & rows <= 365) {
             outdf <- wb[sample(rows, 25), ]
           } else
             if (rows > 365) {
               outdf <- wb[sample(rows, 40), ]
             } 
    }
    } else if (grepl("*.pdf",inFile[1]) == TRUE) {
       outtable <- extract_tables(inFile$datapath)
       outtable[[1]] <- outtable[[1]][-c(1,1),] # Remove header from the table on the first page
       df <- do.call(rbind, outtable) # Turn matrix into data frame
       nrow(df) -> rows
       if (input$select == "low") {
       # sample for low risk (pdf)
   if (rows == 1) {
     outdf <- df[sample(rows, 1), ]
   } else 
     if (rows >= 2 & rows <= 4) {
       outdf <- df[sample(rows, 1), ]
     } else 
       if (rows >= 5 & rows <= 12) {
         outdf <- df[sample(rows, 2), ]
       } else 
         if (rows >= 13 & rows <= 52) {
           outdf <- df[sample(rows, 5), ]
         } else
           if (rows >= 53 & rows <= 365) {
             outdf <- df[sample(rows, 15), ]
           } else
             if (rows > 365) {
               outdf <- df[sample(rows, 25), ]
             } 
        } else {
        # sample for high risk (pdf)
   if (rows == 1) {
     outdf <- df[sample(rows, 1), ]
   } else 
     if (rows >= 2 & rows <= 4) {
       outdf <- df[sample(rows, 2), ]
     } else 
       if (rows >= 5 & rows <= 12) {
         outdf <- df[sample(rows, 3), ]
       } else 
         if (rows >= 13 & rows <= 52) {
           outdf <- df[sample(rows, 8), ]
         } else
           if (rows >= 53 & rows <= 365) {
             outdf <- df[sample(rows, 25), ]
           } else
             if (rows > 365) {
               outdf <- df[sample(rows, 40), ]
             }
        }
      } else {
       NULL
      }
      })
   
      output$contents <- renderTable({
      mydf()
      })
     }
   
     shinyApp(ui = ui, server = server)
   

问题是我不知道如何使下载按钮起作用，以便当用户单击“下载”按钮时，将下载显示的选定审计样本。

Answer 1

您可以使用DT 包来呈现漂亮的表格及其允许下载表格的“按钮”扩展，而不是使用下载按钮。

library(DT)
# in server:
output$contents <- DT::renderDataTable({
  datatable(mydf(), 
            extensions = 'Buttons', 
            options = list(dom = 'Bfrtip', buttons = 'excel'))
})
# in ui:
DT::dataTableOutput("contents")

有关“按钮”扩展的更多信息，请参阅https://rstudio.github.io/DT/003-tabletools-buttons.html。