R Brilliant caching values with updateCheckboxGroupInput () and selectinput ()
I am creating a Shiny app that updates checkboxGroupInput () based on the value of selectInput (). I also want to keep the values that are selected / deselected so that they display the same whenever I reselect the input value. For this, I use reactive values to store the selected values.
Here's an example of a toy:
library(shiny)
letters = c('A','B','C','D','E','F','G','H','I','J','K','L')
words = list( "A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
ui <- fluidPage(
selectInput("letter","Choose Letter",choices=letters,selectize=F),
# Initiate check box group
checkboxGroupInput('words_by_letter',label='Select Your Favorite Words',choices = c(1))
)
server <- function(input, output, session) {
v_selected <- reactiveValues(
"A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
observeEvent(input$letter,{
updateCheckboxGroupInput(session,
inputId = "words_by_letter",
choices = words[[input$letter]],
selected = v_selected[[input$letter]])
})
observeEvent(input$words_by_letter,{
v_selected[[input$letter]] = input$words_by_letter
})
}
shinyApp(ui = ui, server = server)
For the most part, this works great. However, if you scroll quickly through the inputs (while holding the arrow button), eventually some of the groups of checkboxes will be cleared. I'm guessing it has something to do with reactivity and Javascript communication speed, but I don't know how to fix it.
Note : I also tried to use a separate conditional bar for each letter, but this significantly increases the load time of my application, so I would rather not use this strategy.
source to share
It seems like it's a race condition, input$letter
updating too quickly for shinyServer to keep up, and trying to update a reactive state with inconsistent data. For example, it tries and overwrites the words "I" with "J" and then the input selector no longer works. I don't think the root cause is easily fixed.
However, the workaround is to only update your reactive state if the values you have in input$letter
and input$words_by_letter
are consistent.
This may or may not work depending on your actual data - you need to organize the data so there is a consistency condition that you can test and use to protect your update. In your toys example, I can compare the words selected with the ones you initialized with the selection - I used that.
I could have used the comparison of the first letter of the words in the input$words_by_letter
corresponding one input$letter
, but that seemed too specialized - thus comparing the selected data with the initialization of the selection is more likely to be generalized.
Here is the code:
library(shiny)
letters = c('A','B','C','D','E','F','G','H','I','J','K','L')
words = list( "A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
ui <- fluidPage(
selectInput("letter","Choose Letter",choices=letters,selectize=F),
# Initiate check box group
checkboxGroupInput('words_by_letter',label='Select Your Favorite Words',choices = c(1))
)
server <- function(input, output, session) {
v_selected <- reactiveValues(
"A" = c("apples","aardvark","alabama"),
"B" = c("banana","baltimore","beehive"),
"C" = c("catastrophe","cantalope"),
"D" = c("dinosaur","dairy","dolphin"),
"E" = c("eager","elephant","ecumenical"),
"F" = c("fleming","florida","flight"),
"G" = c("gator","greater","gait"),
"H" = c("HI"),
"I" = c("igloo","ignominious","interesting"),
"J" = c("jogging","jumpsuit"),
"K" = c("kellog","kangaroo"),
"L" = c("lemon","lime","lemonjello"))
observeEvent(input$letter,{
v_selected$last <- input$letter
updateCheckboxGroupInput(session,
inputId = "words_by_letter",
choices = words[[input$letter]],
selected = v_selected[[input$letter]])
})
overwriteIfConsistent <- function(selector,newvals,initwords){
# only overwrite if the new values are int the initial list
initwords1 <- initwords[[selector]]
truthvek <- newvals %in% initwords1 # are the newvals in this list?
if (sum(truthvek)==length(newvals)){ # need them all to be true
v_selected[[selector]] = newvals # ok, then overwrite
}
}
observeEvent(input$words_by_letter,{
overwriteIfConsistent(input$letter,input$words_by_letter,words)
})
}
shinyApp(ui = ui, server = server)
For what it's worth, here's what the app looks like:
source to share