r cmd check

Author: gogonzo

DESCRIPTION

@@ -21,6 +21,7 @@ BugReports: https://github.com/insightsengineering/teal.transform/issues
 Depends:
     R (>= 3.6)
 Imports:
+    bsicons,
     checkmate (>= 2.1.0),
     dplyr (>= 1.1.0),
     htmltools,
@@ -30,20 +31,25 @@ Imports:
     shiny (>= 1.6.0),
     shinyjs (>= 2.1.0),
     shinyvalidate (>= 0.1.3),
+    shinyWidgets,
     stats,
     teal,
+    teal.code,
     teal.data (>= 0.8.0),
     teal.logger (>= 0.4.0),
     teal.widgets (>= 0.5.0),
     tidyr (>= 1.0.0),
     tidyselect (>= 1.2.1),
-    utils
+    utils,
+    yaml
 Suggests:
     bslib (>= 0.8.0),
     knitr (>= 1.42),
     rmarkdown (>= 2.23),
+    rvest,
     roxy.shinylive (>= 1.0.0),
     testthat (>= 3.1.5),
+    tibble,
     withr (>= 2.0.0)
 VignetteBuilder:
     knitr,

NAMESPACE

@@ -1,10 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method(.is.delayed,default)
-S3method(.is.delayed,list)
-S3method(.is.delayed,pick)
+S3method(.is_delayed,default)
+S3method(.is_delayed,list)
+S3method(.is_delayed,pick)
 S3method(.picker_icon,Date)
-S3method(.picker_icon,MultiAssayExperiment)
 S3method(.picker_icon,POSIXct)
 S3method(.picker_icon,POSIXlt)
 S3method(.picker_icon,character)
@@ -21,7 +20,6 @@ S3method(data_extract_multiple_srv,reactive)
 S3method(data_extract_srv,FilteredData)
 S3method(data_extract_srv,list)
 S3method(determine,datasets)
-S3method(determine,mae_data)
 S3method(determine,values)
 S3method(determine,variables)
 S3method(filter_spec_internal,default)
@@ -77,7 +75,6 @@ export(datasets)
 export(filter_spec)
 export(first_choice)
 export(first_choices)
-export(format)
 export(format_data_extract)
 export(get_anl_relabel_call)
 export(get_dataset_prefixed_col_names)
@@ -90,12 +87,10 @@ export(is_single_dataset)
 export(last_choice)
 export(last_choices)
 export(list_extract_spec)
-export(mae_data)
 export(merge_datasets)
 export(merge_expression_module)
 export(merge_expression_srv)
 export(merge_srv)
-export(no_more_choices_than)
 export(no_selected_as_NULL)
 export(picks)
 export(picks_srv)
@@ -107,6 +102,7 @@ export(select_spec.default)
 export(select_spec.delayed_data)
 export(split_by_sep)
 export(teal_transform_filter)
+export(tm_merge)
 export(value_choices)
 export(values)
 export(variable_choices)

R/0-as_picks.R

@@ -1,8 +1,8 @@
 #' Convert data_extract_spec to picks
 #'
 #' Helper functions to ease transition between [data_extract_spec()] and [picks()].
+#' @inheritParams teal::teal_transform_module
 #' @param x (`data_extract_spec`, `select_spec`, `filter_spec`) object to convert to [`picks`]
-#'
 #' @details
 #' With introduction of [`picks`], [`data_extract_spec`] will no longer serve a primary tool to
 #' define variable choices and default selection in teal-modules and eventually [`data_extract_spec`]
@@ -51,18 +51,18 @@
 #' )
 #'
 #' @export
