如何组织相互依赖的 selectizeInput 字段

Question

我有这个工作应用程序：这是之前一些问题的后续问题：

library(shiny)
library(vtree)

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)

我想以相互依赖的方式控制

selectizeInput

字段： 让我解释一下：

场景1： 如果

Levels

==

A

，用户应该能够从

Values_A

中进行选择，而不是 Values_B 和

Values_C

。

场景2： 如果

Levels

==

A

和

Values_A

==

nature

，那么在

Values_B

中，只有

animal

和

plant

应该可见以供选择，而不是

machine

，因为

machine

是

not nature

。

场景3： 如果

Levels

==

A

和

Values_A

==

nature

和

Values_B

==

animal

那么在

Values_C

中只有

dog

cat

mouse

应该可见：

Answer 1

嗨，我认为这符合您的要求

library(shiny)
library(vtree)
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)
             )
)

# 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_A <- reactive({
    filtered_df <- df
    if(!is.null(input$valuesA)){
      filtered_df <- filtered_df %>% 
        filter(A %in% input$valuesA)
    }
    filtered_df
  })
  df_B <- reactive({
    if(!is.null(input$valuesB)){
      filtered_df <- df_A() %>% 
        filter(B %in% input$valuesB)
    } else {
      df_A()
    }
  })
  df_C <- reactive({
    if(!is.null(input$valuesC)){
      df_B() %>% 
        filter(C %in% input$valuesC)
    } else {
      df_B()
    }
  })
  vector <- c("A","B", "C")
  
  
  observe({
    # browser()
    updateSelectizeInput(session, "levels", choices = colnames(df[vector]), selected = input$levels) 
    updateSelectizeInput(session, "valuesA", choices = unique(df$A), selected = input$valuesA)
    updateSelectizeInput(session, "valuesB", choices = unique(df_A()$B), selected = input$valuesB)
    updateSelectizeInput(session, "valuesC", choices = unique(df_B()$C), selected = input$valuesC)
  })
  
  output[["VTREE"]] <- renderVtree({
    vtree(df_C(), 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)

希望这有帮助， 贝蒂尔