Make Shiny operate on multiple files *simultaneously* rather than one-by-one?

  • My Shiny app inputs multiple files. Based on which file the user selects, the app will do some operations (display the data as a table, perform several math functions, plot the result).

  • This plotting happens instantly in my minmal reprex (below) - because I'm just log-transforming the data as an example - but in my real-world app this is a complex and time-consuming process (because several functions are run, not just simple log transform and plot).

  • How can I make the app do everything it needs to do at once, in the background, then only use the dropdown menu to display them, not actually do the plotting?

Extremely simple test files (just 3 files each containing 1 row of numbers):
https://easyupload.io/m/ufgjwk

Self-contained, minimal reproducible example

library(shiny)

ui <- shinyUI(fluidPage(
  titlePanel("Multiple Files testing"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file",
                "Upload the file", 
                multiple = TRUE, 
                accept=c('text/csv',
                         'text/comma-separated-values,text/plain',
                         '.csv')), # fileinput() function is used to get the file upload contorl option
    
      uiOutput("selectfile"),
      plotOutput("myplot")),
    mainPanel(
      uiOutput("tb")
    ))))

server <- shinyServer(function(input,output) {
  

  
  # Extract the file path for file
  output$filedf2 <- renderTable({
    if(is.null(input$file)){return ()}
    input$file$datapath # the file input data frame object that contains the file attributes
  })
  
  
  ## Side bar select input widget coming through renderUI()
  # Following code displays the select input widget with the list of file loaded by the user
  output$selectfile <- renderUI({
    if(is.null(input$file)) {return()}
    list(hr(), 
         helpText("Select the files for which you need to see data and summary stats"),
         selectInput("Select", "Select", choices=input$file$name)
         
    )
    
  })
  
  
  ## Dataset code ##
  # This reactive output contains the dataset and display the dataset in table format
  output$table <- renderTable({ 
    if(is.null(input$file)){return()}
    read.table(file=input$file$datapath[input$file$name==input$Select],)
    
  })
  
  ## MainPanel tabset renderUI code ##
  # the following renderUI is used to dynamically generate the tabsets when the file is loaded. 
  # Until the file is loaded, app will not show the tabset.
  output$tb <- renderUI({
    if(is.null(input$file)) {return()}
    else
      tabsetPanel(
        tabPanel("Dataset", tableOutput("table"))
      )
  })
  
  
  output$myplot <- renderPlot({
    req(input$Select)
    req(input$file)
    mydataframe <- as.data.frame(read.table(file=input$file$datapath[input$file$name==input$Select],))
    mydataframe <- log10(mydataframe) #Real app does something much more complex
    plot(mydataframe)
  })
  
  
})

shinyApp(ui, server)




shinyApp(ui, server)

Lets say you can do one of 3 things, each of which takes 2 seconds.
Is it best to immediately take 6 seconds to calculate all 3 then give the user a selector to pick one to look at?
or is it better to take 2 seconds to calculate the one the user chooses to select ?

I suppose a more complex alternative than either would be to calculate the one the user selects and only after that is ready, immediately asyncrhronously calculate the others in anticipation that the user may choose them next. I expect something like that would be a significantly more complex and difficult to implement solution but something like shinyasync of future/promises I would think could be used to achieve it.

Hi,

You can use a strategy where user inputs are prevented during long computations

library(shiny)

ui <- shinyUI(fluidPage(
  titlePanel("Multiple Files testing"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file",
                "Upload the file", 
                multiple = TRUE, 
                accept=c('text/csv',
                         'text/comma-separated-values,text/plain',
                         '.csv')), 
      
      uiOutput("selectfile"),
      plotOutput("myplot")),
    mainPanel(
      uiOutput("tb")
    ))))

