从服务器中的两个 selectInputs 中，如何使一个依赖于另一个？

Posted 2023-03-24

【中文标题】从服务器中的两个 selectInputs 中，如何使一个依赖于另一个？

【英文标题】：From two selectInputs in the server, how to make one dependent on another?

【发布时间】：2021-07-05 03:33:49

【问题描述】：

首先，如果帖子的主要问题（标题）不够清楚，我很抱歉。我不知道如何针对我的问题写一个问题。

嗯，问题是我有两个选择输入。主要的：数据集，有 2 个选项：1）汽车和 2）虹膜。 另一个选择输入，它包含来自 Cars 数据集的信息和来自 Iris 数据集的信息。

如果我选择 Cars，我需要显示来自 Cars 的信息，如果我选择 Iris，我需要显示来自 Iris 的信息。

现在，我的代码无法做到这一点。只是它向您显示了选择数据集的选项，但在第二个选择输入中仅显示来自 Cars 的信息。

我不知道该怎么做，我已经发了很多帖子，但我无法得到我想要的。 例如这篇帖子Filter one selectInput based on selection from another selectInput? 非常相似，我认为我可以做类似的事情，但他没有使用来自 R 的数据集...

我的代码：

library(shiny)
ui <- fluidPage(
  
  titlePanel("Select a dataset"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput("dataset", "Dataset",
                  choices = c("Cars" = "Cars", "Iris" = "Iris")),
      uiOutput("select_cars"),
      uiOutput("select_iris")
      
    ),
    
    mainPanel(
      verbatimTextOutput("text"),
      verbatimTextOutput("text2") 
    )
  )
)

server <- function(input, output) 
  
  cars <- reactive(
    data("mtcars")
    cars <- rownames(mtcars)
    return(cars)
  )
  
  iris <- reactive(
    data("iris")
    iris <- data.frame(unique(iris$Species))
    colnames(iris) <- "iris"
    return(iris)
  )
  
  output$select_cars <- renderUI(
    selectInput(inputId = "options_cars", "Select one", choices = cars())
  )

  output$select_iris <- renderUI(
    selectInput(inputId = "options_iris", "Select one iris", choices = iris())
  )

  output$text <- renderPrint(input$options_cars)
  output$text2 <- renderPrint(input$options_iris)


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

另一方面，我得到一个错误：“闭包”类型的对象不是子集。但我不知道为什么。

最后，如果有人之前已经问过类似的问题，我很抱歉，我真的一直在寻找一个上午，我不知道如何解决它。 （我是 Shiny 的新手，我正在努力做到最好）。

非常感谢，

问候

【问题讨论】：

检查函数updateSelectInput()。

【参考方案1】：

我已经修改了您的一些代码，并从 shinyjs 添加了一些 JS 功能，您可能会或可能不会觉得有用

如果您只更新列表，您实际上不需要一直创建对象，因此我们将使用updateSelectInput 来更新滑块 我最初使用 hidden 功能隐藏元素，因此它们一开始是不可见的 我在observeEvent 中创建了对input$dataset 的依赖关系，因此我们可以更新滑块并隐藏和显示我们不想要的滑块和我们不想要的输出 此外，如果您的数据集是静态的，例如 mtcars 和 iris，最好将它们放在 server.R 之外，这样您就不会做额外的不必要的工作 最后添加req 总是一个好主意，所以如果它们是NULL，你就不会创建任何对象 您最初的错误是由于您将数据帧而不是列表或向量传递给滑块，如果您不确定并查看它们的类型，请尝试打印出对象

---

library(shiny)
library(shinyjs)

ui <- fluidPage(
    titlePanel("Select a dataset"),
    useShinyjs(),
    
    sidebarLayout(
        sidebarPanel(
            selectInput("dataset", "Dataset",
                        choices = c("Cars" = "Cars", "Iris" = "Iris")),
            hidden(selectInput(inputId = "options_cars", "Select one", choices = NULL)),
            hidden(selectInput(inputId = "options_iris", "Select one iris", choices = NULL))
            
        ),
        mainPanel(
            verbatimTextOutput("text_cars"),
            verbatimTextOutput("text_iris") 
        )
    )
)

cars_data <- unique(rownames(mtcars))
iris_data <-  as.character(unique(iris$Species))

server <- function(input, output, session) 
    
    observeEvent(input$dataset,
        if(input$dataset == "Cars")
            show('options_cars')
            hide('options_iris')
            show('text_cars')
            hide('text_iris')
            updateSelectInput(session,"options_cars", "Select one", choices = cars_data)
        else
            show('options_iris')
            hide('options_cars')
            show('text_iris')
            hide('text_cars')
            updateSelectInput(session,"options_iris", "Select one iris", choices = iris_data)
        
    )
    
    output$text_cars <- renderPrint(
        req(input$options_cars)
        input$options_cars
    )
    
    output$text_iris <- renderPrint(
        req(input$options_iris)
        input$options_iris
    )


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

【讨论】：

非常感谢！！你无法想象我现在有多感激。真的非常感谢。我见过很多次人们通常使用shinyjs 包，但我真的不知道它是如何工作的。我正在通过book 和其他教程学习闪亮，但我试图在书中找到这个包，但它不存在。你能给我一些资源来了解更多吗？提前致谢！！！

Hadley 真的很棒，我认为他们现在完成了那本书，我认为shinyjs 包不存在是因为它不是来自闪亮团队的official 版本，所以他试图留下来只是原始代码库。最好的学习方式就是自己动手，官方文档就是你真正需要的shiny.rstudio.com

【参考方案2】：

这是一个允许selectInput切换的代码

library(shiny)
library(datasets)
ui <- fluidPage(
  
  titlePanel("Select a dataset"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput("dataset", "Dataset",
                  choices = c("Cars" = "Cars", "Iris" = "Iris")),
##------removed this---------------
    #  uiOutput("select_cars"),
      #uiOutput("select_iris")
##------------------------------
    uiOutput("select_by_input") 
    ),
    
    mainPanel(
      verbatimTextOutput("text")
     # verbatimTextOutput("text2") 
    )
  )
)

server <- function(input, output) 
  
  cars <- reactive(
    data("mtcars")
    cars <- rownames(mtcars)
    return(cars)
  )
  
  iris <- reactive(
   # data("iris")
   # iris <- data.frame(unique(iris$Species))
    data('iris')
    #colnames(iris) <- "iris"
 # iris_names <- as.character(unique(iris$Species) )
    iris_names <- c('a','b','c')
    return(iris_names)
  )
##------removed this---------------  
  # output$select_cars <- renderUI(
  #   selectInput(inputId = "options_cars", "Select one", choices = cars())
  # )
  # 
  # output$select_iris <- renderUI(
  #   selectInput(inputId = "options_iris", "Select one iris", choices = iris())
  # )
#-----------------------------  
  
   output$select_by_input <- renderUI(
     if (input$dataset=='Cars')
       selectInput(inputId = "options_x", "Select one", choices = cars())
     else if (input$dataset=='Iris')
       selectInput(inputId = "options_x", "Select one iris", choices = iris())
     
   
   )
  
  output$text <- renderPrint(input$options_x)



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

object of type ‘closure’ is not subsettable. 错误是由运行应用程序后未加载iris 数据引起的。我用 iris_names <- c('a','b','c')演示了selectInput的动态变化

【讨论】：

非常感谢您的回答！效果很好！