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 observeEvent
s 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)
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)