[Bug] Functional subset for delayed `variable_choices` isn't working for `tm_g_gh_boxplot`

[donyunardi]

Summary

Per documentation, when operating with delayed data, user can create delayed variable_choices using functional subset technique:

https://github.com/insightsengineering/teal.transform/blob/016799c641e9079a4893a95d825d803cd82f6dda/R/choices_labeled.R#L168-L172

#' # functional subset (with delayed data) - return only factor variables
#' variable_choices("ADRS", subset = function(data) {
#'   idx <- vapply(data, is.factor, logical(1))
#'   names(data)[idx]
#' })

However, this doesn't seem to be working with tm_g_gh_boxplot.

During initial investigation, the issue is because the delayed variable_choices was not resolved when executing teal.widgets::optionalSelectInput:

teal.goshawk/R/tm_g_gh_boxplot.R

Lines 311 to 317 in 4917554

	teal.widgets::optionalSelectInput(
	ns("facet_var"),
	label = "Facet by",
	choices = a$facet_var$choices,
	selected = a$facet_var$selected,
	multiple = FALSE
	),

https://github.com/insightsengineering/teal.widgets/blob/2f43fb5fb5bab6974cae4ccc63501c7f74bbd5cf/R/optionalInput.R#L86-L91

We need investigate further on why the functional subset is not being resolved.
https://github.com/insightsengineering/teal.transform/blob/a0db9fc819a36f9d181d8829f16af81a3c41d721/R/choices_labeled.R#L204-L206

It could also be related with teal.goshawk::get_choices function.

Example Code

data <- teal_data_module(
  ui <- function(id) {
    ns <- NS(id)
    actionButton(ns("submit"), "Submit")
  },
  server = function(id) {
    moduleServer(id, function(input, output, session) {
      eventReactive(input$submit, {
        data <- within(
          teal_data(),
          {
            ADLB <- teal.data::rADLB
            ADSL <- teal.data::rADSL

            library(dplyr)
            library(nestcolor)
            library(stringr)
          #'
            # use non-exported function from goshawk
            h_identify_loq_values <- getFromNamespace("h_identify_loq_values", "goshawk")
          #'
            # original ARM value = dose value
            arm_mapping <- list(
              "A: Drug X" = "150mg QD",
              "B: Placebo" = "Placebo",
              "C: Combination" = "Combination"
            )
            set.seed(1)
            ADSL <- rADSL
            ADLB <- rADLB
            var_labels <- lapply(ADLB, function(x) attributes(x)$label)
            ADLB <- ADLB %>%
              mutate(
                AVISITCD = case_when(
                  AVISIT == "SCREENING" ~ "SCR",
                  AVISIT == "BASELINE" ~ "BL",
                  grepl("WEEK", AVISIT) ~ paste("W", str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
                  TRUE ~ as.character(NA)
                ),
                AVISITCDN = case_when(
                  AVISITCD == "SCR" ~ -2,
                  AVISITCD == "BL" ~ 0,
                  grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
                  TRUE ~ as.numeric(NA)
                ),
                AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
                TRTORD = case_when(
                  ARMCD == "ARM C" ~ 1,
                  ARMCD == "ARM B" ~ 2,
                  ARMCD == "ARM A" ~ 3
                ),
                ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))]),
                ARM = factor(ARM) %>% reorder(TRTORD),
                ACTARM = as.character(arm_mapping[match(ACTARM, names(arm_mapping))]),
                ACTARM = factor(ACTARM) %>% reorder(TRTORD),
                ANRLO = 50,
                ANRHI = 75
              ) %>%
              rowwise() %>%
              group_by(PARAMCD) %>%
              mutate(LBSTRESC = ifelse(
                USUBJID %in% sample(USUBJID, 1, replace = TRUE),
                paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC
              )) %>%
              mutate(LBSTRESC = ifelse(
                USUBJID %in% sample(USUBJID, 1, replace = TRUE),
                paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC
              )) %>%
              ungroup()
          #'
            attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
            attr(ADLB[["ACTARM"]], "label") <- var_labels[["ACTARM"]]
            attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
            attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
          #'
            # add LLOQ and ULOQ variables
            ALB_LOQS <- h_identify_loq_values(ADLB, "LOQFL")
            ADLB <- left_join(ADLB, ALB_LOQS, by = "PARAM")

          }
        )
        datanames <- c("ADLB", "ADSL")

        datanames(data) <- datanames
        join_keys(data) <- default_cdisc_join_keys[datanames]
        data
      })
    })
  }
)

