How to Prevent Shiny App Flickering When Changing selectizeInput to update Plot

The below will dynamically create sliderinputs via renderUI/uiOutput with default values coming from the cgroup while at the same time not overwriting any changes in the currently selected user values whenever an input is added or deleted.

The only time the original default values are restored back to the amount column in the cgroup input is when the cgroup input selection itself is changed, otherwise the presently selected values are kept.

This is all the desired function of how the app must function; however, whenever the cgroup filter is changed there is a brief flicker in between where it does not have the xlim value defined. I thought there may be a way such as freezeReactiveValue to prevent this flicker from occurring but I have not been able to figure out a proper solution.

How can I prevent this flicker from occurring? Thank you for your help.

library(shiny)
library(tidyverse)
colorchoice <- c("red","blue","green","purple","orange","yellow")
colorgroup <- as_tibble_col(colorchoice[1:4],column_name = "color") %>% 
  mutate(group=as_factor("group1"), amount = case_when(color=="red" ~ 30, 
                                                       color=="blue" ~ 10,
                                                       color=="purple" ~ 150,
                                                       color=="yellow" ~ 1000,
                                                       color=="green" ~ 600,
                                                       TRUE ~ 5))

colorgroup <- rbind(colorgroup, 
                    as_tibble_col(colorchoice[2:6],column_name = "color") %>%
                      mutate(group="group2", amount = case_when(color=="red" ~ 800, 
                                                                color=="blue" ~ 952,
                                                                color=="purple" ~ 5,
                                                                color=="yellow" ~ 50,
                                                                color=="green" ~ 35,
                                                                TRUE ~ 588)))


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput('cgroup', 'Color Group:', 
                     choices = levels(colorgroup$group),  
                     selected = 'group1', 
                     multiple = FALSE),
      selectizeInput("si", "Colors", choices  = colorchoice, multiple = TRUE),
      uiOutput("col"),
    ),
    mainPanel(
      plotOutput("plot")  
    )
  )
)



server <- function(input, output, session) {
  observe({
    r <- colorgroup %>% 
      filter(group==input$cgroup) %>% 
      dplyr::select(color)
    updateSelectizeInput(session, "si","Colors",
                         server = TRUE,
                         choices = colorchoice,
                         selected = r$color)
  })
  
  
  col_names <- reactive(paste0(input$si))
  
  
  output$col <- renderUI({
    map(req(col_names()), ~ {
      old_val <- isolate(input[[.x]])
      if (!isTruthy(old_val)) {
        old_val <- colorgroup %>%
          filter(group == input$cgroup) %>%
          filter(color == .x) %>%
          pull(amount)
      }
      sliderInput(.x, label = .x, min = 0, max = 1000, value = old_val)
    })
  })
  
  output$plot <- renderPlot({
    cols <- map_chr(col_names(), ~ input[[.x]] %||% "")
    # convert empty inputs to transparent
    cols[cols == ""] <- NA
    
    barplot(
      rep(1, length(cols)), 
      col = cols,
      space = 0, 
      axes = FALSE
    )
  }, res = 96)
}

shinyApp(ui = ui, server = server)

between preparing cols and using it to make a barplot, bail out if cols is not populated.

    cols <- map_chr(col_names(), ~ input[[.x]] %||% "")
    # convert empty inputs to transparent
    cols[cols == ""] <- NA
    if(!isTruthy(cols))
      return(NULL)
    barplot(

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.