introduce teal_data class

DESCRIPTION

@@ -33,6 +33,7 @@ Imports:
     shinyjs,
     stats,
     teal.logger (>= 0.1.1),
+    teal.code (>= 0.4.1.9003),
     utils,
     yaml (>= 1.1.0)
 Suggests:
@@ -57,7 +58,7 @@ Config/Needs/verdepcheck: rstudio/shiny, mllg/checkmate,
     yaml=vubiostat/r-yaml, rstudio/bslib, tidyverse/dplyr, yihui/knitr,
     tidyverse/magrittr, bioc::MultiAssayExperiment, tidyverse/readr,
     rstudio/reticulate, rstudio/rmarkdown, bioc::SummarizedExperiment,
-    r-lib/testthat, r-lib/withr
+    r-lib/testthat, r-lib/withr, insightsengineering/teal.code
 Config/Needs/website: insightsengineering/nesttemplate
 Encoding: UTF-8
 Language: en-US

NAMESPACE

@@ -12,6 +12,7 @@ S3method(get_code,default)
 S3method(get_dataname,TealDataAbstract)
 S3method(get_dataname,TealDataset)
 S3method(get_dataname,TealDatasetConnector)
+S3method(get_dataname,teal_data)
 S3method(get_dataset,TealDataAbstract)
 S3method(get_dataset,TealDataset)
 S3method(get_dataset,TealDatasetConnector)
@@ -20,6 +21,9 @@ S3method(get_dataset_label,TealDatasetConnector)
 S3method(get_datasets,TealDataAbstract)
 S3method(get_datasets,TealDataset)
 S3method(get_datasets,TealDatasetConnector)
+S3method(get_datasets,teal_data)
+S3method(get_join_keys,TealData)
+S3method(get_join_keys,teal_data)
 S3method(get_key_duplicates,TealDataset)
 S3method(get_key_duplicates,data.frame)
 S3method(get_keys,TealDataAbstract)
@@ -50,7 +54,6 @@ S3method(set_keys,TealDataAbstract)
 S3method(set_keys,TealDataset)
 S3method(set_keys,TealDatasetConnector)
 S3method(to_relational_data,MultiAssayExperiment)
-S3method(to_relational_data,TealData)
 S3method(to_relational_data,TealDataset)
 S3method(to_relational_data,TealDatasetConnector)
 S3method(to_relational_data,data.frame)
@@ -89,6 +92,7 @@ export(get_dataname)
 export(get_dataset)
 export(get_dataset_label)
 export(get_datasets)
+export(get_join_keys)
 export(get_key_duplicates)
 export(get_keys)
 export(get_labels)
@@ -118,7 +122,8 @@ export(teal_data_file)
 export(to_relational_data)
 export(validate_metadata)
 import(shiny)
+import(teal.code)
 importFrom(digest,digest)
 importFrom(logger,log_trace)
-importFrom(shinyjs,show)
+importFrom(shinyjs,useShinyjs)
 importFrom(stats,setNames)

NEWS.md

@@ -1,5 +1,10 @@
 # teal.data 0.3.0.9007
 
+### Breaking changes
+
+* Introduced new data class (`teal_data`) which replaces deprecated `TealData`. New data class becomes a standard input for whole `teal` framework.
+* Deprecated `teal_data` constructor when `TealDataset`, `TealDatasetConnector` or `TealDataConnector` objects are provided. New delayed data loading functions introduced in `teal` package.
+
 ### Miscellaneous
 * Specified minimal version of package dependencies.
 

R/cdisc_data.R

@@ -1,29 +1,16 @@
 #' Data input for teal app
 #'
 #' @description `r lifecycle::badge("stable")`
-#' Function takes datasets and creates `TealData` object which can be used in `teal` applications.
+#' Function is a wrapper around [teal_data()] and guesses `join_keys`
+#' for given datasets which names match ADAM datasets names.
 #'
