时间戳

首页 > 解决方案 > 从服务器中的两个 selectInputs 中，如何使一个依赖于另一个？

r - 从服务器中的两个 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)

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

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

首先十分感谢，

问候

标签： rshinyreactiveshinyappsselectinput

解决方案

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

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

推荐阅读