server <- shinyServer(function(input,output,session) {
  # here you create a reactive data.frame that will change on input$select
  # and where you will store the results from your long computation
  mydataframe <- reactiveVal(data.frame())
  
  output$filedf2 <- renderTable({
    if(is.null(input$file)){return ()}
    input$file$datapath
  })
  
  output$selectfile <- renderUI({
    if(is.null(input$file)) {return()}
    list(hr(), 
         helpText("Select the files for which you need to see data and summary stats"),
         selectInput("Select", "Select", choices=input$file$name)
         
    )
  })
  
  output$table <- renderTable({ 
    if(is.null(input$file)){return()}
    # here you read the table from one of your uploaded file
    foo <- read.table(file=input$file$datapath[input$file$name==input$Select],)
    
    # then you start a long processing
    # 1st you create a div the will occupy all your app
    insertUI(selector = "body", where = "beforeEnd", immediate = TRUE, multiple = FALSE, session = session,
             ui = div( 
               id = "busy_ctn",
               style="width:100%; height:100%; top:0; left:0; position:fixed; display:block; opacity:0.9; background-color:#fff; z-index:99998; text-align:center;",
               tags$div(id = "busy_msg",
                        style='position:absolute; top:50%; left:0; bottom:0; right:0; display:block; align-items:center; justify-content:center; text-align:center; margin:auto; vertical-align:middle;',
                        tags$h2("processing"),
                        tags$div(style = "display:inline-block; vertical-align:super; color:black;",
                                 icon("fas fa-sync-alt fa-spin fa-3x fa-fw")))))
    # then you create a progress bar
    # It is not mandatory but I think it's a good ideat to show that something is being processed
    # and the app is not just freezed/crashed
    pb <- Progress$new()
    # the tryCatch is here to be sure that in cas a error happens you will remove the busy message and close the progress bar
    tryCatch({
      # here I mimic a long computation and show you how to fill the progress bar
      
      # you should adjust to run your maths and store the final result into mydataframe()
      i = seq(from = 0, to = 1, length.out = 21)
      sapply(seq(from = 0, to = 1, length.out = 21), FUN = function(i) {
        pb$set(value = i, message = "computing", detail = sprintf("done %3.f%%", i * 100))
        Sys.sleep(0.2) 
      })
      
      # here the final result is a simple operation
      mydataframe(log10(foo))
    }, finally = {
      pb$close()
      removeUI(selector = "#busy_ctn", multiple = TRUE, immediate = TRUE, session = session)
    })
    return(foo)
  })
  
  output$tb <- renderUI({
    if(is.null(input$file)) {return()}
    else
      tabsetPanel(
        tabPanel("Dataset", tableOutput("table"))
      )
  })
  
  # finally your plot will render the result of your long computation
  output$myplot <- renderPlot({
    if(nrow(mydataframe()) != 0) plot(mydataframe())
  })
})

shinyApp(ui, server)

I'm already learning a lot from your example (like the progress bar) - thanks!

For what I'm trying to do, and for what I think your example attempts,I still don't think it's working as intended.

I'm not sure though. To me, it seems as though each time I select a different file, all the calculations are re-performed (which is my current problem now). I'm looking for a way to have all files uploaded, then the progres bar and loading sign as you've implemented here, then have the dropdown only display the results (rather than re-do them on the fly for each selection).

Can this be modified to do all the calculations right when the files are uploaded, and then when the user selects a file the application just renders the results?

So cool - thank you for taking the time here!!

You can do it in such case with a observer on input$file

library(shiny)

ui <- shinyUI(fluidPage(
  titlePanel("Multiple Files testing"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file",
                "Upload the file", 
                multiple = TRUE, 
                accept=c('text/csv',
                         'text/comma-separated-values,text/plain',
                         '.csv')), 
      
      uiOutput("selectfile"),
      plotOutput("myplot")),
    mainPanel(
      uiOutput("tb")
    ))))

server <- shinyServer(function(input,output,session) {
  # here you create a reactive list that will change on input$file
  # and where you will store the results from your long computation
  myfilesinput <- reactiveVal(list())
  
  observeEvent(input$file, ignoreNULL = TRUE, {
    insertUI(selector = "body", where = "beforeEnd", immediate = TRUE, multiple = FALSE, session = session,
             ui = div( 
               id = "busy_ctn",
               style="width:100%; height:100%; top:0; left:0; position:fixed; display:block; opacity:0.9; background-color:#fff; z-index:99998; text-align:center;",
               tags$div(id = "busy_msg",
                        style='position:absolute; top:50%; left:0; bottom:0; right:0; display:block; align-items:center; justify-content:center; text-align:center; margin:auto; vertical-align:middle;',
                        tags$h2("processing"),
                        tags$div(style = "display:inline-block; vertical-align:super; color:black;",
                                 icon("fas fa-sync-alt fa-spin fa-3x fa-fw")))))
    # then you create a progress bar
    # It is not mandatory but I think it's a good ideat to show that something is being processed
    # and the app is not just freezed/crashed
    pb <- Progress$new()
    # the tryCatch is here to be sure that in cas a error happens you will remove the busy message and close the progress bar
    tryCatch({
      # here I mimic a long computation and show you how to fill the progress bar
      
      # you should adjust to run your maths and store the final result into mydataframe()
      i = seq(from = 0, to = 1, length.out = 21)
      sapply(seq(from = 0, to = 1, length.out = 21), FUN = function(i) {
        pb$set(value = i, message = "computing", detail = sprintf("done %3.f%%", i * 100))
        Sys.sleep(0.2) 
      })
      
      # here the final result is a simple operation
      foo = lapply(1:length(input$file$datapath), FUN = function(i_file) {
        # it is here where you may increase your progress bar
        raw = read.table(file=input$file$datapath[i_file]) # you read your file
        long = log10(raw) # you do your long compuation
        list(raw = raw, long = long)
      })
      names(foo) <- input$file$name
      myfilesinput(foo)
    }, finally = {
      pb$close()
      removeUI(selector = "#busy_ctn", multiple = TRUE, immediate = TRUE, session = session)
    })
  })
  
  output$selectfile <- renderUI({
    if(is.null(input$file)) {return()}
    list(hr(), 
         helpText("Select the files for which you need to see data and summary stats"),
         selectInput("Select", "Select", choices=input$file$name)
         
    )
  })
  
  output$table <- renderTable({ 
    if(is.null(input$file)){return()}
    myfilesinput()[["input$Select"]]$raw
  })
  
  output$tb <- renderUI({
    if(is.null(input$file)) {return()}
    else
      tabsetPanel(
        tabPanel("Dataset", tableOutput("table"))
      )
  })
  
  # finally your plot will render the result of your long computation
  output$myplot <- renderPlot({
    if(is.null(input$file)) return(NULL)
    if(!any(myfilesinput() %in% input$Select)) return(NULL)
    plot(myfilesinput()[[input$Select]]$long)
  })
})