-#' @note This function does not automatically assign keys to `TealDataset`
-#' and `TealDatasetConnector` objects passed to it. If the keys are needed
-#' they should be assigned before calling `cdisc_data`. See example:
-#' ```
-#' test_dataset <- dataset("ADAE", teal.data::example_cdisc_data("ADAE")) # does not have keys
-#' test_adsl <- cdisc_dataset("ADSL", teal.data::example_cdisc_data("ADSL"))
-#' test_data <- cdisc_data(test_dataset, test_adsl)
-#' get_keys(test_data, "ADAE") # returns character(0)
-#'
-#' test_dataset <- cdisc_dataset("ADAE", teal.data::example_cdisc_data("ADAE"))
-#' test_data <- cdisc_data(test_dataset, test_adsl)
-#' get_keys(test_data, "ADAE") # returns [1] "STUDYID" "USUBJID" "ASTDTM"  "AETERM"  "AESEQ"
-#' ```
 #' @inheritParams teal_data
-#' @param ... (`TealDataConnector`, `TealDataset` or
-#'   `TealDatasetConnector`) elements to include.
 #' @param join_keys (`JoinKeys`) or a single (`JoinKeySet`)\cr
 #'   (optional) object with datasets column names used for joining.
-#'   If empty then it would be automatically derived basing on intersection of datasets primary keys
+#'   If empty then it would be automatically derived basing on intersection of datasets primary keys.
+#'   For ADAM datasets it would be automatically derived.
 #'
-#' @return a `TealData` object
+#' @return a `TealData` or `teal_data` object
 #'
 #' @details This function checks if there were keys added to all data sets
 #'
@@ -34,92 +21,85 @@
 #' ADSL <- teal.data::example_cdisc_data("ADSL")
 #' ADTTE <- teal.data::example_cdisc_data("ADTTE")
 #'
-#' # basic example
 #' cdisc_data(
-#'   cdisc_dataset("ADSL", ADSL),
-#'   cdisc_dataset("ADTTE", ADTTE),
-#'   code = "ADSL <- teal.data::example_cdisc_data(\"ADSL\")
-#'           ADTTE <- teal.data::example_cdisc_data(\"ADTTE\")",
-#'   check = TRUE
-#' )
-#'
-#' # Example with keys
-#' cdisc_data(
-#'   cdisc_dataset("ADSL", ADSL,
-#'     keys = c("STUDYID", "USUBJID")
-#'   ),
-#'   cdisc_dataset("ADTTE", ADTTE,
-#'     keys = c("STUDYID", "USUBJID", "PARAMCD"),
-#'     parent = "ADSL"
-#'   ),
+#'   ADSL = ADSL,
+#'   ADTTE = ADTTE,
+#'   code = quote({
+#'     ADSL <- teal.data::example_cdisc_data("ADSL")
+#'     ADTTE <- teal.data::example_cdisc_data("ADTTE")
+#'   }),
 #'   join_keys = join_keys(
