sliderInput control triggers observer during initialisation

[Dumnovs]

We are currently developing an R Shiny app for our business at Lonsec. The UI of this app and the corresponding observers (eventObservers) is dynamically generated when the user selects from the choice of menu options. This UI contains sliderInput controls that trigger observers (pay attention to the console) upon the app initialisation (that should not happen, and it does not happen with the controls that do not require mandatory value, e.g. actionButton or textInput, etc).
Has everyone come across of thi problem and found a robust workaround for this issue (related to observers triggering during the initialisation as well as their destruction)?
Thank you,
Sergei

library(shiny)

ui = basicPage(
    fluidRow(actionButton(inputId = "add_buttons", label = "Add 5 Sliders")),
    uiOutput("more_buttons") # this is where the dynamically added buttons will go.
)

server = function(input, output, session)
{
    
    rvs <- reactiveValues(observers = list(), buttons = list()) 
    
    observeEvent(input$add_buttons,{
        
        l = length(rvs$buttons) + 1
        
        for(i in l:(l+4)) {
            rvs$buttons[[i]] = sliderInput(
                inputId = paste0("button", i),
                label = paste0("Slider ", i),
                min = 1,
                max = 5,
                step = 1,
                value = i
            )
        }
        #rvs$observers <- 
        lapply(
            l:(l+4), 
            function(i) {
                observeEvent(input[[paste0("button",i)]],{
                    if(!identical(rvs$observers[i], input[[paste0("button",i)]])) {
                        print(sprintf("You used the slider number %d",i))} else {
                            rvs$observers[i] <- input[[paste0("button",i)]]}
                },ignoreInit=TRUE)
            }
        )
    }
    )
    
    output$more_buttons <- renderUI({
        do.call(fluidRow, rvs$buttons) # Add the dynamic buttons into a single fluidRow
    })
    
}
shinyApp(ui = ui, server = server)

shinyApp(ui, server)

[winston]

The issue here is a slightly complicated one. ​The ignoreInit parameter has an effect only for the reactive flush cycle in which the observer is created. However, with the way that your code triggers the re-execution of the renderUI for output$more_buttons, the observeEvents for the buttons are created in one flush cycle, but the values trigger their execution in a later flush cycle.

Here's roughly what's happening:

• In the browser, the user clicks on the add_buttons button.
• The server session receives the incremented value for input$add_buttons. This triggers a reactive flush cycle.
• In the flush cycle, the code in the observeEvent(input$add_buttons, ...) executes. This creates the new slider input objects and stores them in rvs$buttons -- but does not send them to the browser!. It also calls observeEvent() for input$button1, input$button2, and so on. Those observers execute immediately in this flush cycle (I think they do, at least -- though it's possible they execute in the next one) and but because of ignoreInit=TRUE, they don't execute the code in the body; however, they are marked as initialized at this point. The reactive flush cycle ends.
• Because rv$buttons has changed, this triggers another reactive flush cycle. It causes the renderUI for output$more_buttons to execute, and sends the new slider UI stuff to the browser. This flush cycle ends.
• The client receives the UI for the sliders and renders them. This creates new input values for the sliders, so the client sends the new slider values to the server.
• The server receives the slider values, and this triggers the observers for the sliders (input$buttons1, etc.) Because these observers were earlier marked as initialized, the code in the observer body executes.

In this situation, where the input value is received after the observer is created, you can add a variable to record whether it has run before. For example:

  has_run <- FALSE
  observeEvent(input$x, {
    if (!has_run) {
      has_run <<- TRUE
      return()
    }

    # Do stuff here...
  })

Here's a modified version of your app that does that:

library(shiny)

ui <- fluidPage(
  fluidRow(actionButton(inputId = "add_buttons", label = "Add 5 Sliders")),
  uiOutput("more_buttons") # this is where the dynamically added buttons will go.
)

server <- function(input, output, session) {
  rvs <- reactiveValues(observers = list(), buttons = list()) 
  
  observeEvent(input$add_buttons,{
    cat("observeEvent(input$add_buttons, ...)\n")
    
    l <- length(rvs$buttons) + 1
    
    for(i in l:(l+4)) {
      rvs$buttons[[i]] <- sliderInput(
        paste0("button", i), paste0("Slider ", i),
        min = 1, max = 20, value = i
      )
    }

    lapply(l:(l+4),  function(i) {
      has_run <- FALSE
      observeEvent(
        {
          # In this event expression, we print out a message
          cat("event input$", paste0("button", i), ": ")
          print(input[[paste0("button",i)]])
          input[[paste0("button",i)]]
        },
        {
          cat("inside observeEvent(input$", paste0("button", i), ", ...): ")
          print(input[[paste0("button",i)]])
          if (!has_run) {
            has_run <<- TRUE
            return()
          }
          
          if (!identical(rvs$observers[i], input[[paste0("button",i)]])) {
            print(sprintf("You used the slider number %d",i))
          } else {
            rvs$observers[i] <- input[[paste0("button",i)]]
          }
        }
      )
    })
  })
  
  output$more_buttons <- renderUI({
    cat("output$more_buttons\n")
    do.call(fluidRow, rvs$buttons) # Add the dynamic buttons into a single fluidRow
  })
}

shinyApp(ui, server)

[Dumnovs]

Hi Winston,

Thank you for your effort to understand the problem and the reply. Yes, it is a complicated problem, and it took me awhile to understand what is happening under the hood.

We use almost the same approach as you suggested (although our case is more complex that the code I posted; the page, that includes a different number of sliderInputs, is ‘repainted’ based on the user menu selection). So we use a) sliderInputs ids that include menu id user used, b) we track the init phase in order to bypass it.