-as.picks <- function(x, ...) {
+as.picks <- function(x) { # nolint
   if (inherits(x, c("picks", "pick"))) {
     x
   } else if (checkmate::test_list(x, c("data_extract_spec", "filter_spec"))) {
-    Filter(length, lapply(x, as.picks, ...))
+    Filter(length, lapply(x, as.picks))
   } else if (inherits(x, "data_extract_spec")) {
     args <- Filter(
       length,
       list(
         datasets(choices = x$dataname, fixed = TRUE),
         as.picks(x$select),
-        as.picks(x$filter, dataname = x$dataname)
+        as.picks(x$filter)
         # filter_spec as they are not necessary linked with `select` (selected variables)
         #  as filter_spec can be specified on the variable(s) different than select_spec for example:
         #  for example: #pseudocode select = select_spec(AVAL); filter = filter_spec(PARAMCD))
@@ -72,7 +72,6 @@ as.picks <- function(x, ...) {
   } else if (inherits(x, "select_spec")) {
     .select_spec_to_variables(x)
   } else if (inherits(x, "filter_spec")) {
-    dataname <- list(...)$dataname
     # warning
     warning(
       "`filter_spec` are not convertible to picks - please use `transformers` argument",
@@ -113,7 +112,7 @@ as.picks <- function(x, ...) {
 teal_transform_filter <- function(x, label = "Filter") {
   checkmate::assert_multi_class(x, c("data_extract_spec", "picks"))
   if (inherits(x, "data_extract_spec")) {
-    lapply(as.picks.filter(x), teal_transform_filter, label = label)
+    lapply(.as.picks.filter(x), teal_transform_filter, label = label)
   } else {
     checkmate::assert_true("values" %in% names(x))
     teal::teal_transform_module(
@@ -123,11 +122,10 @@ teal_transform_filter <- function(x, label = "Filter") {
         picks_ui(ns("transformer"), picks = x, container = div)
       },
       server <- function(id, data) {
-        moduleServer(id, function(input, output, session) {
+        shiny::moduleServer(id, function(input, output, session) {
           selector <- picks_srv("transformer", picks = x, data = data)
           reactive({
             req(data(), selector())
-            # todo: make sure filter call is not executed when setequal(selected, all_possible_choices)
             filter_call <- .make_filter_call(
               datasets = selector()$datasets$selected,
               variables = selector()$variables$selected,
@@ -141,7 +139,7 @@ teal_transform_filter <- function(x, label = "Filter") {
   }
 }
 
-as.picks.filter <- function(x, dataname) {
+.as.picks.filter <- function(x, dataname) { # nolint
   if (inherits(x, "filter_spec")) {
     if (inherits(x$choices, "delayed_data")) {
       warning(
@@ -163,12 +161,12 @@ as.picks.filter <- function(x, dataname) {
       values(choices = x$choices, selected = x$selected, multiple = x$multiple)
     )
   } else if (checkmate::test_list(x, "filter_spec")) {
-    lapply(x, as.picks.filter, dataname = dataname)
+    lapply(x, .as.picks.filter, dataname = dataname)
   } else if (inherits(x, "data_extract_spec")) {
-    as.picks.filter(x$filter, dataname = x$dataname)
+    .as.picks.filter(x$filter, dataname = x$dataname)
   } else if (checkmate::test_list(x, c("data_extract_spec", "list", "NULL"))) {
     unlist(
-      lapply(Filter(length, x), as.picks.filter),
+      lapply(Filter(length, x), .as.picks.filter),
       recursive = FALSE
     )
   }

R/0-badge_dropdown.R

@@ -1,13 +1,13 @@
-#' Dropdown badge
+#' Drop-down badge
 #'
-#' Dropdown button in a form of a badge with `bg-primary` as default style
-#' Clicking badge shows a dropdown containing any `HTML` element. Folded dropdown
+#' Drop-down button in a form of a badge with `bg-primary` as default style
+#' Clicking badge shows a drop-down containing any `HTML` element. Folded drop-down
 #' doesn't trigger display output which means that items rendered using `render*`
-#' will be recomputed only when dropdown is show.
+#' will be recomputed only when drop-down is show.
 #'
 #' @param id (`character(1)`) shiny module's id
 #' @param label (`shiny.tag`) Label displayed on a badge.
-#' @param ... (`shiny.tag`) Content of a dropdown.
+#' @param content (`shiny.tag`) Content of a drop-down.
 #' @keywords internal
 badge_dropdown <- function(id, label, content) {
   ns <- shiny::NS(id)
@@ -28,7 +28,11 @@ badge_dropdown <- function(id, label, content) {
       htmltools::tags$div(
         content,
         id = ns("inputs_container"),
-        style = "visibility: hidden; opacity: 0; pointer-events: none; position: absolute; background: white; border: 1px solid #ccc; border-radius: 4px; box-shadow: 0 2px 10px rgba(0,0,0,0.1); padding: 10px; z-index: 1000; min-width: 200px; transition: opacity 0.2s ease;",
+        style = paste(
+          "visibility: hidden; opacity: 0; pointer-events: none; position: absolute; background: white;",
+          "border: 1px solid #ccc; border-radius: 4px; box-shadow: 0 2px 10px rgba(0,0,0,0.1);",
+          "padding: 10px; z-index: 1000; min-width: 200px; transition: opacity 0.2s ease;"
+        )
       )
     )
   )

R/0-call_utils.R

@@ -241,8 +241,8 @@ calls_combine_by <- function(operator, calls) {
   )
 }
 
-.call_dplyr_filter <- function(A) {
-  predicates <- lapply(unname(A), function(x) {
+.call_dplyr_filter <- function(x) {
+  predicates <- lapply(unname(x), function(x) {
     if (is.numeric(x$values)) {
       call_condition_range(varname = x$variables, range = x$values)
     } else if (inherits(x$values, "Date")) {

R/0-mae-methods.R

@@ -27,17 +27,15 @@
 #'   Default is `"dplyr::inner_join"`. The function must accept `by` and `suffix` parameters.
 #'
 #' @return A `list` with two reactive elements:
-#' \describe{
-#'   \item{`data`}{A `reactive` returning a [teal.data::teal_data] object containing the merged dataset.
+#'  - `data`A `reactive` returning a [teal.data::teal_data] object containing the merged dataset.
 #'     The merged dataset is named according to `output_name` parameter. The `teal_data` object includes:
 #'     - The merged dataset with all selected variables
 #'     - Complete R code to reproduce the merge operation
-#'     - Updated join keys reflecting the merged dataset structure}
-#'   \item{`variables`}{A `reactive` returning a named list mapping selector names to their selected
+#'     - Updated join keys reflecting the merged dataset structure
+#'  - `variables` A `reactive` returning a named list mapping selector names to their selected
 #'     variables in the merged dataset. The structure is:
 #'     `list(selector_name_1 = c("var1", "var2"), selector_name_2 = c("var3", "var4"), ...)`.
-#'     Variable names reflect any renaming that occurred during the merge to avoid conflicts.}
-#' }
+#'     Variable names reflect any renaming that occurred during the merge to avoid conflicts.
 #'
 #' @section How It Works:
 #'
@@ -63,7 +61,7 @@
 #'    - Joins datasets using specified join function and join keys
 #'    - Maintains reproducibility through generated R code
 #'
-#' 6. **Updates Join Keys**: Creates new join key relationships for the merged dataset ("anl")
+#' 6. **Updates Join Keys**: Creates new join key relationships for the merged dataset (`"anl"`)
 #'    relative to remaining datasets in the `teal_data` object
 #'
 #' 7. **Tracks Variables**: Keeps track of the variable names in the merged dataset
@@ -142,7 +140,6 @@
 #' - [teal.data::join_keys()] for defining dataset relationships
 #'
 #' @examples
-#' \dontrun{
 #' # Complete example with CDISC data
 #' library(teal.transform)
 #' library(teal.data)
@@ -195,14 +192,11 @@
 #'     merged$variables()
 #'   })
 #' }
-#'
-#' shinyApp(ui, server)
+#' if (interactive()) {
+#'   shinyApp(ui, server)
 #' }
 #'
 #' @export
-# todo: merge_ui to display error message somewhere (at least)
-#       - if this dataset has no join_keys to anl (anl_datasets) then error saying
-#         can't merge {dataset} with merged dataset composed of {anl_datasets}
 merge_srv <- function(id,
                       data,
                       selectors,
@@ -298,14 +292,13 @@ merge_srv <- function(id,
     this_variables <- this_variables[!duplicated(unname(this_variables))] # because unique drops names
 
     this_call <- .call_dplyr_select(dataname = dataname, variables = this_variables)
-    # todo: make sure filter call is not executed when setequal(selected, all_possible_choices)
     this_call <- calls_combine_by("%>%", c(this_call, .call_dplyr_filter(this_filter_mapping)))
 
     if (i > 1) {
       anl_vs_this <- setdiff(anl_primary_keys, this_primary_keys)
       this_vs_anl <- setdiff(this_primary_keys, anl_primary_keys)
       if (length(anl_vs_this) && length(this_vs_anl)) {
-        # validate(need(FALSE, "cartesian join")) # todo: add more info
+        warning("cartesian join - happens when primary keys A is not a subset of B and B is not a subset of A")
       }
       this_call <- as.call(
         list(
@@ -489,7 +482,7 @@ merge_srv <- function(id,
       need(
         FALSE,
         sprintf(
-          "Cannot merge datasets. The following dataset%s no join keys defined: %s.\n\nPlease define join keys using teal.data::join_keys().",
+          "Cannot merge datasets. The following dataset%s no join keys defined: %s.\n\nPlease define `join_keys`.",
           if (length(datasets_without_keys) == 1) " has" else "s have",
           paste(sprintf("'%s'", datasets_without_keys), collapse = ", ")
         )
@@ -517,7 +510,10 @@ merge_srv <- function(id,
         need(
           FALSE,
           sprintf(
-            "Cannot merge dataset '%s'. No join keys found between '%s' and any of the accumulated datasets: %s.\n\nPlease define join keys using teal.data::join_keys().",
+            paste(
+              "Cannot merge dataset '%s'. No join keys found between '%s' and any of the accumulated datasets:",
+              "%s.\n\nPlease define join keys using teal.data::join_keys()."
+            ),
             current_dataset,
             current_dataset,
             paste(sprintf("'%s'", accumulated), collapse = ", ")
@@ -535,7 +531,7 @@ merge_srv <- function(id,
 
 .validate_is_eager <- function(x) {
   validate(need(
-    !.is.delayed(x),
+    !.is_delayed(x),
     "selected values have not been resolved correctly. Please report this issue to an app-developer."
   ))
 }