-#'     join_key(
-#'       "ADSL",
-#'       "ADTTE",
-#'       c("STUDYID" = "STUDYID", "USUBJID" = "USUBJID")
-#'     )
-#'   ),
-#'   code = "ADSL <- teal.data::example_cdisc_data(\"ADSL\")
-#'           ADTTE <- teal.data::example_cdisc_data(\"ADTTE\")",
-#'   check = TRUE
+#'     join_key("ADSL", "ADTTE", c("STUDYID" = "STUDYID", "USUBJID" = "USUBJID"))
+#'   )
 #' )
 cdisc_data <- function(...,
                        join_keys = teal.data::join_keys(),
                        code = "",
                        check = FALSE) {
   data_objects <- list(...)
-  checkmate::assert_list(
-    data_objects,
-    types = c("TealDataset", "TealDatasetConnector", "TealDataConnector")
-  )
+
+  # todo: is it really important? - to remove
   if (inherits(join_keys, "JoinKeySet")) {
     join_keys <- teal.data::join_keys(join_keys)
   }
 
-  update_join_keys_to_primary(data_objects, join_keys)
-
-  retrieve_parents <- function(x) {
-    tryCatch(
-      x$get_parent(),
-      error = function(cond) rep(character(0), length(x$get_datanames()))
+  if (
+    checkmate::test_list(data_objects, types = c("TealDataConnector", "TealDataset", "TealDatasetConnector"))
+  ) {
+    lifecycle::deprecate_warn(
+      when = "0.3.1",
+      "cdisc_data(
+        data_objects = 'should use data directly. Using TealDatasetConnector and TealDataset is deprecated.'
+      )"
     )
-  }
+    update_join_keys_to_primary(data_objects, join_keys)
 
-  new_parents_fun <- function(data_objects) {
-    lapply(data_objects, function(x) {
+    new_parents_fun <- function(data_objects) {
+      lapply(data_objects, function(x) {
+        if (inherits(x, "TealDataConnector")) {
+          unlist(new_parents_fun(x$get_items()), recursive = FALSE)
+        } else {
+          list(
+            tryCatch(
+              x$get_parent(),
+              error = function(cond) rep(character(0), length(x$get_datanames()))
+            )
+          )
+        }
+      })
+    }
+
+    new_parents <- unlist(new_parents_fun(data_objects), recursive = FALSE)
+
+    names(new_parents) <- unlist(lapply(data_objects, function(x) {
       if (inherits(x, "TealDataConnector")) {
-        unlist(new_parents_fun(x$get_items()), recursive = FALSE)
+        lapply(x$get_items(), function(z) z$get_dataname())
       } else {
-        list(retrieve_parents(x))
+        x$get_datanames()
       }
-    })
-  }
-
-  new_parents <- unlist(new_parents_fun(data_objects), recursive = FALSE)
+    }))
 
-  names(new_parents) <- unlist(lapply(data_objects, function(x) {
-    if (inherits(x, "TealDataConnector")) {
-      lapply(x$get_items(), function(z) z$get_dataname())
-    } else {
-      x$get_datanames()
+    if (is_dag(new_parents)) {
+      stop("Cycle detected in a parent and child dataset graph.")
     }
-  }))
+    join_keys$set_parents(new_parents)
+    join_keys$update_keys_given_parents()
 
-  if (is_dag(new_parents)) {
-    stop("Cycle detected in a parent and child dataset graph.")
-  }
-  join_keys$set_parents(new_parents)
-  join_keys$update_keys_given_parents()
+    x <- TealData$new(..., check = check, join_keys = join_keys)
 
-  x <- TealData$new(..., check = check, join_keys = join_keys)
+    if (length(code) > 0 && !identical(code, "")) {
+      x$set_pull_code(code = code)
+    }
 
-  if (length(code) > 0 && !identical(code, "")) {
-    x$set_pull_code(code = code)
+    x$check_reproducibility()
+    x$check_metadata()
+    x
+  } else {
+    if (!checkmate::test_names(names(data_objects), type = "named")) {
+      stop("Dot (`...`) arguments on `teal_data()` must be named.")
+    }
+    new_teal_data(data = data_objects, code = code, keys = join_keys)
   }
-
-  x$check_reproducibility()
-  x$check_metadata()
-  return(x)
 }
 
 #' Load `TealData` object from a file

R/get_dataname.R

@@ -32,3 +32,9 @@ get_dataname.TealDatasetConnector <- function(x) { # nolint
 get_dataname.TealDataset <- function(x) { # nolint
   return(x$get_dataname())
 }
+
+#' @rdname get_dataname
+#' @export
+get_dataname.teal_data <- function(x) { # nolint
+  return(x@datanames)
+}

R/get_datasets.R

@@ -133,3 +133,9 @@ get_datasets.TealDatasetConnector <- function(x) { # nolint
 get_datasets.TealDataset <- function(x) {
   x
 }
+
+#' @rdname get_datasets
+#' @export
+get_datasets.teal_data <- function(x) {
+  as.list(x@env)[teal.data::get_dataname(x)]
+}

R/get_join_keys.R

@@ -0,0 +1,20 @@
+#' Function to get join keys from a `` object
+#' @param data `` - object to extract the join keys
+#' @return Either `JoinKeys` object or `NULL` if no join keys
+#' @export
+get_join_keys <- function(data) {
+  UseMethod("get_join_keys", data)
+}
+
+
+#' @rdname get_join_keys
+#' @export
+get_join_keys.teal_data <- function(data) {
+  data@join_keys
+}
+
+#' @rdname get_join_keys
+#' @export
+get_join_keys.TealData <- function(data) {
+  data$get_join_keys()
+}

R/teal.data.R

@@ -13,6 +13,6 @@
 #' @import shiny
 #' @importFrom digest digest
 #' @importFrom stats setNames
-#' @importFrom shinyjs show
+#' @importFrom shinyjs useShinyjs
 #' @importFrom logger log_trace
 NULL

R/teal_data-class.R

@@ -0,0 +1,74 @@
+setOldClass("JoinKeys")
+
+#' Reproducible data class.
+#'
+#' Reproducible data class basing on [`teal.code::qenv-class`].
+#' Don't interact with slots directly, it is suggested to use methods instead
+#' (see `methods(class = "teal_data")`).
+#'
+#' @name teal_data-class
+#' @rdname teal_data-class
+#'
+#' @slot code (`character`) representing code necessary to reproduce the environment.
+#'  To extract the `code` please use [get_code()].
+#' @slot env (`environment`) environment which content was generated by the evaluation
+#'  of the `code` slot. To extract variables from the environment please use [get_var()] or [`[[`].
+#' @slot id (`integer`) random identifier of the code element to make sure uniqueness
+#'  when joining.
+#' @slot warnings (`character`) the warnings output when evaluating the code.
+#' To extract the `warnings` use [get_warnings()].
+#' @slot messages (`character`) the messages output when evaluating the code
+#' @slot join_keys (`JoinKeys`) object.
+#'  To extract the `join_keys` use [get_join_keys()].
+#' @slot datanames (`character`) names of datasets in `env`. Needed when non-dataset
+#'  objects are needed in the `env` slot.
+#'  To extract the `datanames` use [get_dataname()].
+#'
+#' @import teal.code
+#' @keywords internal
+setClass(
+  Class = "teal_data",
+  contains = "qenv",
+  slots = c(join_keys = "JoinKeys", datanames = "character"),
+  prototype = list(
+    join_keys = join_keys(),
+    datanames = character(0)
+  )
+)
+
+#' Initialize `teal_data` object
+#'
+#' Initialize `teal_data` object.
+#' @name new_teal_data
+#'
+#' @param data (`named list`) List of data.
+#' @param code (`character` or `language`) code to reproduce the `data`.
+#'   Accepts and stores comments also.
+#' @param keys (`JoinKeys`) object
+#' @param datanames (`character`) names of datasets passed to `data`.
+#'   Needed when non-dataset objects are needed in the `env` slot.
+#' @rdname new_teal_data
+#' @keywords internal
+new_teal_data <- function(data, code = character(0), keys = join_keys(), datanames = names(data)) {
+  checkmate::assert_list(data)
+  checkmate::assert_class(keys, "JoinKeys")
+  checkmate::assert_character(datanames)
+  if (!any(is.language(code), is.character(code))) {
+    stop("`code` must be a character or language object.")
+  }
+  code <- teal.code:::format_expression(code)
+
+  new_env <- rlang::env_clone(list2env(data), parent = parent.env(.GlobalEnv))
+  lockEnvironment(new_env, bindings = TRUE)
+
+  methods::new(
+    "teal_data",
+    env = new_env,
+    code = code,
+    warnings = "",
+    messages = "",
+    id = sample.int(.Machine$integer.max, size = 1L),
+    join_keys = keys,
+    datanames = datanames
+  )
+}