229 delayed_choices as single function

NAMESPACE

@@ -35,7 +35,6 @@ S3method(variable_choices,character)
 S3method(variable_choices,data.frame)
 export("%>%")
 export(add_no_selected_choices)
-export(all_choices)
 export(check_no_multiple_selection)
 export(choices_labeled)
 export(choices_selected)
@@ -45,6 +44,7 @@ export(data_extract_spec)
 export(data_extract_srv)
 export(data_extract_ui)
 export(datanames_input)
+export(delayed_choices)
 export(filter_spec)
 export(format_data_extract)
 export(get_anl_relabel_call)

NEWS.md

@@ -1,5 +1,9 @@
 # teal.transform 0.5.0.9018
 
+### Enhancements
+
+* The utility function `all_choices` has been replaced by the more robust `delayed_choices`.
+
 # teal.transform 0.5.0
 
 ### Breaking changes

R/choices_selected.R

@@ -24,7 +24,7 @@ no_select_keyword <- "-- no selection --"
 #' @param choices (`character`) vector of possible choices or `delayed_data` object.
 #'
 #' See [variable_choices()] and [value_choices()].
-#' @param selected (`character`) vector of preselected options, (`all_choices`) object
+#' @param selected (`character`) vector of preselected options, (`delayed_choices`) object
 #' or (`delayed_data`) object.
 #'
 #' If `delayed_data` object then `choices` must also be `delayed_data` object.
@@ -41,8 +41,8 @@ no_select_keyword <- "-- no selection --"
 #' library(shiny)
 #' library(teal.widgets)
 #'
-#' # all_choices example - semantically the same objects
-#' choices_selected(choices = letters, selected = all_choices())
+#' # delayed_choices example - semantically the same objects
+#' choices_selected(choices = letters, selected = delayed_choices())
 #' choices_selected(choices = letters, selected = letters)
 #'
 #' choices_selected(
@@ -136,12 +136,12 @@ choices_selected <- function(choices,
   )
   checkmate::assert(
     checkmate::check_atomic(selected),
-    checkmate::check_multi_class(selected, c("delayed_data", "all_choices"))
+    checkmate::check_multi_class(selected, c("delayed_data", "delayed_choices"))
   )
   checkmate::assert_flag(keep_order)
   checkmate::assert_flag(fixed)
 
