Disable inputs while server is busy

Question

What is the best way to disable all inputs while the server is busy computing?

I have several inputs whose changes trigger small computations and the rendering of an output. Usually everything works fine, but if someone changes a slider or a numeric input too fast, the program gets stuck somewhere between data preparation/computation and plotting.

• What is the best way to deal with such problems in 2023? Note that this is a very similar question to the one asked here.

• Are there by now any solutions that work for a whole application with different modules without disabling/enabling each input with shinyjs? Also, for a dynamic UI, I am not a big fan of using an action button.

Here is an example, just try to increase the bins from 10 to 20.

histogramInput <- function(id) {
  numericInput(NS(id, "bins"), "Select bins", 10, min = 1, step = 1)
}

histogramOutput <- function(id) {
  plotOutput(NS(id, "histogram"))
}

histogramServer <- function(id, value) {
  stopifnot(is.reactive(value))

  moduleServer(id, function(input, output, session) {

    # Some computational expensive data preparation
    dat_hist <- reactive({
      Sys.sleep(2)
      print(input$bins)
      list(dat = value(), bins = input$bins)
    })

    output$histogram <- renderPlot({
      req(dat_hist())

      graphics::hist(dat_hist()$dat, breaks = dat_hist()$bins)
    }, res = 96)
  })
}

histogramApp <- function() {
  ui <- fluidPage(
    histogramInput("test"),
    histogramOutput("test")
  )

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

    dat <- reactive({cars$speed})
    histogramServer("test", dat)
  }

  shinyApp(ui, server)
}

Answer 1

Heavily based on this awesome answer, I've adapted my code accordingly:

• Compared to the referenced answer I just want to invalidate the inputs. Hence, I differentiate between an input and output column and just invalidate the input column while shiny is busy.
• Optionally, a spinner can be added to the output column. Either like in my answer using e.g. the shinycssloaders package or directly with css code as in the linked answer above.

library("shiny")
# library("shinycssloaders") # optional

histogramInput <- function(id) {
  numericInput(NS(id, "bins"), "Select bins", 10, min = 1, step = 1)
}

histogramOutput <- function(id) {
  plotOutput(NS(id, "histogram"))
}

histogramServer <- function(id, value) {
  stopifnot(is.reactive(value))

  moduleServer(id, function(input, output, session) {

    # Some computational expensive data preparation
    dat_hist <- reactive({
      Sys.sleep(2)
      print(input$bins)
      list(dat = value(), bins = input$bins)
    })

    output$histogram <- renderPlot({
      req(dat_hist())

      graphics::hist(dat_hist()$dat, breaks = dat_hist()$bins)
    }, res = 96)
  })
}

histogramApp <- function() {
  ui <- fluidPage(
    # css to disable input
    tags$head(
      tags$style(HTML(
        "#loadmessage {
        position:fixed; z-index:8; top:50%; left:50%; padding:10px;
        text-align:center; font-weight:bold; color:#000000; background-color:#CCFF66;
        }

        .prevent_click{
        position:fixed;
        z-index:9;
        width:100%;
        height:100vh;
        background-color: transpare'nt;
        }"
      ))
    ),
    fluidRow(
      column(
        width = 4,
        # disable input column when shiny is busy
        conditionalPanel(
          condition = "$(\'html\').hasClass(\'shiny-busy\')",
          tags$div(class = "loader"),
          tags$div(class = "prevent_click")
        ),
        histogramInput("test")
      ),
      column(
        width = 8,
        # shinycssloaders::withSpinner(histogramOutput("test"), color = "lightgray") # optional
        histogramOutput("test")
      )
    )
  )

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

    dat <- reactive({cars$speed})
    histogramServer("test", dat)
  }

  shinyApp(ui, server)
}