DT обновляется быстро, если используется updateselectInput () - PullRequest
Новая
       16

DT обновляется быстро, если используется updateselectInput ()

2 голосов
/ 25 июня 2019

В блестящем приложении выбор selectInput () обновляется на основе значений столбца Grade в кадре данных df .Мне нужно отобразить таблицу DT на основе уникальных значений 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)

Первоначально таблица данных отображается с выбором Все в качестве значения.Если я выбираю другие варианты, например, 10, DT отображает данные, относящиеся к 10 классу, но они быстро обновляются.Следствием этого является то, что данные для классов, отличных от Все , не могут быть просмотрены.

Может кто-нибудь предложить подходящее решение для этой проблемы?

1 Ответ

1 голос
/ 25 июня 2019

Вам потребуется установить аргумент selected для updateSelectInput(), чтобы сохранить текущий выбор: 

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)

Кроме того, я установил server = FALSE для renderDT(), чтобы предотвратить мигание "обработка ... "сообщение при повторной визуализации данных.

...