Rshiny中将来/应许中的系统命令

时间:2019-07-11 12:32:51

标签: r shiny shiny-server

我在闪亮的应用程序中具有以下server.R代码,该系统中的系统命令在future中运行,从而提供一个output.vcf文件。创建此文件后,进度条将被删除,并运行第二个系统命令以将out.vcf转换为out.txt

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

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

有人可以建议这样做的有效方法吗?可能同时在future()内运行两个系统命令,然后将输出返回到downloadHandlerrenderDataTable

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)
      }
    )
  })

1 个答案:

答案 0 :(得分:0)

尝试使用这种简单的“高兴到高兴”转换器(和行号)。

此闪亮应用程序的目标:给定一个文本文件,将所有出现的字符串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
    }) %...>%
      {
        inf <- .
        if (is.null(inf) || !file.exists(inf)) {
          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)
        }
        inf
      } %...>%
      {
        future({
          inf <- .
          if (!is.null(inf) && file.exists(inf)) {
            Sys.sleep(2)
            outf2 <- tempfile()
            ret2 <- system2("cat", c("-n", shQuote(inf)),
                            stdout = outf2)
            if (ret2 == 0L && file.exists(outf2)) {
              outfile2(outf2)
            } else outf2 <- NULL
          }
          list(inf, outf2)
        })
      } %...>%
      {
        inf <- .
        if (is.null(inf[[1]])) {
          # do nothing, we already saw the progress-error
        } else if (is.null(inf[[2]]) || !file.exists(inf[[2]])) {
          prog$set(message = "Problems with Step 2?",
                   detail = "(process interrupted ...)",
                   value = NULL)
        } else outfile2(inf[[2]])
      } %>%
      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子句,如果不为零,该子句会向用户显示一些错误消息;
  • 效率不高,因为它会复制输出文件而不是重命名。我之所以选择它,是因为重命名一次只能下载一次。
  • 我没有花很多时间来处理失败的处理过程。虽然我认为我输入的进度标记很不错,但您可能需要更多测试失败状态; <​​/ li>
  • 明智地在下载按钮上使用shinyjs::toggleState,这样您就无法下载不存在的内容。
  • 最后,我对拥有如此多的observeEvent步骤如此庞大的future并不感到兴奋;最好function概括这些步骤或概括出任意数量的步骤。

screenshot of shiny app, mid-process