R Shiny caching values with updateCheckboxGroupInput() and selectinput()

Question

I'm building a Shiny app that updates a checkboxGroupInput() based on the selectInput() value. I also want to store the values that are selected/de-selected so that they will appear the same whenever I re-select the input value. To do this, I'm using reactive values to store the selections.

Here's a toy example:

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 fine. However, if you scroll through the inputs quickly (by holding down the arrow button), eventually some of the checkbox groups will all be unchecked. I'm assuming this has something to do with the speed of reactivity and communication with Javascript, but I have no idea how to fix it.

Note: I've also tried using a separate conditionalPanel for each 'letter', but this increases the load time of my app considerably, so I'd prefer not to use that strategy.

Answer 1

This seems to be a race condition, the input$letter is getting updated too fast for shinyServer to keep up and it tries to update the reactive state with inconsistent data. For example it trys and overwrites the "I" words with "J" choices, and then the input selector doesn't work any more. I don't think the root cause is easily fixed.

A workaround however 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 that there is a consistency condition that can be tested and use that to guard your update. In your toy example here I can compare the words selected to the ones you initialized the selection with - I leveraged that.

I could have used compared the first letter of the words in input$words_by_letter matching input$letter, but that seemed too specialized - this way, comparing the selected data to the choice initialization is more likely to generalize.

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 is worth, this is what the app looks like: