How to Update choices of select input in r shiny dynamically?

Hi
My app will ask user to select any number of character variable. Based on his selection further input widgets will appear but the choice to select those levels depends on what user selected in earlier levels.

For example if both category and segment are selected in 1st input widgets and only skin_care in 2nd input widgets then Medicated and Non medicated should come as option in 3rd input widgets not all the unique names of segment. If hair_care selected instead of skin_care in 2nd input widgets then Gents and Ladies should be choice in 3rd input widgets drop down. So basically the choice to select from drop down is dependent on what user selected on earlier input widgets. Same goes for brand also.

Please suggest if there is any way to do it. Thanks

library(shiny)
library(DT)

ui <- shinyUI(fluidPage(
tabsetPanel(
tabPanel("Data", fluid = TRUE,
     sidebarLayout(
       sidebarPanel(p("Please remove None first"),
                    uiOutput("dim"),
                    uiOutput("levels1")),
       mainPanel(
         DT::dataTableOutput("data_display")
       ))))))

server <- shinyServer(function(input,output){

# creating Data 
data <- reactive({
data <-  data.frame(Date = as.Date(c("2018-05-25","2018-05-26")),
        category = c(rep("skin_care",6),rep("hair_care",6)),
        Segment =  c(rep("Medicated",4),rep("Non_Medicated",2),
                   rep("Ladies",4),rep("Gents",2)),
        Brand = c("X","X","Y","Y","Z","Z","A","A","B","B","C","C"),
        sales = round(rnorm(12,100,3)))
})


# Displaying Data  

output$data_display <- DT::renderDataTable(                    
datatable(data(),options = list(pageLength = 12),rownames = FALSE)
)

# selects dimension (Only character variable to be selected)

output$dim<-renderUI({
b<-colnames(data()[sapply(data(),class)=="character"])
selectInput("x","Select only character variable",choices = 
          c("NONE",b[1:length(b)]),selected="NONE",multiple = TRUE)
})

#  user selects levels of dimension 

output$levels1<-renderUI({
if(is.null(input$x)){
return(NULL)
}
else if(sum(input$x=="NONE")==1){
return(NULL)
}
else{
lapply(seq(input$x),function(i){
selectInput(inputId = paste0("range",i),
            paste0("Select level of ",input$x[i]),
            choices = c(unique(data()[,input$x[i]]),"ALL"),multiple = TRUE)

})
}
})
})
shinyApp(ui,server)

Check out the documentation for updateSelectInput:
https://shiny.rstudio.com/reference/shiny/latest/updateSelectInput.html

2 Likes

Thanks paul for the link.
My challenge is to make it generic! I kept three character variable here for simplicity. My actual app will ask user to load file and that can have n number of character variable.

I used observeEvent and updateSelectinput but that is more of becoming hard coded. Its more of a logic challenge which i am not able to figure out!

Correct @paul !

@prasun1379
If you use an observe() with the data, you can calculate the columns inside that observe() and set the choice values with updateSelectInput().

server <- function(input, output, session) {
  # ... other code

  # run every time data is updated
  observe({
    # get all character or factor columns
    isCharacter <- vapply(data(), is.character, logical(1)) | vapply(data(), is.character, logical(1))
    characterCols <- names(isCharacter)[isCharacter]
    updateSelect(session, "x",
      choices = characterCols, # update choices
      selected = NULL) # remove selection
  })
}

@barret My apologies for digging up an old post but I am having a very similar problem but with a slight addition. In the case given by prasun1379 they wanted to have all of the choices be the same for each of the n select inputs but I am wondering would it be possible to remove an option as a choice when it is chosen by a different select input? Even if it has to be in numerical order for hierarchy that would be fine but is this at all possible?

Not sure if this exactly matches your request, but you might want to have a look at selectizeGroupServer from library(shinyWidgets).

1 Like