shinyApp(ui, server)

Okay I feel like this is so close. When the 3 test files are deposited, the processes seem to be happening. Now when I select a given file, no processing seems to be happening (great!).

The problem is that the results aren't displayed. It's all just blank. Any idea how to make the results appear once again?

Using observe is really elegant, thank you!

two mistakes indeed...

library(shiny)

ui <- shinyUI(fluidPage(
  titlePanel("Multiple Files testing"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file",
                "Upload the file", 
                multiple = TRUE, 
                accept=c('text/csv',
                         'text/comma-separated-values,text/plain',
                         '.csv')), 
      
      uiOutput("selectfile"),
      plotOutput("myplot")),
    mainPanel(
      uiOutput("tb")
    ))))

server <- shinyServer(function(input,output,session) {
  # here you create a reactive list that will change on input$file
  # and where you will store the results from your long computation
  myfilesinput <- reactiveVal(list())
  
  observeEvent(input$file, ignoreNULL = TRUE, {
    insertUI(selector = "body", where = "beforeEnd", immediate = TRUE, multiple = FALSE, session = session,
             ui = div( 
               id = "busy_ctn",
               style="width:100%; height:100%; top:0; left:0; position:fixed; display:block; opacity:0.9; background-color:#fff; z-index:99998; text-align:center;",
               tags$div(id = "busy_msg",
                        style='position:absolute; top:50%; left:0; bottom:0; right:0; display:block; align-items:center; justify-content:center; text-align:center; margin:auto; vertical-align:middle;',
                        tags$h2("processing"),
                        tags$div(style = "display:inline-block; vertical-align:super; color:black;",
                                 icon("fas fa-sync-alt fa-spin fa-3x fa-fw")))))
    # then you create a progress bar
    # It is not mandatory but I think it's a good ideat to show that something is being processed
    # and the app is not just freezed/crashed
    pb <- Progress$new()
    # the tryCatch is here to be sure that in cas a error happens you will remove the busy message and close the progress bar
    tryCatch({
      # here I mimic a long computation and show you how to fill the progress bar
      
      # you should adjust to run your maths and store the final result into mydataframe()
      i = seq(from = 0, to = 1, length.out = 21)
      sapply(seq(from = 0, to = 1, length.out = 21), FUN = function(i) {
        pb$set(value = i, message = "computing", detail = sprintf("done %3.f%%", i * 100))
        Sys.sleep(0.2) 
      })
      
      # here the final result is a simple operation
      foo = lapply(1:length(input$file$datapath), FUN = function(i_file) {
        # it is here where you may increase your progress bar
        raw = read.table(file=input$file$datapath[i_file]) # you read your file
        long = log10(raw) # you do your lon compuation
        list(raw = raw, long = long)
      })
      names(foo) <- input$file$name
      myfilesinput(foo)
    }, finally = {
      pb$close()
      removeUI(selector = "#busy_ctn", multiple = TRUE, immediate = TRUE, session = session)
    })
  })
  
  output$selectfile <- renderUI({
    if(is.null(input$file)) {return()}
    list(hr(), 
         helpText("Select the files for which you need to see data and summary stats"),
         selectInput("Select", "Select", choices=input$file$name)
         
    )
  })
  
  output$table <- renderTable({ 
    if(is.null(input$file)){return()}
    myfilesinput()[[input$Select]]$raw # error1
  })
  
  output$tb <- renderUI({
    if(is.null(input$file)) {return()}
    else
      tabsetPanel(
        tabPanel("Dataset", tableOutput("table"))
      )
  })
  
  # finally your plot will render the result of your long computation
  output$myplot <- renderPlot({
    if(is.null(input$file)) return(NULL)
    if(!any(names(myfilesinput()) %in% input$Select)) return(NULL) # error2
    plot(myfilesinput()[[input$Select]]$long)
  })
})

shinyApp(ui, server)
1 Like

Solved!

Thanks very much for your time here. It does indeed look like all the processing is done immediately once the files are uploaded, and selecting the input file only displays the results (and does not re-compute them).

I'm going to begin learning more from your example then implement it into my 'real' code.

Thanks again!

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.