189 - Add Pattern Matching Callbacks for Dash R (#228)

* Testing initial implementation * More testing * Callback Context Updates * Updating callback context logic * Fixing callback returns * Adding callback args conditional * Cleanup and additional changes to callback value conditionals * Comment cleanup * Added PMC callback validation, removed unnecessary code * Update R/dependencies.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update R/dependencies.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update R/dependencies.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update R/dependencies.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Added build to gitignore * Updated dependencies.R * Update boilerplate docs and add wildcard symbols * Drying up validation code and applying symbol logic * Update test to use symbols * Cleaned up code and added allsmaller test example * Cleaning up redundant code * Update FUNDING.yml * Updated callback_args logic and example * Adding basic unittests, updated validation * Fixed response for MATCH callbacks * Added integration test and updated examples for docs * Added additional integration test * Formatting and cleanup * update docs * Update to-do app * Add comments to examples * Change empy vector to character type. Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update boilerplate text. Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update tests/integration/callbacks/test_pattern_matching.py Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update tests/integration/callbacks/test_pattern_matching.py Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update tests/integration/callbacks/test_pattern_matching.py Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update tests/integration/callbacks/test_pattern_matching.py Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update tests/integration/callbacks/test_pattern_matching.py Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update tests/testthat/test-wildcards.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update wildcards_test.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update wildcards_test.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update wildcards_test.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update wildcards_test.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update wildcards_test.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update wildcards_test.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update wildcards_test.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Update wildcards_test.R Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> * Removed triple colon syntax * Use seq_along and remove unnecessary unittest * Update CHANGELOG.md * Update CHANGELOG.md * Add support for arbitrary and sorted keys * Whitespace deleted * Added integration tests * Fixing test output * Fixing flakiness * Update test_pattern_matching.py * Update test_pattern_matching.py * Updating boilerplate text and test with generalized keys * Minor test fixes Co-authored-by: Ryan Patrick Kyle <rpkyle@users.noreply.github.com> Co-authored-by: Nicolas Kruchten <nicolas@plot.ly> Co-authored-by: rpkyle <ryan@plotly.com>
plotly · Oct 21, 2020 · 3b54773 · 3b54773
1 parent 766e3a8
commit 3b54773
Show file tree

Hide file tree

Showing 11 changed files with 646 additions and 22 deletions.
diff --git a/.github/FUNDING.yml b/.github/FUNDING.yml
@@ -1 +1,2 @@
+github: plotly
 custom: https://plotly.com/products/consulting-and-oem/
diff --git a/.gitignore b/.gitignore
@@ -7,3 +7,4 @@ node_modules/
 python/
 todo.txt
 r-finance*
+build/
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -4,6 +4,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
 ## [Unreleased]
 ### Added
+- Pattern-matching IDs and callbacks. Component IDs can be lists, and callbacks can reference patterns of components, using three different wildcards: `ALL`, `MATCH`, and `ALLSMALLER`. This lets you create components on demand, and have callbacks respond to any and all of them. To help with this, `app$callback_context` gets three new entries: `outputs_list`, `inputs_list`, and `states_list`, which contain all the ids, properties, and except for the outputs, the property values from all matched components. [#228](https://github.com/plotly/dashR/pull/228)
 - New and improved callback graph in the debug menu. Now based on Cytoscape for much more interactivity, plus callback profiling including number of calls, fine-grained time information, bytes sent and received, and more. You can even add custom timing information on the server with `callback_context.record_timing(name, duration, description)` [#224](https://github.com/plotly/dashR/pull/224)
 - Support for setting attributes on `external_scripts` and `external_stylesheets`, and validation for the parameters passed (attributes are verified, and elements that are lists themselves must be named). [#226](https://github.com/plotly/dashR/pull/226)
 - Dash for R now supports user-defined routes and redirects via the `app$server_route` and `app$redirect` methods. [#225](https://github.com/plotly/dashR/pull/225)

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,7 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(print,dash_component)
+export(ALL)
+export(ALLSMALLER)
 export(Dash)
+export(MATCH)
 export(clientsideFunction)
 export(dashNoUpdate)
 export(input)

diff --git a/R/dash.R b/R/dash.R
@@ -221,18 +221,38 @@ Dash <- R6::R6Class(
         callback_args <- list()
 
         for (input_element in request$body$inputs) {
-          if(is.null(input_element$value))
+          if (any(grepl("id.", names(unlist(input_element))))) {
+            if (!is.null(input_element$id)) input_element <- list(input_element)
+            values <- character(0)
+            for (wildcard_input in input_element) {
+              values <- c(values, wildcard_input$value)
+            }
+            callback_args <- c(callback_args, ifelse(length(values), list(values), list(NULL)))
+          }
+          else if(is.null(input_element$value)) {
             callback_args <- c(callback_args, list(list(NULL)))
-          else
+          }
+          else {
             callback_args <- c(callback_args, list(input_element$value))
+          }
         }
 
         if (length(request$body$state)) {
           for (state_element in request$body$state) {
-            if(is.null(state_element$value))
+            if (any(grepl("id.", names(unlist(state_element))))) {
+              if (!is.null(state_element$id)) state_element <- list(state_element)
+              values <- character(0)
+              for (wildcard_state in state_element) {
+                values <- c(values, wildcard_state$value)
+              }
+              callback_args <- c(callback_args, ifelse(length(values), list(values), list(NULL)))
+            }
+            else if(is.null(state_element$value)) {
               callback_args <- c(callback_args, list(list(NULL)))
-            else
+            }
+            else {
               callback_args <- c(callback_args, list(state_element$value))
+            }
           }
         }
 
@@ -290,6 +310,12 @@ Dash <- R6::R6Class(
              response = allprops,
              multi = TRUE
              )
+          } else if (is.list(request$body$outputs$id)) {
+            props = setNames(list(output_value), gsub( "(^.+)(\\.)", "", request$body$output))
+            resp <- list(
+              response = setNames(list(props), to_JSON(request$body$outputs$id)),
+              multi = TRUE
+            )
           } else {
             resp <- list(
               response = list(
@@ -770,12 +796,43 @@ Dash <- R6::R6Class(
     #' containing valid JavaScript, or a call to [clientsideFunction],
     #' including `namespace` and `function_name` arguments for a locally served
     #' JavaScript function.
+    #'
+    #'
+    #' For pattern-matching callbacks, the `id` field of a component is written
+    #' in JSON-like syntax which describes a dictionary object when serialized
+    #' for consumption by the Dash renderer. The fields are arbitrary keys
+    #' , which describe the targets of the callback.
+    #'
+    #' For example, when we write `input(id=list("foo" = ALL, "bar" = "dropdown")`,
+    #' Dash interprets this as "match any input that has an ID list where 'foo'
+    #' is 'ALL' and 'bar' is anything." If any of the dropdown
+    #' `value` properties change, all of their values are returned to the callback.
+    #'
+    #' However, for readability, we recommend using keys like type, index, or id.
+    #' `type` can be used to refer to the class or set of dynamic components and
+    #' `index` or `id` could be used to refer to the component you are matching
+    #' within that set. While your application may have a single set of dynamic
+    #' components, it's possible to specify multiple sets of dynamic components
+    #' in more complex apps or if you are using `MATCH`.
+    #'
+    #' Like `ALL`, `MATCH` will fire the callback when any of the component's properties
+    #' change. However, instead of passing all of the values into the callback, `MATCH`
+    #' will pass just a single value into the callback. Instead of updating a single
+    #' output, it will update the dynamic output that is "matched" with.
+    #'
+    #' `ALLSMALLER` is used to pass in the values of all of the targeted components
+    #' on the page that have an index smaller than the index corresponding to the div.
+    #' For example, `ALLSMALLER` makes it possible to filter results that are
+    #' increasingly specific as the user applies each additional selection.
+    #'
+    #' `ALLSMALLER` can only be used in `input` and `state` items, and must be used
+    #' on a key that has `MATCH` in the `output` item(s). `ALLSMALLER` it isn't always
+    #' necessary (you can usually use `ALL` and filter out the indices in your callback),
+    #' but it will make your logic simpler.
     callback = function(output, params, func) {
       assert_valid_callbacks(output, params, func)
-
       inputs <- params[vapply(params, function(x) 'input' %in% attr(x, "class"), FUN.VALUE=logical(1))]
       state <- params[vapply(params, function(x) 'state' %in% attr(x, "class"), FUN.VALUE=logical(1))]
-
       if (is.function(func)) {
         clientside_function <- NULL
       } else if (is.character(func)) {

diff --git a/R/dependencies.R b/R/dependencies.R
@@ -1,5 +1,15 @@
 # akin to https://github.com/plotly/dash/blob/d2ebc837/dash/dependencies.py
 
+# Helper functions for handling dependency ids or props
+setWildcardId <- function(id) {
+  # Sort the keys of a wildcard id
+  id <- id[order(names(id))]
+  all_selectors <- vapply(id, function(x) {is.symbol(x)}, logical(1))
+  id[all_selectors] <- as.character(id[all_selectors])
+  id[!all_selectors] <- lapply(id[!all_selectors], function(x) {jsonlite::unbox(x)})
+  return(as.character(jsonlite::toJSON(id, auto_unbox = FALSE)))
+}
+
 #' Input/Output/State definitions
 #'
 #' Use in conjunction with the `callback()` method from the [dash::Dash] class
@@ -8,13 +18,23 @@
 #' The `dashNoUpdate()` function permits application developers to prevent a
 #' single output from updating the layout. It has no formal arguments.
 #' 
+#' `ALL`, `ALLSMALLER` and `MATCH` are symbols corresponding to the
+#' pattern-matching callback selectors with the same names. These allow you
+#' to write callbacks that respond to or update an arbitrary or dynamic
+#' number of components. For more information, see the `callback` section
+#' in \link{dash}.
+#'
 #' @name dependencies
 #' @param id a component id
 #' @param property the component property to use
 
 #' @rdname dependencies
 #' @export
+
 output <- function(id, property) {
+  if (is.list(id)) {
+    id = setWildcardId(id)
+  }
   structure(
     dependency(id, property),
     class = c("dash_dependency", "output")
@@ -24,6 +44,9 @@ output <- function(id, property) {
 #' @rdname dependencies
 #' @export
 input <- function(id, property) {
+  if (is.list(id)) {
+    id = setWildcardId(id)
+  }
   structure(
     dependency(id, property),
     class = c("dash_dependency", "input")
@@ -33,6 +56,9 @@ input <- function(id, property) {
 #' @rdname dependencies
 #' @export
 state <- function(id, property) {
+  if (is.list(id)) {
+    id = setWildcardId(id)
+  }
   structure(
     dependency(id, property),
     class = c("dash_dependency", "state")
@@ -41,6 +67,9 @@ state <- function(id, property) {
 
 dependency <- function(id = NULL, property = NULL) {
   if (is.null(id)) stop("Must specify an id", call. = FALSE)
+  if (is.list(id)) {
+    id = setWildcardId(id)
+  }
   list(
     id = id,
     property = property
@@ -54,3 +83,15 @@ dashNoUpdate <- function() {
   class(x) <- "no_update"
   return(x)
 }
+
+#' @rdname dependencies
+#' @export
+ALL <- as.symbol("ALL")
+
+#' @rdname dependencies
+#' @export
+ALLSMALLER <- as.symbol("ALLSMALLER")
+
+#' @rdname dependencies
+#' @export
+MATCH <- as.symbol("MATCH")
diff --git a/R/utils.R b/R/utils.R
@@ -290,6 +290,22 @@ assert_no_names <- function (x)
                paste(nms, collapse = "', '")), call. = FALSE)
 }
 
+assertValidWildcards <- function(dependency) {
+  if (is.symbol(dependency$id)) {
+    result <- (jsonlite::validate(as.character(dependency$id)) && grepl("{", dependency$id))
+  } else {
+    result <- TRUE
+  }
+  if (!result) {
+    dependencyType <- class(dependency)
+    stop(sprintf("A callback %s ID contains restricted pattern matching callback selectors ALL, MATCH or ALLSMALLER. Please verify that it is formatted as a pattern matching callback list ID, or choose a different component ID.",
+                 dependencyType[dependencyType %in% c("input", "output", "state")]),
+         call. = FALSE)
+  } else {
+    return(result)
+  }
+}
+
 # the following function attempts to prune remote CSS
 # or local CSS/JS dependencies that either should not
 # be resolved to local R package paths, or which have
@@ -403,6 +419,27 @@ assert_valid_callbacks <- function(output, params, func) {
     stop(sprintf("The callback method requires that one or more properly formatted inputs are passed."), call. = FALSE)
   }
 
+  # Verify that 'input', 'state' and 'output' parameters only contain 'Wildcard' keywords if they are JSON formatted ids for pattern matching callbacks
+  valid_wildcard_inputs <- sapply(inputs, function(x) {
+    assertValidWildcards(x)
+  })
+
+
+  valid_wildcard_state <- sapply(state, function(x) {
+    assertValidWildcards(x)
+  })
+
+  if(any(sapply(output, is.list))) {
+    valid_wildcard_output <- sapply(output, function(x) {
+      assertValidWildcards(x)
+    })
+  } else {
+    valid_wildcard_output <- sapply(list(output), function(x) {
+      assertValidWildcards(x)
+    })
+  }
+
+
   # Check that outputs are not inputs
   # https://github.com/plotly/dash/issues/323
 
@@ -987,29 +1024,78 @@ removeHandlers <- function(fnList) {
 }
 
 setCallbackContext <- function(callback_elements) {
-  states <- lapply(callback_elements$states, function(x) {
-    setNames(x$value, paste(x$id, x$property, sep="."))
-  })
+  # Set state elements for this callback
+
+  if (length(callback_elements$state[[1]]) == 0) {
+    states <- sapply(callback_elements$state, function(x) {
+      setNames(list(x$value), paste(x$id, x$property, sep="."))
+    })
+  } else if (is.character(callback_elements$state[[1]][[1]])) {
+    states <- sapply(callback_elements$state, function(x) {
+      setNames(list(x$value), paste(x$id, x$property, sep="."))
+    })
+  } else {
+    states <- sapply(callback_elements$state, function(x) {
+      states_vector <- unlist(x)
+      setNames(list(states_vector[grepl("value|value.", names(states_vector))]), 
+               paste(as.character(jsonlite::toJSON(x[[1]])), x$property, sep="."))
+    })
+  }
 
   splitIdProp <- function(x) unlist(strsplit(x, split = "[.]"))
 
   triggered <- lapply(callback_elements$changedPropIds,
                       function(x) {
                         input_id <- splitIdProp(x)[1]
                         prop <- splitIdProp(x)[2]
-
-                        id_match <- vapply(callback_elements$inputs, function(x) x$id %in% input_id, logical(1))
-                        prop_match <- vapply(callback_elements$inputs, function(x) x$property %in% prop, logical(1))
-
-                        value <- sapply(callback_elements$inputs[id_match & prop_match], `[[`, "value")
-
-                        list(`prop_id` = x, `value` = value)
+
+                        # The following conditionals check whether the callback is a pattern-matching callback and if it has been triggered. 
+                        if (startsWith(input_id, "{")){
+                          id_match <- vapply(callback_elements$inputs, function(x) {
+                            x <- unlist(x)
+                            any(x[grepl("id.", names(x))] %in% jsonlite::fromJSON(input_id)[[1]])
+                          }, logical(1))[[1]]
+                        } else {
+                          id_match <- vapply(callback_elements$inputs, function(x) x$id %in% input_id, logical(1))
+                        }
+
+                        if (startsWith(input_id, "{")){
+                          prop_match <- vapply(callback_elements$inputs, function(x) {
+                            x <- unlist(x)
+                            any(x[names(x) == "property"] %in% prop)
+                          }, logical(1))[[1]]
+                        } else {
+                          prop_match <- vapply(callback_elements$inputs, function(x) x$property %in% prop, logical(1))
+                        }
+
+                        if (startsWith(input_id, "{")){
+                          if (length(callback_elements$inputs) == 1 || !is.null(unlist(callback_elements$inputs, recursive = F)$value)) {
+                            value <- sapply(callback_elements$inputs[id_match & prop_match], `[[`, "value")
+                          } else {
+                            value <- sapply(callback_elements$inputs[id_match & prop_match][[1]], `[[`, "value")
+                          }
+                        } else {
+                          value <- sapply(callback_elements$inputs[id_match & prop_match], `[[`, "value")
+                        }
+
+                        return(list(`prop_id` = x, `value` = value))
                       }
-                      )
-
-  inputs <- sapply(callback_elements$inputs, function(x) {
-    setNames(list(x$value), paste(x$id, x$property, sep="."))
-  })
+                    )
+  if (length(callback_elements$inputs[[1]]) == 0 || is.character(callback_elements$inputs[[1]][[1]])) {
+    inputs <- sapply(callback_elements$inputs, function(x) {
+      setNames(list(x$value), paste(x$id, x$property, sep="."))
+    })
+  } else if (length(callback_elements$inputs[[1]]) > 1) {
+    inputs <- sapply(callback_elements$inputs, function(x) {
+      inputs_vector <- unlist(x)
+      setNames(list(inputs_vector[grepl("value|value.", names(inputs_vector))]), paste(as.character(jsonlite::toJSON(x$id)), x$property, sep="."))
+    })
+  } else {
+    inputs <- sapply(callback_elements$inputs, function(x) {
+      inputs_vector <- unlist(x)
+      setNames(list(inputs_vector[grepl("value|value.", names(inputs_vector))]), paste(as.character(jsonlite::toJSON(x[[1]]$id)), x[[1]]$property, sep="."))
+    })
+  }
 
   return(list(states=states,
               triggered=unlist(triggered, recursive=FALSE),
Original file line number	Diff line number	Diff line change
		@@ -1 +1,2 @@
		github: plotly
		custom: https://plotly.com/products/consulting-and-oem/
-Original file line number
+Diff line change
@@ Expand Up / @@ -7,3 +7,4 @@ node_modules/ @@
     python/
     todo.txt
     r-finance*
+    build/