Make JoinKeys related changes due to refactor (insightsengineering#958

) Related to [teal.data PR insightsengineering#184](insightsengineering/teal.data#184) Make changes to `teal` because of the refactor to the JoinKeys class from R6 to S3. --------- Signed-off-by: Vedha Viyash <[email protected]> Co-authored-by: André Veríssimo <[email protected]> Co-authored-by: Aleksander Chlebowski <[email protected]> Co-authored-by: go_gonzo <[email protected]>
walkowif · Nov 20, 2023 · 54fa9ac · 54fa9ac
1 parent 5e989f9
commit 54fa9ac
Show file tree

Hide file tree

Showing 32 changed files with 71 additions and 69 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -31,9 +31,9 @@ BugReports: https://github.com/insightsengineering/teal/issues
 Depends:
     R (>= 4.0),
     shiny (>= 1.7.0),
-    teal.data (>= 0.3.0),
-    teal.slice (>= 0.4.0.9011),
-    teal.transform (>= 0.4.0)
+    teal.data (>= 0.3.0.9010),
+    teal.slice (>= 0.4.0.9023),
+    teal.transform (>= 0.4.0.9007)
 Imports:
     checkmate,
     jsonlite,

diff --git a/NAMESPACE b/NAMESPACE
@@ -2,9 +2,9 @@
 
 S3method(c,teal_slices)
 S3method(get_code,tdata)
-S3method(get_join_keys,tdata)
 S3method(get_metadata,default)
 S3method(get_metadata,tdata)
+S3method(join_keys,tdata)
 S3method(print,teal_module)
 S3method(print,teal_modules)
 S3method(srv_nested_tabs,default)

diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R
@@ -37,7 +37,7 @@
 #'   }
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 #'
 #' @keywords internal

diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R
@@ -54,7 +54,7 @@
 #'   }
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 #' @keywords internal
 NULL
@@ -109,7 +109,7 @@ ui_nested_tabs.teal_modules <- function(id, modules, datasets, depth = 0L, is_mo
 #' @rdname module_nested_tabs
 #' @export
 ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L, is_module_specific = FALSE) {
-  checkmate::assert_class(datasets, class = "FilteredData")
+  checkmate::assert_class(datasets, classes = "FilteredData")
   ns <- NS(id)
 
   args <- isolate(teal.transform::resolve_delayed(modules$ui_args, datasets))
@@ -288,7 +288,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
 #' @param trigger_data (`reactiveVal`) to trigger getting the filtered data
 #' @return list of reactive datasets with following attributes:
 #' - `code` (`character`) containing datasets reproducible code.
-#' - `join_keys` (`JoinKeys`) containing relationships between datasets.
+#' - `join_keys` (`join_keys`) containing relationships between datasets.
 #' - `metadata` (`list`) containing metadata of datasets.
 #'
 #' @keywords internal

diff --git a/R/module_tabs_with_filters.R b/R/module_tabs_with_filters.R
@@ -50,7 +50,7 @@
 #'   }
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 #'
 NULL

diff --git a/R/module_teal.R b/R/module_teal.R
@@ -54,7 +54,7 @@
 #'   }
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 NULL
 

diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R
@@ -84,8 +84,8 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
         teal.data::teal_data,
         c(
           lapply(data$get_datasets(), function(x) x$get_raw_data()),
-          code = data$get_code(),
-          join_keys = data$get_join_keys()
+          list(code = data$get_code()),
+          list(join_keys = teal.data::join_keys(data))
         )
       )
       reactiveVal(new_data) # will trigger by setting it
@@ -100,8 +100,8 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
             teal.data::teal_data,
             c(
               lapply(data$get_datasets(), function(x) x$get_raw_data()),
-              code = data$get_code(),
-              join_keys = data$get_join_keys()
+              list(code = data$get_code()),
+              list(join_keys = teal.data::join_keys(data))
             )
           )
         }

