Suspending event scheduling in Shiny

Question

I have an app with two observeEvent() handlers reacting to input A and input B and doing some stuff. Among the stuff for event A, is updating input B.

shinyApp(
  ui = fluidPage(
    selectInput("A", "Input A", c(1:5)),
    selectInput("B", "Input B", c(6:10))
  ),
  server = function(input, output, session) {
    observeEvent(input$A, ignoreInit = TRUE, {
      message("Doing A stuff")
      updateSelectInput(session, "B", selected = 10)
    })
    observeEvent(input$B, ignoreInit = TRUE, {
      message("Doing B stuff")
    })
  }
)

So changing input A obviously triggers event B as well. I would like event B to be triggered only when the user is changing the value of the input and not when it is done by updateInput. Is there a way to suspend scheduling events when a expression is evaluated? I would like something like this:

shinyApp(
  ui = fluidPage(
    selectInput("A", "Input A", c(1:5)),
    selectInput("B", "Input B", c(6:10))
  ),
  server = function(input, output, session) {
    observeEvent(input$A, ignoreInit = TRUE, {
      message("Doing A stuff")
      suspendEventScheduling()
      updateSelectInput(session, "B", selected = 10)
      resumeEventScheduling()
    })
    observeEvent(input$B, ignoreInit = TRUE, {
      message("Doing B stuff")
    })
  }
)

Documentation for observers mentions "suspended state" but I cannot find any examples as to how to actually use it.

I don't think the existing observer suspension mechanism is helpful here, in particular because: ["If the observer was invalidated while suspended, then it will schedule itself for re-execution."](https://shiny.rstudio.com/reference/shiny/1.6.0/observe.html) — Mikko Marttila, Mar 10 '22 at 13:45
I think this is more or less the same issue on the Shiny GitHub page: https://github.com/rstudio/shiny/issues/2865 — Mikko Marttila, Mar 11 '22 at 12:45

Mikko Marttila · Answer 1 · 2022-03-11T14:41:35.247

After some playing around, I put together a bit of JavaScript that should do the trick.

The idea is to keep track of suspended inputs whose values should not change. Using an event hook, we can then check if an input event targets one of the suspended inputs. If so, prevent it from making changes. Crucially though, the UI still gets updated – just not the Shiny input values.

We then also need a couple of helper functions to manage the list of suspended inputs. Here’s the JavaScript, and the R helpers:

js <-
  "
  // Don't actually modify the Shiny object in 'real' code!
  Shiny.suspendedInputs = new Set();
  
  $(document).on('shiny:inputchanged', function(event) {
    Shiny.suspendedInputs.has(event.target.id) && event.preventDefault();
  })
  
  Shiny.addCustomMessageHandler('suspendinput', function(message) {
    Shiny.suspendedInputs.add(message.id);
  });
  
  Shiny.addCustomMessageHandler('resumeinput', function(message) {
    Shiny.suspendedInputs.delete(message.id);
    
    // Last value that Shiny got is probably out of sync with the UI
    Shiny.forgetLastInputValue(message.id);
  })
  "

suspendInput <- function(inputId, session = getDefaultReactiveDomain()) {
  session$sendCustomMessage("suspendinput", list(id = inputId))
}

resumeInput <- function(inputId, session = getDefaultReactiveDomain()) {
  session$sendCustomMessage("resumeinput", list(id = inputId))
}

Almost always the suspend and resume messages should be sent on different flush cycles. Otherwise the resume is executed before the input events from any updates have triggered, resulting in nothing happening. Another helper to ensure “correct” usage would be in order:

suspendForNextFlush <- function(inputId, session = getDefaultReactiveDomain()) {
  session$onFlush(function() suspendInput(inputId, session = session))
  session$onFlushed(function() resumeInput(inputId, session = session))
}

And now we are ready to put everything together for a working app:

library(shiny)

shinyApp(
  ui = fluidPage(
    tags$script(HTML(js)),
    selectInput("A", "Input A", c(1:5)),
    selectInput("B", "Input B", c(6:10))
  ),
  server = function(input, output, session) {
    observeEvent(input$A, {
      message("Doing A stuff")
      suspendForNextFlush("B")
      updateSelectInput(session, "B", selected = 10)
    }, ignoreInit = TRUE)
    observeEvent(input$B, {
      message("Doing B stuff")
    }, ignoreInit = TRUE)
  }
)

Mikko Marttila · Answer 2 · 2022-03-10T13:53:37.543

0

In the past I have used a sentinel value pattern to work around these types of situations (see below). But it always feels very fragile. Hopefully this feature request leads to better options.

library(shiny)

shinyApp(
  ui = fluidPage(
    selectInput("A", "Input A", c(1:5)),
    selectInput("B", "Input B", c(6:10))
  ),
  server = function(input, output, session) {
    is_server_update <- FALSE
    observeEvent(input$A, {
      message("Doing A stuff")
      updateSelectInput(session, "B", selected = 10)
      # Unchanged value doesn't trigger an invalidation
      if (input$B != 10) {
        is_server_update <<- TRUE
      }
    }, ignoreInit = TRUE)
    observeEvent(input$B, {
      if (is_server_update) {
        is_server_update <<- FALSE
      } else {
        message("Doing B stuff")
      }
    }, ignoreInit = TRUE)
  }
)

edited Mar 10 '22 at 13:53

answered Mar 10 '22 at 13:40

Mikko Marttila

10,972
18
31

Thanks for sharing! I have tried implementing something similar before, but as you said - it feels fragile, quite fiddly and inefficient, especially if there is a lot of additional relations going on between observers. I hoped there is something better and cleaner implemented to achieve this sort of stuff. – Radvvan Mar 10 '22 at 14:05
Yeah I totally agree. I would love to hear about it, if you find a better way. – Mikko Marttila Mar 10 '22 at 14:09
Turns out this is actually the approach suggested by Shiny authors: https://github.com/rstudio/shiny/issues/2865#issuecomment-623735752 – Mikko Marttila Mar 11 '22 at 12:44

Suspending event scheduling in Shiny

2 Answers2

Linked