remove call to validateselected

NEWS.md

@@ -5,10 +5,14 @@ shiny 1.0.0.9001
 
 ### Breaking changes
 
+* The functions `radioButtons()`, `checkboxGroupInput()` and `selectInput()` (and the corresponding `updateXXX()` functions) no longer accept a `selected` argument whose value is the name of a choice, instead of the value of the choice. This feature had been deprecated since Shiny 0.10 (it printed a warning message, but still tried to match the name to the right choice) and it's now completely unsupported.
+
 ### New features
 
 ### Minor new features and improvements
 
+* Addressed [#1348](https://github.com/rstudio/shiny/issues/1348) and [#1437](https://github.com/rstudio/shiny/issues/1437) by adding two new arguments to `radioButtons()` and `checkboxGroupInput()`: `choiceNames` (list or vector) and `choiceValues` (list or vector). These can be passed in as an alternative to `choices`, with the added benefit that the elements in `choiceNames` can be arbitrary UI (i.e. anything created by `HTML()` and the `tags()` functions, like icons and images). While the underlying values for each choice (passed in through `choiceValues`) must still be simple text, their visual representation on the app (what the user actually clicks to select a different option) can be any valid HTML element. See `?radioButtons` for a small example. ([#1521](https://github.com/rstudio/shiny/pull/1521))
+
 * Updated `tools/README.md` with more detailed instructions. ([##1616](https://github.com/rstudio/shiny/pull/1616))
 
 * Fixed [#1565](https://github.com/rstudio/shiny/issues/1565), which meant that resources with spaces in their names return HTTP 404. ([#1566](https://github.com/rstudio/shiny/pull/1566))

R/input-checkboxgroup.R

@@ -6,9 +6,21 @@
 #'
 #' @inheritParams textInput
 #' @param choices List of values to show checkboxes for. If elements of the list
-#'   are named then that name rather than the value is displayed to the user.
+#'   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 values that should be initially selected, if any.
 #' @param inline If \code{TRUE}, render the choices inline (i.e. horizontally)
+#' @param choiceNames,choiceValues List of names and values, respectively,
+#'   that are displayed to the user in the app and correspond to the each
+#'   choice (for this reason, \code{choiceNames} and \code{choiceValues}
+#'   must have the same length). If either of these arguments is
+#'   provided, then the other \emph{must} be provided and \code{choices}
+#'   \emph{must not} be provided. The advantage of using both of these over
+#'   a named list for \code{choices} is that \code{choiceNames} allows any
+#'   type of UI object to be passed through (tag objects, icons, HTML code,
+#'   ...), instead of just simple text. See Examples.
+#'
 #' @return A list of HTML elements that can be added to a UI definition.
 #'
 #' @family input elements
@@ -26,26 +38,47 @@
 #'   tableOutput("data")
 #' )
 #'
-#' server <- function(input, output) {
+#' server <- function(input, output, session) {
 #'   output$data <- renderTable({
 #'     mtcars[, c("mpg", input$variable), drop = FALSE]
 #'   }, rownames = TRUE)
 #' }
 #'
 #' shinyApp(ui, server)
+#'
+#' ui <- fluidPage(
+#'   checkboxGroupInput("icons", "Choose icons:",
+#'     choiceNames =
+#'       list(icon("calendar"), icon("bed"),
+#'            icon("cog"), icon("bug")),
+#'     choiceValues =
+#'       list("calendar", "bed", "cog", "bug")
+#'   ),
+#'   textOutput("txt")
+#' )
+#'
+#' server <- function(input, output, session) {
+#'   output$txt <- renderText({
+#'     icons <- paste(input$icons, collapse = ", ")
+#'     paste("You chose", icons)
+#'   })
+#' }
+#'
+#' shinyApp(ui, server)
 #' }
 #' @export
-checkboxGroupInput <- function(inputId, label, choices, selected = NULL,
-  inline = FALSE, width = NULL) {
+checkboxGroupInput <- function(inputId, label, choices = NULL, selected = NULL,
+  inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) {
+
+  args <- normalizeChoicesArgs(choices, choiceNames, choiceValues)
 
   selected <- restoreInput(id = inputId, default = selected)
 
-  # resolve names
-  choices <- choicesWithNames(choices)
-  if (!is.null(selected))
-    selected <- validateSelected(selected, choices, inputId)
+  # default value if it's not specified
+  if (!is.null(selected)) selected <- as.character(selected)
 
-  options <- generateOptions(inputId, choices, selected, inline)
+  options <- generateOptions(inputId, selected, inline,
+    'checkbox', args$choiceNames, args$choiceValues)
 
   divClass <- "form-group shiny-input-checkboxgroup shiny-input-container"
   if (inline)

R/input-radiobuttons.R

@@ -11,11 +11,22 @@
 #'
 #' @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)
+#'   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)
+#'   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 choiceNames,choiceValues List of names and values, respectively,
+#'   that are displayed to the user in the app and correspond to the each
+#'   choice (for this reason, \code{choiceNames} and \code{choiceValues}
+#'   must have the same length). If either of these arguments is
+#'   provided, then the other \emph{must} be provided and \code{choices}
+#'   \emph{must not} be provided. The advantage of using both of these over
+#'   a named list for \code{choices} is that \code{choiceNames} allows any
+#'   type of UI object to be passed through (tag objects, icons, HTML code,
+#'   ...), instead of just simple text. See Examples.
 #'
 #' @family input elements
 #' @seealso \code{\link{updateRadioButtons}}
@@ -47,27 +58,46 @@
 #' }
 #'
 #' shinyApp(ui, server)
+#'
+#' ui <- fluidPage(
+#'   radioButtons("rb", "Choose one:",
+#'                choiceNames = list(
+#'                  icon("calendar"),
+#'                  HTML("<p style='color:red;'>Red Text</p>"),
+#'                  "Normal text"
+#'                ),
+#'                choiceValues = list(
+#'                  "icon", "html", "text"
+#'                )),
+#'   textOutput("txt")
+#' )
+#'
+#' server <- function(input, output) {
+#'   output$txt <- renderText({
+#'     paste("You chose", input$rb)
+#'   })
+#' }
+#'
+#' shinyApp(ui, server)
 #' }
 #' @export
-radioButtons <- function(inputId, label, choices, selected = NULL,
-  inline = FALSE, width = NULL) {
+radioButtons <- function(inputId, label, choices = NULL, selected = NULL,
+  inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) {
 
-  # resolve names
-  choices <- choicesWithNames(choices)
+  args <- normalizeChoicesArgs(choices, choiceNames, choiceValues)
 
   selected <- restoreInput(id = inputId, default = selected)
 
   # default value if it's not specified
-  selected <- if (is.null(selected)) choices[[1]] else {
-    validateSelected(selected, choices, inputId)
-  }
+  selected <- if (is.null(selected)) args$choiceValues[[1]] else as.character(selected)
+
   if (length(selected) > 1) stop("The 'selected' argument must be of length 1")
 
-  options <- generateOptions(inputId, choices, selected, inline, type = 'radio')
+  options <- generateOptions(inputId, selected, inline,
+    'radio', args$choiceNames, args$choiceValues)
 
   divClass <- "form-group shiny-input-radiogroup shiny-input-container"
-  if (inline)
-    divClass <- paste(divClass, "shiny-input-container-inline")
+  if (inline) divClass <- paste(divClass, "shiny-input-container-inline")
 
   tags$div(id = inputId,
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),

R/input-select.R

@@ -74,8 +74,8 @@
 #' }
 #' @export
 selectInput <- function(inputId, label, choices, selected = NULL,
-                        multiple = FALSE, selectize = TRUE, width = NULL,
-                        size = NULL) {
+  multiple = FALSE, selectize = TRUE, width = NULL,
+  size = NULL) {
 
   selected <- restoreInput(id = inputId, default = selected)
 
@@ -85,7 +85,7 @@ selectInput <- function(inputId, label, choices, selected = NULL,
   # default value if it's not specified
   if (is.null(selected)) {
     if (!multiple) selected <- firstChoice(choices)
-  } else selected <- validateSelected(selected, choices, inputId)
+  } else selected <- as.character(selected)
 
   if (!is.null(size) && selectize) {
     stop("'size' argument is incompatible with 'selectize=TRUE'.")

R/input-utils.R

@@ -2,45 +2,62 @@ controlLabel <- function(controlName, label) {
   label %AND% tags$label(class = "control-label", `for` = controlName, label)
 }
 
-
-# Before shiny 0.9, `selected` refers to names/labels of `choices`; now it
-# refers to values. Below is a function for backward compatibility. It also
-# coerces the value to `character`.
-validateSelected <- function(selected, choices, inputId) {
-  # this line accomplishes two tings:
-  #   - coerces selected to character
-  #   - drops name, otherwise toJSON() keeps it too
-  selected <- as.character(selected)
-  # if you are using optgroups, you're using shiny > 0.10.0, and you should
-  # already know that `selected` must be a value instead of a label
-  if (needOptgroup(choices)) return(selected)
-
-  if (is.list(choices)) choices <- unlist(choices)
-
-  nms <- names(choices)
-  # labels and values are identical, no need to validate
-  if (identical(nms, unname(choices))) return(selected)
-  # when selected labels instead of values
-  i <- (selected %in% nms) & !(selected %in% choices)
-  if (any(i)) {
-    warnFun <- if (all(i)) {
-      # replace names with values
-      selected <- unname(choices[selected])
-      warning
-    } else stop  # stop when it is ambiguous (some labels == values)
-    warnFun("'selected' must be the values instead of names of 'choices' ",
-            "for the input '", inputId, "'")
+# This function takes in either a list or vector for `choices` (and
+# `choiceNames` and `choiceValues` are passed in as NULL) OR it takes
+# in a list or vector for both `choiceNames` and `choiceValues` (and
+# `choices` is passed as NULL) and returns a list of two elements:
+#    - `choiceNames` is a vector or list that holds the options names
+#      (each element can be arbitrary UI, or simple text)
+#    - `choiceValues` is a vector or list that holds the options values
+#       (each element must be simple text)
+normalizeChoicesArgs <- function(choices, choiceNames, choiceValues,
+  mustExist = TRUE) {
+  # if-else to check that either choices OR (choiceNames + choiceValues)
+  # were correctly provided
+  if (is.null(choices)) {
+    if (is.null(choiceNames) || is.null(choiceValues)) {
+      if (mustExist) {
+        stop("Please specify a non-empty vector for `choices` (or, ",
+             "alternatively, for both `choiceNames` AND `choiceValues`).")
+      } else {
+        if (is.null(choiceNames) && is.null(choiceValues)) {
+          # this is useful when we call this function from `updateInputOptions()`
+          # in which case, all three `choices`, `choiceNames` and `choiceValues`
+          # may legitimately be NULL
+          return(list(choiceNames = NULL, choiceValues = NULL))
+        } else {
+          stop("One of `choiceNames` or `choiceValues` was set to ",
+               "NULL, but either both or none should be NULL.")
+        }
+      }
+    }
+    if (length(choiceNames) != length(choiceValues)) {
+      stop("`choiceNames` and `choiceValues` must have the same length.")
+    }
+    if (anyNamed(choiceNames) || anyNamed(choiceValues)) {
+      stop("`choiceNames` and `choiceValues` must not be named.")
+    }
+  } else {
+    if (!is.null(choiceNames) || !is.null(choiceValues)) {
+      warning("Using `choices` argument; ignoring `choiceNames` and `choiceValues`.")
+    }
+    choices <- choicesWithNames(choices) # resolve names if not specified
+    choiceNames <- names(choices)
+    choiceValues <- unname(choices)
   }
-  selected
-}
 
+  return(list(choiceNames = as.list(choiceNames),
+              choiceValues = as.list(as.character(choiceValues))))
+}
 
 # generate options for radio buttons and checkbox groups (type = 'checkbox' or
 # 'radio')
-generateOptions <- function(inputId, choices, selected, inline, type = 'checkbox') {
+generateOptions <- function(inputId, selected, inline, type = 'checkbox',
+                            choiceNames, choiceValues,
+                            session = getDefaultReactiveDomain()) {
   # generate a list of <input type=? [checked] />
   options <- mapply(
-    choices, names(choices),
+    choiceValues, choiceNames,
     FUN = function(value, name) {
       inputTag <- tags$input(
         type = type, name = inputId, value = value
@@ -48,14 +65,18 @@ generateOptions <- function(inputId, choices, selected, inline, type = 'checkbox
       if (value %in% selected)
         inputTag$attribs$checked <- "checked"
 
+      # in case, the options include UI code other than text
+      # (arbitrary HTML using the tags() function or equivalent)
+      pd <- processDeps(name, session)
+
       # If inline, there's no wrapper div, and the label needs a class like
       # checkbox-inline.
       if (inline) {
-        tags$label(class = paste0(type, "-inline"), inputTag, tags$span(name))
+        tags$label(class = paste0(type, "-inline"), inputTag,
+                   tags$span(pd$html, pd$dep))
       } else {
-        tags$div(class = type,
-          tags$label(inputTag, tags$span(name))
-        )
+        tags$div(class = type, tags$label(inputTag,
+                 tags$span(pd$html, pd$dep)))
       }
     },
     SIMPLIFY = FALSE, USE.NAMES = FALSE

R/update-input.R

@@ -452,16 +452,18 @@ updateSliderInput <- function(session, inputId, label = NULL, value = NULL,
 
 
 updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
-                               selected = NULL, inline = FALSE,
-                               type = 'checkbox') {
-  if (!is.null(choices))
-    choices <- choicesWithNames(choices)
-  if (!is.null(selected))
-    selected <- validateSelected(selected, choices, session$ns(inputId))
+                               selected = NULL, inline = FALSE, type = NULL,
+                               choiceNames = NULL, choiceValues = NULL) {
+  if (is.null(type)) stop("Please specify the type ('checkbox' or 'radio')")
 
-  options <- if (!is.null(choices)) {
+  args <- normalizeChoicesArgs(choices, choiceNames, choiceValues, mustExist = FALSE)
+
+  if (!is.null(selected)) selected <- as.character(selected)
+
+  options <- if (!is.null(args$choiceValues)) {
     format(tagList(
-      generateOptions(session$ns(inputId), choices, selected, inline, type = type)
+      generateOptions(session$ns(inputId), selected, inline, type,
+        args$choiceNames, args$choiceValues)
     ))
   }
 
@@ -510,9 +512,10 @@ updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
 #' }
 #' @export
 updateCheckboxGroupInput <- function(session, inputId, label = NULL,
-                                     choices = NULL, selected = NULL,
-                                     inline = FALSE) {
-  updateInputOptions(session, inputId, label, choices, selected, inline)
+  choices = NULL, selected = NULL, inline = FALSE,
+  choiceNames = NULL, choiceValues = NULL) {
+  updateInputOptions(session, inputId, label, choices, selected,
+                     inline, "checkbox", choiceNames, choiceValues)
 }
 
 
@@ -552,10 +555,15 @@ updateCheckboxGroupInput <- function(session, inputId, label = NULL,
 #' }
 #' @export
 updateRadioButtons <- function(session, inputId, label = NULL, choices = NULL,
-                               selected = NULL, inline = FALSE) {
+                               selected = NULL, inline = FALSE,
+                               choiceNames = NULL, choiceValues = NULL) {
   # you must select at least one radio button
-  if (is.null(selected) && !is.null(choices)) selected <- choices[[1]]
-  updateInputOptions(session, inputId, label, choices, selected, inline, type = 'radio')
+  if (is.null(selected)) {
+    if (!is.null(choices)) selected <- choices[[1]]
+    else if (!is.null(choiceValues)) selected <- choiceValues[[1]]
+  }
+  updateInputOptions(session, inputId, label, choices, selected,
+    inline, 'radio', choiceNames, choiceValues)
 }
 
 
@@ -601,8 +609,7 @@ updateRadioButtons <- function(session, inputId, label = NULL, choices = NULL,
 updateSelectInput <- function(session, inputId, label = NULL, choices = NULL,
                               selected = NULL) {
   choices <- if (!is.null(choices)) choicesWithNames(choices)
-  if (!is.null(selected))
-    selected <- validateSelected(selected, choices, inputId)
+  if (!is.null(selected)) selected <- as.character(selected)
   options <- if (!is.null(choices)) selectOptions(choices, selected)
   message <- dropNulls(list(label = label, options = options, value = selected))
   session$sendInputMessage(inputId, message)

man/checkboxGroupInput.Rd

@@ -4,8 +4,8 @@
 \alias{checkboxGroupInput}
 \title{Checkbox Group Input Control}
 \usage{
-checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE,
-  width = NULL)
+checkboxGroupInput(inputId, label, choices = NULL, selected = NULL,
+  inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -13,7 +13,9 @@ checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE,
 \item{label}{Display label for the control, or \code{NULL} for no label.}
 
 \item{choices}{List of values to show checkboxes for. If elements of the list
-are named then that name rather than the value is displayed to the user.}
+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.}
 
 \item{selected}{The values that should be initially selected, if any.}
 
@@ -21,6 +23,16 @@ are named then that name rather than the value is displayed to the user.}
 
 \item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
 see \code{\link{validateCssUnit}}.}
+
+\item{choiceNames, choiceValues}{List of names and values, respectively,
+that are displayed to the user in the app and correspond to the each
+choice (for this reason, \code{choiceNames} and \code{choiceValues}
+must have the same length). If either of these arguments is
+provided, then the other \emph{must} be provided and \code{choices}
+\emph{must not} be provided. The advantage of using both of these over
+a named list for \code{choices} is that \code{choiceNames} allows any
+type of UI object to be passed through (tag objects, icons, HTML code,
+...), instead of just simple text. See Examples.}
 }
 \value{
 A list of HTML elements that can be added to a UI definition.
@@ -42,12 +54,32 @@ ui <- fluidPage(
   tableOutput("data")
 )
 
-server <- function(input, output) {
+server <- function(input, output, session) {
   output$data <- renderTable({
     mtcars[, c("mpg", input$variable), drop = FALSE]
   }, rownames = TRUE)
 }
 
+shinyApp(ui, server)
+
+ui <- fluidPage(
+  checkboxGroupInput("icons", "Choose icons:",
+    choiceNames =
+      list(icon("calendar"), icon("bed"),
+           icon("cog"), icon("bug")),
+    choiceValues =
+      list("calendar", "bed", "cog", "bug")
+  ),
+  textOutput("txt")
+)
+
+server <- function(input, output, session) {
+  output$txt <- renderText({
+    icons <- paste(input$icons, collapse = ", ")
+    paste("You chose", icons)
+  })
+}
+
 shinyApp(ui, server)
 }
 }

man/radioButtons.Rd

@@ -4,8 +4,8 @@
 \alias{radioButtons}
 \title{Create radio buttons}
 \usage{
-radioButtons(inputId, label, choices, selected = NULL, inline = FALSE,
-  width = NULL)
+radioButtons(inputId, label, choices = NULL, selected = NULL,
+  inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -13,7 +13,9 @@ radioButtons(inputId, label, choices, selected = NULL, inline = FALSE,
 \item{label}{Display label for the control, or \code{NULL} for no label.}
 
 \item{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)}
+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.}
 
 \item{selected}{The initially selected value (if not specified then
 defaults to the first value)}
@@ -22,6 +24,16 @@ defaults to the first value)}
 
 \item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
 see \code{\link{validateCssUnit}}.}
+
+\item{choiceNames, choiceValues}{List of names and values, respectively,
+that are displayed to the user in the app and correspond to the each
+choice (for this reason, \code{choiceNames} and \code{choiceValues}
+must have the same length). If either of these arguments is
+provided, then the other \emph{must} be provided and \code{choices}
+\emph{must not} be provided. The advantage of using both of these over
+a named list for \code{choices} is that \code{choiceNames} allows any
+type of UI object to be passed through (tag objects, icons, HTML code,
+...), instead of just simple text. See Examples.}
 }
 \value{
 A set of radio buttons that can be added to a UI definition.
@@ -63,6 +75,27 @@ server <- function(input, output) {
   })
 }
 
+shinyApp(ui, server)
+
+ui <- fluidPage(
+  radioButtons("rb", "Choose one:",
+               choiceNames = list(
+                 icon("calendar"),
+                 HTML("<p style='color:red;'>Red Text</p>"),
+                 "Normal text"
+               ),
+               choiceValues = list(
+                 "icon", "html", "text"
+               )),
+  textOutput("txt")
+)
+
+server <- function(input, output) {
+  output$txt <- renderText({
+    paste("You chose", input$rb)
+  })
+}
+
 shinyApp(ui, server)
 }
 }

man/updateCheckboxGroupInput.Rd

@@ -5,7 +5,8 @@
 \title{Change the value of a checkbox group input on the client}
 \usage{
 updateCheckboxGroupInput(session, inputId, label = NULL, choices = NULL,
-  selected = NULL, inline = FALSE)
+  selected = NULL, inline = FALSE, choiceNames = NULL,
+  choiceValues = NULL)
 }
 \arguments{
 \item{session}{The \code{session} object passed to function given to
@@ -16,11 +17,33 @@ updateCheckboxGroupInput(session, inputId, label = NULL, choices = NULL,
 \item{label}{The label to set for the input object.}
 
 \item{choices}{List of values to show checkboxes for. If elements of the list
-are named then that name rather than the value is displayed to the user.}
+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.}
 
 \item{selected}{The values that should be initially selected, if any.}
 
 \item{inline}{If \code{TRUE}, render the choices inline (i.e. horizontally)}
+
+\item{choiceNames}{List of names and values, respectively,
+that are displayed to the user in the app and correspond to the each
+choice (for this reason, \code{choiceNames} and \code{choiceValues}
+must have the same length). If either of these arguments is
+provided, then the other \emph{must} be provided and \code{choices}
+\emph{must not} be provided. The advantage of using both of these over
+a named list for \code{choices} is that \code{choiceNames} allows any
+type of UI object to be passed through (tag objects, icons, HTML code,
+...), instead of just simple text. See Examples.}
+
+\item{choiceValues}{List of names and values, respectively,
+that are displayed to the user in the app and correspond to the each
+choice (for this reason, \code{choiceNames} and \code{choiceValues}
+must have the same length). If either of these arguments is
+provided, then the other \emph{must} be provided and \code{choices}
+\emph{must not} be provided. The advantage of using both of these over
+a named list for \code{choices} is that \code{choiceNames} allows any
+type of UI object to be passed through (tag objects, icons, HTML code,
+...), instead of just simple text. See Examples.}
 }
 \description{
 Change the value of a checkbox group input on the client

man/updateRadioButtons.Rd

@@ -5,7 +5,8 @@
 \title{Change the value of a radio input on the client}
 \usage{
 updateRadioButtons(session, inputId, label = NULL, choices = NULL,
-  selected = NULL, inline = FALSE)
+  selected = NULL, inline = FALSE, choiceNames = NULL,
+  choiceValues = NULL)
 }
 \arguments{
 \item{session}{The \code{session} object passed to function given to
@@ -16,12 +17,34 @@ updateRadioButtons(session, inputId, label = NULL, choices = NULL,
 \item{label}{The label to set for the input object.}
 
 \item{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)}
+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.}
 
 \item{selected}{The initially selected value (if not specified then
 defaults to the first value)}
 
 \item{inline}{If \code{TRUE}, render the choices inline (i.e. horizontally)}
+
+\item{choiceNames}{List of names and values, respectively,
+that are displayed to the user in the app and correspond to the each
+choice (for this reason, \code{choiceNames} and \code{choiceValues}
+must have the same length). If either of these arguments is
+provided, then the other \emph{must} be provided and \code{choices}
+\emph{must not} be provided. The advantage of using both of these over
+a named list for \code{choices} is that \code{choiceNames} allows any
+type of UI object to be passed through (tag objects, icons, HTML code,
+...), instead of just simple text. See Examples.}
+
+\item{choiceValues}{List of names and values, respectively,
+that are displayed to the user in the app and correspond to the each
+choice (for this reason, \code{choiceNames} and \code{choiceValues}
+must have the same length). If either of these arguments is
+provided, then the other \emph{must} be provided and \code{choices}
+\emph{must not} be provided. The advantage of using both of these over
+a named list for \code{choices} is that \code{choiceNames} allows any
+type of UI object to be passed through (tag objects, icons, HTML code,
+...), instead of just simple text. See Examples.}
 }
 \description{
 Change the value of a radio input on the client

tests/testthat/test-bootstrap.r

@@ -28,22 +28,43 @@ test_that("Repeated names for selectInput and radioButtons choices", {
      format(x)
   ))
 
-
-  # Radio buttons
+  # Radio buttons using choices
   x <- radioButtons('id','label', choices = c(a='x1', a='x2', b='x3'))
   choices <- x$children
 
-  expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[2]]$children[[1]], 'a')
+  expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[2]]$children[[1]], HTML('a'))
   expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$value, 'x1')
   expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$checked, 'checked')
 
-  expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[2]]$children[[1]], 'a')
+  expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[2]]$children[[1]], HTML('a'))
   expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$value, 'x2')
   expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$checked, NULL)
 
-  expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[2]]$children[[1]], 'b')
+  expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[2]]$children[[1]], HTML('b'))
   expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$value, 'x3')
   expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$checked, NULL)
