更新相互依赖的多个 pickerInputs 的选择

Question

尝试根据第三个的选择更新两个 pickerInput 的选定值会导致小部件本身出现故障（无法 select/deselect 某些值，其他选择器不会更新）。

使用下方 starwars 数据集的示例以及预期结果。

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)
}

Answer 1

我找到了问题的答案。但是，从本质上讲，如果没有 actionButton，这种行为是不方便的，因为在第一次选择之后，仅仅打开和关闭另一个选择器将不可避免地再次改变其他选择器的选择值。

示例：

。 step-1: set 'Hair color to 'blond' (其他选择器正确更新),

。第 2 步：打开 'Skin color' 菜单而不更改任何值，

。第 3 步：关闭 'Skin color' 菜单

我们可以看到 'Hair color' 和 'Eye color' 的值与步骤 1 中的值不同（虽然是正确的）。

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)

}

更新相互依赖的多个 pickerInputs 的选择

Updating selections of multiple pickerInputs dependent to each other

r

shiny