Skip to content

[Bug]: choices_labelled are poorly encapsulated #281

@gogonzo

Description

@gogonzo

Faulty delayed filter_spec

It is not clear how des-engine handles dynamic specs. Output is unpredictable, see multiple scenarios:

filter_spec(vars <choices_selected, choices , selected )

In the code below valid des-code is presented. Following code produces filter:

  • for dataset "ADRS"
  • any factor variable (first selected on init)
  • choices (factor levels) are resolved automatically when vars <variable_choices> choices <NULL>
code
data_extract_spec(
  dataname = "ADRS",
  filter = filter_spec(
    label = "Select endpoints:",
    vars = choices_selected(
      choices = variable_choices("ADRS", subset = function(data) names(Filter(is.factor, data))),
      selected = first_choice()
    ),
    choices = NULL,
    selected = NULL,
    multiple = TRUE
  )
)
Image

filter_spec(vars <choices_selected, choices <value_choices>, selected )

When choices or selected is specified, then module fails to produce input, including input for vars, for example following code will produce following:

code
data_extract_spec(
  dataname = "ADRS",
  filter = filter_spec(
    label = "Select endpoints:",
    vars = choices_selected(
      choices = variable_choices("ADRS", subset = function(data) names(Filter(is.factor, data))),
      selected = first_choice()
    ),
    choices = value_choices(
      "ADRS",
      var_choices = "AGEU",
      subset = function(data) unique(data$AGEU)[1]
    ),
    selected = NULL,

    selected = value_choices(
      "ADRS",
      var_choices = variable_choices("ADRS", subset = function(data) names(Filter(is.factor, data))[2])
    ),
    multiple = TRUE
  ),
  select = select_spec(
    choices = variable_choices("ADRS", c("AVALC", "AVAL")),
    selected = "AVALC",
    multiple = FALSE
  )
)
Image

IMO this hierarchical resolve is unpredictable. I understand that filter_spec(choices = NULL, selected = NULL) means "default" specification.


Repeating dataset/variables is redundant and buggy

For example I can set data_extract_spec(dataname = "ADSL", filter = select_spec(choices = variable_choices("ADRS"))). This is crazy, that variable_choices("ADRS") "pulls" dataset instead of being given by "parent". This means that one can select different datasets in data_extract_spec() and in variable_choices()

a = data_extract_spec(
  dataname = "ADSL",
  select = select_spec(
    choices = variable_choices("ADRS"),
    selected = NULL,
    multiple = FALSE
  )
)
Image

What to do

  1. variable_choices(data) should be empty for delayed choices
  2. values_choices(data, var_choices) both should be empty for delayed choices
  3. values_choices(subset) should be a function of column not a data (resolve should hand over current variable set in filter_spec(vars)

Check the app below and test locally different specifications of filter_spec/select_spec

testing app
tm_extract <- function(label = "PR merge",
                       info = NULL,
                       dataname = NULL,
                       data_extract,
                       pre_output = NULL,
                       post_output = NULL) {
  args <- as.list(environment())
  args$data_extract_call <- styler::style_text(
    strsplit(
      # Line break after every brace
      gsub(
        "\\((d|s|f)", "(\n\\1",
        # Line break after each function input value definition
        gsub(
          "\\,\\s([^\\=]+\\s\\=\\s)", ",\n\\1",
          paste(capture.output(match.call()$data_extract), collapse = " ")
        )
      ),
      split = "\n"
    )[[1]]
  ) |> paste(collapse = "\n")

  mod <- module(
    label = label,
    server = srv_extract,
    ui = ui_extract,
    ui_args = args,
    server_args = list(dataname = dataname, data_extract = data_extract, data_extract_call = args$data_extract_call),
    datanames = "all"
  )
  attr(mod, "teal_bookmarkable") <- TRUE
  mod
}


ui_extract <- function(id, ...) {
  arguments <- list(...)
  ns <- NS(id)
  teal.widgets::standard_layout(
    output = teal.widgets::white_small_well(
      h4("data_extract_spec"),
      verbatimTextOutput(ns("data_extract_spec")),
      h4("data_extract output"),
      verbatimTextOutput(ns("data_extract_out")),
      h4("data merge expr"),
      verbatimTextOutput(ns("merge_expr"))
    ),
    encoding = div(
      lapply(
        names(arguments$data_extract),
        function(i) {
          data_extract_ui(
            id = ns(i),
            label = paste0("Selector ", i),
            data_extract_spec = list(arguments$data_extract[[i]])
          )
        }
      )
    )
  )
}

srv_extract <- function(input, output, session, data, dataname, data_extract, data_extract_call) {
  selector_list <- teal.transform::data_extract_multiple_srv(data_extract, datasets = data)
  merged_expr <- teal.transform::merge_expression_srv(selector_list = selector_list, data = data)
  output$data_extract_spec <- renderText(data_extract_call)
  output$data_extract_out <- renderText({
    yaml::as.yaml(
      lapply(
        selector_list(),
        function(x) x()[names(x()) != "iv"]
      )
    )
  })
  output$merge_expr <- renderText(paste(merged_expr()$expr, collapse = "\n"))
}

library(teal)
library(teal.transform)
# pkgload::load_all("temp/teal.transform")
library(scda)
library(dplyr)

data <- teal_data() |> within({
  library(scda)
  ADSL <- synthetic_cdisc_data("latest")$adsl
  ADLB <- synthetic_cdisc_data("latest")$adlb
  ADTTE <- synthetic_cdisc_data("latest")$adtte
  ADRS <- synthetic_cdisc_data("latest")$adrs
  ADLB <- mutate(ADLB, AVAL2 = 2 * AVAL)
  ADTTE <- mutate(ADTTE, AVAL2 = 2 * AVAL)
})
join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADLB", "ADTTE", "ADRS")]


app <- init(
  data = data,
  modules = modules(
    # single wide ----
    modules(
      label = "Single wide dataset",
      tm_extract(
        label = "Dynamic filter",
        dataname = "ADSL",
        data_extract = list(
          a = data_extract_spec(
            dataname = "ADSL",
            filter = filter_spec(
              label = "Select endpoints:",
              vars = choices_selected(
                choices = variable_choices("ADRS", subset = function(data) names(Filter(is.factor, data))),
                selected = first_choice() # first is AGEU
              ), 
              choices = NULL,
              selected = NULL,
              # choices = value_choices(
              #   "ADRS",
              #   var_choices = "AGEU",
              #   subset = function(data) unique(data$AGEU)[1]
              # ),
              # choices = value_choices(
              #   "ADRS",
              #   var_choices = variable_choices("ADRS", subset = function(data) names(Filter(is.factor, data))[2])
              # ),

              # selected = value_choices(
              #   "ADRS",
              #   var_choices = variable_choices("ADRS", subset = function(data) names(Filter(is.factor, data))[1])
              # ),
              multiple = TRUE
            ),
            select = select_spec(
              choices = variable_choices("ADRS"),
              selected = NULL,
              multiple = FALSE
            )
          )
        )
      )
    )
  )
)

runApp(app)

Metadata

Metadata

Assignees

No one assigned

    Labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions