Prevent flickering of shiny updateSelectizeInput with server = T

Question

I have a shiny app with two kind of choices in selectizeInput, a long one and a short one. If users want to see only the short one, they can click a checkbox and choices change accordingly. Moreover, if users see the long choices, select one choice which is also in the short list and click the checkbox afterwards, the selected choice should remain selected. And the other way around. Up to here everything works in the following app, which is using reactiveValues and updateSelectizeInput:

library("shiny")

choicesONE <- c("a","b","c","d","e")

choicesTWO <- c("a","c","e")

ui <- shinyUI(fluidPage(

  sidebarLayout(

    sidebarPanel(

      selectizeInput(inputId="topic",
                     label = ("Topic"),
                     choices=NULL,
                     multiple = T,
                     options=list(maxItems = 1,
                                  placeholder="Please choose...")),

      checkboxInput("sub", "Show only subchoices", value = FALSE, width = NULL)

    ),

    mainPanel(

    )

  )

))

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

  #------- Initialize the Memory ----------

  choice <- reactiveValues(selection = NULL) 

  #------ Whenever the inputs are changed, it only modifies the memory----

  observeEvent(input$topic,{

    choice$selection <- input$topic

  })

  #------ Update UI element using the values stored in memory ------

  observe({

    if(input$sub==T) {

      updateSelectizeInput(session,
                           server = T,
                           'topic',
                           choices = choicesTWO,
                           selected = choice$selection)

    } else {

      updateSelectizeInput(session,
                           server = T,
                           'topic',
                           choices = choicesONE,
                           selected = choice$selection)


    }


  })



}

shinyApp(ui = ui, server = server)

In my real app, the list of choices contains some thousand choices and without using server = T the app is slowed down enormously.

But if I set server to true, the selectize field is emptied after every click on the checkbox and then filled again, so that the selectize field flickers. This is quite unattractive and especially user-unfriendly.

Does anyone know how I can prevent the flickering and at the same time hold on to server = T?

Answer 1

Since default you are showing the longer list of options, I assume it will not add too much burden to render both of the lists, considering the short list is much shorter.

The hack here is to render both of the lists but hide one of them based on the checkbox's value. This way, we will only need to call renderUI once to generate the DOM on the server side and we can pass in the choices already. (I borrowed the example from @kluu's answer, thanks!).

This way, we can update the selected option for the selectizeInput rather than updating the 'choices' param. And the reactiveVal selectedValue always has the correct selection.

library("shiny")

ui <- shinyUI(fluidPage(

  sidebarLayout(
    sidebarPanel(
      uiOutput("selectInput"),
      checkboxInput("sub", "Show only subchoices", value = FALSE, width = NULL),
      textOutput("debug")
    ),
    mainPanel()
  )

))

server <- function(input, output, session) {
  choicesONE <- as.character(sample(1:1000000, size = 1000))
  choicesTWO <- sample(choicesONE, size = 20)

  output$selectInput <- renderUI({
    tagList(
      conditionalPanel(
        "!input['sub']",
        selectizeInput(
          "longTopic",
          "Topic",
          choices = choicesONE,
          multiple = FALSE,
          options = list(placeholder = "Please choose...")
        )
      ),

      conditionalPanel(
        "input['sub']",
        selectizeInput(
          "shortTopic",
          "Topic",
          choices = choicesTWO,
          multiple = FALSE,
          options = list(placeholder = "Please choose...")
        )
      )
    )
  })

  selectedValue <- reactiveVal(NULL)

  observe({
    if (input$sub) {
      selectedValue(input$shortTopic)
    } else {
      selectedValue(input$longTopic)
    }
  })

  observeEvent(input$sub, {
    id <- ifelse(input$sub, "shortTopic", "longTopic")
    updateSelectizeInput(session, id,  selected = selectedValue())
  })

  output$debug <- renderText({
    selectedValue()
  })
}

shinyApp(ui = ui, server = server)

Answer 2

I'm not sure you can get something fully satisfying without going into selectize.js. It might be a little bit hacky, but if all you focus on is the UX, it can do the job:

choicesONE <- as.character(sample(1:1000000, size = 1000))
choicesTWO <- sample(choicesONE, size = 20)

...

observe({

    if (input$sub) {
        input_choices <- choicesTWO
    } else {
        input_choices <- choicesONE
    }

    input_placeholder <- isolate(input$topic)
    if (!(is.null(input_placeholder) || input_placeholder %in% choicesTWO)) {
        input_placeholder <- "Please choose..."
    }

    isolate(
        updateSelectizeInput(
            session,
            server = T,
            'topic',
            choices = input_choices,
            selected = choice$selection,
            options = list(placeholder=input_placeholder))
    )

})

To make it even more seemless, you could use a little bit of CSS.

Answer 3

Just use isolate in your obsever

observe({
  if(input$sub==T) {
    isolate(
      updateSelectizeInput(
        session,
        server = T,
        'topic',
        choices = choicesTWO,
        selected = choice$selection
      )
    )
  } else {
    isolate(
      updateSelectizeInput(
        session,
        server = T,
        'topic',
        choices = choicesONE,
        selected = choice$selection
      )
    )
  }
})