Tdata in tealdata@main

NAMESPACE

@@ -9,6 +9,7 @@ S3method(get_code,TealDataAbstract)
 S3method(get_code,TealDataset)
 S3method(get_code,TealDatasetConnector)
 S3method(get_code,default)
+S3method(get_code,tdata)
 S3method(get_dataname,TealDataAbstract)
 S3method(get_dataname,TealDataset)
 S3method(get_dataname,TealDatasetConnector)
@@ -20,11 +21,15 @@ S3method(get_dataset_label,TealDatasetConnector)
 S3method(get_datasets,TealDataAbstract)
 S3method(get_datasets,TealDataset)
 S3method(get_datasets,TealDatasetConnector)
+S3method(get_join_keys,default)
+S3method(get_join_keys,tdata)
 S3method(get_key_duplicates,TealDataset)
 S3method(get_key_duplicates,data.frame)
 S3method(get_keys,TealDataAbstract)
 S3method(get_keys,TealDataset)
 S3method(get_keys,TealDatasetConnector)
+S3method(get_metadata,default)
+S3method(get_metadata,tdata)
 S3method(get_raw_data,TealDataAbstract)
 S3method(get_raw_data,TealDataset)
 S3method(get_raw_data,TealDatasetConnector)
@@ -81,13 +86,16 @@ export(fun_dataset_connector)
 export(get_attrs)
 export(get_cdisc_keys)
 export(get_code)
+export(get_code_tdata)
 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)
+export(get_metadata)
 export(get_raw_data)
 export(is_pulled)
 export(join_key)
@@ -98,6 +106,7 @@ export(mae_dataset)
 export(mutate_data)
 export(mutate_dataset)
 export(mutate_join_keys)
+export(new_tdata)
 export(python_cdisc_dataset_connector)
 export(python_code)
 export(python_dataset_connector)
@@ -111,6 +120,7 @@ export(script_cdisc_dataset_connector)
 export(script_dataset_connector)
 export(set_args)
 export(set_keys)
+export(tdata2env)
 export(teal_data)
 export(teal_data_file)
 export(to_relational_data)

R/TealData.R

@@ -193,6 +193,28 @@ TealData <- R6::R6Class( # nolint
       private$join_keys$get_parents()
     },
 
+    #' @description
+    #' returns the `tdata` object.
+    #'
+    #' @return (`tdata`) object of the datasets.
+    get_tdata = function() {
+      datanames <- self$get_datanames()
+      df_list <- lapply(datanames, function(x) self$get_dataset(x)$get_raw_data())
+      names(df_list) <- datanames
+      md_list <- lapply(datanames, function(x) self$get_dataset(x)$get_metadata())
+      names(md_list) <- datanames
+      labels_list <- lapply(datanames, function(x) self$get_dataset(x)$get_dataset_label())
+      names(md_list) <- datanames
+
+      teal.data::new_tdata(
+        data = df_list,
+        join_keys = self$get_join_keys(),
+        code = self$get_code_class(),
+        metadata = md_list,
+        check = self$get_check(),
+        label = labels_list
+      )
+    },
     # ___ shiny ====
 
     #' @description

R/tdata.R

