使用observeEvent与updateSelectInput后，依赖型响应式过滤器异常

问题根源 #

原代码仅在test_category有选中值时更新子类别选项，当test_category被清空（变为NULL）时，未设置对应逻辑更新test_subcategory的选项列表，导致子类别过滤器无选项可显示。

修复方案 #

修改监听test_category的observeEvent逻辑，增加对类别过滤器为空的判断：当类别无选中值时，子类别显示所有唯一值；当有选中类别时，仍展示对应子类别。同时初始化子类别过滤器的默认选项为所有子类别。

修改后的完整代码 #

library(shiny)
library(shinythemes)
library(dplyr)
library(DT)

category<-c('AA','AA','AA','AA','AA','BB','BB','BB','BB','BB')
sub.category<- c('A01','A01','A02','A02','A03','B01','B02','B02','B03','B03')
val1<-c(1,1,2,5,2,4,3,1,1,1)
val2<-c(2,2,2,2,2,2,2,2,2,2)
val3<-c(4,5,5,6,6,3,6,8,1,1)
val4<-c(0,0,0,0,0,0,0,0,0,0)

testdata <- as.data.frame(cbind(category,sub.category,val1,val2,val3,val4))

# 过滤器初始化
cat_name <- unique(testdata$category)
# 预存所有唯一子类别
all_subcat <- unique(testdata$sub.category)
cat_sub_name <- testdata %>% select(category, sub.category) %>% 
  distinct() %>% arrange(sub.category)

# Server函数
server <- function(input, output, session) {
  
  # 响应式数据集
  df_testdata <- reactive({
    if (is.null(input$test_category) && is.null(input$test_subcategory)) {
      testdata
    } else if (is.null(input$test_category) && !is.null(input$test_subcategory)) {
      testdata %>% filter(sub.category %in% input$test_subcategory)
    } else if (!is.null(input$test_category) && is.null(input$test_subcategory)) {
      testdata %>% filter(category %in% input$test_category)
    } else {
      testdata %>% filter(category %in% input$test_category & sub.category %in% input$test_subcategory)
    }
  })
  
  output$tab1 <- DT::renderDataTable(DT::datatable(df_testdata(), style = "bootstrap", filter = list(position = 'top', clear = FALSE), options = list(autoWidth = TRUE, searching = TRUE)))
  
  # 依赖式过滤器更新逻辑
  observeEvent(input$test_category, {
    if (is.null(input$test_category)) {
      # 类别清空时，显示所有子类别
      subcatToShow <- all_subcat
    } else {
      # 选中类别时，显示对应子类别
      subcatToShow <- cat_sub_name %>% 
        filter(category %in% input$test_category) %>% pull(sub.category)
    }
    # 更新子类别选择框，清空自动选中值
    updateSelectInput(session, "test_subcategory", choices = subcatToShow, selected = NULL)
  })
  
}

# UI部分
ui <- fluidPage(
  theme = shinytheme('darkly'),
  
  titlePanel("Analysis Dataset", windowTitle="Category Dataset"),
  
  sidebarLayout(
    mainPanel(
      width = 10,
      DT::dataTableOutput('tab1')
    ),
    sidebarPanel( width = 2,
                  selectInput("test_category",
                              choices = cat_name, 
                              label = "选择类别",
                              multiple = TRUE),
                  selectInput("test_subcategory",
                              choices = all_subcat,  # 初始显示所有子类别
                              label = "选择子类别",
                              multiple = TRUE)
    )
  )
)

shinyApp(ui = ui, server = server)

关键修改点 #

1. 初始化子类别选项：UI中test_subcategory的初始choices设为all_subcat，页面加载时即可看到所有子类别选项。
2. 补充空值判断逻辑：在observeEvent中新增判断，当input$test_category为NULL时，将子类别选项切换为所有唯一子类别。
3. 优化选中状态：更新子类别选择框时设置selected = NULL，避免自动选中第一个选项，符合清空过滤器的操作预期。

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