3

我在闪亮的应用程序中有以下 server.R 代码，其中系统命令在未来运行，它提供了一个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)
      }
    )
  })
4

1 回答 1

0

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

这个闪亮应用程序的目标：给定一个文本文件，将所有出现的字符串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对步骤进行 -ize 或概括为任意数量的步骤。

闪亮的应用程序的屏幕截图，中间过程

于 2019-07-23T22:08:05.987 回答