DT gets refreshed quickly if updateselectInput() is used

user_8483307 0
Viewed 106

In a shiny application, the choices of the selectInput() are updated based on the values of the column Grade in the dataframe df. I need to display a DT table based on the unique values of Grade. 

ui <- uiOutput('mainPage')


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

  grade <- c("All",9,10,11,12)

  output$mainPage <- renderUI({
    fluidPage(

      selectInput(inputId = "grade",shiny::HTML
                  ("<span style='color: white'>Designation</span>"),
                  choices = grade),
      DTOutput('table')
    )
  })


  output$table <- renderDT({

    df <-  data.frame("Name" = c('Arun','Ram','Krishna','Rama','Ashwin'),
                      "Grade" = c(10,11,10,12,11),
                      "StressLevel" = c('Stressful','Very stressful','Very stressful','Stressful','Stressful'))

    df$Name<-as.character(df$Name)

    rownames(df) <- c()

    selectedGrade <- as.list(unique(df[,"Grade"]))

    updateSelectInput(session,inputId = "grade",
                      choices = c("All",selectedGrade))


    if(input$grade == "All"){

      dataSelected <- df[,c(1,3)]

      stressCount <- length(unique(dataSelected$StressLevel))
      if(stressCount == 2){
        color = c('#ff684c','#e03426')
      }else{
        color = c('#ff684c')
      }
      if(stressCount == 0){
        color = c()
      }



      datatable(dataSelected, options = list(pageLenth = 5, searching = FALSE,
                                             lengthMenu = c(5, 10, 15, 20),lengthChange = FALSE,
                                             scrollX = T, autoWidth = TRUE,
                                             initComplete = JS(
                                               "function(settings, json) {",
                                               "$(this.api().table().header()).css({ 
                                               'color': '#fff'});",
                                               "}")))%>% formatStyle(
                                                 'StressLevel',
                                                 Color = styleEqual(unique(dataSelected$StressLevel), 
                                                                    color))


  }else{

    dataSelected <- df %>% filter(Grade == input$grade)

    dataSelected <- dataSelected[,c(1,3)]

    stressCount <- length(unique(dataSelected$StressLevel))
    if(stressCount == 2){
      color = c('#ff684c','#e03426')
    }else{
      color = c('#ff684c')
    }

    if(stressCount == 0){
      color = c()
    }

    datatable(dataSelected, options = list(pageLenth = 5, searching = FALSE,
                                           lengthMenu = c(5, 10, 15, 20),lengthChange = FALSE,
                                           scrollX = T, autoWidth = TRUE,
                                           initComplete = JS(
                                             "function(settings, json) {",
                                             "$(this.api().table().header()).css({ 
                                             'color': '#fff'});",
                                             "}"))) %>% formatStyle(
                                               'StressLevel',
                                               Color = styleEqual(unique(dataSelected$StressLevel),color))     
}
})
}

shinyApp(ui = ui, server = server)

Initially, the datatable is displayed with the choice All as the value. If I select other choices, say for instance 10, DT displays the data related to grade 10 but it gets refreshed quickly. The consequence faced is, the data for the grades other than All cannot be viewed.

Can anyone provide a suitable solution for this issue?

dt shiny r
1 Answers

You will need to set the selected argument of updateSelectInput() to retain the current selection:

library(shiny)
library(DT)
library(dplyr)

ui <- uiOutput('mainPage')

server <- function(input, output, session) {
  grade <- c("All", 9, 10, 11, 12)

  output$mainPage <- renderUI({
    fluidPage(selectInput(
      inputId = "grade",
      shiny::HTML
      ("<span style='color: white'>Designation</span>"),
      choices = grade
    ),
    DTOutput('table'))
  })


  output$table <- renderDT({
    DF <-
      data.frame(
        "Name" = c('Arun', 'Ram', 'Krishna', 'Rama', 'Ashwin'),
        "Grade" = c(10, 11, 10, 12, 11),
        "StressLevel" = c(
          'Stressful',
          'Very stressful',
          'Very stressful',
          'Stressful',
          'Stressful'
        )
      )

    DF$Name <- as.character(DF$Name)

    rownames(DF) <- c()

    selectedGrade <- as.list(unique(DF[, "Grade"]))

    updateSelectInput(
      session,
      inputId = "grade",
      choices = c("All", selectedGrade),
      selected = isolate({
        input$grade
      })
    )


    if (input$grade == "All") {
      dataSelected <- DF[, c(1, 3)]

      stressCount <- length(unique(dataSelected$StressLevel))
      if (stressCount == 2) {
        color = c('#ff684c', '#e03426')
      } else{
        color = c('#ff684c')
      }
      if (stressCount == 0) {
        color = c()
      }



      datatable(
        dataSelected,
        options = list(
          pageLenth = 5,
          searching = FALSE,
          lengthMenu = c(5, 10, 15, 20),
          lengthChange = FALSE,
          scrollX = T,
          autoWidth = TRUE,
          initComplete = JS(
            "function(settings, json) {",
            "$(this.api().table().header()).css({
                                               'color': '#fff'});",
            "}"
          )
        )
      ) %>% formatStyle('StressLevel',
                        Color = styleEqual(unique(dataSelected$StressLevel),
                                           color))


    } else{
      dataSelected <- DF %>% filter(Grade == input$grade)

      dataSelected <- dataSelected[, c(1, 3)]

      stressCount <- length(unique(dataSelected$StressLevel))
      if (stressCount == 2) {
        color = c('#ff684c', '#e03426')
      } else{
        color = c('#ff684c')
      }

      if (stressCount == 0) {
        color = c()
      }

      datatable(
        dataSelected,
        options = list(
          pageLenth = 5,
          searching = FALSE,
          lengthMenu = c(5, 10, 15, 20),
          lengthChange = FALSE,
          scrollX = T,
          autoWidth = TRUE,
          initComplete = JS(
            "function(settings, json) {",
            "$(this.api().table().header()).css({
                                             'color': '#fff'});",
            "}"
          )
        )
      ) %>% formatStyle('StressLevel',
                        Color = styleEqual(unique(dataSelected$StressLevel), color))
    }
  }, server = FALSE)
}

shinyApp(ui = ui, server = server)

Furthermore, I set server = FALSE for renderDT() to prevent the flashing of the "processing..." message when the datatable is re-rendered.

user_98413890
Related