Skip to content

[Bug]: choices_labelled are poorly encapsulated #281

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)

Activity

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

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