Question

我正在基于mtcars数据构建ShinyApp。我在 selectInput按钮中遇到问题。当我单击左侧的显示按钮时，我没有选择。我只会得到全部。同样，当我将某些值放入碳水化合物过滤器中，然后从 vs过滤器中选择另一个值时，碳水化合物并显示立即重置为“全部”，不应该发生的。如果 vs 选择值中存在 carb和disp 中先前选择的值，则应保留这些值。有人可以看看我的代码吗？我将非常感谢。

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)

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

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中将值重置为“全部”

1 个答案: