使用子集数据后Shiny联动组件选中值不显示问题

问题原因分析 #

1. 第一个pickerInput的selected参数写法冗余，虽未直接引发错误，但逻辑不够严谨；
2. 第二个动态生成的pickerInput会随第一个组件的选择重新渲染，每次渲染都会重置选中状态，导致之前的选择丢失；
3. 未处理第一个组件选择为空时的边界情况，可能引发筛选报错。

修正后的完整代码 #

## app.R ##
library(shiny)
library(shinydashboard)
library(shinyWidgets)

# 简化数据创建逻辑，移除冗余的data.frame包裹
x1 <- structure(list(
  `REGION NAME` = c("Central", "Multinational", 
                   "East", "South", "East", "East", "East", "West", "East", "Multinational", 
                   "Multinational", "Multinational", "West", "East", "South", "South", 
                   "East", "East", "North", "Multinational"), 
  `Sector Complex Name` = c("AHVP", 
                            "PEVP", "PEVP", "PIVP", "AHVP", "AHVP", "AHVP", "AHVP", "PIVP", 
                            "PIVP", "PIVP", "PIVP", "AHVP", "AHVP", "PIVP", "AHVP", "AHVP", 
                            "AHVP", "PEVP", "PIVP")), 
  row.names = c(NA, -20L), 
  class = c("tbl_df", "tbl", "data.frame"))

ui <- dashboardPage(
  dashboardHeader(
    title="Task Managers' Workload Analysis",
    titleWidth = 400
  ),
  dashboardSidebar(),
  dashboardBody(
    tabsetPanel(
      tabPanel("Lending Approvals",
               fluidRow(
                 column(2,
                        pickerInput(
                          inputId = "reg",
                          label = "Select region",
                          choices = unique(x1$`REGION NAME`),
                          # 修正selected参数，取去重后的第一个有效元素
                          selected = unique(x1$`REGION NAME`)[1],
                          multiple = TRUE,
                          options = list(
                            `actions-box` = TRUE,
                            `deselect-all-text` = "None...",
                            `select-all-text` = "Yeah, all !",
                            `none-selected-text` = "zero"
                          )
                        )
                 ),
                 column(2,
                        uiOutput("sector")
                 )
               )
      )
    )
  )
)

server <- function(input, output, session) {
  # 用reactiveVal保存部门选中状态，避免重新渲染丢失
  selected_sec <- reactiveVal()
  
  subsets1 <- reactive({
    req(input$reg) # 确保输入有效后再筛选数据，避免空值报错
    subset(x1, `REGION NAME` %in% input$reg)
  })
  
  output$sector <- renderUI({
    sector_choices <- unique(subsets1()$`Sector Complex Name`)
    # 保留合理的选中状态：若之前的选择仍在当前选项中则沿用，否则默认选第一个
    current_selected <- if (!is.null(selected_sec()) && all(selected_sec() %in% sector_choices)) {
      selected_sec()
    } else {
      sector_choices[1]
    }
    
    pickerInput(
      inputId = "sec",
      label = "Select sectors",
      choices = sector_choices,
      selected = current_selected,
      multiple = TRUE,
      options = list(
        `actions-box` = TRUE,
        `deselect-all-text` = "None...",
        `select-all-text` = "Yeah, all !",
        `none-selected-text` = "zero"
      )
    )
  })
  
  # 监听部门选择，实时更新保存的状态
  observeEvent(input$sec, {
    selected_sec(input$sec)
  })
}

shinyApp(ui, server)

关键修改说明 #

• 简化数据创建代码，移除不必要的嵌套结构；
• 修正第一个pickerInput的selected参数逻辑，确保选中值正确；
• 添加reactiveVal保存第二个pickerInput的选中状态，解决重新渲染丢失选择的问题；
• 用req(input$reg)做输入有效性校验，避免空值筛选引发的错误；
• 动态生成第二个picker时，判断历史选中值是否仍在当前选项列表中，保证选中状态的合理性。

内容的提问来源于stack exchange，提问作者firmo23