1380 negative datanames2

[gogonzo]

Closes #1380
Alternative to #1426

This PR provides a solution to the comment here

With @averissimo we considered that maybe module shouldn't automatically inherit parent (modules) datanames so that this could be possible:

modules(
  label = "m1",
  modules(
    label = "m1.1",
    module(label = "m1.1.1") |> set_datanames("-c")
  ) |> set_datanames("-b")
) |> set_datanames("-a")

# TEAL ROOT
# |- Datasets         : -a
#   L- m1.1
#   |- Datasets         : -b
#      L- m1.1.1
#         |- Datasets         : -c
#         |- Properties:
#         |  |- Bookmarkable  : FALSE
#         |  L- Reportable    : FALSE
#         |- UI Arguments     : 
#         |- Server Arguments : 
#         L- Transformators 

Above code sets datanames attribute via set_datanames but not recursively. datanames are set to the teal_modules or teal_module object and they stay there. When the teal_module is called, then inheritance is applied from the root to the teal_module. It means there are possible following datanames configuration:

# real code
modules(
  modules(
    label = "mods1",
    modules(
      label = "mods1.1",
      module(label = "1.1.1", datanames = "all")
    ) |> set_datanames("-b")
  ) |> set_datanames("-a")
) |> set_datanames("all")

# pseudocode
root: all,
  mods1: -a                    # all datasets except a
    mods1.1: -b                # all datasets except a(inherited), b
      mod1.1.1:  "all"         # all except a,b (inherited)  

There are other cases possible which involved mixed positive and negative selection. For example:

1. Modules with positive selection doesn't care about datanames selection in ancestors

root: all
  mods1: -a, -b      # all except a and b
    mods1.1: a, b    # a and b (ignores inherited)
      mod1.1.1: all  # a and b (inherited)

2. Negative selection substracts from inherited set

root: all
  mods1: a, b, c       # a, b, c
    mods1.1: -c        # a, b ([a, b, c] - [c])
      mod1.1.1: all    # a and b (inherited)

example app

options(
  teal.log_level = "TRACE",
  teal.show_js_log = TRUE,
  # teal.bs_theme = bslib::bs_theme(version = 5),
  shiny.bookmarkStore = "server"
)

# pkgload::load_all("teal.data")
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(
    modules(
      label = "no CO2 (inherited)",
      modules(
        label = "no iris (inherited)",
        example_module(label = "no co2 nor iris", datanames = "all")
      ) |> set_datanames("-iris")
    ) |> set_datanames("-CO2"),
    reporter_previewer_module()
  ),
  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)

[gogonzo]

How many modules are out there having datanames = "all"