CODEWITHSUNDEEP
rshiny
u31889
u31889

Reputation: 351

Conditional update of selectInput widgets

Using the starwars dataset, below is a minimal example of the issue I am facing.

My app has three selectInput for filtering out a datatable. These selectInput update each other depending on the selected value of the previous one.

The app also contains radio buttons for selecting type characters. When the radio button 'default' is clicked, the selectInput should select the first value among the choices by default. However, when a radio button is a character (i.e. not 'default'), the selectInput should update and select the value defining the character (through a reactive object info()). As a consequence of the change in selection of the selectInput, the table should be filtered accordingly.

(The only constraint I have to follow here, is that I cannot use the dataset in the UI of the app.)

Here is the example app.

library(shiny)
library(dplyr)

ui <- fluidPage(
    selectInput(inputId="sex",
                label="SEX",
                choices=c(""),
                selected=NULL
    ),
    selectInput(inputId="homeworld",
                label="HOMEWORLD",
                choices=c(""),
                selected=NULL
    ),
    selectInput(inputId="species",
                label="SPECIES",
                choices=c(""),
                selected=NULL
    ),
    hr(),
    radioButtons(inputId="radio",
                 label=NULL,
                 choices=c("default", "C-3PO", "Leia Organa")
    ),
    hr(),
    verbatimTextOutput("info_object"),
    hr(),
    DT::dataTableOutput("table")
)

server <- function(session, input, output){
    
    # Get Sex / Homeworld / Species about character selected
    info <- reactive({
        if(input$radio == "default"){
            return(NULL)
        }
        else{
            list(Sex = starwars %>% subset(name == input$radio) %>% pull(sex),
                 Homeworld = starwars %>% subset(name == input$radio) %>% pull(homeworld),
                 Species = starwars %>% subset(name == input$radio) %>% pull(species))
        }
    })
    
    # To control the content of the 'info()' object
    output$info_object <- renderPrint({
        cat("info() object values:\n")
        print(info())
    })
    
    # Update selectInput widgets
    observe({
        if(is.null(info())){
            updateSelectInput(session=session,
                              inputId="sex",
                              choices=starwars$sex %>% 
                                         unique()
            )
            
            observeEvent(input$sex, {
                updateSelectInput(session=session,
                                  inputId="homeworld",
                                  choices=starwars %>% 
                                          subset(sex == input$sex) %>% 
                                          pull(homeworld) %>% 
                                          unique()
                )
            })
            
            observeEvent(input$homeworld, {
                updateSelectInput(session=session,
                                  inputId="species",
                                  choices=starwars %>% 
                                          subset(sex == input$sex & homeworld == input$homeworld) %>% 
                                          pull(species) %>% 
                                          unique()
                )
            })
        }
        else{
            updateSelectInput(session=session,
                              inputId="sex",
                              choices=starwars$sex %>% 
                                      unique(),
                              selected = info()$Sex
            )
            
            observeEvent(input$sex, {
                updateSelectInput(session=session,
                                  inputId="homeworld",
                                  choices=starwars %>% 
                                          subset(sex == input$sex) %>% 
                                          pull(homeworld) %>% 
                                          unique(),
                                  selected = info()$Homeworld
                )
            })
            
            observeEvent(input$homeworld, {
                updateSelectInput(session=session,
                                  inputId="species",
                                  choices=starwars %>% 
                                          subset(sex == input$sex & homeworld == input$homeworld) %>% 
                                          pull(species) %>% 
                                          unique(),
                                  selected = info()$Species
                )
            })
        }
        
        # Data table
        output$table <- DT::renderDataTable({
            DT::datatable(starwars %>% subset(sex == input$sex & homeworld == input$homeworld & species == input$species))
        })
    })                             
}

shinyApp(ui, server)

As you can see the selectInput do not update properly when choosing a radio button.

Upvotes: 0

Views: 67

Answers (1)

SmokeyShakers
SmokeyShakers

Reputation: 3412

It's probably due to a conflict between your choices and and selected.

For this type of thing I like to build a reactive chain, but observing both selects will also work. Change your observeEvent(s) for species to:

  observeEvent(c(input$homeworld, input$species), {
    updateSelectInput(session=session,
                      inputId="species",
                      choices=starwars %>% 
                        subset(sex == input$sex & homeworld == input$homeworld) %>% 
                        pull(species) %>% 
                        unique(),
                      selected = info()$Species
    )
  })

Upvotes: 2

Related Questions