从服务器中的两个 selectInputs,如何使一个依赖另一个?

From two selectInputs in the server, how to make one dependent on another?

首先,如果post的主要问题(标题)不够清楚,我很抱歉。我不知道如何写问题。

嗯,问题是我有两个 select 输入。主要的:数据集,它有 2 个选项:1) 汽车和 2) 虹膜。 另一个 select 输入,它具有来自 Cars 数据集的信息和来自 Iris 数据集的信息。

我需要显示 Cars 的信息,如果我 select Cars 和 Iris 的信息,如果我 select Iris。

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

我不知道怎么做,我已经post了很多,但我无法得到我想要的。 例如这个 post 非常相似,我认为我可以做类似的事情,但他没有使用 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)

另一方面,我得到一个错误:object of type 'closure' is not subsettable. 但我不知道为什么。

最后,如果之前有人问过类似的问题,我很抱歉,我真的找了一个早上,我不知道如何解决。 (我是 Shiny 的新手,我正在努力做到最好)。

非常感谢,

此致

我已经修改了您的一些代码并添加了一些来自 shinyjsJS 功能,您可能觉得有用也可能没用

  • 如果你只更新列表,你真的不需要一直创建对象,所以我们将使用updateSelectInput来更新滑块
  • 我最初使用 hidden 功能来隐藏元素,因此它们一开始是不可见的
  • 我在 observeEvent 中创建了对 input$dataset 的依赖,因此我们可以更新滑块并隐藏和显示我们不想要的滑块和我们不想要的输出
  • 此外,如果您的数据集是静态的,例如 mtcarsiris,最好将它们带到 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)

这是一个允许通过 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

的动态变化