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

问题描述

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

好吧,问题是我有两个选择输入。主要的一个:数据集,它有 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)

另一方面,我收到一个错误‘closure’类型的对象不是子集的。但我不知道为什么。

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

非常感谢,

问候

解决方法

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

  • 如果您只想更新列表,您实际上不需要一直创建对象,因此我们将使用 updateSelectInput 来更新滑块
  • 我最初使用 hidden 功能来隐藏元素,因此它们一开始就不可见
  • 我在 input$dataset 中创建了对 observeEvent 的依赖,因此我们可以更新滑块并隐藏和显示我们不需要的滑块和我们不需要的输出
  • 另外,如果您的数据集是静态的,例如 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",choices = cars_data)
        }else{
            show('options_iris')
            hide('options_cars')
            show('text_iris')
            hide('text_cars')
            updateSelectInput(session,"options_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",##------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",choices = cars())
  # })
  # 
  # output$select_iris <- renderUI({
  #   selectInput(inputId = "options_iris",choices = iris())
  # })
#-----------------------------  
  
   output$select_by_input <- renderUI({
     if (input$dataset=='Cars'){
       selectInput(inputId = "options_x",choices = cars())
     }else if (input$dataset=='Iris'){
       selectInput(inputId = "options_x",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','c') 来演示 selectInput

的动态变化