Как сделать вложенные выделения selectInput () в RMarkdown с Shiny? - PullRequest
Новая
       23

Как сделать вложенные выделения selectInput () в RMarkdown с Shiny?

0 голосов
/ 07 мая 2019

В приведенном ниже фрагменте кода из моего RMarkdown \ flexdashboard кода с shiny мне нужно изменить choices для второй функции selectInput() на основе выбора, сделанного в первом selectInput() функция.

selectInput('theme', 'Select theme:',
            choices = c(dtThemes$Theme %>% unique()))  

selectInput('question', 'Select Question:', 
            choices = c(dtQuestions$Question %>% unique())) # This works
            #choices = strQuestions)  # This does not work

strQuestions <- reactive({
    nQuestions <- dtThemes[Theme == input$theme, Q2018]
    dtQuestions[nQuestion %in% nQuestions, strQuestion]
})

Как мне это сделать?

Инкапсуляция кода в renderUI() не помогла: 

  renderUI({
    selectInput('question', 'Select Question:', 
                strQuestions(), width="100%") 
  })

Ответы [ 2 ]

1 голос
/ 07 мая 2019

Вы можете использовать updateSelectInput. Ниже приведен небольшой пример, в котором варианты для варианта B представляют собой последовательность длины, указанной в варианте A: 

library(shiny)

ui <- fluidPage(
   selectInput("A", "Option A", choices = 1:10),
   selectInput("B", "Option B", choices = NULL)
)


server <- function(input, output, session) {
   observe({
      choices_B <- seq(as.numeric(input$A))
      updateSelectInput(session, "B", choices = choices_B)
   })
}


shinyApp(ui, server)
0 голосов
/ 08 мая 2019

Я дополнительно изучил этот пост: Создать реактивный selectInput - flexdashboard с Shiny и смог выяснить, как заставить мой код работать: 

selectInput('theme', 'Select theme:',
            choices = c("All", dt$Theme %>% unique()), selected="All")

dt.subset<- reactive({
    if (input$theme=="All") {
      dt
    }else{
      dt[Theme == input$theme]
    }
  })
 renderUI({
    selectInput('question', 'Select Question:', 
                choices = (dt.subset()$Question ) %>% unique(), 
                selected =  ( (dt.subset()$Question ) %>% unique() )[1]) 
  })

}

Хитрость в том, что вам нужно иметь значение по умолчанию selected. В противном случае происходит сбой кода.

Обратите внимание, что я использую data.table для dt.

...