Force output renderers to be after certain observers

[dipterix]

Hi,

A notice before the feature request: outputOption doesn't work in this case.

How hard it'll be to force output renderers to be always after some observers?

For instance, if I write an interface to users allowing them to customize renderPlot, the users might use reactive values such as but not limited to input. What's difficult is I cannot control or limit the variables getting used. This might result in a race condition with other observers.

Here's an minimal example that can reproduce the issue

library(shiny)

ui <- fluidPage(
  textInput('a', 'A'),
  textInput('b', 'B'),
  plotOutput('plot')
)

server <- function(input, output, session) {
  output$plot <- shiny::renderPlot({
    #  --- Some code you cannot control ---
    cat('Rendering plot...\n')
    plot(1:10, main = paste(input$a, input$b))
    # --- End of customized block --- 
  })

  # An observer that might race with the plot
  obsver <- observeEvent(input$a, {
    # update input$b
    updateTextInput(session, 'b', value = Sys.time())
  })
}

shinyApp(ui, server)

*Every time when I update A, the plot gets rendered twice, but I want the renderer to wait until the observer gets finished.

I want to explicitly specify the order of renderPlot and observeEvent, so that whenever certain observeEvent is in the queue, renderPlot gets moved towards the back of queue?

shiny::render_after(reactives = obsver, outputId = 'plot')

[dipterix]

My current work-around. Updating A or B will result in only one update.

render_after <- function(reactives, renderer, env, debounce = 200){
  last_obs <- Sys.time()
  tmp <- NULL

  for(obs in reactives){
    .func <- obs$.func
    obs$.func <- function(...){
      .func(...)
      last_obs <<- Sys.time()
    }
  }
  renderer <- substitute(renderer)
  expr <- renderer[[2]]
  f <- function(){
    if(isTRUE(tmp == last_obs)){
      eval(expr, envir = env)
    } else {
      tmp <<- last_obs
      shiny::invalidateLater(debounce)
    }
  }

  eval(as.call(list(
    renderer[[1]],
    quote(f())
  )))

}

ui <- fluidPage(
  textInput('a', 'A'),
  textInput('b', 'B'),
  plotOutput('plot')
)

server <- function(input, output, session) {
  local_data = new.env()
  local_data$last_obs = Sys.time()

  obs = observeEvent(input$a, {
    # update input$b
    updateTextInput(session, 'b', value = Sys.time())
    local_data$last_obs = Sys.time()
  })

  output$plot <- render_after(list(obs), renderPlot({
    cat('Rendering plot...\n')
    plot(1:10, main = paste(input$a, input$b))
  }), env = environment())

}

shinyApp(ui, server)

[wch]

If you want to control the order that observers are executed, you can set them with a higher priority than the default of 0. (The renderXXX functions are automatically wrapped into an observer when assigned to output$x, using the default priority of 0.)

However, that won't solve your problem here. When you call updateTextInput, it sends a message to the browser in the same "tick" in which it renders the plot. The browser receives the updated plot at the same time as the update message; it renders the plot and changes the value in the form element. Then it sends the updated input value to the server, and the server re-renders the plot and sends it to the browser.

So the behavior you're looking for will require you to write some additional code on the server side.

[dipterix]

Maybe it's better to defer/throttle the output renders? For example, in the observer, tell shiny to move output renderer out of the queue and wait for 0.3 seconds. For deferred output, If no changes made, then render, otherwise wait another 0.3 seconds. For throttled output, just wait 0.3 seconds and render.

[cpsievert]

Does it help if you wrap the title in a debounce()d reactive()?

library(shiny)

ui <- fluidPage(
  textInput('a', 'A'),
  textInput('b', 'B'),
  plotOutput('plot')
)

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

  title <- reactive({
    paste(input$a, input$b)
  })
  title <- debounce(title, 30)

  output$plot <- shiny::renderPlot({
    cat('Rendering plot...\n')
    plot(1:10, main = title())
  })

  obsver <- observeEvent(input$a, {
    updateTextInput(session, 'b', value = Sys.time())
  })
}

shinyApp(ui, server)

It seems another way to attack the problem would be to wrap the input value in a reactiveVal(), but that makes the reactive logic a bit harder to reason about

[dipterix]

@cpsievert Thanks for the example code. The problem is I cannot control the code block within renderPlot and I don't know which variables getting used. (Think about I'm writing an interface letting users to define customize the rendering, I don't event know if they are using ggplot2 or base plot).

Currently what I did was to make my own fake_input <- reactiveValues(), use one observer to monitor any changes to the input, copy the inputs to fake_input. In user-customized code, mask the input variable by fake_input so that they though they are using session$input but in fact my fake one.

The disadvantage of the solution is I can't control if the user uses session$input, then my fake input does nothing at all.

If I can know ahead what variables getting used for each reactive blocks, the problem can be solved automatically using your method