system commands in future/promises in Rshiny

Question

I have the below server.R code in shiny app where a system command is run inside future which gives an output.vcf file. Upon creation of this file the progress bar is removed and a second system command is run to convert out.vcf to out.txt

The system commands are used as R could not read huge vectors on a 32Gb machine. Hence some system commands are used to process the data.

The output produced in the first system command i.e. out.vcf has to be rendered to downloadHandler and the output from the second command out.txt has to be returned to renderDataTable.

Could someone suggest an efficient way of doing this? possibly running both the system commands inside the future() and returning the outputs to downloadHandler and 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

Try this simple "Happy to Glad" converter (and line-numberer).

Goal of this shiny app: given a text file, convert all occurrences of the string happy (case-sensitive) with glad. An input file, for demonstration:

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

And the sample app, using a simple two-step command process.

Update: I've updated it to provide (1) progress, and (2) download of each file. Over to you if you want to disable one or the other download.

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)

Notes:

• It is not very smart, so for each if (ret1 == 0L), you should have an else clause that presents some error message to the user if non-zero;
• It is a little inefficient in that it makes a copy of the output file instead of renaming it. I chose this because renaming it would allow a download only once.
• I haven't spent a lot of time troubleshooting what happens with failed processing; while I think the progress markers I've put in are decent, you might want more testing of fail-states;
• It would likely be useful to include judicious use of shinyjs::toggleState on the download buttons so that you can't download what does not exist.
• And finally, I'm not truly thrilled with having such a gargantuan observeEvent with multiple future steps; it'd be nice to function-ize the steps or generalize for an arbitrary number of steps.