tdata to teal_data

DESCRIPTION

@@ -34,13 +34,12 @@ Imports:
     stats,
     teal.data (>= 0.3.0.9010),
     teal.logger (>= 0.1.1),
-    teal.slice (>= 0.4.0.9023),
     teal.widgets (>= 0.4.0),
     tidyr (>= 0.8.3),
     tidyselect
 Suggests:
     knitr (>= 1.42),
-    shinytest (>= 1.5.1),
+    rmarkdown (>= 2.19),
     teal.code (>= 0.4.0),
     testthat (>= 3.1.5)
 VignetteBuilder:
@@ -49,9 +48,9 @@ RdMacros:
     lifecycle
 Config/Needs/verdepcheck: tidyverse/magrittr, mllg/checkmate,
     tidyverse/dplyr, r-lib/lifecycle, daroczig/logger, r-lib/rlang,
-    rstudio/shiny, daattali/shinyjs, rstudio/shinyvalidate,
+    rstudio/rmarkdown, rstudio/shiny, daattali/shinyjs, rstudio/shinyvalidate,
     insightsengineering/teal.data, insightsengineering/teal.logger,
-    insightsengineering/teal.slice, insightsengineering/teal.widgets,
+    insightsengineering/teal.widgets,
     tidyverse/tidyr, r-lib/tidyselect, yihui/knitr, rstudio/shinytest,
     insightsengineering/teal.code, r-lib/testthat
 Config/Needs/website: insightsengineering/nesttemplate

NAMESPACE

@@ -2,10 +2,15 @@
 
 S3method(data_extract_multiple_srv,FilteredData)
 S3method(data_extract_multiple_srv,list)
+S3method(data_extract_multiple_srv,reactive)
 S3method(data_extract_srv,FilteredData)
 S3method(data_extract_srv,list)
 S3method(filter_spec_internal,default)
 S3method(filter_spec_internal,delayed_data)
+S3method(merge_expression_module,list)
+S3method(merge_expression_module,reactive)
+S3method(merge_expression_srv,list)
+S3method(merge_expression_srv,reactive)
 S3method(print,choices_labeled)
 S3method(print,delayed_choices_selected)
 S3method(print,delayed_data_extract_spec)
@@ -24,12 +29,8 @@ S3method(resolve,delayed_variable_choices)
 S3method(resolve,list)
 S3method(resolve_delayed,FilteredData)
 S3method(resolve_delayed,list)
-S3method(value_choices,TealDataset)
-S3method(value_choices,TealDatasetConnector)
 S3method(value_choices,character)
 S3method(value_choices,data.frame)
-S3method(variable_choices,TealDataset)
-S3method(variable_choices,TealDatasetConnector)
 S3method(variable_choices,character)
 S3method(variable_choices,data.frame)
 export(add_no_selected_choices)
@@ -42,8 +43,6 @@ export(data_extract_multiple_srv)
 export(data_extract_spec)
 export(data_extract_srv)
 export(data_extract_ui)
-export(data_merge_module)
-export(data_merge_srv)
 export(datanames_input)
 export(filter_spec)
 export(format_data_extract)

R/Queue.R

@@ -105,6 +105,5 @@ Queue <- R6::R6Class( # nolint
   private = list(
     array = c()
   ),
-
   lock_class = TRUE
 )

R/choices_labeled.R

