Finalize dynamic update of inputs (#23)

R/controls.R

@@ -1,15 +1,15 @@
 #Copyright © 2016 RTE Réseau de transport d’électricité
 
-mwControlFactory <- function(type, inputFunction, params, postProcessing = I,
-                             valueVar = NULL) {
+# Private function used to create input generator functions.
+mwControlFactory <- function(type, inputFunction, params, valueVar = NULL) {
 
   res <- function(params) {
     if (!is.null(valueVar)) {
       params[[valueVar]] <- params$value
       params$value <- NULL
     }
     if (is.null(params$label)) params$label <- params$inputId
-    postProcessing(do.call(inputFunction, params))
+    do.call(inputFunction, params)
   }
 
   attr(res, "params") <- params
@@ -61,9 +61,9 @@ mwControlFactory <- function(type, inputFunction, params, postProcessing = I,
 #' @family controls
 mwSlider <- function(min, max, value, label = NULL, ...) {
   mwControlFactory(
-    "slider", sliderInput,
-    list(min = min, max = max, value = value, label = label, ...),
-    function(x) {tags$div(style = "padding:0 5px;", x)}
+    "slider",
+    function(...) {tags$div(style = "padding:0 5px;", sliderInput(...))},
+    list(min = min, max = max, value = value, label = label, ...)
   )
 }
 

R/controlsUtils.R

@@ -1,10 +1,19 @@
+# Set or update the elements of a list given the elements of another list.
+mergeList <- function(x, y) {
+  for (n in names(y)) {
+    x[[n]] <- y[[n]]
+  }
+  x
+}
+
 # Internal function that extracts the name, initial value and type of input
 # controls defined by the user.
 # This function is required because of the fact that the user can group controls
 # and even create nested groups so it is a bit hard to know what are the
 # available controls.
 #
-# Returns a data.frame with columns "name", "initValue", "type" and "level".
+# Returns a data.frame with columns "name", "initValue", "type", "level",
+# "multiple" and "params".
 # "level" is equal to 1 if the input is not contained in a group, 2 if it is
 # contained in a group, 3 if it is contained in a group contained in a group,
 # etc.
@@ -123,7 +132,7 @@ initValueIsValid <- function(x) {
   }
 
   if (type == "slider") {
-    return(all(params$value >= params$min & params$value <= params$min) )
+    return(all(params$value >= params$min & params$value <= params$max) )
   }
 
   TRUE
@@ -171,11 +180,13 @@ comparisonControls <- function(controls, compare, updateInputs = NULL) {
   names(initValues) <- controlsDesc$name
 
   initValues1 <- lapply(compare, function(x) {if(is.null(x)) x else x[[1]]})
+  initValues1 <- mergeList(initValues, initValues1)
   initValues2 <- lapply(compare, function(x) {if(is.null(x)) x else x[[2]]})
+  initValues2 <- mergeList(initValues, initValues2)
 
   # Reset initial values of input controls
-  newParams1 <- eval(updateInputs, list2env(initValues, parent = parent.frame()))
-  newParams2 <- eval(updateInputs, list2env(initValues, parent = parent.frame()))
+  newParams1 <- eval(updateInputs, list2env(initValues1, parent = parent.frame()))
+  newParams2 <- eval(updateInputs, list2env(initValues2, parent = parent.frame()))
 
   ind <- resetInitValues(ind, initValues1, newParams1)
   ind2 <- resetInitValues(ind2, initValues2, newParams2)

R/mwServer.R

@@ -154,41 +154,25 @@ updateInputs <- function(session, input, controlDesc, .display, .compare, .updat
       text = updateTextInput,
       numeric = updateNumericInput,
       password = updatePasswordInput,
-      select = updateSelectizeInput
+      select = updateSelectizeInput,
+      checkbox = updateCheckboxInput,
+      radio = updateRadioButtons,
+      date = updateDateInput,
+      dateRange = updateDateRangeInput,
+      checkboxGroup = updateCheckboxGroupInput
     )
 
     for (p in names(newParams[[n]])) {
       if (identical(newParams[[n]][[p]], desc$params[[1]][[p]])) {
         next
       }
-      args <- newParams[[n]][[p]]
+      args <- newParams[[n]][p]
       args$session <- session
       args$inputId <- inputId
       do.call(updateInputFun, args)
 
       controlDesc$params[controlDesc$name == inputId][[1]][[p]] <-  newParams[[n]][[p]]
     }
-    # possibleChoices <- unlist(newChoices[[n]])
-    # desc <- controlDesc[controlDesc$name == inputId,]
-    #
-    # if (identical(newChoices[[n]], desc$choices[[1]])) {
-    #   next
-    # }
-    #
-    # if (desc$multiple) {
-    #   newValue <- intersect(env[[n]], possibleChoices)
-    # } else {
-    #   if (env[[n]] %in% possibleChoices) {
-    #     newValue <- env[[n]]
-    #   } else {
-    #     newValue <- possibleChoices[1]
-    #   }
-    # }
-    #
-    # updateSelectInput(session, inputId, choices = newChoices[[n]],
-    #                   selected = newValue)
-    #
-    # controlDesc$choices[controlDesc$name == inputId] <- list(newChoices[[n]])
   }
 
   return(controlDesc)