233 delayed value choices

[chlebowa]

Closes #233

Opened value_choices(var_choices) to accept delayed_data.
Added a step in resolve.delayed_value_choices to resolve var_choices.
Added delayed_data class to delayed_choices functions.
Modified delayed_choices functions to return delayed_choices as is.
Modified delayed_choices functions to return arguments where x$subset is NULL as is.

Some minor adjustments.

[gogonzo]

This fixes the problem. I've checked with an example app. I need more time to analyse the workflow and see if there is anything else needed.

example app

options(
  shiny.bookmarkStore = "server",
  teal.log_level = logger::DEBUG
)

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)
pkgload::load_all("temp/teal.transform")

data <- teal_data_module(
  ui = function(id) NULL,
  server = function(id) {
    reactive({
      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 <- dplyr::mutate(ADLB, AVAL2 = 2 * AVAL)
        ADTTE <- dplyr::mutate(ADTTE, AVAL2 = 2 * AVAL)
      })
      datanames(data) <- c("ADSL", "ADLB", "ADTTE", "ADRS")
      join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADLB", "ADTTE", "ADRS")]

      data
    })
  }
)

app <- init(
  data = data,
  modules = modules(
    # single wide ----
    modules(
      label = "Single wide dataset",
      tm_extract(
        label = "dynamic input",
        data_extract = list(
          a = data_extract_spec(
            dataname = "ADSL",
            select = select_spec(
              choices = variable_choices("ADSL"),
              selected = "AGE"
            ),
            filter = filter_spec(
              vars = choices_selected(
                choices = variable_choices("ADSL", subset = function(data) {
                  names(Filter(function(x) is.factor(x) && length(levels(x)) > 1, data))
                }),
                selected = first_choice()
              ),
              choices = value_choices(
                "ADSL",
                var_choices = variable_choices("ADSL", subset = function(data) {
                  names(Filter(function(x) is.factor(x) && length(levels(x)) > 1, data))[1]
                })
              )
            )
          )
        )
      )
    )
  )
)

runApp(app)

[gogonzo]

Good job. Thanks for a fix! 👍