-  if (inherits(selected, "all_choices")) selected <- choices
+  if (inherits(selected, "delayed_choices")) selected <- selected(choices)
 
   if (inherits(selected, "delayed_data") && !inherits(choices, "delayed_data")) {
     stop("If 'selected' is of class 'delayed_data', so must be 'choices'.")

R/data_extract_filter_module.R

@@ -69,6 +69,10 @@ data_extract_filter_srv <- function(id, datasets, filter) {
       isolate({
         # when the filter is initialized with a delayed spec, the choices and selected are NULL
         # here delayed are resolved and the values are set up
+        # Begin by resolving delayed choices.
+        if (inherits(filter$selected, "delayed_choices"))  {
+          filter$selected <- filter$selected(filter$choices)
+        }
         teal.widgets::updateOptionalSelectInput(
           session = session,
           inputId = "col",
@@ -102,6 +106,7 @@ data_extract_filter_srv <- function(id, datasets, filter) {
             } else {
               choices[1]
             }
+
           } else {
             choices <- character(0)
             selected <- character(0)
@@ -148,8 +153,8 @@ get_initial_filter_values <- function(filter, datasets) {
       datasets[[filter$dataname]](),
       as.character(filter$vars_selected)
     )
-    initial_values$selected <- if (inherits(filter$selected, "all_choices")) {
-      initial_values$choices
+    initial_values$selected <- if (inherits(filter$selected, "delayed_choices")) {
+      filter$selected(initial_values$choices)
     } else {
       filter$selected
     }

R/data_extract_spec.R

@@ -103,7 +103,7 @@ data_extract_spec <- function(dataname, select = NULL, filter = NULL, reshape =
     )
     filter <- filter_spec(
       vars = choices_selected(variable_choices(dataname)),
-      selected = all_choices()
+      selected = delayed_choices()
     )
   }
 

R/delayed_choices.R

@@ -0,0 +1,70 @@
+#' Bare constructor for `delayed_choices` object
+#'
+#' @description
+#' `r lifecycle::badge("experimental")`
+#'
+#' An S3 structure that delays selection of possible choices in a
+#' `filter_spec`, `select_spec` or `choices_selected` object.
+#'
+#' @param which `character(1)` string specifying which choices to select
+#' @return
+#' Object of class `delayed_choices`, which is a function that returns the appropriate subset of its argument.
+#' `delayed_choices` also have additional classes, which depend on `which`, for internal use.
+#'
+#' @examples
+#' # Both structures are semantically identical
+#' filter_spec(
+#'   vars = c("selected_variable"),
+#'   choices = c("value1", "value2"),
+#'   selected = c("value1", "value2")
+#' )
+#'
+#' filter_spec(
+#'   vars = c("selected_variable"),
+#'   choices = c("value1", "value2"),
+#'   selected = delayed_choices()
+#' )
+#'
+#' choices_selected(choices = letters, selected = letters)
+#' choices_selected(choices = letters, selected = delayed_choices())
+#' @export
+#'
+delayed_choices <- function(which = c("all", "first", "last")) {
+  which <- match.arg(which)
+  ans <-
+    switch(which,
+      "all" = function(x) x,
+      "first" = function(x) {
+        if (length(x) == 0L) {
+          return(x)
+        }
+        if (is.atomic(x)) {
+          return(x[1L])
+        }
+        x$subset <- function(data) {
+          modifier <- function(x) x[1L]
+          Reduce(function(f, ...) f(...), c(x$subset, modifier), init = data, right = TRUE)
+        }
+        x
+      },
+      "last" = function(x) {
+        if (length(x) == 0L) {
+          return(x)
+        }
+        if (is.atomic(x)) {
+          return(x[length(x)])
+        }
+        x$subset <- function(data) {
+          modifier <- function(x) x[length(x)]
+          Reduce(function(f, ...) f(...), c(x$subset, modifier), init = data, right = TRUE)
+        }
+        x
+      }
+    )
+  extra_class <- switch(which,
+    "all" = "all_choices",
+    "first" = "first_choice",
+    "last" = "last_choice"
+  )
+  structure(ans, class = c(extra_class, "delayed_choices"))
+}

R/filter_spec.R

@@ -36,11 +36,11 @@
 #' The `sep` input has to be `" - "` in this case.
 #'
 #' `delayed_data` objects can be created via [variable_choices()] or [value_choices()].
-#' @param selected (`character` or `numeric` or `logical` or (`delayed_data` or `all_choices`) object.
+#' @param selected (`character` or `numeric` or `logical` or (`delayed_data` or `delayed_choices`) object.
 #' Named character vector to define the selected values of a shiny [shiny::selectInput()]
 #' (default values).
 #' This value will be displayed inside the shiny app upon start.
-#' The `all_choices` object indicates selecting all possible choices.
+#' `delayed_choices` objects resolve selection when choices become available.
 #' @param drop_keys (`logical`) optional, whether to drop filter column from the
 #' dataset keys, `TRUE` on default.
 #' @param label (`character`) optional, defines a label on top of this specific
@@ -103,7 +103,7 @@
 #' adsl_filter <- filter_spec(
 #'   vars = choices_selected(variable_choices("ADSL"), "SEX", fixed = FALSE),
 #'   choices = value_choices("ADSL", "SEX"),
-#'   selected = all_choices()
+#'   selected = delayed_choices()
 #' )
 #' @export
 #'
@@ -133,7 +133,7 @@ filter_spec <- function(vars,
     checkmate::check_numeric(selected, min.len = 1, any.missing = FALSE),
     checkmate::check_logical(selected, min.len = 1, any.missing = FALSE),
     checkmate::check_class(selected, "delayed_data"),
-    checkmate::check_class(selected, "all_choices")
+    checkmate::check_class(selected, "delayed_choices")
   )
 
   checkmate::assert_flag(multiple)
@@ -142,7 +142,7 @@ filter_spec <- function(vars,
   checkmate::assert_flag(drop_keys)
   stopifnot(multiple || !inherits(selected, "all_choices"))
 
-  if (inherits(selected, "all_choices") && !is.null(choices)) selected <- choices
+  if (inherits(selected, "delayed_choices") && !is.null(choices)) selected <- selected(choices)
 
   if (inherits(vars, "choices_selected")) {
     filter_spec_internal(
@@ -307,7 +307,7 @@ filter_spec_internal.delayed_data <- function(vars_choices,
     checkmate::check_numeric(selected, min.len = 1, any.missing = FALSE),
     checkmate::check_logical(selected, min.len = 1, any.missing = FALSE),
     checkmate::check_class(selected, "delayed_data"),
-    checkmate::check_class(selected, "all_choices")
+    checkmate::check_class(selected, "delayed_choices")
   )
 
   structure(
@@ -376,7 +376,7 @@ filter_spec_internal.default <- function(vars_choices,
     stopifnot(all(vapply(split_choices, length, integer(1)) == length(vars_selected)))
   }
 
-  if (!is.null(selected) && !inherits(selected, "all_choices")) {
+  if (!is.null(selected) && !inherits(selected, "delayed_choices")) {
     stopifnot(multiple || length(selected) == 1)
     checkmate::assert(
       checkmate::check_character(selected, min.len = 1, any.missing = FALSE),

R/select_spec.R

@@ -13,9 +13,9 @@
 #' These have to be columns in the dataset defined in the [data_extract_spec()]
 #' where this is called.
 #' `delayed_data` objects can be created via [variable_choices()] or [value_choices()].
-#' @param selected (`character` or `NULL` or `all_choices` or `delayed_data`) optional
+#' @param selected (`character` or `NULL` or `delayed_choices` or `delayed_data`) optional
 #' named character vector to define the selected values of a shiny [shiny::selectInput()].
-#' Passing an `all_choices()` object indicates selecting all possible choices.
+#' Passing a `delayed_choices()` object defers selection until data is available.
 #' Defaults to the first value of `choices` or `NULL` for delayed data loading.
 #' @param multiple (`logical`) Whether multiple values shall be allowed in the
 #' shiny [shiny::selectInput()].
@@ -71,16 +71,16 @@
 #'   fixed = FALSE
 #' )
 #'
-#' # all_choices passed to selected
+#' # delayed_choices passed to selected
 #' select_spec(
 #'   label = "Select variable:",
 #'   choices = variable_choices("ADSL", c("BMRKR1", "BMRKR2")),
-#'   selected = all_choices()
+#'   selected = delayed_choices()
 #' )
 #'
 #' # Both below objects are semantically the same
 #' select_spec(choices = variable_choices("ADSL"), selected = variable_choices("ADSL"))
-#' select_spec(choices = variable_choices("ADSL"), selected = all_choices())
+#' select_spec(choices = variable_choices("ADSL"), selected = delayed_choices())
 #' @export
 #'
 select_spec <- function(choices,
@@ -98,7 +98,7 @@ select_spec <- function(choices,
   stopifnot(multiple || !inherits(selected, "all_choices"))
   if (fixed) stopifnot(is.null(always_selected))
 
-  if (inherits(selected, "all_choices")) selected <- choices
+  if (inherits(selected, "delayed_choices")) selected <- selected(choices)
   if (inherits(choices, "delayed_data") || inherits(selected, "delayed_data")) {
     select_spec.delayed_data(choices, selected, multiple, fixed, always_selected, ordered, label)
   } else {

_pkgdown.yml

@@ -28,7 +28,7 @@ reference:
       Functions used to create transform instructions for `teal` applications.
     contents:
       - add_no_selected_choices
-      - all_choices
+      - delayed_choices
       - check_no_multiple_selection
       - choices_labeled
       - choices_selected