How to show that Shiny is busy (or loading) when changing tab panels?

[Jonathan Baik]

I posted this question on StackOverflow, and I am sorry for cross posting questions between different sites. I thought that I may receive better answers if I posted here.

Link to SO question and copy pasted below. If there is a solution, feel free to post it as an answer on SO as well!



I am working on making a web app with Shiny, and some of the R commands that I am executing take minutes to complete. I found that I need to provide the user with some indication that Shiny is working, or they will continuously change the parameters I provide in the side panel, which just causes Shiny to reactively restart the calculations once the initial run is completed.

So, I created a conditional panel that shows a "Loading" message (referred to as a modal) with the following (thanks to Joe Cheng on the Shiny Google group for the conditional statement):

    # generateButton is the name of my action button
    loadPanel <- conditionalPanel("input.generateButton > 0 && $('html').hasClass('shiny-busy')"),
                                  loadingMsg)

This is working as intended if the user remains on the current tab. However, the user can switch to another tab (that may contain some calculations that need to be run for some time), but the loading panel appears and disappears immediately, all while R chugs away at the calculations, and then refreshing the content only after it is done.

Since this may be hard to visualize, I provided some code to run below. You will notice that clicking the button to start the calculations will produce a nice loading message. However, when you switch to tab 2, R starts running some calculations, but fails to show the loading message (maybe Shiny does not register as being busy?). If you restart the calculations by pressing the button again, the loading screen will show up correctly.

I want the loading message to appear when switching to a tab that is loading!

ui.R

    library(shiny)
   
    # Code to make a message that shiny is loading
    # Make the loading bar
    loadingBar <- tags$div(class="progress progress-striped active",
                           tags$div(class="bar", style="width: 100%;"))
    # Code for loading message
    loadingMsg <- tags$div(class="modal", tabindex="-1", role="dialog",
                           "aria-labelledby"="myModalLabel", "aria-hidden"="true",
                           tags$div(class="modal-header",
                                    tags$h3(id="myModalHeader", "Loading...")),
                           tags$div(class="modal-footer",
                                    loadingBar))
    # The conditional panel to show when shiny is busy
    loadingPanel <- conditionalPanel(paste("input.goButton > 0 &&",
                                           "$('html').hasClass('shiny-busy')"),
                                     loadingMsg)
   
    # Now the UI code
    shinyUI(pageWithSidebar(
      headerPanel("Tabsets"),
      sidebarPanel(
        sliderInput(inputId="time", label="System sleep time (in seconds)",
                    value=1, min=1, max=5),
        actionButton("goButton", "Let's go!")
      ),
     
      mainPanel(
        tabsetPanel(
          tabPanel(title="Tab 1", loadingPanel, textOutput("tabText1")),
          tabPanel(title="Tab 2", loadingPanel, textOutput("tabText2"))
        )
      )
    ))

server.R

    library(shiny)
   
    # Define server logic for sleeping
    shinyServer(function(input, output) {
      sleep1 <- reactive({
        if(input$goButton==0) return(NULL)
        return(isolate({
          Sys.sleep(input$time)
          input$time
        }))
      })
     
      sleep2 <- reactive({
        if(input$goButton==0) return(NULL)
        return(isolate({
          Sys.sleep(input$time*2)
          input$time*2
        }))
      })
     
      output$tabText1 <- renderText({
        if(input$goButton==0) return(NULL)
        return({
          print(paste("Slept for", sleep1(), "seconds."))
        })
      })
     
      output$tabText2 <- renderText({
        if(input$goButton==0) return(NULL)
        return({
          print(paste("Multiplied by 2, that is", sleep2(), "seconds."))
        })
      })
    })

[Joe Cheng]

The shiny-incubator package now has a progress indicator, see ?withProgress. Perhaps that would do the trick?

--
You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discus...@googlegroups.com.
For more options, visit https://groups.google.com/groups/opt_out.

[Jonathan]

Thanks for the reply, Joe.

Is there anything I need to do with the "withProgress" function in the ui.R file?

I tried running the following code below (adapted from ?withProgress), and I do not see a progress bar.

UI.r:

library(shiny)
library(shinyIncubator)

# Code adapted from http://rstudio.github.io/shiny/tutorial/#tabsets

shinyUI(pageWithSidebar(
  headerPanel("Tabsets"),
  sidebarPanel(

    # Action button

    actionButton("goButton", "Let's go!")
  ),
 

  # Show a tabset that includes a plot, summary, and table view
  # of the generated distribution
  mainPanel(
    #     loadingPanel,
    tabsetPanel(
      tabPanel(title="Tab 1", plotOutput("plot1")),
      tabPanel(title="Tab 1", plotOutput("plot2"))
    )
  )
))



