CODEWITHSUNDEEP
rinputshinyshinydashboarddt
Doctor
Doctor

Reputation: 59

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

I'm building a shinyApp on mtcars data. I'm facing a problem in selectInput buttons. When i click disp button on the left, i don't get the choices. I only get All. Similarly when i put some values in carb filter, and then select another value from vs filter, immediately carb and disp resets to 'All' which shouldn't be happening. The previous selected values in carb and disp should remain if they are present in vs selected value. Can somebody please have a look at my codes. I shall be extremely grateful.

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)

Upvotes: 0

Views: 1628

Answers (1)

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84519

I've done several modifications in your code. In particular, I've added some req's (see ?req), and in output$disp_selector I've modified 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)

FYI, for a cleaner solution, you might be interested in selectizeGroupUI in the shinyWidgets package:

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)

Upvotes: 1

Related Questions