Fix initialization problems:

- choices are evaluated before widgets so initial values of inputs are correct when evaluating for the first time the widgets
- selectInput are now correctly initialized in all situations

R/controls.R

@@ -215,7 +215,7 @@ mwPassword <- function(value = "", label = NULL, ...) {
 #' @export
 #' @family controls
 mwSelect <- function(choices = value, value = NULL, label = NULL, ..., multiple = FALSE) {
-  res <- function(id, value, label, width) {
+  res <- function(id, value, label, width, choices) {
     if (is.null(label)) label <- id
     selectInput(id, label, choices, value, width = width, ..., multiple = multiple)
   }

R/controlsUtils.R

@@ -27,8 +27,9 @@ getControlDesc <- function(controls) {
      m <- if (is.null(attr(x, "multiple"))) NA else attr(x, "multiple")
      multiple <<- append(multiple, m)
      choices <<- append(choices, list(attr(x, "choices")))
-   }
-   else mapply(getControlDescRecursive, x=x, name = names(x), level = level + 1)
+   } else if (length(x) == 0) {
+     return()
+   } else mapply(getControlDescRecursive, x=x, name = names(x), level = level + 1)
  }
  getControlDescRecursive(controls)
 
@@ -85,7 +86,7 @@ addSuffixToControls <- function(controls, suffix) {
 }
 
 # Private function that resets the initial values of some controls
-resetInitValues <- function(controls, values) {
+resetInitValues <- function(controls, values, choices = NULL) {
   if (length(controls) == 0) return(controls)
   resetInitValuesRecursive <- function(x) {
     for (n in names(x)) {
@@ -95,6 +96,16 @@ resetInitValues <- function(controls, values) {
         if (n %in% names(values) && ! is.null(values[[n]])) {
           attr(x[[n]], "value") <- values[[n]]
         }
+        if (n %in% names(choices) && !is.null(choices[[n]])) {
+          attr(x[[n]], "choices") <- choices[[n]]
+          if (attr(x[[n]], "multiple")) {
+            attr(x[[n]], "value") <- intersect(attr(x[[n]], "value"), choices[[n]])
+          } else {
+            if (is.null(attr(x[[n]], "value")) || ! attr(x[[n]], "value") %in% choices[[n]]) {
+              attr(x[[n]], "value") <- choices[[n]][[1]]
+            }
+          }
+        }
       }
     }
     return(x)
@@ -106,7 +117,7 @@ resetInitValues <- function(controls, values) {
 # - common: list of common controls
 # - ind: list of individual controls for the first chart to compare
 # - ind2: list of individual controls for the seconde chart to compare
-comparisonControls <- function(controls, compare) {
+comparisonControls <- function(controls, compare, choices = NULL) {
   common <- filterControls(controls, names(compare), drop = TRUE)
   ind <- filterControls(controls, names(compare))
   ind2 <- ind
@@ -116,9 +127,12 @@ comparisonControls <- function(controls, compare) {
   initValues2 <- lapply(compare, function(x) {if(is.null(x)) x else x[[2]]})
 
   # Reset initial values of input controls
-  ind <- resetInitValues(ind, initValues1)
-  ind2 <- resetInitValues(ind2, initValues2)
+  choices1 <- eval(choices, list2env(initValues1, parent = parent.frame()))
+  choices2 <- eval(choices, list2env(initValues2, parent = parent.frame()))
 
+  ind <- resetInitValues(ind, initValues1, choices1)
+  ind2 <- resetInitValues(ind2, initValues2, choices2)
+  common <- resetInitValues(common, NULL, choices1)
   # Add a "2" at the end of the names of the inputs of the second chart
   ind2 <- addSuffixToControls(ind2, "2")
 

R/manipulateWidget.R

@@ -42,7 +42,7 @@
 #'   associated condition is evaluated. If the result is TRUE then the control
 #'   is visible, else it is hidden.
 #' @param .choices A named list of expressions that return a character vector.
-#'   This parameter can be used to dinamically update the choices of a given
+#'   This parameter can be used to dynamically update the choices of a given
 #'   input control conditionally to the value of the other controls.
 #' @param .compare Sometimes one wants to compare the same chart but with two
 #'   different sets of parameters. This is the purpose of this argument. It must
@@ -224,7 +224,6 @@ manipulateWidget <- function(.expr, ..., .main = NULL, .updateBtn = FALSE,
   .compareLayout <- match.arg(.compareLayout)
   .env <- parent.frame()
   compareMode <- !is.null(.compare)
-  controlDesc <- getControlDesc(list(...))
 
   if (.controlPos == "tab") .updateBtn <- FALSE
 
@@ -239,6 +238,9 @@ manipulateWidget <- function(.expr, ..., .main = NULL, .updateBtn = FALSE,
   }
 
   # Evaluate a first time .expr to determine the class of the output
+  controls <- comparisonControls(list(...), .compare, .choices)
+  controlDesc <- getControlDesc(controls[c("common", "ind")])
+
   initValues <- controlDesc$initValue
   names(initValues) <- controlDesc$name
 
@@ -253,7 +255,11 @@ manipulateWidget <- function(.expr, ..., .main = NULL, .updateBtn = FALSE,
   initWidget <- eval(.expr, envir = list2env(initValues, parent = .env))
 
   if (compareMode) {
-    initValues2 <- initValues
+    controlDesc2 <- getControlDesc(controls[c("common", "ind2")])
+    initValues2 <- controlDesc2$initValue
+    names(initValues2) <- controlDesc$name
+    initValues2$.initial <- TRUE
+    initValues2$.session <- NULL
     initValues2$.output <- "output2"
     initValues2$.id <- 2
 
@@ -294,6 +300,7 @@ manipulateWidget <- function(.expr, ..., .main = NULL, .updateBtn = FALSE,
     .main = .main,
     .outputFun = outputFunction,
     .titleBar = !isRuntimeShiny,
+    .choices = .choices,
     .compare = .compare,
     .compareLayout = .compareLayout
   )

R/mwControlsUI.R

@@ -52,11 +52,18 @@ mwControlsUI <- function(controlList, .dir = c("v", "h"), .n = 1, .updateBtn = F
       } else {
         inputValue <- attr(f, "value")
         inputLabel <- attr(f, "label")
+        choices <- attr(f, "choices")
         if (is.null(inputLabel)) inputLabel <- id
 
         res <- conditionalPanel(
           condition = sprintf("input.%s_visible", id),
-          f(id, inputValue, inputLabel, width = ifelse(.dir == "v", "100%", "180px"))
+          if (!is.null(choices)) {
+            f(id, inputValue, inputLabel, choices = choices,
+              width = ifelse(.dir == "v", "100%", "180px"))
+          } else {
+            f(id, inputValue, inputLabel, width = ifelse(.dir == "v", "100%", "180px"))
+          }
+
         )
       }
 

R/mwServer.R

@@ -7,7 +7,7 @@ mwServer <- function(.expr, initWidget, initWidget2 = NULL,
 
   function(input, output, session) {
     compareMode <- !is.null(initWidget2)
-    selectInputList <- subset(controlDesc, type == "select" & multiple)$name
+    selectInputList <- controlDesc[controlDesc$type == "select" & controlDesc$multiple, "name"]
 
     # Since the widget has already been created with the initial values, we want
     # to skip the first evaluation of the widget by the server function. This is
@@ -21,7 +21,7 @@ mwServer <- function(.expr, initWidget, initWidget2 = NULL,
         paste0(controlDesc2$name, "2"),
         controlDesc2$name
       )
-      selectInputList2 <- subset(controlDesc2, type == "select" & multiple)$name
+      selectInputList2 <- controlDesc2[controlDesc2$type == "select" & controlDesc2$multiple, "name"]
       firstEval2 <- TRUE
     }
 

R/mwUI.R

@@ -23,25 +23,25 @@
 mwUI <- function(..., .controlPos = c("left", "top", "right", "bottom", "tab"),
                  .tabColumns = 2, .updateBtn = FALSE, .main = "",
                  .outputFun = NULL, .outputId = "output",
-                 .titleBar = TRUE, .compare = NULL, .compareLayout = c("v", "h"),
+                 .titleBar = TRUE, .choices = NULL, .compare = NULL, .compareLayout = c("v", "h"),
                  .controlList = NULL, .container = miniUI::miniContentPanel,
                  .style = "") {
 
   .controlPos <- match.arg(.controlPos)
   .compareLayout <- match.arg(.compareLayout)
   controls <- append(list(...), .controlList)
 
-  if (is.null(.compare)) {
-    commonControls <- controls
+  controls <- comparisonControls(controls, .compare, .choices)
+  commonControls <- controls$common
 
+  if (is.null(.compare)) {
     if(is.null(.outputFun)) {
       .content <- htmlOutput(.outputId, style = "height:100%;width:100%")
     } else {
       .content <- .outputFun(.outputId, width = "100%", height = "100%")
     }
   } else {
-    controls <- comparisonControls(controls, .compare)
-    commonControls <- controls$common
+
 
     if (.compareLayout == "v") {
       .content <- fillCol(