如果使用updateselectInput（），则DT会快速刷新

Question

在闪亮的应用程序中， selectInput（）的选择将根据数据帧 df 中的列 Grade 的值进行更新。 。我需要根据成绩的唯一值显示DT表。

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年级相关的数据，但很快就会刷新。面临的结果是，无法查看除全部以外的成绩数据。

有人可以为这个问题提供合适的解决方案吗？

Answer 1

您需要设置selected的{​​{1}}参数以保留当前选择：

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，以防止在重新呈现数据表时闪烁“正在处理...”消息。