如何获取Shiny的updateSelectionInput以值列表进行更新

时间:2019-02-18 15:49:22

标签: r drop-down-menu shiny reactive

我正在尝试根据用户的先前选择来填充列表。例如,如果用户从我的第二个下拉列表中选择“ B1_B2”,则第三个下拉列表应显示sublist_12。唯一的问题是我的代码仅使用sublist_12中的第一项更新下拉框。如何获取包含全套元素的下拉列表? (此外,我完全乐于接受更优雅的方法。请随时告诉我这是否效率很低)。谢谢!

library(shiny)

list_A <- c("A1","A2","A3")
list_B <- c("B1", "B2", "B3", "B1_B2")
sublist_1 <- c("X","Y")
sublist_2 <- c("Z")
sublist_12 <- c("foo", "boo", "zoo")

ui <- fluidPage(
  # Application title
  titlePanel("Select Category"),
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        selectInput(inputId = "listA_options", label = "Select Cateroy", 
choices = c(list_A, list_B)),
        selectInput(inputId = "listB_options", label = "Select subcat1", 
choices = list_B),
        selectInput(inputId = "sublist_options", label = "Select subcat2", 
choices = NULL))),
mainPanel(  )))

server <- function(input, output, session) 
{
  #Update the Selection options
  choices_interventions <- reactive({
    choices_interventions <- ifelse(input$listB_options == "B1", sublist_1, 
                                    ifelse(input$listB_options == "B2", sublist_1,
                                           ifelse(input$listB_options == "B3", sublist_2,
                                                  ifelse(input$listB_options == "B1_B2", sublist_12))))})
  observe({
    updateSelectInput(session = session, inputId = "sublist_options", choices = choices_interventions())
  })
 }

# Run the application 
shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分:0)

使用ifelse()是ifelse的矢量化形式时,我们需要小心,而不仅仅是写if(condition) ... else ...的更方便的方法。

为了将来的知识,在ifelse(condition,true,false) truefalse中都进行了评估。然后使用条件将向量作为子集。

示例:ifelse(c(TRUE,TRUE,FALSE,FALSE,TRUE),c(1,2,3,4,5),c(6,7,8,9,10)) = [1,2,8,9,5]

无论如何,之所以只显示第一个元素,是因为条件语句input$listB_options == "B1"是一维的。最好使用常规的if() else,甚至最好使用switch语句。

library(shiny)

list_A <- c("A1","A2","A3")
list_B <- c("B1", "B2", "B3", "B1_B2")
sublist_1 <- c("X","Y")
sublist_2 <- c("Z")
sublist_12 <- c("foo", "boo", "zoo")

ui <- fluidPage(
  # Application title
  titlePanel("Select Category"),
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        selectInput(inputId = "listA_options", label = "Select Cateroy", 
                    choices = c(list_A, list_B)),
        selectInput(inputId = "listB_options", label = "Select subcat1", 
                    choices = list_B),
        selectInput(inputId = "sublist_options", label = "Select subcat2", 
                    choices = NULL))),
    mainPanel(  )))

server <- function(input, output, session) {
  #Update the Selection options
  choices_interventions <- reactive({

  switch(input$listB_options,
         "B1" = sublist_1,
         "B2" = sublist_1,
         "B3" = sublist_2,
         "B1_B2" = sublist_12)
  })



  observe({
    req(choices_interventions())
    updateSelectInput(session = session, inputId = "sublist_options", choices = choices_interventions())
  })
}

# Run the application 
shinyApp(ui = ui, server = server)