It is somehow working although I do not have a clear picture how sliderInput (with same ids) observers destroyed and recreated when the user return to the menu s/he used already.

It would be better to have a solid robust solution.

Thank you again
Sergei

[Dumnovs]

Hi Winston,

I probably did explain the problem properly and why it is difficult to crack… A user of the application we build has a top menu with options say A, B, C (more than that actually). When the user pick one of them, say A, the application dynamically builds the input /analysis page that includes a few sliderInputs.

If the option A is used 1st time, that workaround you suggested (and we used something like that as well ) works, but if later during the session the user comes back to the option A again, and a number of sliders for the option A is equal or less than for the previous option than Shiny ‘thinks’ there is no need to initialise as the sliders with those ids are already in the memory.

It causes us a lot of grief. We can’t use the static UI as the data source is constantly changes. It would be really great if someone can help us, please.

Thanks,

Sergei

[winston]

It is somehow working although I do not have a clear picture how sliderInput (with same ids) observers destroyed and recreated when the user return to the menu s/he used already.

You should bear in mind that the observers are not destroyed. Typically, there are two ways that observers are destroyed: when o$destroy() is called explicitly, or when the session ends (any observers created in that session are then destroyed).

I think this example should help. The previous observers a destroyed every time the renderUI() is called, and it uses freezeReactiveValues() to avoid over-reacting to changed values.

library(shiny)

shinyApp(
  fluidPage(
    radioButtons("n_sliders", "Number of sliders", c("1", "2", "3")),
    uiOutput("ui")
  ),
  function(input, output) {
    slider_observers <- list()
    
    reset_slider_observers <- function() {
      lapply(slider_observers, function(o) { o$destroy() })
      slider_observers <<- list()
    }

    output$ui <- renderUI({
      # Every time this renderUI is called, destroy all the old observers
      reset_slider_observers()
      
      n_sliders <- as.numeric(input$n_sliders)
      
      sliders <- lapply(seq_len(n_sliders), function(i) {
        name <- paste0("X", i)
        
        id <- round(runif(1, max = 100))
        has_run <- FALSE
        slider_observers[[name]] <<- observeEvent(input[[name]],
          {
            if (!has_run) {
              has_run <<- TRUE
              return()
            }
            message("You changed ", name, ": ", input[[name]])
          }
        )
        
        # Don't react to the specified input this flush cycle ends. This handles
        # the case where input$X1 has already been set to a value by the user,
        # and then the user changes the number of sliders.
        freezeReactiveValue(input, name)
      
        sliderInput(name, name, 1, 5, i)
      })
      do.call(div, sliders)
    })
  }
)

[Dumnovs]

Hi Winston,

Thank you very much for making the effort to dig deeper and help us. After a quick glance at your recommendation I think I might work and will test it later today.

Thanks again,
Sergei