Make JoinKeys related changes due to refactor (#160)

Related to [teal.data PR #184](insightsengineering/teal.data#184) Make changes to `teal.transform` because of the refactor to the `JoinKeys` class from R6 to S3. --------- Signed-off-by: Vedha Viyash <[email protected]> Co-authored-by: Dawid Kałędkowski <[email protected]> Co-authored-by: André Veríssimo <[email protected]> Co-authored-by: Vedha Viyash <[email protected]> Co-authored-by: go_gonzo <[email protected]>
insightsengineering · Nov 20, 2023 · f82c7fc · f82c7fc
1 parent 26e4718
commit f82c7fc
Show file tree

Hide file tree

Showing 27 changed files with 69 additions and 65 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -32,9 +32,9 @@ Imports:
     shinyjs,
     shinyvalidate,
     stats,
-    teal.data (>= 0.3.0),
+    teal.data (>= 0.3.0.9010),
     teal.logger (>= 0.1.1),
-    teal.slice (>= 0.4.0),
+    teal.slice (>= 0.4.0.9023),
     teal.widgets (>= 0.4.0),
     tidyr (>= 0.8.3),
     tidyselect

diff --git a/R/choices_labeled.R b/R/choices_labeled.R
@@ -378,7 +378,7 @@ value_choices.data.frame <- function(data, # nolint
     df_choices <- dplyr::mutate_if(
       df_choices,
       .predicate = function(col) inherits(col, c("POSIXct", "POSIXlt", "POSIXt")),
-      .fun = function(col) {
+      .funs = function(col) {
         if (is.null(attr(col, "tzone")) || all(attr(col, "tzone") == "")) {
           format(trunc(col), "%Y-%m-%d %H:%M:%S")
         } else {

diff --git a/R/data_extract_module.R b/R/data_extract_module.R
@@ -346,7 +346,7 @@ check_data_extract_spec_react <- function(datasets, data_extract) {
 #'   }
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 #'
 #' # Using FilteredData - Note this method will be deprecated
@@ -381,7 +381,7 @@ check_data_extract_spec_react <- function(datasets, data_extract) {
 #'   }
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 data_extract_srv <- function(id, datasets, data_extract_spec, ...) {
   checkmate::assert_multi_class(datasets, c("FilteredData", "list"))
@@ -421,7 +421,7 @@ data_extract_srv.FilteredData <- function(id, datasets, data_extract_spec, ...)
 }
 
 #' @rdname data_extract_srv
-#' @param join_keys (`JoinKeys` or `NULL`) of keys per dataset in `datasets`
+#' @param join_keys (`join_keys` or `NULL`) of keys per dataset in `datasets`
 #' @param select_validation_rule (`NULL` or `function`)
 #'   Should there be any `shinyvalidate` input validation of the select parts of the `data_extract_ui`.
 #'   You can use a validation function directly (i.e. `select_validation_rule = shinyvalidate::sv_required()`)
@@ -443,7 +443,7 @@ data_extract_srv.list <- function(id, datasets, data_extract_spec, join_keys = N
                                   },
                                   ...) {
   checkmate::assert_list(datasets, types = c("reactive", "data.frame"), names = "named")
-  checkmate::assert_class(join_keys, "JoinKeys", null.ok = TRUE)
+  checkmate::assert_class(join_keys, "join_keys", null.ok = TRUE)
   checkmate::assert_multi_class(select_validation_rule, classes = c("function", "formula"), null.ok = TRUE)
   checkmate::assert_multi_class(filter_validation_rule, classes = c("function", "formula"), null.ok = TRUE)
   checkmate::assert_multi_class(dataset_validation_rule, classes = c("function", "formula"), null.ok = TRUE)
@@ -456,8 +456,8 @@ data_extract_srv.list <- function(id, datasets, data_extract_spec, join_keys = N
       )
 
       # get keys out of join_keys
-      if (!is.null(join_keys)) {
-        keys <- sapply(names(datasets), simplify = FALSE, function(x) join_keys$get(x, x))
+      if (length(join_keys)) {
+        keys <- sapply(names(datasets), simplify = FALSE, function(x) join_keys[x, x])
       } else {
         keys <- sapply(names(datasets), simplify = FALSE, function(x) character(0))
       }
@@ -651,7 +651,7 @@ data_extract_srv.list <- function(id, datasets, data_extract_spec, join_keys = N
 #'   }
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 data_extract_multiple_srv <- function(data_extract, datasets, ...) {
   checkmate::assert_list(data_extract, names = "named")
@@ -681,7 +681,7 @@ data_extract_multiple_srv.FilteredData <- function(data_extract, datasets, ...)
 }
 
 #' @rdname data_extract_multiple_srv
-#' @param join_keys (`JoinKeys` or `NULL`) of join keys per dataset in `datasets`.
+#' @param join_keys (`join_keys` or `NULL`) of join keys per dataset in `datasets`.
 #' @param select_validation_rule (`NULL`, `function` or `named list` of `function`)
 #'   Should there be any `shinyvalidate` input validation of the select parts of the `data_extract_ui`
 #'   If all `data_extract` require the same validation function then this can be used directly (
@@ -702,17 +702,17 @@ data_extract_multiple_srv.list <- function(data_extract, datasets, join_keys = N
                                              shinyvalidate::sv_required("Please select a dataset")
                                            }, ...) {
   checkmate::assert_list(datasets, types = c("reactive", "data.frame"), names = "named")
-  checkmate::assert_class(join_keys, "JoinKeys", null.ok = TRUE)
+  checkmate::assert_class(join_keys, "join_keys", null.ok = TRUE)
   checkmate::assert(
-    checkmate::check_multi_class(select_validation_rule, class = c("function", "formula"), null.ok = TRUE),
+    checkmate::check_multi_class(select_validation_rule, classes = c("function", "formula"), null.ok = TRUE),
     checkmate::check_list(select_validation_rule, types = c("function", "formula", "NULL"), null.ok = TRUE)
   )
   checkmate::assert(
-    checkmate::check_multi_class(filter_validation_rule, class = c("function", "formula"), null.ok = TRUE),
+    checkmate::check_multi_class(filter_validation_rule, classes = c("function", "formula"), null.ok = TRUE),
     checkmate::check_list(filter_validation_rule, types = c("function", "formula", "NULL"), null.ok = TRUE)
   )
   checkmate::assert(
-    checkmate::check_multi_class(dataset_validation_rule, class = c("function", "formula"), null.ok = TRUE),
+    checkmate::check_multi_class(dataset_validation_rule, classes = c("function", "formula"), null.ok = TRUE),
     checkmate::check_list(dataset_validation_rule, types = c("function", "formula", "NULL"), null.ok = TRUE)
   )
 

diff --git a/R/get_dplyr_call.R b/R/get_dplyr_call.R
@@ -9,7 +9,7 @@
 #' @keywords internal
 get_dplyr_call_data <- function(selector_list, join_keys = teal.data::join_keys()) {
   logger::log_trace("get_dplyr_call_data called with: { paste(names(selector_list), collapse = ', ') } selectors.")
-  checkmate::assert_class(join_keys, "JoinKeys")
+  checkmate::assert_class(join_keys, "join_keys")
   lapply(selector_list, check_selector)
 
   all_merge_key_list <- get_merge_key_grid(selector_list, join_keys)
@@ -211,7 +211,7 @@ get_dplyr_call <- function(selector_list,
     )
   )
   lapply(selector_list, check_selector)
-  checkmate::assert_class(join_keys, "JoinKeys", null.ok = TRUE)
+  checkmate::assert_class(join_keys, "join_keys", null.ok = TRUE)
   checkmate::assert_integer(idx, len = 1, any.missing = FALSE)
 
   n_selectors <- length(selector_list)
@@ -291,9 +291,11 @@ get_filter_call <- function(filter, dataname = NULL, datasets = NULL) {
     return(NULL)
   }
 
-  stopifnot((!is.null(dataname) && is.null(datasets)) ||
-    (is.null(dataname) && is.null(datasets)) ||
-    (!is.null(datasets) && isTRUE(dataname %in% names(datasets))))
+  stopifnot(
+    (!is.null(dataname) && is.null(datasets)) ||
+      (is.null(dataname) && is.null(datasets)) ||
+      (!is.null(datasets) && isTRUE(dataname %in% names(datasets)))
+  )
 
   get_filter_call_internal <- function(filter, dataname, datasets) {
     if (rlang::is_empty(filter$selected)) {

diff --git a/R/get_merge_call.R b/R/get_merge_call.R
@@ -4,7 +4,7 @@
 #' Returns list of calls depending on selector(s) and type of the merge
 #' Order of merge is the same as in selectors passed to the function.
 #' @inheritParams merge_datasets
-#' @param join_keys (`JoinKeys`) nested list of keys used for joining
+#' @param join_keys (`join_keys`) nested list of keys used for joining
 #' @param dplyr_call_data (`list`) simplified selectors with aggregated set of filters,
 #'
 #' @return (`list` with `call` elements)
@@ -130,7 +130,7 @@ get_merge_key_grid <- function(selector_list, join_keys = teal.data::join_keys()
           get_merge_key_pair(
             selector_from,
             selector_to,
-            join_keys$get(selector_from$dataname, selector_to$dataname)
+            join_keys[selector_from$dataname, selector_to$dataname]
           )
         }
       )

diff --git a/R/merge_datasets.R b/R/merge_datasets.R
@@ -51,7 +51,7 @@ merge_datasets <- function(selector_list, datasets, join_keys, merge_function =
   checkmate::assert_list(selector_list, min.len = 1)
   checkmate::assert_string(anl_name)
   checkmate::assert_list(datasets, names = "named")
-  checkmate::assert_class(join_keys, "JoinKeys")
+  checkmate::assert_class(join_keys, "join_keys")
   stopifnot(attr(regexec("[A-Za-z0-9\\_]*", anl_name)[[1]], "match.length") == nchar(anl_name))
   lapply(selector_list, check_selector)
   merge_selectors_out <- merge_selectors(selector_list)
@@ -177,10 +177,12 @@ merge_selectors <- function(selector_list) {
         next
       }
       selector_idx2 <- selector_list[[idx2]]
-      if (identical(selector_idx1$dataname, selector_idx2$dataname) &&
-        identical(selector_idx1$reshape, selector_idx2$reshape) &&
-        identical(selector_idx1$filters, selector_idx2$filters) &&
-        identical(selector_idx1$keys, selector_idx2$keys)) {
+      if (
+        identical(selector_idx1$dataname, selector_idx2$dataname) &&
+          identical(selector_idx1$reshape, selector_idx2$reshape) &&
+          identical(selector_idx1$filters, selector_idx2$filters) &&
+          identical(selector_idx1$keys, selector_idx2$keys)
+      ) {
         res_map_idx[idx2] <- idx1
       }
     }
@@ -239,7 +241,7 @@ check_data_merge_selectors <- function(selector_list) {
 #' `merged_selector_list` come from datasets, which don't have the
 #' appropriate join keys in `join_keys`.
 #'
-#' @param join_keys (`JoinKeys`) the provided join keys
+#' @param join_keys (`join_keys`) the provided join keys
 #' @param merged_selector_list (`list`) the specification of datasets' slices to merge
 #'
 #' @return `TRUE` if the provided keys meet the requirements; the `shiny`
@@ -278,7 +280,7 @@ are_needed_keys_provided <- function(join_keys, merged_selector_list) {
   }
 
   do_join_keys_exist <- function(dataset_name1, dataset_name2, join_keys) {
-    length(join_keys$get(dataset_name1, dataset_name2) > 0)
+    length(join_keys[dataset_name1, dataset_name2] > 0)
   }
 
   datasets_names <- vapply(merged_selector_list, function(slice) slice[["dataname"]], FUN.VALUE = character(1))

diff --git a/R/merge_expression_module.R b/R/merge_expression_module.R
@@ -9,7 +9,7 @@
 #' @param datasets (named `list` of `reactive` or non-`reactive` `data.frame`)\cr
 #'  object containing data as a list of `data.frame`. When passing a list of non-reactive `data.frame` objects, they are
 #'  converted to reactive `data.frame` objects internally.
-#' @param join_keys (`JoinKeys`)\cr
+#' @param join_keys (`join_keys`)\cr
 #'  of variables used as join keys for each of the datasets in `datasets`.
 #'  This will be used to extract the `keys` of every dataset.
 #' @param data_extract (named `list` of `data_extract_spec`)\cr
@@ -130,7 +130,7 @@
 #'   }
 #' )
 #' \dontrun{
-#' runApp(app)
+#' shinyApp(app$ui, app$server)
 #' }
 #' @export
 merge_expression_module <- function(datasets,
@@ -171,7 +171,7 @@ merge_expression_module <- function(datasets,
 #' @param datasets (named `list` of `reactive` or non-`reactive` `data.frame`)\cr
 #'  object containing data as a list of `data.frame`. When passing a list of non-reactive `data.frame` objects, they are
 #'  converted to reactive `data.frame` objects internally.
-#' @param join_keys (`JoinKeys`)\cr
+#' @param join_keys (`join_keys`)\cr
 #'  of variables used as join keys for each of the datasets in `datasets`.
 #'  This will be used to extract the `keys` of every dataset.
 #' @param selector_list (`reactive`)\cr
@@ -303,7 +303,7 @@ merge_expression_module <- function(datasets,
 #'   }
 #' )
 #' \dontrun{
-#' runApp(app)
+#' shinyApp(app$ui, app$server)
 #' }
 merge_expression_srv <- function(id = "merge_id",
                                  selector_list,
@@ -315,7 +315,7 @@ merge_expression_srv <- function(id = "merge_id",
   stopifnot(make.names(anl_name) == anl_name)
   checkmate::assert_class(selector_list, "reactive")
   checkmate::assert_list(datasets, types = c("reactive", "data.frame"), names = "named")
-  checkmate::assert_class(join_keys, "JoinKeys")
+  checkmate::assert_class(join_keys, "join_keys")
 
   moduleServer(
     id,

diff --git a/R/resolve.R b/R/resolve.R
@@ -64,7 +64,7 @@
 #'   teal.transform:::resolve(arm_ref_comp, data_list, keys)
 #' })
 resolve <- function(x, datasets, keys = NULL) {
-  checkmate::assert_list(datasets, type = "reactive", min.len = 1, names = "named")
+  checkmate::assert_list(datasets, types = "reactive", min.len = 1, names = "named")
   checkmate::assert_list(keys, "character", names = "named", null.ok = TRUE)
   checkmate::assert(
     .var.name = "keys",

diff --git a/R/resolve_delayed.R b/R/resolve_delayed.R
@@ -83,7 +83,7 @@ resolve_delayed.FilteredData <- function(x,
 
 #' @export
 resolve_delayed.list <- function(x, datasets, keys = NULL) {
-  checkmate::assert_list(datasets, type = c("reactive", "data.frame"), min.len = 1, names = "named")
+  checkmate::assert_list(datasets, types = c("reactive", "data.frame"), min.len = 1, names = "named")
   checkmate::assert_list(keys, "character", names = "named", null.ok = TRUE)
   checkmate::assert(
     .var.name = "keys",

diff --git a/R/utils.R b/R/utils.R
@@ -139,7 +139,7 @@ extract_choices_labels <- function(choices, values = NULL) {
 #'   }
 #' )
 #' if (interactive()) {
-#'   runApp(app)
+#'   shinyApp(app$ui, app$server)
 #' }
 compose_and_enable_validators <- function(iv, selector_list, validator_names = NULL) {
   if (is.null(validator_names)) {

diff --git a/man/are_needed_keys_provided.Rd b/man/are_needed_keys_provided.Rd
diff --git a/man/compose_and_enable_validators.Rd b/man/compose_and_enable_validators.Rd
diff --git a/man/data_extract_multiple_srv.Rd b/man/data_extract_multiple_srv.Rd
diff --git a/man/data_extract_srv.Rd b/man/data_extract_srv.Rd
diff --git a/man/get_dplyr_call.Rd b/man/get_dplyr_call.Rd
diff --git a/man/get_dplyr_call_data.Rd b/man/get_dplyr_call_data.Rd
diff --git a/man/get_merge_call.Rd b/man/get_merge_call.Rd
diff --git a/man/get_merge_key_grid.Rd b/man/get_merge_key_grid.Rd
diff --git a/man/get_rename_call.Rd b/man/get_rename_call.Rd
diff --git a/man/get_reshape_call.Rd b/man/get_reshape_call.Rd
diff --git a/man/merge_datasets.Rd b/man/merge_datasets.Rd