diff --git a/DESCRIPTION b/DESCRIPTION index 55364d154d..b865d7b5e0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -92,6 +92,7 @@ Collate: 'modules_debugging.R' 'reporter_previewer_module.R' 'show_rcode_modal.R' + 'tdata.R' 'teal.R' 'utils.R' 'validations.R' diff --git a/NAMESPACE b/NAMESPACE index cd11e02fa6..891d858b71 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,10 @@ # Generated by roxygen2: do not edit by hand +S3method(get_code,tdata) +S3method(get_join_keys,default) +S3method(get_join_keys,tdata) +S3method(get_metadata,default) +S3method(get_metadata,tdata) S3method(is_arg_used,"function") S3method(is_arg_used,default) S3method(is_arg_used,teal_module) @@ -20,6 +25,9 @@ export(.log) export(bookmarkableShinyApp) export(default_filter) export(example_module) +export(get_code_tdata) +export(get_join_keys) +export(get_metadata) export(get_rcode) export(get_rcode_srv) export(get_rcode_ui) @@ -27,10 +35,12 @@ export(init) export(log_app_usage) export(module) export(modules) +export(new_tdata) export(reporter_previewer_module) export(root_modules) export(show_rcode_modal) export(srv_teal_with_splash) +export(tdata2env) export(ui_teal_with_splash) export(validate_has_data) export(validate_has_elements) diff --git a/NEWS.md b/NEWS.md index f4860b0d82..600312c2ae 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,16 @@ # teal 0.12.0.9002 +### Major breaking changes + +* The use of `datasets` argument in `teal` `modules` has been deprecated and will be removed in a future release. Please use `data` argument instead. `data` is of type `tdata`; see "Creating custom modules" vignettes and function documentation of `teal::new_tdata` for further details. + +### Breaking changes + +* Due to deprecation of `chunks` in `teal.code`, the `teal` framework now uses their replacement (`qenv`) instead. The documentation in `teal` has been updated to reflect this and custom modules written with `chunks` should be updated to use `qenv`. + + +### Miscellaneous + * Updated examples to use `scda.2022`. * Added R session information into a link in the footer of `teal` applications. @@ -15,7 +26,7 @@ * Updated `teal_module` to have `data` argument which receives a list of reactive filter data with `"code"` and `"join_keys"` attributes. * Updated `teal_module` to have `filter_panel_api` argument which receives a `FilterPanelAPI` object. * Updated the internals of `module_teal` to reflect changes in `teal.slice`. -* Updated vignettes and README content. + ### Breaking changes diff --git a/R/example_module.R b/R/example_module.R index f742540020..b3cb8b7bcc 100644 --- a/R/example_module.R +++ b/R/example_module.R @@ -11,24 +11,25 @@ #' ), #' modules = modules(example_module()) #' ) -#' \dontrun{ -#' shinyApp(app$ui, app$server) +#' if (interactive()) { +#' shinyApp(app$ui, app$server) #' } #' @export example_module <- function(label = "example teal module") { checkmate::assert_string(label) module( label, - server = function(id, datasets) { + server = function(id, data) { + checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { - output$text <- renderPrint(datasets$get_data(input$dataname, filtered = TRUE)) + output$text <- renderPrint(data[[input$dataname]]()) }) }, - ui = function(id, datasets) { + ui = function(id, data) { ns <- NS(id) teal.widgets::standard_layout( output = verbatimTextOutput(ns("text")), - encoding = selectInput(ns("dataname"), "Choose a dataset", choices = datasets$datanames()) + encoding = selectInput(ns("dataname"), "Choose a dataset", choices = names(data)) ) }, filters = "all" diff --git a/R/get_rcode.R b/R/get_rcode.R index 20a25cd035..3ee88b8ece 100644 --- a/R/get_rcode.R +++ b/R/get_rcode.R @@ -1,6 +1,6 @@ #' Returns R Code from a teal module #' -#' @description `r lifecycle::badge("stable")` +#' @description `r lifecycle::badge("deprecated")` #' Return the R-code used to create a teal::teal] module analysis. This function #' will return all analysis code as a character string. In case of a good setup it will #' not only return the code used create the module analysis, but also the code used by @@ -62,6 +62,14 @@ get_rcode <- function(datasets = NULL, title = NULL, description = NULL) { checkmate::assert_class(datasets, "FilteredData", null.ok = TRUE) + + lifecycle::deprecate_warn( + when = "0.12.1", + what = "get_rcode()", + details = "Reproducibility in teal apps has changed. + See the teal.code package and example modules for further details" + ) + if (!inherits(chunks, "chunks")) { stop("No code chunks given") } @@ -70,7 +78,7 @@ get_rcode <- function(datasets = NULL, rlang::push_options(width = 120) if (!is.null(session)) { - lifecycle::deprecate_warn("0.11.2", "get_rcode(session)") + lifecycle::deprecate_warn("0.12.1", "get_rcode(session)") } if (!is.null(datasets)) { @@ -191,7 +199,7 @@ get_datasets_code <- function(datanames, datasets) { ## Module ---- #' Server part of get R code module #' -#' @description `r lifecycle::badge("stable")` +#' @description `r lifecycle::badge("deprecated")` #' #' @inheritParams get_rcode #' @inheritParams shiny::moduleServer @@ -210,6 +218,15 @@ get_rcode_srv <- function(id, code_header = "Automatically generated R code", disable_buttons = reactiveVal(FALSE)) { checkmate::check_class(disable_buttons, c("reactive", "function")) + + lifecycle::deprecate_warn( + when = "0.12.1", + what = "get_rcode_srv()", + with = "teal.widgets::verbatim_popup_srv()", + details = "Show R Code behaviour has changed, + see example modules in vignettes for more details" + ) + moduleServer(id, function(input, output, server) { chunks <- teal.code::get_chunks_object(parent_idx = 1L) observeEvent(input$show_rcode, { @@ -247,13 +264,21 @@ get_rcode_srv <- function(id, #' Ui part of get R code module #' -#' @description `r lifecycle::badge("stable")` +#' @description `r lifecycle::badge("deprecated")` #' @param id (`character`) id of shiny module #' #' @return (`shiny.tag`) #' #' @export get_rcode_ui <- function(id) { + lifecycle::deprecate_warn( + when = "0.12.1", + what = "get_rcode_ui()", + with = "teal.widgets::verbatim_popup_ui()", + details = "Show R Code behaviour has changed, + see example modules in vignettes for more details" + ) + ns <- NS(id) tagList( tags$div(actionButton(ns("show_rcode"), "Show R code", width = "100%")), diff --git a/R/init.R b/R/init.R index 283218f23b..1fafea07bd 100644 --- a/R/init.R +++ b/R/init.R @@ -16,8 +16,9 @@ #' #' @param data (`TealData` or `TealDataset` or `TealDatasetConnector` or `list` or `data.frame` #' or `MultiAssayExperiment`)\cr -#' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()], [teal.data::cdisc_dataset()], [teal.data::dataset()], -#' [teal.data::dataset_connector()] or [teal.data::cdisc_dataset_connector()] or a single `data.frame` or a `MultiAssayExperiment` +#' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()], +#' [teal.data::cdisc_dataset()], [teal.data::dataset()], [teal.data::dataset_connector()] or +#' [teal.data::cdisc_dataset_connector()] or a single `data.frame` or a `MultiAssayExperiment` #' or a list of the previous objects or function returning a named list. #' NOTE: teal does not guarantee reproducibility of the code when names of the list elements #' do not match the original object names. To ensure reproducibility please use [teal.data::teal_data()] @@ -120,16 +121,16 @@ #' modules = modules( #' module( #' "data source", -#' server = function(input, output, session, datasets) {}, +#' server = function(input, output, session, data) {}, #' ui = function(id, ...) div(p("information about data source")), #' filters = "all" #' ), #' example_module(), #' module( #' "ADSL AGE histogram", -#' server = function(input, output, session, datasets) { +#' server = function(input, output, session, data) { #' output$hist <- renderPlot( -#' hist(datasets$get_data("ADSL", filtered = TRUE)$AGE) +#' hist(data[["ADSL"]]()$AGE) #' ) #' }, #' ui = function(id, ...) { @@ -144,12 +145,10 @@ #' header = tags$h1("Sample App"), #' footer = tags$p("Copyright 2017 - 2020") #' ) -#' \dontrun{ -#' shinyApp(app$ui, app$server) +#' if (interactive()) { +#' shinyApp(app$ui, app$server) #' } #' -#' # See the vignette for an example how to embed this app as a module -#' # into a larger application init <- function(data, modules, title = NULL, diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 2e00d7364b..e2f524a206 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -96,24 +96,9 @@ ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L) { args <- c(args, datasets = datasets) } - if (is_arg_used(modules$ui, "data")) { - datanames <- if (identical("all", modules$filter)) datasets$datanames() else modules$filter - - # list of reactive filtered data - data <- sapply( - datanames, - simplify = FALSE, - function(x) { - reactive(datasets$get_data(x, filtered = TRUE)) - } - ) - - # code from previous stages - attr(data, "code") <- get_datasets_code(datanames, datasets) - - # join_keys - attr(data, "join_keys") <- datasets$get_join_keys() + if (is_arg_used(modules$ui, "data")) { + data <- .datasets_to_data(modules, datasets) args <- c(args, data = list(data)) } @@ -217,23 +202,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, reporter) { } if (is_arg_used(modules$server, "data")) { - datanames <- if (identical("all", modules$filter)) datasets$datanames() else modules$filter - - # list of reactive filtered data - data <- sapply( - datanames, - simplify = FALSE, - function(x) { - reactive(datasets$get_data(x, filtered = TRUE)) - } - ) - - # code from previous stages - attr(data, "code") <- get_datasets_code(datanames, datasets) - - # join_keys - attr(data, "join_keys") <- datasets$get_join_keys() - + data <- .datasets_to_data(modules, datasets) args <- c(args, data = list(data)) } @@ -258,3 +227,41 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, reporter) { } reactive(modules) } + +#' Convert `FilteredData` to reactive list of datasets of the `tdata` type. +#' +#' Converts `FilteredData` object to `tdata` object containing datasets needed for a specific module. +#' Please note that if module needs dataset which has a parent, then parent will be also returned. +#' +#' @param module (`teal_module`) module where needed filters are taken from +#' @param datasets (`FilteredData`) object where needed data are taken from +#' @return list of reactive datasets with following attributes: +#' - `code` (`character`) containing datasets reproducible code. +#' @keywords internal +#' - `join_keys` (`JoinKeys`) containing relationships between datasets. +.datasets_to_data <- function(module, datasets) { + datanames <- if (identical("all", module$filter) || is.null(module$filter)) { + datasets$datanames() + } else { + datasets$get_filterable_datanames(module$filter) # get_filterable_datanames adds parents if present + } + + # list of reactive filtered data + data <- sapply( + datanames, + simplify = FALSE, + function(x) { + reactive(datasets$get_data(x, filtered = TRUE)) + } + ) + + metadata <- lapply(datanames, datasets$get_metadata) + names(metadata) <- datanames + + new_tdata( + data, + reactive(get_datasets_code(datanames, datasets)), + datasets$get_join_keys(), + metadata + ) +} diff --git a/R/modules.R b/R/modules.R index 7d338fd567..6d85877a86 100644 --- a/R/modules.R +++ b/R/modules.R @@ -29,15 +29,15 @@ #' label = "Module", #' module( #' label = "Inner module", -#' server = function(id, datasets) { +#' server = function(id, data) { #' moduleServer( #' id, #' module = function(input, output, session) { -#' output$data <- renderDataTable(datasets$get_data("iris")) +#' output$data <- renderDataTable(data[["iris"]]()) #' } #' ) #' }, -#' ui = function(id, datasets) { +#' ui = function(id) { #' ns <- NS(id) #' tagList(dataTableOutput(ns("data"))) #' }, @@ -46,7 +46,7 @@ #' ), #' module( #' label = "Another module", -#' server = function(id, datasets) { +#' server = function(id) { #' moduleServer( #' id, #' module = function(input, output, session) { @@ -54,7 +54,7 @@ #' } #' ) #' }, -#' ui = function(id, datasets) { +#' ui = function(id) { #' ns <- NS(id) #' tagList(textOutput(ns("text"))) #' }, @@ -169,15 +169,15 @@ is_arg_used.function <- function(modules, arg) { #' modules = modules( #' module( #' label = "Module", -#' server = function(id, datasets) { +#' server = function(id, data) { #' moduleServer( #' id, #' module = function(input, output, session) { -#' output$data <- renderDataTable(datasets$get_data("iris")) +#' output$data <- renderDataTable(data[["iris"]]()) #' } #' ) #' }, -#' ui = function(id, datasets) { +#' ui = function(id) { #' ns <- NS(id) #' tagList(dataTableOutput(ns("data"))) #' }, @@ -185,7 +185,7 @@ is_arg_used.function <- function(modules, arg) { #' ), #' module( #' label = "Another module", -#' server = function(id, datasets) { +#' server = function(id) { #' moduleServer( #' id, #' module = function(input, output, session) { @@ -193,11 +193,11 @@ is_arg_used.function <- function(modules, arg) { #' } #' ) #' }, -#' ui = function(id, datasets) { +#' ui = function(id) { #' ns <- NS(id) #' tagList(textOutput(ns("text"))) #' }, -#' filters = NULL +#' filters = "all" #' ) #' ) #' ) @@ -230,8 +230,8 @@ root_modules <- function(...) { #' @param server (`function`) `shiny` module with following arguments: #' - `id` - teal will set proper shiny namespace for this module (see [shiny::moduleServer()]). #' - `input`, `output`, `session` - (not recommended) then [shiny::callModule()] will be used to call a module. -#' - `data` (optional) module will receive list of reactive (filtered) data specified in the `filters` argument. `filters` -#' can't be NULL +#' - `data` (optional) module will receive a `tdata` object, a list of reactive (filtered) data specified in +#' the `filters` argument. #' - `datasets` (optional) module will receive `FilteredData`. (See `[teal.slice::FilteredData]`). #' - `reporter` (optional) module will receive `Reporter`. (See [teal.reporter::Reporter]). # - `filter_panel_api` (optional) module will receive `FilterPanelAPI`. (See [teal.slice::FilterPanelAPI]). @@ -244,8 +244,7 @@ root_modules <- function(...) { #' @param filters (`character`) A vector with datanames that are relevant for the item. The #' filter panel will automatically update the shown filters to include only #' filters in the listed datasets. `NULL` will hide the filter panel, -#' and the keyword `'all'` will show the filters of all datasets. `filters` can't be `NULL` when -#' `data` argument is present in the `server` formals. +#' and the keyword `'all'` will show the filters of all datasets. #' @param server_args (named `list`) with additional arguments passed on to the #' `server` function. #' @param ui_args (named `list`) with additional arguments passed on to the @@ -261,15 +260,15 @@ root_modules <- function(...) { #' modules = list( #' module( #' label = "Module", -#' server = function(id, datasets) { +#' server = function(id, data) { #' moduleServer( #' id, #' module = function(input, output, session) { -#' output$data <- renderDataTable(datasets$get_data("iris")) +#' output$data <- renderDataTable(data[["iris"]]()) #' } #' ) #' }, -#' ui = function(id, datasets) { +#' ui = function(id) { #' ns <- NS(id) #' tagList(dataTableOutput(ns("data"))) #' } @@ -281,7 +280,7 @@ root_modules <- function(...) { #' } module <- function(label = "module", server = function(id, ...) { - moduleServer(id, function(input, output, session) {}) + moduleServer(id, function(input, output, session) {}) # nolint }, ui = function(id, ...) { tags$p(paste0("This module has no UI (id: ", id, " )")) @@ -323,13 +322,6 @@ module <- function(label = "module", ) } - if ("data" %in% server_formals && is.null(filters)) { - stop( - "\n`filters = NULL` indicates that the module doesn't need any data while it has the `data` in formals.", - "\nPlease specify `filters` with the names of needed datasets or exclude `data` from the arguments." - ) - } - ui_formals <- names(formals(ui)) if (!"id" %in% ui_formals) { stop( diff --git a/R/modules_debugging.R b/R/modules_debugging.R index 83a8f3232e..91e60e354c 100644 --- a/R/modules_debugging.R +++ b/R/modules_debugging.R @@ -10,8 +10,6 @@ #' and avoids session restarts! #' #' @param label `character` label of module -#' @param active_datanames `character vector` datanames shown in filter panel; -#' can be `"all"` to mean all available datasets #' @keywords internal #' #' @examples @@ -34,19 +32,19 @@ #' ), #' header = "Simple teal app" #' ) -#' \dontrun{ -#' shinyApp(app$ui, app$server) +#' if (interactive()) { +#' shinyApp(app$ui, app$server) #' } -filter_calls_module <- function(label = "Filter Calls Module", active_datanames = "all") { # nolint +filter_calls_module <- function(label = "Filter Calls Module") { # nolint checkmate::assert_string(label) - checkmate::check_character(active_datanames, min.len = 1, any.missing = FALSE) module( label = label, - server = function(input, output, session, datasets) { + server = function(input, output, session, data) { + checkmate::assert_class(data, "tdata") + output$filter_calls <- renderText({ - active_datanames <- datasets$handle_active_datanames(active_datanames) - teal.slice::get_filter_expr(datasets, datanames = active_datanames) + get_code_tdata(data) }) }, ui = function(id, ...) { @@ -56,6 +54,6 @@ filter_calls_module <- function(label = "Filter Calls Module", active_datanames verbatimTextOutput(ns("filter_calls")) ) }, - filters = active_datanames + filters = "all" ) } diff --git a/R/reporter_previewer_module.R b/R/reporter_previewer_module.R index 175a54331e..1d30c5e9fd 100644 --- a/R/reporter_previewer_module.R +++ b/R/reporter_previewer_module.R @@ -14,11 +14,11 @@ #' @export reporter_previewer_module <- function(label = "Report previewer") { checkmate::assert_string(label) - srv <- function(id, datasets, reporter, ...) { + srv <- function(id, reporter, ...) { teal.reporter::reporter_previewer_srv(id, reporter, ...) } - ui <- function(id, datasets, ...) { + ui <- function(id, ...) { teal.reporter::reporter_previewer_ui(id, ...) } diff --git a/R/tdata.R b/R/tdata.R new file mode 100644 index 0000000000..25fc845d38 --- /dev/null +++ b/R/tdata.R @@ -0,0 +1,173 @@ +#' 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. +#' @return A `tdata` object +#' @examples +#' +#' data <- new_tdata( +#' data = list(iris = iris, mtcars = reactive(mtcars), dd = data.frame(x = 1:10)), +#' code = "iris <- iris +#' mtcars <- mtcars +#' dd <- data.frame(x = 1:10)", +#' metadata = list(dd = list(author = "NEST"), iris = list(version = 1)) +#' ) +#' +#' # Extract a data.frame +#' isolate(data[["iris"]]()) +#' +#' # Get code +#' isolate(get_code(data)) +#' +#' # Get metadata +#' get_metadata(data, "iris") +#' +#' @export +new_tdata <- function(data, code = "", join_keys = NULL, metadata = NULL) { + 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")) + + 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_class(code(), "character", .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" + ) + ) + } + } + + # set attributes + attr(data, "code") <- if (is.reactive(code)) code else reactive(code) + attr(data, "join_keys") <- join_keys + attr(data, "metadata") <- metadata + + # 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" +#' ) +#' +#' 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(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") +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 811afd4a7a..8fd57dc9a8 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -40,6 +40,13 @@ reference: - title: Report previewer module contents: - reporter_previewer_module + - title: Functions for module developers + contents: + - tdata + - get_code_tdata + - get_join_keys + - get_metadata + - tdata2env - title: Functions moved to other packages desc: These functions have been moved from teal and will be deprecated. contents: @@ -48,12 +55,10 @@ reference: - title: Validation functions contents: - starts_with("validate_") - - title: Functions related to showing R code + - title: Deprecated functions contents: + - bookmarkableShinyApp - get_rcode - get_rcode_srv - get_rcode_ui - show_rcode_modal - - title: Deprecated function - contents: - - bookmarkableShinyApp diff --git a/man/dot-datasets_to_data.Rd b/man/dot-datasets_to_data.Rd new file mode 100644 index 0000000000..71c31ea5ba --- /dev/null +++ b/man/dot-datasets_to_data.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_nested_tabs.R +\name{.datasets_to_data} +\alias{.datasets_to_data} +\title{Convert \code{FilteredData} to reactive list of datasets of the \code{tdata} type.} +\usage{ +.datasets_to_data(module, datasets) +} +\arguments{ +\item{module}{(\code{teal_module}) module where needed filters are taken from} + +\item{datasets}{(\code{FilteredData}) object where needed data are taken from} +} +\value{ +list of reactive datasets with following attributes: +\itemize{ +\item \code{code} (\code{character}) containing datasets reproducible code. +} +} +\description{ +Converts \code{FilteredData} object to \code{tdata} object containing datasets needed for a specific module. +Please note that if module needs dataset which has a parent, then parent will be also returned. +} +\keyword{(`JoinKeys`)} +\keyword{-} +\keyword{`join_keys`} +\keyword{between} +\keyword{containing} +\keyword{datasets.} +\keyword{internal} +\keyword{relationships} diff --git a/man/example_module.Rd b/man/example_module.Rd index 749fedfbad..19d6c718c6 100644 --- a/man/example_module.Rd +++ b/man/example_module.Rd @@ -23,7 +23,7 @@ app <- init( ), modules = modules(example_module()) ) -\dontrun{ -shinyApp(app$ui, app$server) +if (interactive()) { + shinyApp(app$ui, app$server) } } diff --git a/man/filter_calls_module.Rd b/man/filter_calls_module.Rd index 3ceb67c161..dc49091cb8 100644 --- a/man/filter_calls_module.Rd +++ b/man/filter_calls_module.Rd @@ -4,13 +4,10 @@ \alias{filter_calls_module} \title{Dummy module to show the filter calls generated by the right encoding panel} \usage{ -filter_calls_module(label = "Filter Calls Module", active_datanames = "all") +filter_calls_module(label = "Filter Calls Module") } \arguments{ \item{label}{\code{character} label of module} - -\item{active_datanames}{\verb{character vector} datanames shown in filter panel; -can be \code{"all"} to mean all available datasets} } \description{ Please do not remove, this is useful for debugging teal without @@ -37,8 +34,8 @@ app <- init( ), header = "Simple teal app" ) -\dontrun{ -shinyApp(app$ui, app$server) +if (interactive()) { + shinyApp(app$ui, app$server) } } \keyword{internal} diff --git a/man/get_code_tdata.Rd b/man/get_code_tdata.Rd new file mode 100644 index 0000000000..c220f29959 --- /dev/null +++ b/man/get_code_tdata.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tdata.R +\name{get_code_tdata} +\alias{get_code_tdata} +\title{Wrapper for \code{get_code.tdata} +This wrapper is to be used by downstream packages to extract the code of a \code{tdata} object} +\usage{ +get_code_tdata(data) +} +\arguments{ +\item{data}{(\code{tdata}) object} +} +\value{ +(\code{character}) code used in the \code{tdata} object. +} +\description{ +Wrapper for \code{get_code.tdata} +This wrapper is to be used by downstream packages to extract the code of a \code{tdata} object +} diff --git a/man/get_join_keys.Rd b/man/get_join_keys.Rd new file mode 100644 index 0000000000..d69ef17f9c --- /dev/null +++ b/man/get_join_keys.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tdata.R +\name{get_join_keys} +\alias{get_join_keys} +\alias{get_join_keys.tdata} +\alias{get_join_keys.default} +\title{Function to get join keys from a \code{tdata} object} +\usage{ +get_join_keys(data) + +\method{get_join_keys}{tdata}(data) + +\method{get_join_keys}{default}(data) +} +\arguments{ +\item{data}{\code{tdata} - object to extract the join keys} +} +\value{ +Either \code{JoinKeys} object or \code{NULL} if no join keys +} +\description{ +Function to get join keys from a \code{tdata} object +} diff --git a/man/get_metadata.Rd b/man/get_metadata.Rd new file mode 100644 index 0000000000..31bf8dc0a9 --- /dev/null +++ b/man/get_metadata.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tdata.R +\name{get_metadata} +\alias{get_metadata} +\alias{get_metadata.tdata} +\alias{get_metadata.default} +\title{Function to get metadata from a \code{tdata} object} +\usage{ +get_metadata(data, dataname) + +\method{get_metadata}{tdata}(data, dataname) + +\method{get_metadata}{default}(data, dataname) +} +\arguments{ +\item{data}{\code{tdata} - object to extract the data from} + +\item{dataname}{\code{character(1)} the dataset name whose metadata is requested} +} +\value{ +Either list of metadata or NULL if no metadata +} +\description{ +Function to get metadata from a \code{tdata} object +} diff --git a/man/get_rcode.Rd b/man/get_rcode.Rd index e9e36b65e5..16471ba245 100644 --- a/man/get_rcode.Rd +++ b/man/get_rcode.Rd @@ -51,7 +51,7 @@ code will be returned, too. If code chunks were used, these will also be used to derive module R Code. } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Return the R-code used to create a teal::teal] module analysis. This function will return all analysis code as a character string. In case of a good setup it will not only return the code used create the module analysis, but also the code used by diff --git a/man/get_rcode_srv.Rd b/man/get_rcode_srv.Rd index d1d5b716fa..95978238b4 100644 --- a/man/get_rcode_srv.Rd +++ b/man/get_rcode_srv.Rd @@ -34,5 +34,5 @@ a shiny reactive value. Should be a single boolean value, indicating whether to or enable the show R code and Debug info buttons. Default: \code{reactiveVal(FALSE)}.} } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} } diff --git a/man/get_rcode_ui.Rd b/man/get_rcode_ui.Rd index 6a9e265161..ede2bb078a 100644 --- a/man/get_rcode_ui.Rd +++ b/man/get_rcode_ui.Rd @@ -13,5 +13,5 @@ get_rcode_ui(id) (\code{shiny.tag}) } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} } diff --git a/man/init.Rd b/man/init.Rd index b3d191be5e..14f55d42db 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -17,8 +17,9 @@ init( \arguments{ \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} or \code{MultiAssayExperiment})\cr -\code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, \code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, -\code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or \code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} +\code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, +\code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or +\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} or a list of the previous objects or function returning a named list. NOTE: teal does not guarantee reproducibility of the code when names of the list elements do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} @@ -135,16 +136,16 @@ app <- init( modules = modules( module( "data source", - server = function(input, output, session, datasets) {}, + server = function(input, output, session, data) {}, ui = function(id, ...) div(p("information about data source")), filters = "all" ), example_module(), module( "ADSL AGE histogram", - server = function(input, output, session, datasets) { + server = function(input, output, session, data) { output$hist <- renderPlot( - hist(datasets$get_data("ADSL", filtered = TRUE)$AGE) + hist(data[["ADSL"]]()$AGE) ) }, ui = function(id, ...) { @@ -159,10 +160,8 @@ app <- init( header = tags$h1("Sample App"), footer = tags$p("Copyright 2017 - 2020") ) -\dontrun{ -shinyApp(app$ui, app$server) +if (interactive()) { + shinyApp(app$ui, app$server) } -# See the vignette for an example how to embed this app as a module -# into a larger application } diff --git a/man/module.Rd b/man/module.Rd index 5b1fc5effd..9565154f30 100644 --- a/man/module.Rd +++ b/man/module.Rd @@ -33,8 +33,8 @@ module( \itemize{ \item \code{id} - teal will set proper shiny namespace for this module (see \code{\link[shiny:moduleServer]{shiny::moduleServer()}}). \item \code{input}, \code{output}, \code{session} - (not recommended) then \code{\link[shiny:callModule]{shiny::callModule()}} will be used to call a module. -\item \code{data} (optional) module will receive list of reactive (filtered) data specified in the \code{filters} argument. \code{filters} -can't be NULL +\item \code{data} (optional) module will receive a \code{tdata} object, a list of reactive (filtered) data specified in +the \code{filters} argument. \item \code{datasets} (optional) module will receive \code{FilteredData}. (See \verb{[teal.slice::FilteredData]}). \item \code{reporter} (optional) module will receive \code{Reporter}. (See \link[teal.reporter:Reporter]{teal.reporter::Reporter}). \item \code{...} (optional) \code{server_args} elements will be passed to the module named argument or to the \code{...}. @@ -51,8 +51,7 @@ can't be NULL \item{filters}{(\code{character}) A vector with datanames that are relevant for the item. The filter panel will automatically update the shown filters to include only filters in the listed datasets. \code{NULL} will hide the filter panel, -and the keyword \code{'all'} will show the filters of all datasets. \code{filters} can't be \code{NULL} when -\code{data} argument is present in the \code{server} formals.} +and the keyword \code{'all'} will show the filters of all datasets.} \item{server_args}{(named \code{list}) with additional arguments passed on to the \code{server} function.} @@ -82,15 +81,15 @@ app <- init( modules = list( module( label = "Module", - server = function(id, datasets) { + server = function(id, data) { moduleServer( id, module = function(input, output, session) { - output$data <- renderDataTable(datasets$get_data("iris")) + output$data <- renderDataTable(data[["iris"]]()) } ) }, - ui = function(id, datasets) { + ui = function(id) { ns <- NS(id) tagList(dataTableOutput(ns("data"))) } diff --git a/man/modules.Rd b/man/modules.Rd index a6a5f94e73..ab16d72e5c 100644 --- a/man/modules.Rd +++ b/man/modules.Rd @@ -53,15 +53,15 @@ app <- init( label = "Module", module( label = "Inner module", - server = function(id, datasets) { + server = function(id, data) { moduleServer( id, module = function(input, output, session) { - output$data <- renderDataTable(datasets$get_data("iris")) + output$data <- renderDataTable(data[["iris"]]()) } ) }, - ui = function(id, datasets) { + ui = function(id) { ns <- NS(id) tagList(dataTableOutput(ns("data"))) }, @@ -70,7 +70,7 @@ app <- init( ), module( label = "Another module", - server = function(id, datasets) { + server = function(id) { moduleServer( id, module = function(input, output, session) { @@ -78,7 +78,7 @@ app <- init( } ) }, - ui = function(id, datasets) { + ui = function(id) { ns <- NS(id) tagList(textOutput(ns("text"))) }, diff --git a/man/root_modules.Rd b/man/root_modules.Rd index 79fbe2c0f3..39527fb4ca 100644 --- a/man/root_modules.Rd +++ b/man/root_modules.Rd @@ -27,15 +27,15 @@ app <- init( modules = modules( module( label = "Module", - server = function(id, datasets) { + server = function(id, data) { moduleServer( id, module = function(input, output, session) { - output$data <- renderDataTable(datasets$get_data("iris")) + output$data <- renderDataTable(data[["iris"]]()) } ) }, - ui = function(id, datasets) { + ui = function(id) { ns <- NS(id) tagList(dataTableOutput(ns("data"))) }, @@ -43,7 +43,7 @@ app <- init( ), module( label = "Another module", - server = function(id, datasets) { + server = function(id) { moduleServer( id, module = function(input, output, session) { @@ -51,11 +51,11 @@ app <- init( } ) }, - ui = function(id, datasets) { + ui = function(id) { ns <- NS(id) tagList(textOutput(ns("text"))) }, - filters = NULL + filters = "all" ) ) ) diff --git a/man/srv_teal_with_splash.Rd b/man/srv_teal_with_splash.Rd index ee726529f9..2b76b6ca1b 100644 --- a/man/srv_teal_with_splash.Rd +++ b/man/srv_teal_with_splash.Rd @@ -16,8 +16,9 @@ is then preferred to this function.} \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} or \code{MultiAssayExperiment})\cr -\code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, \code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, -\code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or \code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} +\code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, +\code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or +\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} or a list of the previous objects or function returning a named list. NOTE: teal does not guarantee reproducibility of the code when names of the list elements do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} diff --git a/man/tdata.Rd b/man/tdata.Rd new file mode 100644 index 0000000000..1fb33f1e25 --- /dev/null +++ b/man/tdata.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tdata.R +\name{tdata} +\alias{tdata} +\alias{new_tdata} +\alias{get_code.tdata} +\title{Create a \code{tdata} Object} +\usage{ +new_tdata(data, code = "", join_keys = NULL, metadata = NULL) + +\method{get_code}{tdata}(x, ...) +} +\arguments{ +\item{data}{A \verb{named list} of \code{data.frames} (or \code{MultiAssayExperiment}) +which optionally can be \code{reactive}. +Inside this object all of these items will be made \code{reactive}.} + +\item{code}{A \code{character} (or \code{reactive} which evaluates to a \code{character}) containing +the code used to generate the data. This should be \code{reactive} if the code is changing +during a reactive context (e.g. if filtering changes the code). Inside this +object \code{code} will be made reactive} + +\item{join_keys}{A \code{teal.data::JoinKeys} object containing relationships between the +datasets.} + +\item{metadata}{A \verb{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.} + +\item{x}{a \code{tdata} object} + +\item{...}{additional arguments for the generic} +} +\value{ +A \code{tdata} object +} +\description{ +Create a new object called \code{tdata} which contains \code{data}, a \code{reactive} list of data.frames +(or \code{MultiAssayExperiment}), with attributes: +\itemize{ +\item{\code{code} (\code{reactive}) containing code used to generate the data} +\item{join_keys (\code{JoinKeys}) containing the relationships between the data} +\item{metadata (\verb{named list}) containing any metadata associated with the data frames} +} +} +\examples{ + +data <- new_tdata( + data = list(iris = iris, mtcars = reactive(mtcars), dd = data.frame(x = 1:10)), + code = "iris <- iris + mtcars <- mtcars + dd <- data.frame(x = 1:10)", + metadata = list(dd = list(author = "NEST"), iris = list(version = 1)) +) + +# Extract a data.frame +isolate(data[["iris"]]()) + +# Get code +isolate(get_code(data)) + +# Get metadata +get_metadata(data, "iris") + +} diff --git a/man/tdata2env.Rd b/man/tdata2env.Rd new file mode 100644 index 0000000000..eb3f2bec20 --- /dev/null +++ b/man/tdata2env.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tdata.R +\name{tdata2env} +\alias{tdata2env} +\title{Function to convert a \code{tdata} object to an \code{environment} +Any \code{reactives} inside \code{tdata} are first evaluated} +\usage{ +tdata2env(data) +} +\arguments{ +\item{data}{a \code{tdata} object} +} +\value{ +an \code{environment} +} +\description{ +Function to convert a \code{tdata} object to an \code{environment} +Any \code{reactives} inside \code{tdata} are first evaluated +} +\examples{ + +data <- new_tdata( + data = list(iris = iris, mtcars = reactive(mtcars)), + code = "iris <- iris + mtcars = mtcars" +) + +my_env <- isolate(tdata2env(data)) + +} diff --git a/man/ui_teal_with_splash.Rd b/man/ui_teal_with_splash.Rd index 5e9a616e21..e7cb07e5da 100644 --- a/man/ui_teal_with_splash.Rd +++ b/man/ui_teal_with_splash.Rd @@ -18,8 +18,9 @@ module id} \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} or \code{MultiAssayExperiment})\cr -\code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, \code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, -\code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or \code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} +\code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, +\code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or +\code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} or a list of the previous objects or function returning a named list. NOTE: teal does not guarantee reproducibility of the code when names of the list elements do not match the original object names. To ensure reproducibility please use \code{\link[teal.data:teal_data]{teal.data::teal_data()}} diff --git a/tests/testthat/test-get_rcode.R b/tests/testthat/test-get_rcode.R index a7bb432940..b2273afc92 100644 --- a/tests/testthat/test-get_rcode.R +++ b/tests/testthat/test-get_rcode.R @@ -1,7 +1,8 @@ testthat::test_that("get_rcode returns header only for empty chunks", { ch <- teal.code::chunks_new() - r_code_from_chunks <- strsplit(get_rcode(chunks = ch), "\n")[[1]] + # deprecation warning + testthat::expect_warning(r_code_from_chunks <- strsplit(get_rcode(chunks = ch), "\n")[[1]]) r_code_from_header <- strsplit(sprintf("\n\n%s\n", paste(get_rcode_header(), collapse = "\n")), "\n")[[1]] # removing the Date line from the header as the seconds may be different diff --git a/tests/testthat/test-module_nested_tabs.R b/tests/testthat/test-module_nested_tabs.R index 376fce0f85..b0334221c8 100644 --- a/tests/testthat/test-module_nested_tabs.R +++ b/tests/testthat/test-module_nested_tabs.R @@ -257,3 +257,89 @@ testthat::test_that("srv_nested_tabs.teal_module passes filter_panel_api to the NA ) }) + + +get_example_filtered_data <- function() { + d1 <- data.frame(id = 1:5, pk = c(2, 3, 2, 1, 4), val = 1:5) + d2 <- data.frame(id = 1:5, value = 1:5) + + cc <- teal.data:::CodeClass$new() + cc$set_code("d1 <- data.frame(id = 1:5, pk = c(2,3,2,1,4), val = 1:5)", "d1") + cc$set_code("d2 <- data.frame(id = 1:5, value = 1:5)", "d2") + + teal.slice::init_filtered_data( + x = list( + d1 = list(dataset = d1, keys = "id", metadata = list("A" = 1)), + d2 = list(dataset = d2, keys = "id") + ), + join_keys = teal.data::join_keys(teal.data::join_key("d1", "d2", c("pk" = "id"))), + code = cc, + check = TRUE + ) +} + +testthat::test_that(".datasets_to_data returns data which is filtered", { + datasets <- get_example_filtered_data() + isolate(datasets$set_filter_state(list(d1 = list(val = list(selected = c(1, 2)))))) + module <- list(filter = "all") + data <- isolate(.datasets_to_data(module, datasets)) + + d1_filtered <- isolate(data[["d1"]]()) + testthat::expect_equal(d1_filtered, data.frame(id = 1:2, pk = 2:3, val = 1:2)) + d2_filtered <- isolate(data[["d2"]]()) + testthat::expect_equal(d2_filtered, data.frame(id = 1:5, value = 1:5)) +}) + + +testthat::test_that(".datasets_to_data returns only data requested by modules$filter", { + datasets <- get_example_filtered_data() + module <- list(filter = "d1") + data <- .datasets_to_data(module, datasets) + testthat::expect_equal(isolate(names(data)), "d1") +}) + +testthat::test_that(".datasets_to_data returns tdata object", { + datasets <- get_example_filtered_data() + module <- list(filter = "all") + data <- .datasets_to_data(module, datasets) + + testthat::expect_s3_class(data, "tdata") + + # join_keys + testthat::expect_equal( + get_join_keys(data), + teal.data::join_keys(teal.data::join_key("d1", "d2", c("pk" = "id"))) + ) + + # code + testthat::expect_equal( + isolate(get_code(data)[1]), + "d1 <- data.frame(id = 1:5, pk = c(2, 3, 2, 1, 4), val = 1:5)\nd2 <- data.frame(id = 1:5, value = 1:5)\n\n" + ) + + # metadata + testthat::expect_equal( + get_metadata(data, "d1"), + list(A = 1) + ) + + testthat::expect_null(get_metadata(data, "d2")) +}) + +testthat::test_that(".datasets_to_data returns parent datasets for CDISC data", { + adsl <- data.frame(STUDYID = 1, USUBJID = 1) + adae <- data.frame(STUDYID = 1, USUBJID = 1, ASTDTM = 1, AETERM = 1, AESEQ = 1) + adtte <- data.frame(STUDYID = 1, USUBJID = 1, PARAMCD = 1) + + datasets <- teal.slice::init_filtered_data( + teal.data::cdisc_data( + teal.data::cdisc_dataset("ADSL", adsl), + teal.data::cdisc_dataset("ADAE", adae), + teal.data::cdisc_dataset("ADTTE", adtte) + ) + ) + + module <- list(filter = "ADAE") + data <- .datasets_to_data(module, datasets) + testthat::expect_setequal(isolate(names(data)), c("ADSL", "ADAE")) +}) diff --git a/tests/testthat/test-modules.R b/tests/testthat/test-modules.R index 3bfbb98dcb..3af8e1e381 100644 --- a/tests/testthat/test-modules.R +++ b/tests/testthat/test-modules.R @@ -118,18 +118,12 @@ testthat::test_that("module expects all ui_args being a ui arguments or passed t ) }) -testthat::test_that("module requires filters argument to be a character", { +testthat::test_that("module requires filters argument to be a character or NULL", { testthat::expect_error(module(filters = "all"), NA) testthat::expect_error(module(filters = ""), NA) testthat::expect_error(module(filters = NULL), NA) testthat::expect_error(module(filters = NA_character_), "Contains missing values") -}) - -testthat::test_that("module shouldn't have filter = NULL and data or datasets in the formals", { - testthat::expect_error( - module(server = function(id, data) NULL, filters = NULL), - "Please specify `filters`" - ) + testthat::expect_error(module(server = function(id, data) NULL, filters = NULL), NA) }) testthat::test_that("module() returns list of class 'teal_module' containing input objects", { diff --git a/tests/testthat/test-tdata.R b/tests/testthat/test-tdata.R new file mode 100644 index 0000000000..7f486f3c9f --- /dev/null +++ b/tests/testthat/test-tdata.R @@ -0,0 +1,220 @@ +# ---- constructor ---- +testthat::test_that("new_tdata accepts reactive and not reactive MAE and data.frames", { + utils::data(miniACC, package = "MultiAssayExperiment") + + testthat::expect_error( + new_tdata( + list( + a = reactive(data.frame(x = 1:10)), + b = data.frame(y = 1:10), + c = reactive(miniACC), + d = miniACC + ) + ), + NA + ) +}) + +testthat::test_that("new_tdata throws error if data is not a list with unique names", { + testthat::expect_error( + new_tdata(data.frame(1:10)), "Must be of type 'list'" + ) + + testthat::expect_error( + new_tdata(list(data.frame(1:10))), "Must have names" + ) + + testthat::expect_error( + new_tdata(list(x = data.frame(1:10), x = data.frame(1:5))), "Must have unique names" + ) +}) + +testthat::test_that("new_tdata throws error if contents of data list are not of correct type", { + testthat::expect_error( + new_tdata(list(x = 1)), "May only contain the following types: \\{data.frame,reactive,MultiAssayExperiment\\}" + ) + + testthat::expect_error( + new_tdata(list(x = reactive(1))), + "Must inherit from class 'data.frame'/'MultiAssayExperiment'" + ) +}) + +testthat::test_that("new_tdata throws error if code is not character or reactive character", { + testthat::expect_error( + new_tdata(list(x = iris), code = 5), + "Assertion on 'code' failed: Must inherit from class 'character'/'reactive'" + ) + + testthat::expect_error( + new_tdata(list(x = iris), code = reactive(5)), + "Assertion on 'code' failed: Must inherit from class 'character'" + ) +}) + +testthat::test_that("new_tdata accepts character and reactive characters for code argument", { + testthat::expect_error( + new_tdata(list(x = iris, y = mtcars), code = c("x <- iris", "y <- mtcars")), NA + ) + + testthat::expect_error( + new_tdata(list(x = iris, y = mtcars), code = reactive(c("x <- iris", "y <- mtcars"))), NA + ) +}) + +testthat::test_that("new_tdata throws error if join_keys is not of class JoinKeys", { + testthat::expect_error( + new_tdata(list(x = iris), join_keys = "x"), + "Assertion on 'join_keys' failed: Must inherit from class 'JoinKeys'" + ) +}) + +testthat::test_that("new_tdata throws no error if join_keys is of class JoinKeys", { + testthat::expect_error( + new_tdata(list(x = iris), join_keys = teal.data::join_keys()), + NA + ) +}) + +# note not testing the contents of metadata elements are good as we are relying on +# the (tested) function in teal.data to do this +testthat::test_that( + "new_tdata throws error if metadata is not a list with unique names a subset of the names of data", + { + testthat::expect_error( + new_tdata(list(x = iris, y = mtcars), metadata = 1:3), + "Assertion on 'metadata' failed: Must be of type 'list' \\(or 'NULL'\\)" + ) + + testthat::expect_error( + new_tdata(list(x = iris, y = mtcars), metadata = list(1, 2, 3)), + "Assertion on 'metadata' failed: Must have names." + ) + + testthat::expect_error( + new_tdata(list(x = iris, y = mtcars), metadata = list(x = list(A = 1), z = list(B = 1))), + "Must be a subset of \\{'x','y'\\}, but has additional elements \\{'z'\\}." + ) + } +) + +testthat::test_that("new_tdata does not throw error with valid metadata", { + testthat::expect_error( + new_tdata(list(x = iris, y = mtcars), metadata = list(x = list(A = 1), y = list(B = 1))), + NA + ) +}) + +# ---- get_metadata ---- +testthat::test_that("get_metadata returns NULL if no metadata", { + my_tdata <- new_tdata(data = list(iris = iris, mtcars = mtcars)) + testthat::expect_null(get_metadata(my_tdata, "iris")) +}) + +testthat::test_that("get_metadata returns NULL if no metadata for given dataset", { + my_tdata <- new_tdata( + data = list(iris = iris, mtcars = mtcars), + metadata = list(mtcars = list(A = 1)) + ) + testthat::expect_null(get_metadata(my_tdata, "iris")) +}) + +testthat::test_that("get_metadata returns metadata for given dataset", { + my_tdata <- new_tdata( + data = list(iris = iris, mtcars = mtcars), + metadata = list(mtcars = list(A = 1, B = 2)) + ) + testthat::expect_equal(get_metadata(my_tdata, "mtcars"), list(A = 1, B = 2)) +}) + +testthat::test_that("get_metadata returns NULL if dataset doesn't exist", { + my_tdata <- new_tdata( + data = list(iris = iris, mtcars = mtcars), + metadata = list(mtcars = list(A = 1, B = 2)) + ) + testthat::expect_null(get_metadata(my_tdata, "not_existing_df")) +}) + +# ---- get_code ---- +testthat::test_that("get_code returns empty character if tdata object has no code", { + my_tdata <- new_tdata(data = list(iris = iris, mtcars = mtcars)) + testthat::expect_equal("", isolate(get_code(my_tdata))) +}) + +testthat::test_that("get_code returns character of code if tdata object has code", { + code_string <- c("iris <- head(iris)", "mtcars <- head(mtcars)") + + # reactive case (for constructor) + my_tdata <- new_tdata( + data = list(x = iris, mtcars = head(mtcars)), + code = reactive(code_string) + ) + testthat::expect_equal(isolate(get_code(my_tdata)), code_string) + + # not reactive case (for constructor) + my_tdata <- new_tdata( + data = list(x = iris, mtcars = head(mtcars)), + code = code_string + ) + testthat::expect_equal(isolate(get_code(my_tdata)), code_string) +}) + +# ---- get_code wrapper ---- + +testthat::test_that("get_code_tdata accepts tdata", { + data <- new_tdata(data = list(iris = iris), code = "iris <- iris") + testthat::expect_error(isolate(get_code_tdata(data)), NA) +}) + +testthat::test_that("get_code_tdata throws error when input is not tdata", { + testthat::expect_error( + isolate(get_code_tdata(iris)), + "Assertion on 'data' failed: Must inherit from class 'tdata', but has class 'data.frame'." + ) + + testthat::expect_error( + isolate(get_code_tdata("iris")), + "Assertion on 'data' failed: Must inherit from class 'tdata', but has class 'character'." + ) +}) + +testthat::test_that("get_code_tdata returns character code", { + data <- new_tdata(data = list(iris = iris), code = "iris <- iris") + testthat::expect_identical(isolate(get_code_tdata(data)), "iris <- iris") +}) + +# ---- tdata2env ---- +testthat::test_that("tdata2env returns environment containing tdata contents ", { + utils::data(miniACC, package = "MultiAssayExperiment") + my_tdata <- new_tdata(data = list(iris = iris, mae = reactive(miniACC))) + + my_env <- isolate(tdata2env(my_tdata)) + my_env_as_list <- as.list(my_env) + testthat::expect_setequal(names(my_env_as_list), c("iris", "mae")) + testthat::expect_equal(iris, my_env_as_list$iris) + testthat::expect_equal(miniACC, my_env_as_list$mae) +}) + +testthat::test_that("tdata2env throws error if argument is not tdata", { + testthat::expect_error(tdata2env(iris), "Must inherit from class 'tdata'") +}) + +# ---- get_join_keys ---- +testthat::test_that("get_join_keys returns NULL if no JoinKeys object exists inside tdata", { + my_tdata <- new_tdata(data = list(iris = iris, mae = reactive(miniACC))) + testthat::expect_null(get_join_keys(my_tdata)) +}) + +testthat::test_that("get_join_keys returns JoinKeys object if it exists inside tdata", { + jk <- teal.data::join_keys(teal.data::join_key("A", "B", c("id" = "fk"))) + + my_tdata <- new_tdata( + data = list( + A = data.frame(id = 1:10, val = 1:10), + B = data.frame(id = 1:10, val = 1:10, fk = 10:1) + ), + join_keys = jk + ) + + testthat::expect_equal(get_join_keys(my_tdata), jk) +}) diff --git a/vignettes/adding-support-for-reporting.Rmd b/vignettes/adding-support-for-reporting.Rmd index 507e2553ba..dd52c3c1c6 100644 --- a/vignettes/adding-support-for-reporting.Rmd +++ b/vignettes/adding-support-for-reporting.Rmd @@ -33,16 +33,17 @@ teal_example_module <- function(label = "example teal module") { checkmate::assert_string(label) module( label, - server = function(id, datasets) { + server = function(id, data) { + checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { - output$text <- renderPrint(datasets$get_data(input$dataname, filtered = TRUE)) + output$text <- renderPrint(data[[input$dataname]]()) }) }, - ui = function(id, datasets) { + ui = function(id, data) { ns <- NS(id) teal.widgets::standard_layout( output = verbatimTextOutput(ns("text")), - encoding = selectInput(ns("dataname"), "Choose a dataset", choices = datasets$datanames()) + encoding = selectInput(ns("dataname"), "Choose a dataset", choices = names(data)) ) }, filters = "all" @@ -65,23 +66,23 @@ if (interactive()) shinyApp(app$ui, app$server) ## Add support for Reporting ### Change the declaration of the server function -The first step is to add another argument to the server function declaration - `reporter`. This needs to be the third -argument to the server function inside the `teal.module` call. See below: +The first step is to add another argument to the server function declaration - `reporter`. See below: ```{r} example_module_with_reporting <- function(label = "example teal module") { checkmate::assert_string(label) module( label, - server = function(id, datasets, reporter) { + server = function(id, data, reporter) { + checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { - output$text <- renderPrint(datasets$get_data(input$dataname, filtered = TRUE)) + output$text <- renderPrint(data[[input$dataname]]()) }) }, - ui = function(id, datasets) { + ui = function(id, data) { ns <- NS(id) teal.widgets::standard_layout( output = verbatimTextOutput(ns("text")), - encoding = selectInput(ns("dataname"), "Choose a dataset", choices = datasets$datanames()) + encoding = selectInput(ns("dataname"), "Choose a dataset", choices = names(data)) ) }, filters = "all" @@ -114,24 +115,25 @@ example_module_with_reporting <- function(label = "example teal module") { checkmate::assert_string(label) module( label, - server = function(id, datasets, reporter) { + server = function(id, data, reporter) { + checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { teal.reporter::simple_reporter_srv( id = "reporter", reporter = reporter, card_fun = function(card) card ) - output$text <- renderPrint(datasets$get_data(input$dataname, filtered = TRUE)) + output$text <- renderPrint(data[[input$dataname]]()) }) }, - ui = function(id, datasets) { + ui = function(id, data) { ns <- NS(id) teal.widgets::standard_layout( output = tagList( teal.reporter::simple_reporter_ui(ns("reporter")), verbatimTextOutput(ns("text")) ), - encoding = selectInput(ns("dataname"), "Choose a dataset", choices = datasets$datanames()) + encoding = selectInput(ns("dataname"), "Choose a dataset", choices = names(data)) ) }, filters = "all" @@ -176,20 +178,21 @@ example_module_with_reporting <- function(label = "example teal module") { checkmate::assert_string(label) module( label, - server = function(id, datasets, reporter) { + server = function(id, data, reporter) { + checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { teal.reporter::simple_reporter_srv(id = "simpleReporter", reporter = reporter, card_fun = custom_function) - output$text <- renderPrint(datasets$get_data(input$dataname, filtered = TRUE)) + output$text <- renderPrint(data[[input$dataname]]()) }) }, - ui = function(id, datasets) { + ui = function(id, data) { ns <- NS(id) teal.widgets::standard_layout( output = tagList( teal.reporter::simple_reporter_ui(ns("simpleReporter")), verbatimTextOutput(ns("text")) ), - encoding = selectInput(ns("dataname"), "Choose a dataset", choices = datasets$datanames()) + encoding = selectInput(ns("dataname"), "Choose a dataset", choices = names(data)) ) }, filters = "all" @@ -233,6 +236,7 @@ Otherwise, the API of `TealReportCard` will not be available inside the function ## Example Summing up, we could build a regular teal app with code reproducibility and reporter functionality. +Note that the `server` function requires the `filter_panel_api` argument so that the filter panel state can be added to the report. ```{r} library(teal) @@ -241,28 +245,40 @@ library(teal.reporter) example_reporter_module <- function(label = "Example") { module( label, - server = function(id, datasets, reporter) { + server = function(id, data, reporter, filter_panel_api) { + with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelApi") + checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { - simple_chunks <- teal.code::chunks_new() - dat <- reactive(dat <- datasets$get_data(input$dataname, filtered = TRUE)) + dat <- reactive(data[[input$dataname]]()) output$nrow_ui <- renderUI({ - sliderInput(session$ns("nrow"), "Number of rows:", 1, nrow(dat()), 10) + sliderInput(session$ns("nrow"), "Number of rows:", 1, nrow(data[[input$dataname]]()), 10) }) - table_r <- reactive({ + + table_q <- reactive({ req(input$nrow) - teal.code::chunks_reset(chunks = simple_chunks) - teal.code::chunks_push(bquote(result <- .(dat())), id = "get_data", chunks = simple_chunks) - teal.code::chunks_push(bquote(result <- head(result, .(input$nrow))), id = "nrow", chunks = simple_chunks) - teal.code::chunks_push(quote(result), id = "print_result", chunks = simple_chunks) - teal.code::chunks_safe_eval(chunks = simple_chunks) + + teal.code::new_qenv(tdata2env(data), code = get_code(data)) %>% + teal.code::eval_code( + substitute( + result <- head(data, nrows), + list( + data = as.name(input$dataname), + nrows = input$nrow + ) + ) + ) }) - output$table <- renderTable(table_r()) + + output$table <- renderTable(table_q()[["result"]]) + ### REPORTER card_fun <- function(card = ReportCard$new(), comment) { card$set_name("Table Module") card$append_text(paste("Selected dataset", input$dataname), "header2") card$append_text("Selected Filters", "header3") - card$append_text(datasets$get_formatted_filter_state(), "verbatim") + if (with_filter) { + card$append_text(filter_panel_api$get_filter_state(), "verbatim") + } card$append_text("Encoding", "header3") card$append_text( yaml::as.yaml( @@ -271,9 +287,9 @@ example_reporter_module <- function(label = "Example") { "verbatim" ) card$append_text("Module Table", "header3") - card$append_table(table_r()) + card$append_table(table_q()[["result"]]) card$append_text("Show R Code", "header3") - card$append_text(paste(teal.code::chunks_get_rcode(simple_chunks), collapse = "\n"), "verbatim") + card$append_text(paste(teal.code::get_code(table_q()), collapse = "\n"), "verbatim") if (!comment == "") { card$append_text("Comment", "header3") card$append_text(comment) @@ -286,7 +302,7 @@ example_reporter_module <- function(label = "Example") { ### }) }, - ui = function(id, datasets) { + ui = function(id, data) { ns <- NS(id) teal.widgets::standard_layout( output = tableOutput(ns("table")), @@ -296,7 +312,7 @@ example_reporter_module <- function(label = "Example") { teal.reporter::download_report_button_ui(ns("downloadButton")), teal.reporter::reset_report_button_ui(ns("resetButton")) ), - selectInput(ns("dataname"), "Choose a dataset", choices = datasets$datanames()), + selectInput(ns("dataname"), "Choose a dataset", choices = names(data)), uiOutput(ns("nrow_ui")) ) ) @@ -306,7 +322,10 @@ example_reporter_module <- function(label = "Example") { } app <- init( - data = teal_data(dataset("AIR", airquality), dataset("IRIS", iris), check = FALSE), + data = teal_data( + dataset("AIR", airquality, code = "AIR <- data(airquality)"), + dataset("IRIS", iris, code = "IRIS <- data(iris)") + ), modules = modules( example_reporter_module(label = "with Reporter"), example_module(label = "without Reporter") diff --git a/vignettes/creating-custom-modules.Rmd b/vignettes/creating-custom-modules.Rmd index 7d64f9f043..381a311267 100644 --- a/vignettes/creating-custom-modules.Rmd +++ b/vignettes/creating-custom-modules.Rmd @@ -22,16 +22,17 @@ example_module <- function(label = "example teal module") { checkmate::assert_string(label) module( label, - server = function(id, datasets) { + server = function(id, data) { + checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { - output$text <- renderPrint(datasets$get_data(input$dataname, filtered = TRUE)) + output$text <- renderPrint(data[[input$dataname]]()) }) }, - ui = function(id, datasets) { + ui = function(id, data) { ns <- NS(id) teal.widgets::standard_layout( output = verbatimTextOutput(ns("text")), - encoding = selectInput(ns("dataname"), "Choose a dataset", choices = datasets$datanames()) + encoding = selectInput(ns("dataname"), "Choose a dataset", choices = names(data)) ) }, filters = "all" @@ -45,8 +46,10 @@ which can be added into `teal` apps using `example_module(label = "Label for tab ### UI function -This function contains the UI required for the module. It should be a function with at least the arguments `id` and `datasets`. -It can contain standard UI components alongside additional widgets provided by the `teal.widgets` package. +This function contains the UI required for the module. It should be a function with at least the arguments `id`. +It can also contain the argument `data` for access to the application data. See the server section below for more details. + +The UI function can contain standard UI components alongside additional widgets provided by the `teal.widgets` package. In the example above we are using the `standard_layout` function of `teal.widgets` which generates a layout including an encoding panel on the left and main output covering the rest of the module's UI. @@ -55,7 +58,11 @@ including an encoding panel on the left and main output covering the rest of the This function contains the shiny server logic for the module and should be of the form: ``` -function(id, datasets, ...) { +function(id, + data, # optional, use if you want your module to access the application data + filter_panel_api, # optional, use if you want access to the filter panel from your module see teal.slice + reporter, # optional, use if your module supports reporting, see reporting vignette in teal + ...) { moduleServer(id, function(input, output, session) { # module code here }) @@ -63,10 +70,9 @@ function(id, datasets, ...) { ``` -The `datasets` argument is a `FilteredData` object which provides a call to extract the data after having been filtered by the filterpanel: -`datasets$get_data(<>, filtered = TRUE)`. For more details about the `FilteredData` object see the supporting `teal` package -[`teal.slice`](https://insightsengineering.github.io/teal.slice/) - +When used inside a teal application called with `teal::init`, the `data` argument is a named list of reactive data.frames +containing the data after having been filtered through the filter panel. It is of the `tdata` type and can be created using +the `new_tdata` function. ## A More Complicated Example @@ -89,7 +95,7 @@ library(teal) # ui function for the module # histogram_var is a teal.transform::data_extract_spec object # specifying which columns of which datasets users can choose -ui_histogram_example <- function(id, datasets, histogram_var) { +ui_histogram_example <- function(id, histogram_var) { ns <- NS(id) teal.widgets::standard_layout( output = plotOutput(ns("plot")), @@ -102,52 +108,54 @@ ui_histogram_example <- function(id, datasets, histogram_var) { ), # we have a show R code button to show the code needed # to generate the histogram - forms = teal::get_rcode_ui(ns("rcode")) + forms = teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") ) } # server function for the module # histogram_var is a teal.transform::data_extract_spec object # specifying which columns of which datasets users can choose -srv_histogram_example <- function(id, datasets, histogram_var) { +srv_histogram_example <- function(id, data, histogram_var) { + checkmate::assert_class(data, "tdata") moduleServer(id, function(input, output, session) { - # initialize the reproducibility part of teal (i.e. "chunks") - teal.code::init_chunks() - # get the selected dataset and column from the UI - extracted <- teal.transform::data_extract_srv("histogram_var", datasets, histogram_var) + extracted <- teal.transform::data_extract_srv( + id = "histogram_var", + datasets = data, + data_extract_spec = histogram_var, + join_keys = get_join_keys(data) + ) + dataname <- reactive(extracted()$dataname) selected <- reactive(extracted()$select) - # the reactive which adds the code to plot the histogram into the chunks - plot_code <- reactive({ + # the reactive which adds the code to plot the histogram into the qenv + plot_code_q <- reactive({ validate(need(length(selected) == 1, "Please select a variable")) - # take the filtered data from the datasets object and add it into the chunks environment - new_env <- new.env() - assign(dataname(), datasets$get_data(dataname(), filtered = TRUE), envir = new_env) - teal.code::chunks_reset(envir = new_env) - - # add the code for the plot into the chunks - teal.code::chunks_push( - bquote(hist(.(as.name(dataname()))[, .(selected())])) - ) - - # evaluate the chunks - teal.code::chunks_safe_eval() + # take the filtered data from the data object and add it into the qenv environment + teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% + teal.code::eval_code( + substitute( + expr = p <- hist(dataname[, selected]), + env = list( + dataname = as.name(dataname()), + selected = selected() + ) + ) + ) }) # shiny component to view output$plot <- renderPlot({ - plot_code() + plot_code_q()[["p"]] }) # Show the R code when user clicks 'Show R Code' button - teal::get_rcode_srv( + teal.widgets::verbatim_popup_srv( id = "rcode", - datasets = datasets, - modal_title = "R code for custom plot", - code_header = "R code for custom plot" + verbatim_content = reactive(teal.code::get_code(plot_code_q())), + title = "R Code" ) }) } diff --git a/vignettes/images/custom_app.png b/vignettes/images/custom_app.png index 9e0bfbdd8f..d6ef818e0e 100644 Binary files a/vignettes/images/custom_app.png and b/vignettes/images/custom_app.png differ diff --git a/vignettes/including-adam-data-in-teal.Rmd b/vignettes/including-adam-data-in-teal.Rmd index 8475460c1a..a5dbb7a517 100644 --- a/vignettes/including-adam-data-in-teal.Rmd +++ b/vignettes/including-adam-data-in-teal.Rmd @@ -91,4 +91,14 @@ if (interactive()) { } ``` +The [teal.data::join_keys()] function is used to specify keys: + +- [teal.data::join_keys()] is a collection of multiple [teal.data::join_key()] entries +- [teal.data::join_key()] specifies the relation between two datasets: + - `dataset_1`, `dataset_2` - name of two datasets + - `key` - (optionally) named vector of column names + +Note that it is assumed that join keys are symmetric, i.e. `join_key("x", "y", "x_col" = "y_col")` will enable merge +from "x" to "y" and vice-versa. + For more information about preprocessing, reproducibility, relationships between datasets and DDL, please refer to the [`teal.data` package](https://insightsengineering.github.io/teal.data/). diff --git a/vignettes/teal.Rmd b/vignettes/teal.Rmd index 5629367347..023f6ba5d4 100644 --- a/vignettes/teal.Rmd +++ b/vignettes/teal.Rmd @@ -1,7 +1,7 @@ --- title: "Getting Started with Teal" -author: "Nikolas Burkoff" -date: "2022-03-24" +author: "NEST CoreDev" +date: "2022-11-03" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Getting Started with Teal}