negative datanames selection

[gogonzo]

closes #1380

Feature set_datanames has a limited effect because of the fact that modules can have $datanames slot set to names which are absolutely crucial for module to work. This is why we allow using set_datanames when $datanames == "all". Adding "negative selection" will also have limited effect for the same reason but the code complication seems big enough to not recommend this feature.

pkgload::load_all("teal")

trans <- list(
  anl_w_datanames = teal_transform_module(
    label = "ANL with datanames",
    ui = function(id) {
      ns <- NS(id)
      tagList(
        div("This transformer adds ANL based on specified ADSL, ADTTE"),
        numericInput(ns("obs"), "Number of subjects", value = 400, min = 0, max = 400)
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          within(data(),
            {
              ANL <- dplyr::inner_join(
                head(ADSL, nobs),
                ADTTE[c("STUDYID", "USUBJID", setdiff(colnames(ADTTE), colnames(ADSL)))],
                by = c("USUBJID", "STUDYID")
              )
            },
            nobs = input$obs
          )
        })
      })
    },
    datanames = "ADTTE"
  ),
  anl_wout_datanames = teal_transform_module(
    label = "ANL without datanames",
    ui = function(id) {
      ns <- NS(id)
      tagList(
        div("This transformer adds ANL based on unspecified ADSL, ADTTE"),
        numericInput(ns("obs"), "Number of subjects", value = 400, min = 0, max = 400)
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          within(data(),
            {
              ANL <- dplyr::inner_join(
                head(ADSL, nobs),
                ADTTE[c("STUDYID", "USUBJID", setdiff(colnames(ADTTE), colnames(ADSL)))],
                by = c("USUBJID", "STUDYID")
              )
            },
            nobs = input$obs
          )
        })
      })
    }
  ),
  adsl_w_datanames = teal_transform_module(
    label = "modify ADSL",
    ui = function(id) {
      ns <- NS(id)
      tagList(
        div("This transformer modifies ADSL based on specified ADTTE")
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          within(data(),
            {
              ADTTE_summary <- ADTTE |>
                dplyr::group_by(STUDYID, USUBJID) |>
                dplyr::summarize(PARAMCD_AVAL = paste(paste(PARAMCD, "-", AVAL), collapse = "; "))
              ADSL <- dplyr::left_join(ADSL, ADTTE_summary)
            },
            nobs = input$obs
          )
        })
      })
    },
    datanames = c("ADSL", "ADTTE")
  ),
  adsl_wout_datanames = teal_transform_module(
    label = "modify ADSL",
    ui = function(id) {
      ns <- NS(id)
      tagList(
        div("This transformer modifies ADSL based on unspecified ADTTE")
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          within(data(),
            {
              ADTTE_summary <- ADTTE |>
                dplyr::group_by(STUDYID, USUBJID) |>
                dplyr::summarize(PARAMCD_AVAL = paste(sprintf("%s - %.2f", PARAMCD, AVAL), collapse = "; "))
              ADSL <- dplyr::left_join(ADSL, ADTTE_summary)
            },
            nobs = input$obs
          )
        })
      })
    },
    datanames = "ADSL"
  )
)

data <- teal_data_module(
  once = FALSE,
  ui = function(id) {
    ns <- NS(id)
    tagList(
      numericInput(ns("obs"), "Number of observations to show", 1000),
      actionButton(ns("submit"), label = "Submit")
    )
  },
  server = function(id, ...) {
    moduleServer(id, function(input, output, session) {
      logger::log_trace("example_module_transform2 initializing.")
      eventReactive(input$submit, {
        data <- teal_data(a = NULL) |>
          within(
            {
              logger::log_trace("Loading data")
              ADSL <- head(teal.data::rADSL, n = n)
              ADTTE <- teal.data::rADTTE
              iris <- iris
              .iris_raw <- iris
              CO2 <- CO2
              factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L))))
              CO2[factors] <- lapply(CO2[factors], as.character)
            },
            n = as.numeric(input$obs)
          )
        join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")]
        data
      })
    })
  }
)

app <- teal::init(
  data = data,
  modules = modules(
    example_module("all", datanames = "all"),
    example_module("null", datanames = NULL),
    example_module("adtte", datanames = "ADTTE"),
    example_module("adsl", datanames = "ADSL"),
    example_module("adsl+adtte", datanames = c("ADSL", "ADTTE")),
    example_module("inexisting+existing", datanames = c("ADTTE", "inexisting")),
    example_module("anl - transform w/ datanames", dataname = "ANL", transformators = trans["anl_w_datanames"]),
    example_module("anl - transform w/o datanames", dataname = "ANL", transformators = trans["anl_wout_datanames"]),
    example_module("adsl - transform w/ datanames", dataname = "ADSL", transformators = trans["adsl_w_datanames"]),
    example_module("adsl - transform w/o datanames", dataname = "ADSL", transformators = trans["adsl_wout_datanames"]),
    example_module("inexisting", datanames = "inexisting"),
    reporter_previewer_module()
  ) |> set_datanames("-ADTTE"),
  filter = teal_slices(
    teal_slice("ADSL", "SEX"),
    teal_slice("ADSL", "AGE", selected = c(18L, 65L)),
    teal_slice("ADTTE", "PARAMCD", selected = "CRSD"),
    include_varnames = list(
      ADSL = c("SEX", "AGE")
    )
  )
)