@@ -0,0 +1,188 @@
+#' Create a `tdata` Object
+#'
+#' Create a new object called `tdata` which contains `data`, a `reactive` list of data.frames
+#' (or `MultiAssayExperiment`), with attributes:
+#' \itemize{
+#'   \item{`code` (`reactive`) containing code used to generate the data}
+#'   \item{join_keys (`JoinKeys`) containing the relationships between the data}
+#'   \item{metadata (`named list`) containing any metadata associated with the data frames}
+#' }
+#' @name tdata
+#' @param data A `named list` of `data.frames` (or `MultiAssayExperiment`)
+#'  which optionally can be `reactive`.
+#'   Inside this object all of these items will be made `reactive`.
+#' @param code A `character` (or `reactive` which evaluates to a `character`) containing
+#'   the code used to generate the data. This should be `reactive` if the code is changing
+#'   during a reactive context (e.g. if filtering changes the code). Inside this
+#'   object `code` will be made reactive
+#' @param join_keys A `teal.data::JoinKeys` object containing relationships between the
+#'   datasets.
+#' @param metadata A `named list` each element contains a list of metadata about the named data.frame
+#' Each element of these list should be atomic and length one.
+#' @param check (`logical`) value whether reproducibility check is requested or not.
+#' @param label named (`list`) of datasets labels.
+#'
+#' @return A `tdata` object
+#' @examples
+#'
+#' data <- new_tdata(
+#'   data = list(iris = iris, mtcars = reactive(mtcars), ds1 = data.frame(x = 1:10)),
+#'   code = "iris <- iris
+#'     mtcars <- mtcars
+#'     dd <- data.frame(x = 1:10)",
+#'   metadata = list(ds1 = list(author = "NEST"), iris = list(version = 1)),
+#'   check = TRUE,
+#'   label = list(iris = "iris", mtcars = "mtcars", ds1 = "ds1")
+#' )
+#'
+#' # Extract a data.frame
+#' isolate(data[["iris"]]())
+#'
+#' # Get code
+#' isolate(get_code_tdata(data))
+#'
+#' # Get metadata
+#' get_metadata(data, "iris")
+#'
+#' @export
+new_tdata <- function(data, code = "", join_keys = NULL, metadata = NULL, check = FALSE, label) {
+  checkmate::assert_list(
+    data,
+    any.missing = FALSE, names = "unique",
+    types = c("data.frame", "reactive", "MultiAssayExperiment")
+  )
+  checkmate::assert_class(join_keys, "JoinKeys", null.ok = TRUE)
+  checkmate::assert_multi_class(code, c("character", "reactive", "CodeClass"))
+
+  checkmate::assert_list(metadata, names = "unique", null.ok = TRUE)
+  checkmate::assert_subset(names(metadata), names(data))
+  for (m in metadata) teal.data::validate_metadata(m)
+
+  if (is.reactive(code)) {
+    isolate(checkmate::assert_multi_class(code(), c("character", "CodeClass"), .var.name = "code"))
+  }
+
+  # create reactive data.frames
+  for (x in names(data)) {
+    if (!is.reactive(data[[x]])) {
+      data[[x]] <- do.call(reactive, list(as.name(x)), envir = list2env(data[x]))
+    } else {
+      isolate(
+        checkmate::assert_multi_class(
+          data[[x]](), c("data.frame", "MultiAssayExperiment"),
+          .var.name = "data"
+        )
+      )
+    }
+  }
+
+  # code #nolint
+  # code <- if (is.reactive(code) && is.character(code())) { #nolint
+  #   CodeClass$new(code()) #nolint
+  # } else if (is.character(code)) { #nolint
+  #   CodeClass$new(code) #nolint
+  # } #nolint
+
+  # set attributes
+  attr(data, "code") <- if (is.reactive(code)) code else reactive(code)
+  attr(data, "join_keys") <- join_keys
+  attr(data, "metadata") <- metadata
+  attr(data, "check") <- check
+  attr(data, "label") <- label
+
+  # set class
+  class(data) <- c("tdata", class(data))
+  data
+}
+
+#' Function to convert a `tdata` object to an `environment`
+#' Any `reactives` inside `tdata` are first evaluated
+#' @param data a `tdata` object
+#' @return an `environment`
+#' @examples
+#'
+#' data <- new_tdata(
+#'   data = list(iris = iris, mtcars = reactive(mtcars)),
+#'   code = "iris <- iris
+#'     mtcars = mtcars",
+#'   label = list(iris = "iris", mtcars = "mtcars")
+#' )
+#'
+#' my_env <- isolate(tdata2env(data))
+#'
+#' @export
+tdata2env <- function(data) { # nolint
+  checkmate::assert_class(data, "tdata")
+  list2env(lapply(data, function(x) if (is.reactive(x)) x() else x))
+}
+
+#' @rdname tdata
+#' @param x a `tdata` object
+#' @param ... additional arguments for the generic
+#' @export
+get_code.tdata <- function(x, ...) { # nolint
+  # note teal.data which teal depends on defines the get_code method
+  attr(x, "code")()
+}
+
+
+#' Wrapper for `get_code.tdata`
+#' This wrapper is to be used by downstream packages to extract the code of a `tdata` object
+#'
+#' @param data (`tdata`) object
+#'
+#' @return (`character`) code used in the `tdata` object.
+#' @export
+get_code_tdata <- function(data) {
+  checkmate::assert_class(data, "tdata")
+  get_code.tdata(data)
+}
+
+
+#' Function to get join keys from a `tdata` object
+#' @param data `tdata` - 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.tdata <- function(data) {
+  attr(data, "join_keys")
+}
+
+
+#' @rdname get_join_keys
+#' @export
+get_join_keys.default <- function(data) {
+  stop("get_join_keys function not implemented for this object")
+}
+
+#' Function to get metadata from a `tdata` object
+#' @param data `tdata` - object to extract the data from
+#' @param dataname `character(1)` the dataset name whose metadata is requested
+#' @return Either list of metadata or NULL if no metadata
+#' @export
+get_metadata <- function(data, dataname) {
+  checkmate::assert_string(dataname)
+  UseMethod("get_metadata", data)
+}
+
+#' @rdname get_metadata
+#' @export
+get_metadata.tdata <- function(data, dataname) {
+  metadata <- attr(data, "metadata")
+  if (is.null(metadata)) {
+    return(NULL)
+  }
+  metadata[[dataname]]
+}
+
+#' @rdname get_metadata
+#' @export
+get_metadata.default <- function(data, dataname) {
+  stop("get_metadata function not implemented for this object")
+}

_pkgdown.yml

@@ -118,3 +118,10 @@ reference:
       - TealDataConnector
       - TealDataset
       - TealDatasetConnector
+  - title: Functions for module developers
+    contents:
+      - tdata
+      - get_code_tdata
+      - get_join_keys
+      - get_metadata
+      - tdata2env