Updating selections of multiple pickerInputs dependent to each other

user_15004486 0
Viewed 39

Trying to update the selected values of two pickerInput depending on the selection of the third one leads to malfunctionning of the widgets themselves (impossible to select/deselect certain values, other pickers not updating).

An example using the starwars dataset below with the expected outcomes.

if (interactive()) {

library(shiny)
library(shinyWidgets)
library(dplyr)

df <- head(starwars, 20)

ui <- fluidPage(
  pickerInput(inputId = "p1",
              label = "Hair color",
              choices =df$hair_color %>% unique(),
              selected = df$hair_color %>% unique(), 
              multiple = T),
  pickerInput(inputId = "p2",
              label = "Skin color",
              choices = df$skin_color %>% unique(),
              selected = df$skin_color %>% unique(), 
              multiple = T),
  pickerInput(inputId = "p3",
              label = "Eye color",
              choices = df$eye_color %>% unique(),
              selected = df$eye_color %>% unique(), 
              multiple = T),
  hr(),
  p("Example 1:"),
  p("When selecting 'Hair color' = 'blond':"),
  p("• Selected values in 'Skin color' picker should be 'fair'"),
  p("• Selected values in 'Eye color' picker should be 'blue'"),
  br(),
  p("Example 2:"),
  p("When selecting 'Skin color' = 'light':"),
  p("• Selected values in 'Hair color' picker should be 'brown', 'brown, grey', 'black' and 'none'"),
  p("• Selected values in 'Eye color' picker should be 'blue', 'brown' and 'hazel"),
  br()
)

server <- function(input, output, session){
  
  observeEvent(input$p1, {
    updatePickerInput(session = session,
                      inputId = "p2",
                      selected = df %>%
                        filter(hair_color %in% input$p1) %>%
                        pull(skin_color) %>%
                        unique())
    
    updatePickerInput(session = session,
                      inputId = "p3",
                      selected = df %>%
                        filter(hair_color %in% input$p1) %>%
                        pull(eye_color) %>%
                        unique())
  })
  
  observeEvent(input$p2, {
    updatePickerInput(session = session,
                      inputId = "p1",
                      selected = df %>%
                        filter(skin_color %in% input$p2) %>%
                        pull(hair_color) %>%
                        unique())
    
    updatePickerInput(session = session,
                      inputId = "p3",
                      selected = df %>%
                        filter(skin_color %in% input$p2) %>%
                        pull(eye_color) %>%
                        unique())
  })
  
  observeEvent(input$p3, {
    updatePickerInput(session = session,
                      inputId = "p1",
                      selected = df %>%
                        filter(eye_color %in% input$p3) %>%
                        pull(hair_color) %>%
                        unique())
    
    updatePickerInput(session = session,
                      inputId = "p2",
                      selected = df %>%
                        filter(eye_color %in% input$p3) %>%
                        pull(skin_color) %>%
                        unique())
  })
}
  
shinyApp(ui, server)
}
shiny r
1 Answers

I found the answer to my question. But, by essence, this behaviour is not convenient without an actionButton since, after a first selection, just opening and closing another picker will inevitably change again the selected values of the other pickers.

Example:

. step-1: set 'Hair color to 'blond' (the other pickers are updated properly),

. step-2: open 'Skin color' menu without changing any values,

. step-3: close 'Skin color' menu

We can see that the values of the 'Hair color' and 'Eye color' are not the same as in step-1 (which are correct though).

if(interactive()){

library(shiny)
library(shinyWidgets)
library(dplyr)

df <- head(starwars, 20)

ui <- fluidPage(
  uiOutput("p1_ui"),
  uiOutput("p2_ui"),
  uiOutput("p3_ui"),
  hr(),
  p("Example 1:"),
  p("When selecting 'Hair color' = 'blond':"),
  p("• Selected values in 'Skin color' picker should be 'fair'"),
  p("• Selected values in 'Eye color' picker should be 'blue'"),
  br(),
  p("Example 2:"),
  p("When selecting 'Skin color' = 'light':"),
  p("• Selected values in 'Hair color' picker should be 'brown', 'brown, grey', 'black' and 'none'"),
  p("• Selected values in 'Eye color' picker should be 'blue', 'brown' and 'hazel"),
  br()
)

server <- function(input, output, session){
  
  filters <- reactiveValues(hair = df$hair_color %>% unique(),
                            skin = df$skin_color %>% unique(),
                            eye  = df$eye_color %>% unique()
  )
  
  output$p1_ui <- renderUI({
    pickerInput(inputId = "p1",
                label = "Hair color",
                choices =df$hair_color %>% unique(),
                selected = filters$hair, 
                multiple = T,
                options = list(
                  `actions-box` = TRUE,
                  `live-search` = TRUE,
                  title = "Select signature(s)",
                  `selected-text-format` = "count > 2",
                  style = "margin-bottom: 0.5em;"),)
  })
  
  output$p2_ui <- renderUI({
    pickerInput(inputId = "p2",
                label = "Skin color",
                choices =df$skin_color %>% unique(),
                selected = filters$skin, 
                multiple = T,
                options = list(
                  `actions-box` = TRUE,
                  `live-search` = TRUE,
                  title = "Select signature(s)",
                  `selected-text-format` = "count > 2",
                  style = "margin-bottom: 0.5em;"),)
  })
  
  output$p3_ui <- renderUI({
    pickerInput(inputId = "p3",
                label = "Eye color",
                choices =df$eye_color %>% unique(),
                selected = filters$eye, 
                multiple = T,
                options = list(
                  `actions-box` = TRUE,
                  `live-search` = TRUE,
                  title = "Select signature(s)",
                  `selected-text-format` = "count > 2",
                  style = "margin-bottom: 0.5em;"),)
  })
  
  
  observeEvent(input$p1_open, {
    if(!isTRUE(input$p1_open)){
      filters$skin <- df %>%
        filter(hair_color %in% input$p1) %>%
        pull(skin_color) %>%
        unique()
      
      filters$eye <- df %>%
        filter(hair_color %in% input$p1) %>%
        pull(eye_color) %>%
        unique()
    }
  })
  
  observeEvent(input$p2_open, {
    if(!isTRUE(input$p2_open)){
      filters$hair <- df %>%
        filter(skin_color %in% input$p2) %>%
        pull(hair_color) %>%
        unique()
      
      filters$eye <- df %>%
        filter(skin_color %in% input$p2) %>%
        pull(eye_color) %>%
        unique()
    }
  })
  
  observeEvent(input$p3_open, {
    if(!isTRUE(input$p3_open)){
      filters$hair <- df %>%
        filter(eye_color %in% input$p3) %>%
        pull(hair_color) %>%
        unique()
      
      filters$skin <- df %>%
        filter(eye_color %in% input$p3) %>%
        pull(skin_color) %>%
        unique()
    }
  })
}
  
shinyApp(ui, server)

}
user_150044860
Related