闪亮的下拉菜单中只显示一个选项（在几个选项中）

Question

我是 Shiny 的新手，我在 SO 上的类似问题的答案对我有帮助。

我想在下拉菜单上显示动态选择，具体取决于用户在单选按钮上选择的内容。但是下面的sn-p只能显示亚种的一种选择，一旦用户选择，首先#1动物类型，然后#2整体vs.亚种选择。

我有三个变量：#1。动物类型（狮子与老虎）； #2。整体与亚种（单选按钮）； #3。亚种（如果用户在#2 中选择“整体”，那么亚种应该等于“不适用”）。

仅供参考：

• 老虎亚种 = {孟加拉、西伯利亚}

• 狮子亚种 = {巴巴里、西南非洲、德兰士瓦}

感谢任何帮助。谢谢。

    library(shiny)
    if (interactive()) {

    ui <- fluidPage(
     selectizeInput("VarAnimal",
               label = "Animal",
               choices = c("Tiger", "Lion"),
               selected = "Tiger"),

     radioButtons("VarWholeOrSub", 
             "Whole or Sub",
              choices = c("Whole species", "Subspecies"),
              selected = "Whole species"), 

     selectizeInput("VarSubspecies",
               label = "Subspecies",
               choices = c("Not Applicable", "Bengal", "Siberian", "Barbary", "Southwest African", "Transvaal"),
               selected = "")
    )

    server <- function(input, output, session) {
    observe({
       x <- input$VarWholeOrSub

       if (input$VarWholeOrSub == "Whole species"){
         x <- c("Not Applicable")} else{
         x <- ifelse(input$VarAnimal == "Tiger", c("Bengal", "Siberian"), c("Barbary", "Southwest African", "Transvaal"))  
    }

      updateSelectizeInput(session,
                       "VarSubspecies",
                       choices = x)

    })
    }


    shinyApp(ui, server)
    }

Answer 1

问题来自ifelse(test, yes, no)的使用，当yes或no有不同的测试长度时：

> ifelse("a"=="a", c("a","b"), c("b","a"))
[1] "a"
> ifelse(rep("a"=="a",2), c("a","b"), c("b","a"))
[1] "a" "b"

在你的情况下 - 有 3 种不同的长度 - 你应该使用 if 代替：

  if (input$VarWholeOrSub == "Whole species"){
    x <- c("Not Applicable")
    } else {
      if(input$VarAnimal == "Tiger")
        x <- c("Bengal", "Siberian")
      else
        x <- c("Barbary", "Southwest African", "Transvaal")
    }

Answer 2

ifelse 的文档说明：

ifelse 返回一个与 test 具有相同形状的值，其中填充有从是或否中选择的元素，具体取决于 test 的元素是 TRUE 还是 FALSE。

library(shiny)
if (interactive()) {

  ui <- fluidPage(
    selectizeInput("VarAnimal",
                   label = "Animal",
                   choices = c("Tiger", "Lion"),
                   selected = "Tiger"),

    radioButtons("VarWholeOrSub", 
                 "Whole or Sub",
                 choices = c("Whole species", "Subspecies"),
                 selected = "Whole species"), 

    selectizeInput("VarSubspecies",
                   label = "Subspecies",
                   choices = c("Not Applicable", "Bengal", "Siberian", "Barbary", "Southwest African", "Transvaal"),
                   selected = "")
  )

  server <- function(input, output, session) {
    observe({

      if (input$VarWholeOrSub == "Whole species"){
        updateSelectizeInput(session, 'VarSubspecies', choices = c("Not Applicable"))
        } else{
          if(input$VarAnimal == "Tiger"){
            updateSelectizeInput(session, 'VarSubspecies', choices = c("Bengal", "Siberian"))
          } else if (input$VarAnimal == "Lion"){
            updateSelectizeInput(session, 'VarSubspecies', choices = c("Barbary", "Southwest African", "Transvaal"))
          }
        }
    })
  }


  shinyApp(ui, server)
} 

Answer 3

几点：

(1) 如前所述，ifelse 是这里的罪魁祸首。 ?ifelse 说

ifelse（测试，是，否）
ifelse 返回一个与测试形状相同的值

在您的情况下，您应该按照建议使用 if-else 块。

(2) 您可能希望通过分离数据（可能是全局数据，以便以后无需更改 R 代码来更改数据）并摆脱一些冗余代码：

df <- data.frame(Animals = c("Tiger", "Lion"), 
                 WholeSpecies=rep("Not Applicable", 2),
                 SubSpecies=c("Bengal, Siberian", "Barbary, Southwest African, Transvaal"), 
                 stringsAsFactors = FALSE)
head(df)
#  Animals   WholeSpecies                            SubSpecies
#1   Tiger Not Applicable                      Bengal, Siberian
#2    Lion Not Applicable Barbary, Southwest African, Transvaal

library(shiny)
if (interactive()) {

  ui <- fluidPage(
    selectizeInput("VarAnimal",
                   label = "Animal",
                   choices = df$Animals,
                   selected = df$Animals[1]),

    radioButtons("VarWholeOrSub", 
                 "Whole or Sub",
                 choices = c("Whole species", "Subspecies"),
                 selected = "Whole species"), 

    selectizeInput("VarSubspecies",
                   label = "Subspecies",
                   choices = c(unique(df$WholeSpecies), unlist(strsplit(unique(df$SubSpecies), split=','))),
                   selected = "")
  )

  server <- function(input, output, session) {
    observe({

      x <- df[df$Animals==input$VarAnimal,]$WholeSpecies

      if (input$VarWholeOrSub == "Subspecies"){
        x <- unlist(strsplit(df[df$Animals==input$VarAnimal,]$SubSpecies, split=','))
      }

      updateSelectizeInput(session,
                           "VarSubspecies",
                           choices = x)

    })
  }

  shinyApp(ui, server)
}