Files
shiny/R/input-radiobuttons.R
Barbara Borges Ribeiro 00276abfa7 working but ugly
2017-03-24 17:55:00 +00:00

117 lines
3.8 KiB
R

#' Create radio buttons
#'
#' Create a set of radio buttons used to select an item from a list.
#'
#' If you need to represent a "None selected" state, it's possible to default
#' the radio buttons to have no options selected by using
#' \code{selected = character(0)}. However, this is not recommended, as it gives
#' the user no way to return to that state once they've made a selection.
#' Instead, consider having the first of your choices be \code{c("None selected"
#' = "")}.
#'
#' @inheritParams textInput
#' @param 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). If
#' this argument is provided, then \code{choiceNames} and \code{choiceValues}
#' must not be provided, and vice-versa.
#' @param selected The initially selected value (if not specified then
#' defaults to the first value)
#' @param inline If \code{TRUE}, render the choices inline (i.e. horizontally)
#' @return A set of radio buttons that can be added to a UI definition.
#' @param choicesValues
#' @param choicesNames List
#'
#' @family input elements
#' @seealso \code{\link{updateRadioButtons}}
#'
#' @examples
#' ## Only run examples in interactive R sessions
#' if (interactive()) {
#'
#' ui <- fluidPage(
#' radioButtons("dist", "Distribution type:",
#' c("Normal" = "norm",
#' "Uniform" = "unif",
#' "Log-normal" = "lnorm",
#' "Exponential" = "exp")),
#' plotOutput("distPlot")
#' )
#'
#' server <- function(input, output) {
#' output$distPlot <- renderPlot({
#' dist <- switch(input$dist,
#' norm = rnorm,
#' unif = runif,
#' lnorm = rlnorm,
#' exp = rexp,
#' rnorm)
#'
#' hist(dist(500))
#' })
#' }
#'
#' shinyApp(ui, server)
#' }
#' @export
radioButtons <- function(inputId, label, choices = NULL, selected = NULL,
inline = FALSE, width = NULL, choicesValues = NULL, choicesNames = NULL) {
lenNames <- length(choicesNames)
lenVals <- length(choicesValues)
useChoices <- FALSE
if (is.null(choices)) {
if (lenNames == 0 || lenVals == 0) {
stop("Please specify a non-empty vector for `choices` (or,
alternatively, for both `choicesNames` and `choicesValues`).")
}
if (lenNames != lenVals) {
stop("`choicesNames` and `choicesValues` must have the same length.")
}
if (!is.null(names(choicesNames)) || !is.null(names(choicesValues))) {
stop("`choicesNames` and `choicesValues` must not be named.")
}
} else {
if (lenNames != 0 || lenVals != 0) {
warning("Using `choices` argument; ignoring `choicesNames` and
`choicesValues`.")
}
# resolve names
useChoices <- TRUE
choices <- choicesWithNames(choices)
}
selected <- restoreInput(id = inputId, default = selected)
# default value if it's not specified
selected <- if (is.null(selected)) {
if (useChoices) choices[[1]] else choicesValues[[1]]
} else {
if (useChoices) validateSelected(selected, choices, inputId)
else validateSelected2(selected, choicesNames, choicesValues, inputId)
}
if (length(selected) > 1) stop("The 'selected' argument must be of length 1")
#print(choicesNames)
#print(choicesValues)
options <- if (useChoices)
generateOptions(inputId, choices, selected, inline, type = 'radio')
else
generateOptions(inputId, NULL, selected, inline, type = 'radio',
choicesNames, choicesValues)
#print(options)
divClass <- "form-group shiny-input-radiogroup shiny-input-container"
if (inline) divClass <- paste(divClass, "shiny-input-container-inline")
tags$div(id = inputId,
style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
class = divClass,
controlLabel(inputId, label),
options
)
}