Как из двух selectInputs на сервере сделать один зависимым от другого?

Прежде всего, мне очень жаль, если основной вопрос (заголовок) поста недостаточно ясен. Я не знал, как написать вопрос с моей проблемой.

Ну, дело в том, что у меня есть два входа select. Основной: Dataset, который имеет 2 варианта: 1) Cars и 2) Iris. Другой вход select содержит информацию из набора данных Cars и информацию из набора данных Iris.

Мне нужно показать информацию от Cars, если я выберу Cars, и информацию от Iris, если я выберу Iris.

Теперь мой код не может этого сделать. Просто он показывает вам варианты выбора наборов данных, но во втором выборе ввода отображается только информация из автомобилей.

Я не знаю, как это сделать, у меня было много сообщений, но я не мог получить то, что хочу. Например, этот пост Фильтровать один selectInput на основе выбора из другого 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 и стараюсь изо всех сил).

Большое спасибо заранее,

С уважением


r reactive shiny selectinput shinyapps
person Eva    schedule 09.04.2021    source источник
comment
Проверьте функцию updateSelectInput().   -  person Érico Patto    schedule 09.04.2021

Ответы (2)


arrow_upward
1
arrow_downward

Я изменил часть вашего кода и добавил некоторые JS функции из shinyjs, которые могут оказаться полезными, а могут и не оказаться.

  • Вам не нужно постоянно создавать объекты, если вы собираетесь обновлять только список, поэтому мы собираемся использовать updateSelectInput для обновления ползунков.
  • Я использовал функциональность hidden, чтобы изначально скрыть элементы, чтобы они были невидимыми для начала.
  • Я создал зависимость от 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)
person Pork Chop    schedule 09.04.2021
comment
Большое спасибо!! Ты не представляешь, как я благодарен сейчас. Большое спасибо. Я много раз видел, что люди обычно используют пакет shinyjs, но я действительно не знаю, как он работает. Я изучаю блеск с помощью этой книги и других руководств, но я попытался найти этот пакет в книге, и он не там. Не могли бы вы прислать мне несколько источников, чтобы узнать больше об этом? Заранее спасибо!!! - person Eva; 09.04.2021
comment
Хэдли действительно хорош, я думаю, что они закончили эту книгу сейчас, я думаю, что пакета shinyjs нет, потому что это не релиз official от блестящей команды, поэтому он попытался остаться только с исходной кодовой базой. Лучший способ учиться — делать это самостоятельно. Официальная документация — это все, что вам действительно нужно shiny.rstudio.com. - person Pork Chop; 09.04.2021

arrow_upward
1
arrow_downward

Вот код, который позволяет переключаться на 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.

person Keniajin    schedule 09.04.2021
comment
Большое спасибо за ваш ответ! это работает отлично! - person Eva; 09.04.2021