+
+  # Radio buttons using choiceNames and choiceValues
+  x <- radioButtons('id','label',
+    choiceNames = list(icon('calendar'), HTML('<p style="color:red;">Red</p>'), 'Normal'),
+    choiceValues = list('icon', 'html', 'text')
+  )
+  choices <- x$children
+
+  expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[2]]$children[[1]],
+    HTML('<i class="fa fa-calendar"></i>'))
+  expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$value, 'icon')
+  expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$checked, 'checked')
+
+  expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[2]]$children[[1]],
+    HTML('<p style="color:red;">Red</p>'))
+  expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$value, 'html')
+  expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$checked, NULL)
+
+  expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[2]]$children[[1]],
+    HTML('Normal'))
+  expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$value, 'text')
+  expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$checked, NULL)
 })
 
 
@@ -167,3 +188,62 @@ test_that("selectInput selects items by default", {
     selectInput('x', 'x', list("a", "b"), multiple = TRUE)
   ))
 })
+
+test_that("normalizeChoicesArgs does its job", {
+
+  # Unnamed vectors and lists
+  expected <- list(choiceNames = list("a", "b"), choiceValues = list("a", "b"))
+  expect_equal(normalizeChoicesArgs(c("a", "b"), NULL, NULL), expected)
+  expect_equal(normalizeChoicesArgs(list("a", "b"), NULL, NULL), expected)
+
+  # Named list
+  expected <- list(choiceNames = list("one", "two"), choiceValues = list("a", "b"))
+  x <- list(one = "a", two = "b")
+  expect_equal(normalizeChoicesArgs(x, NULL, NULL), expected)
+  expect_equal(normalizeChoicesArgs(NULL, names(x), unname(x)), expected)
+
+  # Using unnamed `choiceNames` and `choiceValues` vectors/lists directly
+  expect_equal(normalizeChoicesArgs(NULL, c("one", "two"),  c("a", "b")), expected)
+  expect_equal(normalizeChoicesArgs(NULL, list("one", "two"), list("a", "b")), expected)
+
+  # Numbers
+  expected <- list(choiceNames = list("a", "b"), choiceValues = list("1", "2"))
+  expect_equal(normalizeChoicesArgs(c("a" = 1, "b" = 2), NULL, NULL), expected)
+  expect_equal(normalizeChoicesArgs(list("a" = 1, "b" = 2), NULL, NULL), expected)
+  expect_equal(normalizeChoicesArgs(NULL, c("a", "b"), c(1, 2)), expected)
+  expect_equal(normalizeChoicesArgs(NULL, list("a", "b"), list("1", "2")), expected)
+
+  # Using choiceNames with HTML and choiceValues
+  nms <- list(icon("calendar"), HTML("<p style='color:red;'>Red Text</p>"))
+  vals <- list("a", "b")
+  expected <- list(choiceNames = nms, choiceValues = vals)
+  expect_equal(normalizeChoicesArgs(NULL, nms, vals), expected)
+
+  # Attempt to use choices, AND choiceNames + choiceValues
+  x <- list("a", "b")
+  expect_warning(res <- normalizeChoicesArgs(x, nms, vals),
+    "Using `choices` argument; ignoring `choiceNames` and `choiceValues`.")
+  expect_equal(res, list(choiceNames = list("a", "b"), choiceValues = list("a", "b")))
+
+  # Set possibilities to character(0)
+  expected <- list(choiceNames = list(), choiceValues = list())
+  expect_equal(normalizeChoicesArgs(character(0), NULL, NULL), expected)
+  expect_equal(normalizeChoicesArgs(NULL, character(0), character(0)), expected)
+  expect_warning(res <- normalizeChoicesArgs(character(0), character(0), character(0)),
+    "Using `choices` argument; ignoring `choiceNames` and `choiceValues`.")
+  expect_equal(res, expected)
+
+  # Set possibilities to NULL in an inconsistent way
+  expected <- paste("One of `choiceNames` or `choiceValues` was set to NULL,",
+                    "but either both or none should be NULL.")
+  expect_error(normalizeChoicesArgs(NULL, character(0), NULL, FALSE), expected, fixed = TRUE)
+  expect_error(normalizeChoicesArgs(NULL, NULL, character(0), FALSE), expected, fixed = TRUE)
+  expected <- paste("Please specify a non-empty vector for `choices` (or,",
+                    "alternatively, for both `choiceNames` AND `choiceValues`).")
+  expect_error(normalizeChoicesArgs(NULL, character(0), NULL), expected, fixed = TRUE)
+  expect_error(normalizeChoicesArgs(NULL, NULL, character(0)), expected, fixed = TRUE)
+
+  # Set all possibilities to NULL (and mustExist = FALSE)
+  expected <- list(choiceNames = NULL, choiceValues = NULL)
+  expect_equal(normalizeChoicesArgs(NULL, NULL, NULL, FALSE), expected)
+})