如何实现Shiny中selectizeInput组件的联动依赖控制

原应用代码 #

library(shiny)
library(vtree)
library(tibble) # 补充原代码缺失的包加载

df <- tibble(A = c(rep("nature", 18), rep("not nature", 9)),
             B = rep(c("animal", "plant", "machine"), each=9),
             C = c(rep(c("dog", "cat", 'mouse'), 3),
                   rep(c("tree", "flower", "grass"), 3),
                   rep(c("car", "plane", "train"), 3)
             )
)

# Define UI ----
ui <- pageWithSidebar(
  
  # App title ----
  headerPanel("my app"),
  
  # Sidebar panel for inputs ----
  sidebarPanel(
    selectizeInput("levels", label = "Levels", choices = NULL, multiple = TRUE),
    selectizeInput("valuesA", label= "Values_A", choices = NULL, multiple=TRUE),
    selectizeInput("valuesB", label= "Values_B", choices = NULL, multiple=TRUE),
    selectizeInput("valuesC", label= "Values_C", choices = NULL, multiple=TRUE),
  ),
  
  # Main panel for displaying outputs ----
  mainPanel(
    vtreeOutput("VTREE")
    
  )
)

# Define server logic to plot ----
server <- function(input, output,session) {
  df <- reactiveVal(df)
  vector <- c("A","B", "C")
  
  
  observe({
    updateSelectizeInput(session, "levels", choices = colnames(df()[vector]), selected = NULL) 
    updateSelectizeInput(session, "valuesA", choices = unique(df()$A))
    updateSelectizeInput(session, "valuesB", choices = unique(df()$B))
    updateSelectizeInput(session, "valuesC", choices = unique(df()$C))
  })
  
  output[["VTREE"]] <- renderVtree({
    vtree(df(), c(input$levels),
          sameline = TRUE,
          keep=list(A=input$valuesA,
                    B = input$valuesB,
                    C = input$valuesC),
          pngknit=FALSE,
          horiz=TRUE,height=450,width=850)
  })
  
}
shinyApp(ui, server)

需求说明 #

需要实现三个联动场景：

• 场景1：当Levels选择A时，仅允许选择Values_A，Values_B和Values_C不可选。
• 场景2：当Levels选择A且Values_A选择nature时，Values_B仅显示animal和plant选项（隐藏machine）。
• 场景3：当Levels选择A、Values_A选择nature且Values_B选择animal时，Values_C仅显示dog、cat、mouse选项。

修改后的完整代码 #

library(shiny)
library(vtree)
library(tibble)
library(dplyr) # 用于数据筛选

df <- tibble(A = c(rep("nature", 18), rep("not nature", 9)),
             B = rep(c("animal", "plant", "machine"), each=9),
             C = c(rep(c("dog", "cat", 'mouse'), 3),
                   rep(c("tree", "flower", "grass"), 3),
                   rep(c("car", "plane", "train"), 3)
             )
)

ui <- pageWithSidebar(
  headerPanel("my app"),
  sidebarPanel(
    selectizeInput("levels", label = "Levels", choices = NULL, multiple = TRUE),
    selectizeInput("valuesA", label= "Values_A", choices = NULL, multiple=TRUE),
    selectizeInput("valuesB", label= "Values_B", choices = NULL, multiple=TRUE),
    selectizeInput("valuesC", label= "Values_C", choices = NULL, multiple=TRUE),
  ),
  mainPanel(
    vtreeOutput("VTREE")
  )
)

server <- function(input, output,session) {
  df <- reactiveVal(df)
  vector <- c("A","B", "C")
  
  # 初始化Levels选项
  observe({
    updateSelectizeInput(session, "levels", choices = colnames(df()[vector]), selected = NULL)
  })
  
  # 监听Levels变化，控制Values系列组件的启用状态
  observeEvent(input$levels, {
    # 场景1：仅选A时，禁用B、C的选择框
    if ("A" %in% input$levels && length(input$levels) == 1) {
      updateSelectizeInput(session, "valuesA", choices = unique(df()$A), selected = input$valuesA)
      updateSelectizeInput(session, "valuesB", choices = unique(df()$B), selected = NULL, disabled = TRUE)
      updateSelectizeInput(session, "valuesC", choices = unique(df()$C), selected = NULL, disabled = TRUE)
    } else {
      # 其他情况启用所有选择框，后续再根据输入筛选选项
      updateSelectizeInput(session, "valuesA", choices = unique(df()$A), selected = input$valuesA, disabled = FALSE)
      updateSelectizeInput(session, "valuesB", choices = unique(df()$B), selected = input$valuesB, disabled = FALSE)
      updateSelectizeInput(session, "valuesC", choices = unique(df()$C), selected = input$valuesC, disabled = FALSE)
    }
  }, ignoreNULL = FALSE)
  
  # 监听Values_A变化，动态更新Values_B的选项
  observeEvent(input$valuesA, {
    if ("A" %in% input$levels && !is.null(input$valuesA)) {
      # 筛选当前A值对应的B选项
      filtered_df <- df() %>% filter(A %in% input$valuesA)
      valid_B <- unique(filtered_df$B)
      # 场景2：自动匹配A值对应的有效B选项
      updateSelectizeInput(session, "valuesB", choices = valid_B, selected = NULL, disabled = FALSE)
      # 重置Values_C并禁用，直到B被选择
      updateSelectizeInput(session, "valuesC", choices = unique(df()$C), selected = NULL, disabled = TRUE)
    }
  })
  
  # 监听Values_B变化，动态更新Values_C的选项
  observeEvent(input$valuesB, {
    if ("A" %in% input$levels && !is.null(input$valuesA) && !is.null(input$valuesB)) {
      # 筛选当前A和B值对应的C选项
      filtered_df <- df() %>% filter(A %in% input$valuesA, B %in% input$valuesB)
      valid_C <- unique(filtered_df$C)
      # 场景3：自动匹配A+B值对应的有效C选项
      updateSelectizeInput(session, "valuesC", choices = valid_C, selected = NULL, disabled = FALSE)
    }
  })
  
  output[["VTREE"]] <- renderVtree({
    # 处理空输入，避免vtree报错
    keep_list <- list()
    if (!is.null(input$valuesA)) keep_list$A <- input$valuesA
    if (!is.null(input$valuesB)) keep_list$B <- input$valuesB
    if (!is.null(input$valuesC)) keep_list$C <- input$valuesC
    
    vtree(df(), c(input$levels),
          sameline = TRUE,
          keep = keep_list,
          pngknit=FALSE,
          horiz=TRUE,height=450,width=850)
  })
  
}
shinyApp(ui, server)

关键改动说明 #

1. 组件启用/禁用控制：通过updateSelectizeInput的disabled参数，在场景1中锁定Values_B和Values_C，确保用户只能操作Values_A。
2. 动态选项筛选：用dplyr::filter根据已选的上游值，实时筛选下游组件的有效选项，精准匹配场景2和3的需求。
3. 分模块监听：拆分多个observeEvent分别监听Levels、Values_A、Values_B的变化，避免逻辑混乱，确保联动响应精准。
4. 空输入兼容：在vtree渲染部分处理空输入的情况，避免因无选择值导致的报错。

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