server.R

library(shinyIncubator)

shinyServer(function(input, output, session) {
  output$plot1 <- renderPlot({
    if(input$goButton==0) return(NULL)
   
    return({
      withProgress(session, min=1, max=15, {
        setProgress(message = 'Calculation in progress',
                    detail = 'This may take a while...')
        for (i in 1:15) {
          setProgress(value = i)
          Sys.sleep(0.5)
        }
      })
      plot(cars)
    })
  })
 
  output$plot2 <- renderPlot({
    if(input$goButton==0) return(NULL)
   
    return({
      withProgress(session, min=1, max=15, {
        setProgress(message = 'Calculation in progress',
                    detail = 'This may take a while...')
        for (i in 1:15) {
          setProgress(value = i)
          Sys.sleep(0.5)
        }
      })
      plot(cars)
    })
  })
})

[Joe Cheng]

You shouldn't need to--the progress message should just appear in the upper right corner of the page. Are you not seeing that?

[Jonathan]

I am not seeing the progress message appear. I will try setting up Shiny on another machine and try again.

[Joe Cheng]

What browser and operating system are you using? This is very new code, it's quite possible there's a bug.

[xiong xiong]

I tried to embed withProgress on googleVis scatter chart, and no progress bar shown either. I ran on safari and chrome but neither of them worked. Will it be a problem as googleVis charts return html?

[Zhuo Jia Dai]

Check if you are connected to net or if you net is slow

[Jonathan]

I am running local Shiny (not Shiny server) from a Ubuntu 12.04 server using Firefox 23.0.1. If it matters, I am using RStudio Server to connect to R on the server from my web browser.

[Jonathan]

So I discovered that you can run Shiny apps from a gist. I copied my server.R and ui.R that uses the "withProgress" function to a gist.

You can try

runGist("86f6ca71c11ae3cac38d")

to check if my code is runs.

Thanks,
Jonathan

[Joe Cheng]

Jonathan and Xiong Xiong, please be sure to add "progressInit()" to ui.R, somewhere within your shinyUI (doesn't matter where, you won't see anything visible at that spot). That should do it.

[Joe Cheng]

Anywhere but there ;)

Try putting it directly inside the mainPanel (either before or after the tabsetPanel).

On Sat, Sep 7, 2013 at 12:58 AM, DZJ <zhuoj...@gmail.com> wrote:

Hi where can I place the progressInit() in my shinyUI?

I tried placing it at many places and it just wouldn't render and give me errors. This is one of my tries

shinyUI(

  pageWithSidebar( 

  

  headerPanel("Tabsets"),  

  sidebarPanel(

    # Action button

    

    actionButton("goButton", "Let's go!")

  ),    

  # Show a tabset that includes a plot, summary, and table view

  # of the generated distribution

  mainPanel(

    #     loadingPanel,

    tabsetPanel(

      tabPanel(title="Tab 1", plotOutput("plot1")),

      progressInit(),

      tabPanel(title="Tab 1", plotOutput("plot2"))

    )

  )

))

[Stéphane Laurent]

I have the same problem as Jonathan with condition $('html').hasClass('shiny-busy') in conditionalPanel() : when switching to a tab, R starts running some calculations, but fails to show the loading message.

However this problem occurs for one of my apps but not for another one, and I don't find what causes the difference. Any ideas ? 

[Stéphane Laurent]

I think I have found the cause of the different behaviour : the problem does not occur if there is a reactive object in the first tab (such as a renderPlot) which is reactive to input$tab (the tab identifier).

[Stéphane Laurent]

The tip for Jonathan's example :

library(shiny)

# Code to make a message that shiny is loading

# Make the loading bar

loadingBar <- tags$div(class="progress progress-striped active",

                       tags$div(class="bar", style="width: 100%;"))

# Code for loading message

loadingMsg <- tags$div(class="modal", tabindex="-1", role="dialog", 

                       "aria-labelledby"="myModalLabel", "aria-hidden"="true",

                       tags$div(class="modal-header",

                                tags$h3(id="myModalHeader", "Loading...")),

                       tags$div(class="modal-footer",

                                loadingBar))

# The conditional panel to show when shiny is busy

loadingPanel <- conditionalPanel(paste("input.goButton > 0 &&", 

                                       "$('html').hasClass('shiny-busy')"),

                                 loadingMsg)

