selectInput 未在 shinyApp 中显示选项并将值重置为 'All'

Question

我正在基于 mtcars 数据构建一个 shinyApp。我在 select 输入按钮 中遇到问题。当我点击左边的 disp button 时，我没有得到选择。我只得到 All。同样，当我将一些值放入 carb filter，然后 select 来自 vs filter 的另一个值时，立即 carb并且 disp 重置为 'All' 这不应该发生。 carb 和 disp 中的先前 selected 值如果出现在 vs selected 值中，则它们应该保留。有人可以看看我的代码吗？将不胜感激。

library(readr)  
library(shiny)   
library(DT)     
library(dplyr) 
library(shinythemes) 
library(htmlwidgets) 
library(shinyWidgets) 
library(shinydashboard)


data_table<-mtcars


#ui
ui = fluidPage( 
  sidebarLayout(
    sidebarPanel (



      uiOutput("vs_selector"),
      uiOutput("carb_selector"),
      uiOutput("disp_selector")),


    mainPanel(


      DT::dataTableOutput('mytable') )))




#server
server = function(input, output, session) {

  output$vs_selector <- renderUI({


    selectInput(inputId = "vs",
                label = "vs:", multiple = TRUE,
                choices = c( unique(data_table$vs)),
                selected = c(0,1))

  })



  output$carb_selector <- renderUI({

    available0 <- data_table[c(data_table$vs %in% input$vs ), "carb"]  


    selectInput(
      inputId = "carb", 
      label = "carb:",
      multiple = TRUE,
      choices = c('All',as.character(unique(available0))),
      selected = 'All')

  })



  output$disp_selector <- renderUI({

    available <- data_table[c(data_table$carb %in% input$carb    &    
data_table$vs %in% input$vs), "disp"]

    selectInput(
      inputId = "disp", 
      label = "disp:",
      multiple = TRUE,
      choices = c('All',as.character(unique(available))),
      selected = 'All')

  })



  thedata <- reactive({


    data_table<-data_table[data_table$vs %in% input$vs,]


    if(input$carb != 'All'){
      data_table<-data_table[data_table$carb %in% input$carb,]
    }


    if(input$disp != 'All'){
      data_table<-data_table[data_table$disp %in% input$disp,]
    }


    data_table

  })


  output$mytable = DT::renderDataTable({

    DT::datatable( {     

                     thedata()   # Call reactive thedata()


                   })

  })}  

shinyApp(ui = ui, server = server)

Answer 1

我对您的代码进行了多次修改。特别是，我添加了一些 req（参见 ?req），并且在 output$disp_selector 中我修改了 available:

available <- data_table[["disp"]][data_table$vs %in% input$vs]
if(! "All" %in% input$carb){
  available <- available[data_table$carb %in% input$carb]
}

data_table<-mtcars    

#ui
ui = fluidPage( 
  sidebarLayout(
    sidebarPanel (

      uiOutput("vs_selector"),
      uiOutput("carb_selector"),
      uiOutput("disp_selector")),


    mainPanel(

      DT::dataTableOutput('mytable') 

    )

))




#server
server = function(input, output, session) {

  output$vs_selector <- renderUI({

    selectInput(inputId = "vs",
                label = "vs:", multiple = TRUE,
                choices = c( unique(data_table$vs)),
                selected = c(0,1))

  })

  output$carb_selector <- renderUI({

    req(input$vs)

    available0 <- data_table[c(data_table$vs %in% input$vs ), "carb"]  

    selectInput(
      inputId = "carb", 
      label = "carb:",
      multiple = TRUE,
      choices = c('All',as.character(unique(available0))),
      selected = 'All')

  })


  output$disp_selector <- renderUI({
    req(input$vs, input$carb)

    available <- data_table[["disp"]][data_table$vs %in% input$vs]
    if(! "All" %in% input$carb){
      available <- available[data_table$carb %in% input$carb]
    }

    selectInput(
      inputId = "disp", 
      label = "disp:",
      multiple = TRUE,
      choices = c('All',as.character(unique(available))),
      selected = 'All')

  })



  thedata <- reactive({

    req(input$disp, input$vs, input$carb)

    data_table<-data_table[data_table$vs %in% input$vs,]

    if(! "All" %in% input$carb){
      data_table<-data_table[data_table$carb %in% input$carb,]
    }

    if(! "All" %in% input$disp){
      data_table<-data_table[data_table$disp %in% input$disp,]
    }

    data_table

  })


  output$mytable = DT::renderDataTable({

    DT::datatable( {     

      thedata()   # Call reactive thedata()

    })

  })

}  

shinyApp(ui = ui, server = server)

仅供参考，对于更简洁的解决方案，您可能对 shinyWidgets 包中的 selectizeGroupUI 感兴趣：

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  fluidRow(
    column(
      width = 10, offset = 1,
      tags$h3("Filter data with selectize group"),
      panel(
        selectizeGroupUI(
          id = "my-filters",
          params = list(
            disp = list(inputId = "disp", title = "disp:"),
            carb = list(inputId = "carb", title = "carb:"),
            vs = list(inputId = "vs", title = "vs:")
          )
        ), status = "primary"
      ),
      dataTableOutput(outputId = "table")
    )
  )
)

server <- function(input, output, session) {
  res_mod <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = mtcars,
    vars = c("disp", "carb", "vs")
  )
  output$table <- renderDataTable(res_mod())
}

shinyApp(ui, server)

selectInput 未在 shinyApp 中显示选项并将值重置为 'All'

selectInput not showing the choices and resetting values to 'All' in shinyApp

r

input

shiny

shinydashboard

dt