View source: R/optionalInput.R
| optionalSelectInput | R Documentation | 
pickerInput
Wrapper for 
shinyWidgets::pickerInput() with additional features.
When fixed = TRUE or when the number of choices is less or equal to 1 (see fixed_on_single),
the pickerInput widget is hidden and non-interactive widget will be displayed
instead. Toggle of HTML elements is just the visual effect to avoid displaying
pickerInput widget when there is only one choice.
optionalSelectInput(
  inputId,
  label = NULL,
  choices = NULL,
  selected = NULL,
  multiple = FALSE,
  sep = NULL,
  options = list(),
  label_help = NULL,
  fixed = FALSE,
  fixed_on_single = FALSE,
  width = NULL
)
updateOptionalSelectInput(
  session,
  inputId,
  label = NULL,
  selected = NULL,
  choices = NULL
)
| inputId | The  | 
| label | Display label for the control, or  | 
| choices | List of values to select from. If elements of the list are named then that name rather than the value is displayed to the user. | 
| selected | The initially selected value (or multiple values if  | 
| multiple | Is selection of multiple items allowed? | 
| sep | ( | 
| options | List of options, see pickerOptions for all available options. To limit the number of selection possible, see example below. | 
| label_help | ( | 
| fixed | ( | 
| fixed_on_single | ( | 
| width | ( | 
| session | ( | 
(shiny.tag) HTML tag with pickerInput widget and
non-interactive element listing selected values.
library(shiny)
# Create a minimal example data frame
data <- data.frame(
  AGE = c(25, 30, 40, 35, 28),
  SEX = c("Male", "Female", "Male", "Female", "Male"),
  PARAMCD = c("Val1", "Val2", "Val3", "Val4", "Val5"),
  PARAM = c("Param1", "Param2", "Param3", "Param4", "Param5"),
  AVISIT = c("Visit1", "Visit2", "Visit3", "Visit4", "Visit5"),
  stringsAsFactors = TRUE
)
ui_grid <- function(...) {
  fluidPage(
    fluidRow(
      lapply(list(...), function(x) column(4, wellPanel(x)))
    )
  )
}
ui <- ui_grid(
  tags$div(
    optionalSelectInput(
      inputId = "c1",
      label = "Fixed choices",
      choices = LETTERS[1:5],
      selected = c("A", "B"),
      fixed = TRUE
    ),
    verbatimTextOutput(outputId = "c1_out")
  ),
  tags$div(
    optionalSelectInput(
      inputId = "c2",
      label = "Single choice",
      choices = "A",
      selected = "A"
    ),
    verbatimTextOutput(outputId = "c2_out")
  ),
  tags$div(
    optionalSelectInput(
      inputId = "c3",
      label = "NULL choices",
      choices = NULL
    ),
    verbatimTextOutput(outputId = "c3_out")
  ),
  tags$div(
    optionalSelectInput(
      inputId = "c4",
      label = "Default",
      choices = LETTERS[1:5],
      selected = "A"
    ),
    verbatimTextOutput(outputId = "c4_out")
  ),
  tags$div(
    optionalSelectInput(
      inputId = "c5",
      label = "Named vector",
      choices = c(`A - value A` = "A", `B - value B` = "B", `C - value C` = "C"),
      selected = "A"
    ),
    verbatimTextOutput(outputId = "c5_out")
  ),
  tags$div(
    selectInput(
      inputId = "c6_choices", label = "Update choices", choices = letters, multiple = TRUE
    ),
    optionalSelectInput(
      inputId = "c6",
      label = "Updated choices",
      choices = NULL,
      multiple = TRUE,
      fixed_on_single = TRUE
    ),
    verbatimTextOutput(outputId = "c6_out")
  )
)
server <- function(input, output, session) {
  observeEvent(input$c6_choices, ignoreNULL = FALSE, {
    updateOptionalSelectInput(
      session = session,
      inputId = "c6",
      choices = input$c6_choices,
      selected = input$c6_choices
    )
  })
  output$c1_out <- renderPrint(input$c1)
  output$c2_out <- renderPrint(input$c2)
  output$c3_out <- renderPrint(input$c3)
  output$c4_out <- renderPrint(input$c4)
  output$c5_out <- renderPrint(input$c5)
  output$c6_out <- renderPrint(input$c6)
}
if (interactive()) {
  shinyApp(ui, server)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.