runApp(

  list(

    server=function(input, output, session){

      sleep1 <- reactive({

        if(input$goButton==0) return(NULL)

        return(isolate({

          Sys.sleep(input$time)

          input$time

        }))

      })

      

      sleep2 <- reactive({

        if(input$goButton==0) return(NULL)

        return(isolate({

          Sys.sleep(input$time*2)

          input$time*2

        }))

      })

      

      output$tabText1 <- renderText({

        if(input$goButton==0) return(NULL)

        input$tab

        return({

          print(paste("Slept for", sleep1(), "seconds."))

        })

      })

      

      output$tabText2 <- renderText({

        if(input$goButton==0) return(NULL)

        return({

          print(paste("Multiplied by 2, that is", sleep2(), "seconds."))

        })

      })

    }

,

    ui=pageWithSidebar(

      headerPanel("Tabsets"),

      sidebarPanel(

        sliderInput(inputId="time", label="System sleep time (in seconds)", 

                    value=1, min=1, max=5),

        actionButton("goButton", "Let's go!")

      ),

      

      mainPanel(

        tabsetPanel(

          tabPanel(title="Tab 1", loadingPanel, textOutput("tabText1")), 

          tabPanel(title="Tab 2", loadingPanel, textOutput("tabText2")),

          id="tab"

        )

      )

    )

  )

)

[jussi jussinen]

What would be a good design pattern for a situation where I have a sidebar panel where user inputs values, and multiple tabs, each tab containing multiple plots (calculated from the input values)? I would like to show a single progress bar, that would show until all plots in the tab have finished rendering. Any ideas?

[Lina Castano-Duque]

Hi, I am trying to run an application using shiny but I found out that shinyIncubator was sort of integrated into shiny and that progressInit is no longer used, but now that I still need a progress bar what function replaced progressInit?

[Joe Cheng]

You don't need progressInit but withProgress/setProgress should work as before.

To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/0cd1076d-2ccd-40db-b3fc-6bc896a4a157%40googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

[meharji....@helsinki.fi]

Hi Jonathan,

I am in a similar situation after 5 years of your post. Could you please help where and what sort of code is required to be put in. The issue has been posted here Link to Stack .

Below is a sample code which takes two inputs: 1) input file and 2) input number of rows. Upon clicking the "Analyze" button the output from the server command return to the "Table" in "Results" tabset. This is a simple example where the command will be executed quickly and switches to the "Results" tabsetpanel.

In real case, the command takes longer to execute. Hence, i would like to 1) show a "Status Message" or "Progress Bar" when the command is executed when "Analyze" is clicked. And then 2) switch to "Results" tabsetpanel only upon completion of the command. Any help is appreciated.

library(shiny)
library(shinydashboard)

sidebar <- dashboardSidebar(width=200,
                        sidebarMenu(id="tabs",
                                    menuItem("File", tabName = "tab1",icon = icon("fas fa-file"))))
body <- tabItem(tabName = "tab1",
               h2("Input File"),
               fluidRow(tabPanel("Upload file", value="upload_file",
                                 fileInput(inputId ="uploadFile",label = "Upload Input file",multiple=FALSE,
                                           accept = c(".txt")),
                                 checkboxInput('header', label = 'Header', TRUE)),
                        box(title="Filter X rows", width=7,status="info",
                            tabsetPanel(id="input_tab",
                                        tabPanel("Parameters",numericInput("nrows",label="Entire number of rows",value=5, max=10),
                                                 actionButton("run","Analyze")),
                                        tabPanel("Results", value="results",navbarPage(NULL,
                                                                                       tabPanel("Table",DT::dataTableOutput("res_table"),icon = icon("table"))),
                                                 downloadButton("downList", "Download"))))))
ui<- shinyUI(dashboardPage(dashboardHeader(title = "TestApp", titleWidth = 150),sidebar,dashboardBody(tabItems(body))))


server <- function(input, output, session) {
file_rows <- eventReactive(input$run, {
system(paste("cat", input$uploadFile,"|", paste0("head -",input$nrows) ,">","out.txt"),intern=TRUE)
head_rows <- read.delim("out.txt")
head_rows
})

observeEvent(input$run,{
updateTabsetPanel(session,"input_tab", "results")
})

output$res_table <- DT::renderDataTable(DT::datatable(file_rows(),options = list(searching = TRUE,pageLength = 10, rownames(NULL), scrollX = T)))

output$downList <- downloadHandler(
filename = function() {
  paste0("output", ".vcf")
},
content = function(file) {
  write.table(file_rows(), file, row.names = FALSE)
})
}

shinyApp(ui=ui, server=server)




I need to show the progress when actionButton 'run' is clicked, and updateTabsetPanel and renderDataTable should be done upon completion of the command in file_rows() in the server side.