# functional subset
cs_facet_var <- choices_selected(
  choices = variable_choices("ADLB", function(data) {
    c("ARM", "AVISITCD", names(data)[26:193])
  }),
  selected = "AVISITCD"
)

app <- init(
  data = data,
  modules = modules(
    tm_g_gh_boxplot(
      label = "Box Plot",
      dataname = "ADLB",
      param_var = "PARAMCD",
      param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
      yaxis_var = choices_selected(c("AVAL", "BASE", "CHG"), "AVAL"),
      xaxis_var = choices_selected(c("ACTARM", "ARM", "AVISITCD", "STUDYID"), "ARM"),
      facet_var = cs_facet_var,
      trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
      loq_legend = TRUE,
      rotate_xlab = FALSE,
      hline_arb = c(60, 55),
      hline_arb_color = c("grey", "red"),
      hline_arb_label = c("default_hori_A", "default_hori_B"),
      hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
      hline_vars_colors = c("pink", "brown", "purple", "black"),
    )
  ),
  title = "my teal app"
)

shinyApp(app$ui, app$server)

Acceptance Criteria

• User can perform functional subset when creating delayed variable_choices/choices_selected when using tm_g_gh_boxplot
• Investigate and assess if the solution is also applicable with other teal.goshawk modules.
• If not, investigate, assess, and create actionable issues.

[npaszty]

@donyunardi

thanks for writing the acceptance criteria. I'm assuming that with the fix any module would be able to pass a function?

tm_g_gh_lineplot also uses the same concept of spliting the lines so that's another test case.

[donyunardi]

I added a new acceptance criteria to check solution with other teal.goshawk modules.

[gogonzo]

What probably should be done is something similar to the fix in tm_abnormality.
Delayed choices_selected needs to be resolved

[m7pr]

Hey, in this package, only the xaxis_var, yaxis_var and param parameters could be passed as delayed_data.
facet_var parameter in tm_g_gh_boxplot could not be passed as delayed_data base on functional form of variables_choices.

Thanks to the collective ideas from @gogonzo and brainstorms with @vedhav I was able to adjust tm_g_gh_boxplot so it's facet_var parameter can be passed as delayed_data, based on how it was implemented for other parameters.

Here is the PR #313

The last question is, if we want to extend this approach to trt_group parameter that is one more parameter that can be passed as variables_choices but it can not yet be passed as delayed_data (yet!). If yes, we can incorporate this change in all modules. trt_group exists in all other modules. facet_var existed only in tm_g_gh_boxplot.

[m7pr]

PR for trt_group is here #314
Let me know @donyunardi if there anything else you need

[donyunardi]

Thanks to the collective ideas from @gogonzo and brainstorms with @vedhav I was able to adjust tm_g_gh_boxplot so it's facet_var parameter can be passed as delayed_data, based on how it was implemented for other parameters.

It's interesting to discover that teal modules need to be written in a specific way to enable the functional subset on delayed data when creating variable_choices.

From what I've observed, this is not clearly communicated anywhere in our documentation, especially under the topic of creating custom teal modules. We should make this information more visible in our docs or reassess whether this is the right approach for subsetting delayed data object.

[donyunardi]

The last question is, if we want to extend this approach to trt_group parameter that is one more parameter that can be passed as variables_choices but it can not yet be passed as delayed_data (yet!).

Yes, I would think we want to extend this to trt_group parameter and any other arguments that accepts choices_selected/variable_choices.

[donyunardi]

Can Should we also add this feature to filter_var in tm_g_gh_spaghettiplot?