diff --git a/R/modules.R b/R/modules.R
@@ -63,7 +63,7 @@
 #'   )
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 modules <- function(..., label = "root") {
   checkmate::assert_string(label)
@@ -219,7 +219,7 @@ is_arg_used <- function(modules, arg) {
 #'   )
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 module <- function(label = "module",
                    server = function(id, ...) {

diff --git a/R/modules_debugging.R b/R/modules_debugging.R
@@ -19,7 +19,7 @@
 #'   header = "Simple teal app"
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 filter_calls_module <- function(label = "Filter Calls Module") { # nolint
   checkmate::assert_string(label)

diff --git a/R/tdata.R b/R/tdata.R
@@ -4,7 +4,7 @@
 #' (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{join_keys (`join_keys`) containing the relationships between the data}
 #'   \item{metadata (`named list`) containing any metadata associated with the data frames}
 #' }
 #' @name tdata
@@ -15,7 +15,7 @@
 #'   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
+#' @param join_keys A `teal.data::join_keys` 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.
@@ -46,7 +46,7 @@ new_tdata <- function(data, code = "", join_keys = NULL, metadata = NULL) {
     any.missing = FALSE, names = "unique",
     types = c("data.frame", "reactive", "MultiAssayExperiment")
   )
-  checkmate::assert_class(join_keys, "JoinKeys", null.ok = TRUE)
+  checkmate::assert_class(join_keys, "join_keys", null.ok = TRUE)
   checkmate::assert_multi_class(code, c("character", "reactive"))
 
   checkmate::assert_list(metadata, names = "unique", null.ok = TRUE)
@@ -123,15 +123,15 @@ get_code_tdata <- function(data) {
   get_code(data)
 }
 
-#' Extract `JoinKeys` from `tdata`
-#' @rdname get_join_keys
-#' @param data (`tdata`) object
-#' @keywords internal
+#' Extract `join_keys` from `tdata`
+#' @param data A `tdata` object
+#' @param ... Additional arguments (not used)
 #' @export
-get_join_keys.tdata <- function(data) {
+join_keys.tdata <- function(data, ...) {
   attr(data, "join_keys")
 }
 
+
 #' 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

diff --git a/R/teal_slices.R b/R/teal_slices.R
@@ -60,7 +60,7 @@
 #' )
 #'
 #' if (interactive()) {
-#'   shiny::runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 #'
 #' @export

diff --git a/R/utils.R b/R/utils.R
@@ -38,7 +38,7 @@ include_parent_datanames <- function(dataname, join_keys) {
   parents <- character(0)
   for (i in dataname) {
     while (length(i) > 0) {
-      parent_i <- join_keys$get_parent(i)
+      parent_i <- teal.data::parent(join_keys, i)
       parents <- c(parent_i, parents)
       i <- parent_i
     }
@@ -106,7 +106,7 @@ report_card_template <- function(title, label, description = NULL, with_filter,
 #' When `datanames` is set to `"all"` it is replaced with all available datasets names.
 #' @param modules (`teal_modules`) object
 #' @param datanames (`character`) names of datasets available in the `data` object
-#' @param join_keys (`JoinKeys`) object
+#' @param join_keys (`join_keys`) object
 #' @return `teal_modules` with resolved `datanames`
 #' @keywords internal
 resolve_modules_datanames <- function(modules, datanames, join_keys) {

diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -119,6 +119,7 @@ reference:
       - get_metadata
       - tdata2env
       - show_rcode_modal
+      - join_keys.tdata
   # - title: Functions Moved to Other Packages
     # desc: These functions have been moved from teal and will be deprecated
     # contents:

diff --git a/man/dot-datasets_to_data.Rd b/man/dot-datasets_to_data.Rd
diff --git a/man/filter_calls_module.Rd b/man/filter_calls_module.Rd
diff --git a/man/get_join_keys.Rd b/man/get_join_keys.Rd
diff --git a/man/join_keys.tdata.Rd b/man/join_keys.tdata.Rd
diff --git a/man/module.Rd b/man/module.Rd
diff --git a/man/module_filter_manager_modal.Rd b/man/module_filter_manager_modal.Rd
diff --git a/man/module_nested_tabs.Rd b/man/module_nested_tabs.Rd
diff --git a/man/module_tabs_with_filters.Rd b/man/module_tabs_with_filters.Rd
diff --git a/man/module_teal.Rd b/man/module_teal.Rd
diff --git a/man/modules.Rd b/man/modules.Rd
diff --git a/man/resolve_modules_datanames.Rd b/man/resolve_modules_datanames.Rd
diff --git a/man/tdata.Rd b/man/tdata.Rd
diff --git a/man/teal_slices.Rd b/man/teal_slices.Rd
diff --git a/tests/testthat/test-module_nested_tabs.R b/tests/testthat/test-module_nested_tabs.R
@@ -451,7 +451,7 @@ testthat::test_that(".datasets_to_data returns tdata object", {
 
   # join_keys
   testthat::expect_equal(
-    get_join_keys(data),
+    join_keys(data),
     teal.data::join_keys(teal.data::join_key("d1", "d2", c("pk" = "id")))
   )
 

diff --git a/tests/testthat/test-tdata.R b/tests/testthat/test-tdata.R
@@ -62,14 +62,14 @@ testthat::test_that("new_tdata accepts character and reactive characters for cod
   )
 })
 
-testthat::test_that("new_tdata throws error if join_keys is not of class JoinKeys", {
+testthat::test_that("new_tdata throws error if join_keys is not of class join_keys", {
   testthat::expect_error(
     new_tdata(list(x = iris), join_keys = "x"),
-    "Assertion on 'join_keys' failed: Must inherit from class 'JoinKeys'"
+    "Assertion on 'join_keys' failed: Must inherit from class 'join_keys'"
   )
 })
 
-testthat::test_that("new_tdata throws no error if join_keys is of class JoinKeys", {
+testthat::test_that("new_tdata throws no error if join_keys is of class join_keys", {
   testthat::expect_error(
     new_tdata(list(x = iris), join_keys = teal.data::join_keys()),
     NA
@@ -200,12 +200,12 @@ testthat::test_that("tdata2env throws error if argument is not tdata", {
 })
 
 # ---- get_join_keys ----
-testthat::test_that("get_join_keys returns NULL if no JoinKeys object exists inside tdata", {
+testthat::test_that("join_keys returns NULL if no join_keys object exists inside tdata", {
   my_tdata <- new_tdata(data = list(iris = iris, mae = reactive(miniACC)))
-  testthat::expect_null(get_join_keys(my_tdata))
+  testthat::expect_null(join_keys(my_tdata))
 })
 
-testthat::test_that("get_join_keys returns JoinKeys object if it exists inside tdata", {
+testthat::test_that("join_keys returns join_keys object if it exists inside tdata", {
   jk <- teal.data::join_keys(teal.data::join_key("A", "B", c("id" = "fk")))
 
   my_tdata <- new_tdata(
@@ -216,5 +216,5 @@ testthat::test_that("get_join_keys returns JoinKeys object if it exists inside t
     join_keys = jk
   )
 
-  testthat::expect_equal(get_join_keys(my_tdata), jk)
+  testthat::expect_equal(join_keys(my_tdata), jk)
 })
-Original file line number
+Diff line change
@@ Expand Up / @@ -50,7 +50,7 @@ @@
     #'   }
     #' )
     #' if (interactive()) {
-    #'   runApp(app)
+    #'   shinyApp(app$ui, app$server)
     #' }
     #'
     NULL
@@ Expand Down @@