@@ -117,10 +117,9 @@ choices_labeled <- function(choices, labels, subset = NULL, types = NULL) {
 #'
 #' @description `r lifecycle::badge("stable")`
 #'
-#' @param data (`data.frame`, `character`, `TealDataset`, `TealDatasetConnector`)
+#' @param data (`data.frame`, `character`)
 #' If `data.frame`, then data to extract labels from
 #' If `character`, then name of the dataset to extract data from once available
-#' If `TealDataset` or `TealDatasetConnector`, then raw data to extract labels from.
 #' @param subset (`character` or `function`)
 #' If `character`, then a vector of column names.
 #' If `function`, then this function is used to determine the possible columns (e.g. all factor columns).
@@ -144,22 +143,15 @@ choices_labeled <- function(choices, labels, subset = NULL, types = NULL) {
 #' variable_choices(ADRS)
 #' variable_choices(ADRS, subset = c("PARAM", "PARAMCD"))
 #' variable_choices(ADRS, subset = c("", "PARAM", "PARAMCD"))
-#' variable_choices(ADRS, subset = c("", "PARAM", "PARAMCD"), key = teal.data::get_cdisc_keys("ADRS"))
+#' variable_choices(
+#'   ADRS,
+#'   subset = c("", "PARAM", "PARAMCD"),
+#'   key = teal.data::default_cdisc_join_keys["ADRS", "ADRS"]
+#' )
 #'
 #' # delayed version
 #' variable_choices("ADRS", subset = c("USUBJID", "STUDYID"))
 #'
-#' # also works with [teal.data::TealDataset] and [teal.data::TealDatasetConnector]
-#' ADRS_dataset <- teal.data::dataset("ADRS", ADRS, key = teal.data::get_cdisc_keys("ADRS"))
-#' variable_choices(ADRS_dataset)
-#'
-#' ADRS_conn <- teal.data::dataset_connector(
-#'   "ADRS",
-#'   pull_callable = teal.data::callable_code("radrs(cached = TRUE)"),
-#'   key = teal.data::get_cdisc_keys("ADRS")
-#' )
-#' variable_choices(ADRS_conn)
-#'
 #' # functional subset (with delayed data) - return only factor variables
 #' variable_choices("ADRS", subset = function(data) {
 #'   idx <- vapply(data, is.factor, logical(1))
@@ -205,7 +197,8 @@ variable_choices.data.frame <- function(data, subset = NULL, fill = TRUE, key =
 
   key <- intersect(subset, key)
 
-  var_types <- stats::setNames(teal.slice:::variable_types(data = data), names(data))
+  var_types <- vapply(data, function(x) class(x)[[1]], character(1))
+
   if (length(key) != 0) {
     var_types[key] <- "primary_key"
   }
@@ -237,49 +230,13 @@ variable_choices.data.frame <- function(data, subset = NULL, fill = TRUE, key =
   return(res)
 }
 
-#' @rdname variable_choices
-#' @export
-variable_choices.TealDataset <- function(data, subset = NULL, fill = FALSE, key = teal.data::get_keys(data)) {
-  variable_choices(
-    data = teal.data::get_raw_data(data),
-    subset = subset,
-    fill = fill,
-    key = key
-  )
-}
-
-#' @rdname variable_choices
-#' @export
-variable_choices.TealDatasetConnector <- function(data, # nolint
-                                                  subset = NULL,
-                                                  fill = FALSE,
-                                                  key = teal.data::get_keys(data)) {
-  if (teal.data::is_pulled(data)) {
-    variable_choices(
-      data = teal.data::get_raw_data(data),
-      subset = subset,
-      fill = fill,
-      key = key
-    )
-  } else {
-    variable_choices(
-      data = teal.data::get_dataname(data),
-      subset = subset,
-      fill = fill,
-      key = key
-    )
-  }
-}
-
-
 #' Wrapper on [choices_labeled] to label variable values basing on other variable values
 #'
 #' @description `r lifecycle::badge("stable")`
 #'
-#' @param data (`data.frame`, `character`, `TealDataset`, `TealDatasetConnector`)
-#' If `data.frame`, then data to extract labels from
-#' If `character`, then name of the dataset to extract data from once available
-#' If `TealDataset` or `TealDatasetConnector`, then raw data to extract labels from.
+#' @param data (`data.frame`, `character`)
+#' If `data.frame`, then data to extract labels from.
+#' If `character`, then name of the dataset to extract data from once available.
 #' @param var_choices (`character` or `NULL`) vector with choices column names
 #' @param var_label (`character`) vector with labels column names
 #' @param subset (`character` or `function`)
@@ -407,47 +364,6 @@ value_choices.data.frame <- function(data, # nolint
   return(res)
 }
 
-#' @rdname value_choices
-#' @export
-value_choices.TealDataset <- function(data,
-                                      var_choices,
-                                      var_label = NULL,
-                                      subset = NULL,
-                                      sep = " - ") {
-  value_choices(
-    data = teal.data::get_raw_data(data),
-    var_choices = var_choices,
-    var_label = var_label,
-    subset = subset,
-    sep = sep
-  )
-}
-
-#' @rdname value_choices
-#' @export
-value_choices.TealDatasetConnector <- function(data, # nolint
-                                               var_choices,
-                                               var_label = NULL,
-                                               subset = NULL,
-                                               sep = " - ") {
-  if (teal.data::is_pulled(data)) {
-    value_choices(
-      data = teal.data::get_raw_data(data),
-      var_choices = var_choices,
-      var_label = var_label,
-      subset = subset,
-      sep = sep
-    )
-  } else {
-    value_choices(
-      data = teal.data::get_dataname(data),
-      var_choices = var_choices,
-      var_label = var_label,
-      subset = subset,
-      sep = sep
-    )
-  }
-}
 #' Print choices_labeled object
 #' @description `r lifecycle::badge("stable")`
 #' @rdname choices_labeled

R/choices_selected.R

@@ -148,16 +148,7 @@ choices_selected <- function(choices,
   # remove duplicates
   choices <- vector_remove_dups(choices)
   selected <- vector_remove_dups(selected)
-
-  if (!all(selected %in% choices)) {
-    stop(paste(
-      paste(
-        selected[which(!selected %in% choices)],
-        collapse = ", "
-      ),
-      "'selected' but not in 'choices'"
-    ))
-  }
+  checkmate::assert_subset(selected, choices)
 
   if (!keep_order && length(choices) > 0) {
     choices_in_selected <- which(choices %in% selected)

R/data_extract_filter_module.R

@@ -18,18 +18,18 @@ data_extract_filter_ui <- function(filter, id = "filter") {
 
   html_col <- teal.widgets::optionalSelectInput(
     inputId = ns("col"),
-    label = filter$vars_label,
-    choices = filter$vars_choices,
-    selected = filter$vars_selected,
+    label = `if`(inherits(filter, "delayed_filter_spec"), NULL, filter$vars_label),
+    choices = `if`(inherits(filter, "delayed_filter_spec"), NULL, filter$vars_choices),
+    selected = `if`(inherits(filter, "delayed_filter_spec"), NULL, filter$vars_selected),
     multiple = filter$vars_multiple,
     fixed = filter$vars_fixed
   )
 
   html_vals <- teal.widgets::optionalSelectInput(
     inputId = ns("vals"),
     label = filter$label,
-    choices = filter$choices,
-    selected = filter$selected,
+    choices = `if`(inherits(filter, "delayed_filter_spec"), NULL, filter$choices),
+    selected = `if`(inherits(filter, "delayed_filter_spec"), NULL, filter$selected),
     multiple = filter$multiple,
     fixed = filter$fixed
   )
@@ -60,19 +60,31 @@ data_extract_filter_srv <- function(id, datasets, filter) {
       # We force the evaluation of filter, otherwise the observers are set up with the last element
       # of the list in data_extract_single_srv and not all of them (due to R lazy evaluation)
       force(filter)
-      logger::log_trace(
-        "data_extract_filter_srv initialized with: { filter$dataname } dataset."
-      )
+      logger::log_trace("data_extract_filter_srv initialized with: { filter$dataname } dataset.")
+
+      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
+        teal.widgets::updateOptionalSelectInput(
+          session = session,
+          inputId = "col",
+          choices = filter$vars_choices,
+          selected = filter$vars_selected
+        )
+        teal.widgets::updateOptionalSelectInput(
+          session = session,
+          inputId = "vals",
+          choices = filter$choices,
+          selected = filter$selected
+        )
+      })
 
-      observeEvent(input$col,
+      observeEvent(
+        input$col,
+        ignoreInit = TRUE, # When observeEvent is initialized input$col is still NULL as it is set few lines above
+        ignoreNULL = FALSE, # columns could be NULL, then vals should be set to NULL also
         handlerExpr = {
-          if (!filter$initialized) {
-            initial_inputs <- get_initial_filter_values(filter, datasets)
-            choices <- initial_inputs$choices
-            selected <- initial_inputs$selected
-            filter$initialized <- TRUE
-            filter <<- filter
-          } else if (!rlang::is_empty(input$col)) {
+          if (!rlang::is_empty(input$col)) {
             choices <- value_choices(
               datasets[[filter$dataname]](),
               input$col,
@@ -108,9 +120,7 @@ data_extract_filter_srv <- function(id, datasets, filter) {
             choices = choices,
             selected = selected
           )
-        },
-        ignoreInit = FALSE,
-        ignoreNULL = FALSE
+        }
       )
     }
   )

R/data_extract_module.R

@@ -250,7 +250,7 @@ check_data_extract_spec_react <- function(datasets, data_extract) {
 #'
 #' @inheritParams shiny::moduleServer
 #' @param datasets (`FilteredData` or `list` of `reactive` or non-`reactive` `data.frame`)\cr
-#'  object containing data either in the form of [teal.slice::FilteredData] or as a list of `data.frame`.
+#'  object containing data either in the form of `FilteredData` or as a list of `data.frame`.
 #'  When passing a list of non-reactive `data.frame` objects, they are converted to reactive `data.frame`s internally.
 #'  When passing a list of reactive or non-reactive `data.frame` objects, the argument `join_keys` is required also.
 #' @param data_extract_spec (`data_extract_spec` or a list of `data_extract_spec`)\cr
@@ -349,13 +349,6 @@ check_data_extract_spec_react <- function(datasets, data_extract) {
 #'   shinyApp(app$ui, app$server)
 #' }
 #'
-#' # Using FilteredData - Note this method will be deprecated
-#' datasets <- teal.slice::init_filtered_data(
-#'   list(ADSL = list(dataset = ADSL)),
-#'   join_keys = teal.data::join_keys(
-#'     teal.data::join_key("ADSL", "ADSL", c("USUBJID", "STUDYID"))
-#'   )
-#' )
 #'
 #' app <- shinyApp(
 #'   ui = fluidPage(
@@ -551,7 +544,6 @@ data_extract_srv.list <- function(id, datasets, data_extract_spec, join_keys = N
 #' @description `r lifecycle::badge("experimental")`
 #' `data_extract_multiple_srv` loops over the list of `data_extract` given and
 #' runs `data_extract_srv` for each one returning a list of reactive objects.
-#' This was suitable as input for (deprecated) [data_merge_srv()].
 #'
 #' @inheritParams data_extract_srv
 #' @param data_extract (named `list` of `data_extract_spec` objects) the list `data_extract_spec` objects.
@@ -655,15 +647,23 @@ data_extract_srv.list <- function(id, datasets, data_extract_spec, join_keys = N
 #' }
 data_extract_multiple_srv <- function(data_extract, datasets, ...) {
   checkmate::assert_list(data_extract, names = "named")
+  checkmate::assert_multi_class(datasets, c("reactive", "FilteredData", "list"))
   lapply(data_extract, function(x) {
     if (is.list(x) && !inherits(x, "data_extract_spec")) {
       checkmate::assert_list(x, "data_extract_spec")
     }
   })
-  checkmate::assert_multi_class(datasets, classes = c("FilteredData", "list"))
   UseMethod("data_extract_multiple_srv", datasets)
 }
 
+#' @rdname data_extract_multiple_srv
+#' @export
+data_extract_multiple_srv.reactive <- function(data_extract, datasets, ...) {
+  # convert teal_data to list of reactives
+  datasets_new <- convert_teal_data(datasets)
+  data_extract_multiple_srv.list(data_extract, datasets_new, ...)
+}
+
 #' @rdname data_extract_multiple_srv
 #' @export
 data_extract_multiple_srv.FilteredData <- function(data_extract, datasets, ...) {

R/data_extract_select_module.R

@@ -20,8 +20,8 @@ data_extract_select_ui <- function(select, id = "select") {
     teal.widgets::optionalSelectInput(
       inputId = id,
       label = select$label,
-      choices = select$choices,
-      selected = select$selected,
+      choices = `if`(inherits(select, "delayed_select_spec"), NULL, select$choices),
+      selected = `if`(inherits(select, "delayed_select_spec"), NULL, select$selected),
       multiple = select$multiple,
       fixed = select$fixed
     )