runApp(app)

[github-actions]

Code Coverage Summary

Filename                          Stmts    Miss  Cover    Missing
------------------------------  -------  ------  -------  ----------------------------------------------------------------------------------------------------------------------------------------
R/checkmate.R                        24       0  100.00%
R/dummy_functions.R                  67      11  83.58%   41, 43, 85-93
R/get_rcode_utils.R                  12       0  100.00%
R/include_css_js.R                   22      17  22.73%   12-38, 76-82
R/init.R                             99      42  57.58%   150-159, 161, 173-194, 219-222, 229-235, 238-239, 241
R/landing_popup_module.R             25      25  0.00%    61-87
R/module_bookmark_manager.R         158     127  19.62%   47-68, 88-138, 143-144, 156, 203, 238-315
R/module_data_summary.R             203      37  81.77%   26-54, 68, 78, 232, 263-267
R/module_filter_data.R               64       2  96.88%   22-23
R/module_filter_manager.R           230      57  75.22%   56-62, 73-82, 90-95, 108-112, 117-118, 291-314, 340, 367, 379, 386-387
R/module_init_data.R                 74       0  100.00%
R/module_nested_tabs.R              226      85  62.39%   40-136, 168, 193-195, 312, 344
R/module_snapshot_manager.R         216     146  32.41%   89-95, 104-113, 121-133, 152-153, 170-180, 184-199, 201-208, 215-230, 234-238, 240-246, 249-262, 265-273, 303-317, 320-331, 334-340, 354
R/module_teal_data.R                149      76  48.99%   41-144
R/module_teal_lockfile.R            131      44  66.41%   32-36, 44-56, 59-61, 75, 85-87, 99-101, 109-118, 121, 123, 125-126, 160-161
R/module_teal_with_splash.R          12      12  0.00%    22-38
R/module_teal.R                     195      87  55.38%   48-143, 158, 184-185, 224
R/module_transform_data.R           110       4  96.36%   20, 59, 129-130
R/modules.R                         282      75  73.40%   171-175, 230-233, 354-374, 382, 532-538, 551-559, 574-628, 661, 673-681
R/reporter_previewer_module.R        19       2  89.47%   30, 34
R/show_rcode_modal.R                 24      24  0.00%    17-42
R/tdata.R                            14      14  0.00%    19-61
R/teal_data_module-eval_code.R       24       0  100.00%
R/teal_data_module-within.R           7       0  100.00%
R/teal_data_module.R                 20       0  100.00%
R/teal_data_utils.R                  10       0  100.00%
R/teal_reporter.R                    68       6  91.18%   69, 77, 125-126, 129, 146
R/teal_slices-store.R                29       0  100.00%
R/teal_slices.R                      63       0  100.00%
R/teal_transform_module.R            45       0  100.00%
R/TealAppDriver.R                   353     353  0.00%    52-735
R/utils.R                           253      38  84.98%   405-454
R/validate_inputs.R                  32       0  100.00%
R/validations.R                      58      37  36.21%   110-377
R/zzz.R                              15      11  26.67%   4-18
TOTAL                              3333    1332  60.04%

Diff against main

Filename       Stmts    Miss  Cover
-----------  -------  ------  -------
R/modules.R       +4      +4  -1.06%
TOTAL             +4      +4  -0.07%

Results for commit: 0d776a4

Minimum allowed coverage is 80%

♻️ This comment has been updated with latest results

[github-actions]

Unit Tests Summary

  1 files   27 suites   8m 59s ⏱️
275 tests 257 ✅ 18 💤 0 ❌
501 runs  483 ✅ 18 💤 0 ❌

Results for commit 0d776a4.

♻️ This comment has been updated with latest results.

[github-actions]

Unit Test Performance Difference

Test Suite	$Status$	Time on main	$±Time$	$±Tests$	$±Skipped$	$±Failures$	$±Errors$
shinytest2-data_summary	💚	$50.92$	$-1.94$	$0$	$0$	$0$	$0$
shinytest2-filter_panel	💚	$42.44$	$-2.21$	$0$	$0$	$0$	$0$
shinytest2-landing_popup	💚	$44.87$	$-1.88$	$0$	$0$	$0$	$0$
shinytest2-module_bookmark_manager	💚	$36.24$	$-2.03$	$0$	$0$	$0$	$0$
shinytest2-modules	💚	$39.09$	$-1.64$	$0$	$0$	$0$	$0$
shinytest2-reporter	💚	$68.21$	$-2.81$	$0$	$0$	$0$	$0$
shinytest2-teal_data_module	💚	$48.52$	$-1.63$	$-1$	$0$	$0$	$0$
shinytest2-wunder_bar	💚	$21.92$	$-1.02$	$0$	$0$	$0$	$0$

Results for commit 1fc760f

♻️ This comment has been updated with latest results.

[gogonzo]

I'll try another solution which will add a datanames attribute to the modules also.

[gogonzo]

This is one is no longer worth a consideration