системные команды в будущем / обещания в Ршинах

Question

У меня есть приведенный ниже код server.R в блестящем приложении, в котором в будущем выполняется системная команда, которая выдает файл output.vcf. При создании этого файла индикатор выполнения удаляется, и запускается вторая системная команда для преобразования out.vcf в out.txt

Системные команды используются, поскольку R не может прочитать огромные векторы на 32-гигабайтной машине. Следовательно, некоторые системные команды используются для обработки данных.

Вывод, полученный в первой системной команде, т. Е. 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" (и номер строки).

Цель этого блестящего приложения: с учетом текстового файла преобразовать все вхождения строки 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, которое представляет какое-то сообщение об ошибке пользователю, если оно не равно нулю;
• Это немного неэффективно, потому что он делает копию выходного файла, а не переименовывает его. Я выбрал это, потому что переименование разрешит загрузку только один раз.
• Я не тратил много времени на устранение неполадок, возникающих при неудачной обработке; хотя я думаю, что маркеры прогресса, которые я поставил, являются приличными, вам может потребоваться дополнительное тестирование состояний отказа;
• Вероятно, было бы полезно включить в кнопки загрузки shinyjs::toggleState, чтобы вы не могли загрузить то, что не существует.
• И, наконец, я не очень рад такому огромному количеству observeEvent с несколькими future шагами; было бы неплохо function -измерить шаги или обобщить на произвольное количество шагов.