No recursion

.Rbuildignore

@@ -20,3 +20,4 @@
 ^revdep$
 ^TODO-promises.md$
 ^manualtests$
+^\.github$

R/input-utils.R

@@ -90,41 +90,58 @@ generateOptions <- function(inputId, selected, inline, type = 'checkbox',
   div(class = "shiny-options-group", options)
 }
 
-# Take a vector or list, and convert to named list. Also, if any children are
-# vectors with length > 1, convert those to list. If the list is unnamed,
-# convert it to a named list with blank names.
-listify <- function(x) {
-  if (is.list(x) || is.null(x)) {
-    asNamedVector(lapply(x, listify))
-  } else if (is.character(x)) {
-    if (length(x) == 1 && is.null(names(x))) {
-      x
+# True when a choice list item represents a group of related inputs
+isGroup <- function(choice) {
+  length(choice) > 1 || !is.null(names(choice))
+}
+
+# True when choices is a list and contains at least one group of related inputs
+hasGroups <- function(choices) {
+  is.list(choices) && Position(isGroup, choices, nomatch = 0)
+}
+
+# Assigns empty names to x if it's unnamed, and then fills any empty names with
+# the corresponding value coerced to a character(1)
+setDefaultNames <- function(x) {
+  x <- asNamed(x)
+  emptyNames <- names(x) == ""
+  names(x)[emptyNames] <- as.character(x)[emptyNames]
+  x
+}
+
+# Makes a character vector out of x in a way that preserves names if x is a
+# factor.
+asCharacter <- function(x) {
+  stats::setNames(as.character(x), names(x))
+}
+
+processFlatChoices <- function(choices) {
+  choices <- setDefaultNames(asCharacter(choices))
+  as.list(choices)
+}
+
+processGroupedChoices <- function(choices) {
+  choices <- asNamed(choices)
+  choices <- mapply(function(name, group, choice) {
+    if (group && name == "") {
+      stop('All sub-lists in "choices" must be named.')
+    } else if (group) {
+      processFlatChoices(choice)
     } else {
-      as.list(asNamedVector(x))
+      as.character(choice)
     }
-  } else {
-    # Can get here if x is a factor.
-    listify(stats::setNames(as.character(x), names(x)))
-  }
+  }, names(choices), lapply(choices, isGroup), choices, SIMPLIFY = FALSE)
+  setDefaultNames(choices)
 }
 
 # Takes a vector or list, and adds names (same as the value) to any entries
 # without names. Coerces all leaf nodes to `character`.
 choicesWithNames <- function(choices) {
-
-  choices <- listify(choices)
-  if (length(choices) == 0) return(choices)
-
-  # Recurse into any subgroups
-  choices <- mapply(choices, names(choices), FUN = function(choice, name) {
-    if (!is.list(choice)) return(choice)
-    if (name == "") stop('All sub-lists in "choices" must be named.')
-    choicesWithNames(choice)
-  }, SIMPLIFY = FALSE)
-
-  # default missing names to choice values
-  missing <- names(choices) == ""
-  names(choices)[missing] <- as.character(choices)[missing]
-
-  choices
+  if (length(choices) == 0) {
+    choices
+  } else if (hasGroups(choices)) {
+    processGroupedChoices(choices)
+  } else {
+    processFlatChoices(choices)
+  }
 }

R/shiny.R

@@ -639,7 +639,7 @@ ShinySession <- R6Class(
           # that the resulting object is represented as an object in JSON
           # instead of an array, and so that the RDS data structure is of a
           # consistent type.
-          values <- lapply(values, asNamedVector)
+          values <- lapply(values, asNamed)
 
           if (length(values) == 0) {
             return(httpResponse(400, "text/plain",

R/utils.R

@@ -173,8 +173,8 @@ anyUnnamed <- function(x) {
 }
 
 
-# Given a vector/list, returns a named vector (the labels will be blank).
-asNamedVector <- function(x) {
+# Given a vector/list, returns a named vector/list (the labels will be blank).
+asNamed <- function(x) {
   if (is.null(names(x))) {
     names(x) <- character(length(x))
   }

man/reactlog.Rd

@@ -15,6 +15,10 @@ showReactLog(time = TRUE)
 
 reactlogReset()
 }
+\arguments{
+\item{time}{A boolean that specifies whether or not to display the
+time that each reactive takes to calculate a result.}
+}
 \description{
 Provides an interactive browser-based tool for visualizing reactive
 dependencies and execution in your application.

tests/testthat/test-bootstrap.r

@@ -69,6 +69,11 @@ test_that("Repeated names for selectInput and radioButtons choices", {
 
 
 test_that("Choices are correctly assigned names", {
+  # Empty character vector
+  expect_identical(
+    choicesWithNames(c("")),
+    stats::setNames(list(""), "")
+  )
   # Unnamed character vector
   expect_identical(
     choicesWithNames(c("a","b","3")),