Используйте кнопку загрузки с датафреймом внутри события наблюдения

Question

У меня есть приложение, которое позволяет пользователю загружать данные, а затем кнопка действия для запуска некоторых вычислений.Затем у меня есть индикатор выполнения, чтобы показать пользователю, сколько времени займет этот процесс.После завершения расчета я хотел бы добавить кнопку загрузки, чтобы пользователь мог загрузить результат расчета.

Я не уверен, как получить доступ к датированному файлу, созданному внутри функции наблюдения событий, поэтому я могу использовать его в функции загрузчика загрузки?

Вот мой код:

server <- function(input, output) {
  options(shiny.maxRequestSize=200*1024^2)

  file_name <- reactive({
    inFile <- input$file1

    if (is.null(inFile))
      return(NULL)

    return (stringi::stri_extract_first(str = inFile$name, regex = ".*(?=\\.)"))
  })

  output$myFileName <- renderText({ paste("Claim data selected:",file_name()) })

  mydata <- reactive({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    tbl <- read.csv(inFile$datapath,sep=";")
    return(tbl)
  })

  output$my_output_data <- DT::renderDataTable({
    mydata() },
    options = list(
      lengthChange = FALSE,
      autowidth = TRUE,
      columnDefs = list(list(width = '70%', targets = 1)))
  )

  output$summary <- renderText({    
    dt.size <- nrow({mydata()})
    paste("There are",dt.size,"records.", sep =" ")
  })

  observeEvent(input$goButton1,{
    output$table1 <- DT::renderDataTable({
    withProgress(message = 'Calculation in progress...',
                 value = 0, {function1({mydata()},progress=TRUE)})
  })

  output$table1 <- DT::renderDataTable(function1({mydata()}))

  output$downloadData <- downloadHandler(
    filename = function() { 
      paste("DLR result-", Sys.Date(), ".csv", sep="")
    },
    content = function(file) {
      #fwrite("output$table 1 should be here", file)
  })  

})

}

Answer 1

Проблема с кодом, который вы дали, заключается в том, что функция fread из библиотеки data.table принимает аргумент data.frame или data.table.Здесь вы дали ему объект DT javascript DataTable.Мой код использует базу данных data.frames вместо data.table, но вы должны соответствующим образом адаптировать ее.

library(shiny)
library(shinydashboard)

ui = dashboardPage(
    dashboardHeader(title = "File Download"),
    dashboardSidebar(),
    dashboardBody(
        fluidPage(
            fluidRow(
                box(width=12,
                    title = "UploadDownload",
                    fileInput("file1", label="File1 upload"),
                    downloadButton("downloadData", "Download")
                )
            ),
            fluidRow(
                box(width=12,
                    title = "DataTable", 
                    textOutput("myFileName"),
                    DT::dataTableOutput("my_output_data")
                )
            )
        )
    )
)

server = function(input, output) {

    file_name = reactive({
        req(input$file1)
        return(gsub("\\..*$", "", input$file1$name))
    })

    output$myFileName = renderText({ 
        paste("Claim data selected:",file_name()) 
    })

    mydata = reactive ({
        req(input$file1) 
        tbl = read.csv(input$file1$datapath)
        return(tbl)

    })

    mydata2 = reactive ({
       tbl = mydata() 
       # a calculation that will take some time
        withProgress(message="Adding another column", detail="this may take some time", 
                     {
                         n = dim(tbl)[2]
                         tbl$newcolumn = NULL
                         for (i in 1:n) {
                             tbl$newcolumn[i] = sample.int(10,1)
                             incProgress(1/n)
                             Sys.sleep(5/n)
                         }
                     })
    })

    output$my_output_data = DT::renderDataTable(
        mydata(),
        options = list(
            lengthChange=FALSE,
            autowidth=TRUE,
            columnDefs=list(list(width='70%', targets=1))
        )
    )

    output$downloadData = downloadHandler(
        filename = function() {
            paste("DLR results-", Sys.Date(), ".csv", sep="")
        },
        content = function(file) {
            write.csv(mydata2(), file)
        }
    )

}

shinyApp(ui, server)