Search code examples
rdynamicshinyobservers

observers fire on render of dynamic UI when they should not


The problem I face is that observers linked to dynamically rendered elements seem to fire on render, while this is not how I want it to be.

The reason this is a problem, is that the color buttons I'm making are linked to a plot that takes several seconds to render (plotly widget)

I added ignoreInit = T the observers that are created, but they still fire on rendering, unlike normal observers linked to a button build directly in the UI

How do I stop the observers linked to the dynamically rendered colourInput from firing when the element is rendered?

In the dummy app below the following series of events is recreated in simplified form:
A model spits out a number (simulated by test button in demo app) Based on this number, a number of colourInput buttons are made A same number of observeEvents are made for each.

Not in the dummy app: When the user chooses to change a color, the corresponding group in plots is recolored accordingly

The test app contains a working static colourInput, and a dynamic part that demonstrates the problem scenario.

Test app:

library(shiny)
 library("colourpicker")

THECOLORS <- c('#383838', '#5b195b','#1A237E', '#000080', '#224D17', '#cccc00', '#b37400',  '#990000', 
               '#505050',  '#a02ca0',  '#000099', '#2645e0', '#099441', '#e5e500', '#cc8400', '#cc0000', 
               '#737373', '#e53fe5', '#0000FF', '#4479e1',  '#60A830', '#ffff00','#e69500', '#ff0000', 
               '#b2b2b2', '#eb6ceb', '#6666ff', '#d0a3ff', '#9FDA40',  '#ffff7f', '#ffa500', '#ff4c4c')
ui <- fluidPage(      
      h1("WELCOME TO THE TEST APP", style = 'text-align: center; font-weight:bold' ),
    br(), 
    h3("STATIC PART: doesn't fire on startup, great!",  style = 'font-weight:bold'),
    div(colourpicker::colourInput(inputId = 'StaticColor', label = NULL, palette = "limited", allowedCols = THECOLORS, value = THECOLORS[14], showColour = "background", returnName = TRUE), 
    style = " height: 30px; width: 30px; border-radius: 6px;  border-width: 2px; text-align:center; padding: 0px; display:block; margin-bottom: 10px"),
    br(),
    h3("Dynamic part: fires on render, NOT great!",  style = 'font-weight:bold'),
    actionButton(inputId = 'Tester', label = 'Click me'),
    br(),
    uiOutput('colorbutton')
  )

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

 values <- reactiveValues()
 values$mycolors <- THECOLORS

 observeEvent(input$Tester, { values$NrofButtons <- sample(1:10, 1) })

 observeEvent(values$NrofButtons, { 
  COLElement <-    function(idx){sprintf("COL_button-%s-%d",values$NrofButtons,idx)}

  output$colorbutton <- renderUI({
    lapply(1:values$NrofButtons, function(x) { 
      div(colourpicker::colourInput(inputId = COLElement(x), label = NULL, palette = "limited", allowedCols = values$mycolors, value = values$mycolors[x], showColour = "background", returnName = TRUE), 
      style = " height: 30px; width: 30px; border-radius: 6px;  border-width: 2px; text-align:center; padding: 0px; display:block; margin-bottom: 10px")  })
  })

  lapply(1:values$NrofButtons, function(x) { observeEvent(input[[COLElement(x)]], { print(input[[COLElement(x)]] )}, ignoreInit = T)  }) # make observer for each button

 })

 observeEvent(input[['StaticColor']], { print(input[['StaticColor']] )}, ignoreInit = T)

}

shinyApp(ui,server)

Solution

  • Renders should always be by themselves and be data driven, not event driven -- so I've made the render require the number of colors to be defined before rendering. Of course the number of colors aren't defined until the observeEvent is fired by clicking the button.

    Overall there is still the issue that every time the button is clicked more observers are created for the same ID, working on a way to destroy these automatically on a subsequent click of the tester button.

    The key addition was a ignoreInit = TRUE in your observeEvent(input$Tester, {...}) observer.

    library(shiny)
    library("colourpicker")
    
    THECOLORS <- c('#383838', '#5b195b','#1A237E', '#000080', '#224D17', '#cccc00', '#b37400',  '#990000', 
                   '#505050',  '#a02ca0',  '#000099', '#2645e0', '#099441', '#e5e500', '#cc8400', '#cc0000', 
                   '#737373', '#e53fe5', '#0000FF', '#4479e1',  '#60A830', '#ffff00','#e69500', '#ff0000', 
                   '#b2b2b2', '#eb6ceb', '#6666ff', '#d0a3ff', '#9FDA40',  '#ffff7f', '#ffa500', '#ff4c4c')
    ui <- fluidPage(      
      h1("WELCOME TO THE TEST APP", style = 'text-align: center; font-weight:bold' ),
      br(), 
      h3("STATIC PART: doesn't fire on startup, great!",  style = 'font-weight:bold'),
      div(colourpicker::colourInput(inputId = 'StaticColor', label = NULL, palette = "limited", allowedCols = THECOLORS, value = THECOLORS[14], showColour = "background", returnName = TRUE), 
          style = " height: 30px; width: 30px; border-radius: 6px;  border-width: 2px; text-align:center; padding: 0px; display:block; margin-bottom: 10px"),
      br(),
      h3("Dynamic part: fires on render, NOT great!",  style = 'font-weight:bold'),
      actionButton(inputId = 'Tester', label = 'Click me'),
      br(),
      uiOutput('colorbutton')
    )
    
    
    COLElement <- function(idx) sprintf("COL_button-%d", idx)
    
    server <- function(input, output, session) {
    
      values <- reactiveValues(previous_max = 1)
    
      observeEvent(input$Tester, {
        values$NrofButtons <- sample(1:10, 1)
    
        # reset counters for all observers
        for (i in seq(values$NrofButtons)) {
          values[[sprintf("observer%d_renders", i)]] <- 0L
        }
    
        # only initialize incremental observers
        lapply(values$previous_max:values$NrofButtons, function(x) { 
          observeEvent(input[[COLElement(x)]], { 
            # only execute the second time, since the `ignoreInit` isn't obeyed
            if (values[[sprintf("observer%d_renders", x)]] > 0) {
              print(input[[COLElement(x)]] )
            } else {
              values[[sprintf("observer%d_renders", x)]] <- 1L
            }
    
          }, ignoreInit = TRUE)
        }) # make observer for each button
    
        # record the max
        values$previous_max <- max(values$previous_max, max(values$NrofButtons))
      }, ignoreInit = TRUE)
    
    
      output$colorbutton <- renderUI({
    
        req(length(values$NrofButtons) > 0)
    
        lapply(1:values$NrofButtons, function(x) { 
          div(colourpicker::colourInput(
            inputId     = COLElement(x)
            , label       = NULL
            , palette     = "limited"
            , allowedCols = THECOLORS
            , value       = THECOLORS[x]
            , showColour  = "background"
            , returnName  = TRUE
          )
          , style = " height: 30px; width: 30px; border-radius: 6px;  border-width: 2px; text-align:center; padding: 0px; display:block; margin-bottom: 10px"
          )
        })
      })
    
      observeEvent(input$StaticColor, { 
        print(input$StaticColor )
      }, ignoreInit = TRUE)
    
    }
    
    shinyApp(ui,server)