r - future 的系统命令/R Shiny 中的 promise

Question

我在 Shiny 的应用程序中有以下 server.R 代码，其中系统命令在 future 中运行，它给出了 output.vcf文件。创建此文件后，进度条将被删除，并运行第二个系统命令来转换 out.vcf至 out.txt

使用系统命令是因为 R 无法在 32Gb 机器上读取巨大的向量。因此，一些系统命令用于处理数据。

第一个系统命令中产生的输出，即 out.vcf必须呈现为 downloadHandler和第二个命令的输出 out.txt必须返回到renderDataTable .

有人可以建议一种有效的方法吗？可能在 future() 中运行两个系统命令并将输出返回到 downloadHandler和 renderDataTable .

server <- function(input, output, session) {
file_rows <- reactiveVal()

observeEvent(input$run, {
  prog <- Progress$new(session)
  prog$set(message = "Analysis in progress",
    detail = "This may take a while...",
    value = NULL)

  path <- input$uploadFile$datapath
  nrows <- input$nrows

  future({
    system(paste(
      "cat",
      input$uploadFile$datapath,
      "|",
      paste0("head -", input$nrows) ,
      ">",
      "out.vcf"
    ),
      intern = TRUE)
   read.delim("out.vcf")
  }) %...>%
    file_rows() %>%
    finally(~prog$close())
})



observeEvent(req(file_rows()), {
updateTabsetPanel(session, "input_tab", "results")
    rows_input <- file_rows()

    system(paste(
      "cat",
      rows_input,
      "|",
      paste(some system command"),
      ">",
      "out.txt"
    ),
      intern = TRUE)

##How could we render the content of "out.txt" from the above system command to datatable in the below code#######  
    output$out_table <-
      DT::renderDataTable(DT::datatable(
        out.txt,
        options = list(
          searching = TRUE,
          pageLength = 10,
          rownames(NULL),
          scrollX = T
        )
      ))

##How could we render the content of "out.vcf" from the first system command to downloadHandler in the below code#######    
output$out_VCFdownList <- downloadHandler(
      filename = function() {
        paste0("output", ".vcf")
      },
      content = function(file) {
        write.vcf("out.vcf from first system command ", file)
      }
    )
  })

Answer 1

试试这个简单的“Happy to Glad”转换器(和行号器)。

这个 Shiny 应用程序的目标:给定一个文本文件，将所有出现的字符串 happy(区分大小写)转换为 glad。输入文件，用于演示:

This is a happy file.
It attempts to be very happy.

以及示例应用程序，使用一个简单的两步命令过程。

更新:我更新了它以提供 (1) 进度，以及 (2) 每个文件的下载。如果您想禁用一个或另一个下载，请交给您。

library(shiny)
library(future)
library(promises)
plan(transparent)

ui <- fluidPage(
  titlePanel("\"Happy\" to \"Glad\"!"),
  sidebarLayout(
    sidebarPanel(
      fileInput("infile", "Upload a text file:"),
      tags$hr(),
      actionButton("act", "Convert!"),
      tags$hr(),
      splitLayout(
        downloadButton("download1", label = "Download 1!"),
        downloadButton("download2", label = "Download 2!")
      )
    ),
    mainPanel(
      textAreaInput("intext", label = "Input", rows = 3),
      tags$hr(),
      textAreaInput("outtext", label = "Gladified", rows = 3)
    )
  )
)

server <- function(input, output, session) {
  outfile1 <- reactiveVal(NULL)
  outfile2 <- reactiveVal(NULL)

  observeEvent(input$act, {
    req(input$infile)
    prog <- Progress$new(session)
    prog$set(message = "Step 1 in progress",
             detail = "This may take a few moments...",
             value = NULL)
    future({
      Sys.sleep(2)
      outf1 <- tempfile()
      ret1 <- system2("sed", c("-e", "s/happy/glad/g",
                               shQuote(input$infile$datapath)),
                      stdout = outf1)
      if (ret1 == 0L && file.exists(outf1)) {
        outfile1(outf1)
      } else outf1 <- NULL
      outf1
    }) %...>%
      {
        outf1 <- .
        if (is.null(outf1) || !file.exists(outf1)) {
          prog$set(message = "Problems with Step 1?",
                   detail = "(process interrupted ...)",
                   value = NULL)
        } else {
          prog$set(message = "Step 2 in progress",
                   detail = "This may take a few moments...",
                   value = NULL)
        }
        outf1
      } %...>%
      {
        future({
          outf1 <- .
          if (!is.null(outf1inf) && file.exists(outf1)) {
            Sys.sleep(2)
            outf2 <- tempfile()
            ret2 <- system2("cat", c("-n", shQuote(outf1)),
                            stdout = outf2)
            if (ret2 == 0L && file.exists(outf2)) {
              outfile2(outf2)
            } else outf2 <- NULL
          }
          list(outf1, outf2)
        })
      } %...>%
      {
        bothfiles <- .
        if (is.null(bothfiles[[1]])) {
          # do nothing, we already saw the progress-error
        } else if (is.null(bothfiles[[2]]) || !file.exists(bothfiles[[2]])) {
          prog$set(message = "Problems with Step 2?",
                   detail = "(process interrupted ...)",
                   value = NULL)
        }
      } %>%
      finally(~ prog$close())
  })

  observeEvent(input$infile, {
    req(input$infile$datapath, file.exists(input$infile$datapath))
    txt <- readLines(input$infile$datapath, n = 10)
    updateTextAreaInput(session, "intext", value = paste(txt, collapse = "\n"))
  })

  observeEvent(outfile2(), {
    req(outfile2(), file.exists(outfile2()))
    txt <- readLines(outfile2(), n = 10)
    updateTextAreaInput(session, "outtext", value = paste(txt, collapse = "\n"))
  })

  output$download1 <- downloadHandler(
    filename = function() {
      req(input$infile)
      paste0(basename(input$infile$name), "_gladified")
    },
    content = function(file) {
      req(outfile1())
      file.copy(outfile1(), file)
    }
  )

  output$download2 <- downloadHandler(
    filename = function() {
      req(input$infile)
      paste0(basename(input$infile$name), "_gladified_and_numbered")
    },
    content = function(file) {
      req(outfile2())
      file.copy(outfile2(), file)
    }
  )

}

shinyApp(ui, server)

注意事项:

• 它不是很智能，所以对于每个 if (ret1 == 0L)，您应该有一个 else 子句，如果不符合则向用户显示一些错误消息-零；
• 它的效率有点低，因为它会复制输出文件而不是重命名它。我选择这个是因为重命名它只允许下载一次。
• 我没有花很多时间来解决处理失败的问题；虽然我认为我放置的进度标记很不错，但您可能需要对失败状态进行更多测试；
• 在下载按钮上明智地使用 shinyjs::toggleState 可能会很有用，这样您就无法下载不存在的内容。
• 最后，我对拥有如此庞大的 observeEvent 和多个 future 步骤并不感到兴奋； function 化步骤或泛化任意数量的步骤会很好。