R Shiny: How to temporarily disable reactivity?

Question

I am building a UI containing DT tables and sliders (both as inputs), as well as plot outputs. The tables are used to make a selection out of several. The user can only select one cell to make a choice.

I want the user to be able to store the setting of tables and sliders because they are quite complex. The idea is that the user can then switch back and forth between two stored settings, for example, and see how the resulting plots change. When a user restores a setting, the tables and sliders get updated, which updates the plot(s).

The problem is that the plot is not updated once, but usually twice. It seems that there is a delay somewhere in the logic, causing Shiny to first react to the update of the sliders, then to the update of the tables, so that the plot is re-plotted in two steps. This is very annoying for two reasons: (1) it causes the calculation to re-run twice, making the app react twice as slow and (2) it's impossible to see the changes directly in the plot because the original plot is first replaced by an intermediate plot which has no meaning to the user.

To illustrate the problem, I created this minimum working example, where I reduced complexity to just one table and one slider. I added a 3 second Sys.sleep to simulate a long calculation because obviously one would not see the problem otherwise:

library(shiny)
library(DT)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      actionButton("button", "Preset"),
      # No problem with selectInput:
      # selectInput("select", "x", choices = names(iris)[1:4], selected = "Sepal.Length"),
      DT::dataTableOutput("table"),
      sliderInput("slider", "bins", min = 1, max = 50, value = 30)
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$button, {
    # updateSelectInput(session, "select", selected =  "Petal.Width")
    selectRows(DT::dataTableProxy("table"), 4)
    updateSliderInput(session, "slider", value = 15)
  })

  output$table <- DT::renderDataTable(
    DT::datatable(
      data.frame(x = names(iris)[1:4]),
      rownames = FALSE,
      selection = "single",
      options = list(searching = FALSE, paging = FALSE, info = FALSE, ordering = FALSE)
    )
  )

  output$distPlot <- renderPlot({
    req(input$table_rows_selected)
    # x <- iris[[input$select]]
    x <- iris[[input$table_rows_selected]]
    bins <- seq(min(x), max(x), length.out = input$slider + 1)
    # Simulate long calculation:
    Sys.sleep(3)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
}

shinyApp(ui = ui, server = server)

Clicking first on the cell "Sepal.Length" in the table, then on the button "Preset" will load the preset and demonstrate the problem.

It seems that this is a timing issue/race condition, because sometimes, it works OK and the plot is updated only once (only in the minimal example, not the actual app). Usually the first time after starting the app. But in that case, just click on "Sepal.Length" again and change the slider position, then click on the "Preset" button and usually the plot will update twice.

I noticed that the problem does not appear when I replace the table with a selectInput. But the tables have a certain meaning: they stand for morphological fields (see package morphr), so I'd rather stick with tables to have the right appearance.

I could obviuously also disable reactivity using isolate() as suggested here: R Shiny: how to prevent duplicate plot update with nested selectors? and then e.g. introduce a button "Update plot". But I would prefer to keep the app reactive to changes in the sliders and tables, because that's a very useful user experience and one reason for me to use Shiny instead of PHP/python/etc.

My first idea to solve the problem was to introduce a reactive value:

server <- function(input, output, session) {
  updating <- reactiveVal(FALSE)
  # ...
}

then change the value before and after the updates to the inputs:

observeEvent(input$button, {
  updating(TRUE)
  selectRows(DT::dataTableProxy("table"), 4)
  updateSliderInput(session, "slider", value = 15)
  updating(FALSE)
})

and add an if statement in the renderPlot() code, e.g. with validate:

output$distPlot <- renderPlot({
  validate(need(!updating(), ""))
  # ...
})    

But that has no effect, because the entire code in the observeEvent(input$button) runs first, setting updating to TRUE and immediately back to FALSE. But the code inside renderPlot() is executed later (after the invalidation has occurred) and updating is always FALSE when it runs.

So, at the moment I have few ideas how to solve this. It would be best if one could somehow disable reactivity for the plot, then update the inputs, enable reactivity again and trigger a plot update programmatically. But is this possible?

Any other ideas for a workaround?

Answer 1

I'm not sure to understand the issue. Does this solve the problem:

library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  ......

  observeEvent(input$button, {
    runjs("Shiny.setInputValue('slider', 15); Shiny.setInputValue('table_rows_selected', 4);")
    selectRows(DT::dataTableProxy("table"), 4)
    updateSliderInput(session, "slider", value = 15)
  })