[Bug]: Error in some modules due to `delayed_value_choices`

[vedhav]

What happened?

Identical to this issue insightsengineering/teal.modules.clinical#918
Running the examples of the modules in the package teal.goshawk works fine because they do not pass a "delayed" choices.
But, these modules fail when called with a delayed_choices_selected object in them, which was done inside the longitudinal app in the teal.gallery: tm_g_gh_boxplot, tm_g_gh_correlationplot, tm_g_gh_density_distribution_plot, tm_g_gh_lineplot, and tm_g_gh_spaghettiplot.

The point of failure was inside the templ_ui_params_vars() which is unable to handle the delayed object. This function is called by six modules in the package.

Error produced:

Warning: Error in teal.widgets::optionalSelectInput: is.null(selected) || length(selected) == 0 || all(selected %in%  .... is not TRUE
  3: runApp
  2: print.shiny.appobj
  1: <Anonymous>

Example to reproduce the error:

devtools::load_all("teal.goshawk")
library(teal.modules.clinical)

data <- teal_data()
data <- within(data, {
  library(DescTools)
  library(magrittr)
  library(dplyr)
  library(scda)
  library(scda.2022)
  library(stringr)
  library(formatters)
  library(sparkline)
  ADSL <- synthetic_cdisc_data("latest")$adsl
  ADLB <- synthetic_cdisc_data("latest")$adlb
  exclude_l2 <- c("")
  exclude_chg <- c("")
  arm_mapping <- list(
    "A: Drug X" = "Drug X 100mg",
    "C: Combination" = "Combination 100mg",
    "B: Placebo" = "Placebo"
  )

  `%keep_label%` <- function(lhv, rhv) {
    attributes(lhv) <- attributes(rhv)
    lhv
  }

  `%make_label%` <- function(lhv, label) {
    attr(lhv, "label") <- label
    lhv
  }

  ADSL <- ADSL %>%
    filter(ITTFL == "Y") %>%
    mutate(
      TRTORD = case_when(
        TRT01P == "A: Drug X" ~ 1,
        TRT01P == "C: Combination" ~ 2,
        TRT01P == "B: Placebo" ~ 3,
        TRUE ~ as.numeric(NA)
      ),
      TRTORD = TRTORD %make_label% "Treatment Order",
      TRT01P = as.character(arm_mapping[match(TRT01P, names(arm_mapping))]),
      TRT01P = factor(ARM) %>% reorder(TRTORD),
      TRT01P = TRT01P %make_label% "Planned Treatment for Period 01"
    )

  adsl_labels <- teal.data::col_labels(ADSL)
  date_vars_adsl <- names(ADSL)[vapply(ADSL, function(x) inherits(x, c("Date", "POSIXct", "POSIXlt")), logical(1))]
  char_vars_adsl <- names(Filter(isTRUE, sapply(ADSL, is.character)))

  ADSL <- ADSL %>%
    mutate_at(char_vars_adsl, factor)

  var_labels(ADSL) <- c(adsl_labels)

  set.seed(1, kind = "Mersenne-Twister") # Reproducible code due to `sample` calls

  ADLB_SUBSET <- ADLB %>%
    filter(!is.na(AVAL)) %>%
    filter(ITTFL == "Y" & toupper(AVISIT) %like any% c("SCREEN%", "BASE%", "%WEEK%", "%FOLLOW%")) %>%
    select(c(
      "STUDYID", "USUBJID",
      "ITTFL",
      "ARM", "ARMCD", "ACTARM", "ACTARMCD", "TRT01P", "TRT01A",
      "AVISIT", "AVISITN", "ADY",
      "PARAM", "PARAMCD",
      "AVAL", "AVALU", "BASE", "CHG", "PCHG",
      "ANRLO", "ANRHI",
      "LBSTRESC",
      "SEX", "RACE",
      "LOQFL"
    )) %>%
    mutate(
      AVISITCD = case_when(
        toupper(AVISIT) == "SCREENING" ~ "SCR",
        toupper(AVISIT) == "BASELINE" ~ "BL",
        grepl("WEEK", toupper(AVISIT)) ~ paste("W", trimws(substr(AVISIT, start = 6, stop = stringr::str_locate(AVISIT, "DAY") - 1))),
        grepl("FOLLOW", toupper(AVISIT)) ~ "FU",
        TRUE ~ as.character(NA)
      ),
      AVISITCDN = case_when(
        AVISITCD == "SCR" ~ -2,
        AVISITCD == "BL" ~ 0,
        grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]+", "", AVISITCD)) * 7,
        AVISITCD == "FU" ~ 100,
        TRUE ~ as.numeric(NA)
      ),
      TRTORD = case_when(
        TRT01P == "A: Drug X" ~ 1,
        TRT01P == "C: Combination" ~ 2,
        TRT01P == "B: Placebo" ~ 3,
        TRUE ~ as.numeric(NA)
      ),
      LOQFL = if_else(as.character(LOQFL) == "Y", as.character(LOQFL), "N"), # need explicit "N" value for LOQFL
      BASE2 = NA,
      CHG2 = NA,
      PCHG2 = NA
    ) %>%
    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_SUBSET[["LBSTRESC"]], "label") <- "Character Result/Finding in Std Format"
  attr(ADLB_SUBSET[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
  attr(ADLB_SUBSET[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"

  PARAM_MINS <- ADLB_SUBSET %>%
    select(USUBJID, PARAMCD, AVAL) %>%
    group_by(PARAMCD) %>%
    summarise(AVAL_MIN = min(AVAL, na.rm = TRUE), .groups = "drop") %>%
    mutate(PARAMCD = PARAMCD %make_label% "Parameter Code")

  ADLB_SUPED1 <- ADLB_SUBSET %>%
    mutate(BASE2 = ifelse(toupper(AVISIT) == "SCREENING" & is.na(BASE2), AVAL, BASE2) %keep_label% BASE2) %>%
    mutate(CHG2 = ifelse(toupper(AVISIT) == "SCREENING" & is.na(CHG2), 0, CHG2) %keep_label% CHG2) %>%
    mutate(PCHG2 = ifelse(toupper(AVISIT) == "SCREENING" & is.na(PCHG2), 0, PCHG2) %keep_label% PCHG2) %>%
    mutate(BASE = ifelse(toupper(AVISIT) == "BASELINE" & is.na(BASE), AVAL, BASE) %keep_label% BASE) %>%
    mutate(CHG = ifelse(toupper(AVISIT) == "BASELINE" & is.na(CHG), 0, CHG) %keep_label% CHG) %>%
    mutate(PCHG = ifelse(toupper(AVISIT) == "BASELINE" & is.na(PCHG), 0, PCHG) %keep_label% PCHG) %>%
    mutate(TRTORD = TRTORD %make_label% "Treatment Order")

  ADLB_SUPED2 <- inner_join(PARAM_MINS, ADLB_SUPED1, by = "PARAMCD")[, union(names(ADLB_SUPED1), names(PARAM_MINS))] %>%
    mutate(AVALL2 = ifelse(PARAMCD %in% exclude_l2, AVAL,
      ifelse(PARAMCD %in% exclude_chg, NA,
        ifelse(AVAL == 0 & AVAL_MIN > 0, log2(AVAL_MIN / 2),
          ifelse(AVAL == 0 & AVAL_MIN <= 0, NA,
            ifelse(AVAL > 0, log2(AVAL), NA)
          )
        )
      )
    ) %make_label% "Log2 of AVAL") %>%
    mutate(BASEL2 = ifelse(PARAMCD %in% exclude_l2, BASE,
      ifelse(PARAMCD %in% exclude_chg, NA,
        ifelse(BASE == 0 & AVAL_MIN > 0, log2(AVAL_MIN / 2),
          ifelse(BASE == 0 & AVAL_MIN <= 0, NA,
            ifelse(BASE > 0, log2(BASE), NA)
          )
        )
      )
    ) %make_label% "Log2 of BASE") %>%
    mutate(BASE2L2 = ifelse(PARAMCD %in% exclude_l2, BASE2,
      ifelse(PARAMCD %in% exclude_chg, NA,
        ifelse(BASE2 == 0 & AVAL_MIN > 0, log2(AVAL_MIN / 2),
          ifelse(BASE2 == 0 & AVAL_MIN <= 0, NA,
            ifelse(BASE2 > 0, log2(BASE2), NA)
          )
        )
      )
    ) %make_label% "Log2 of BASE2") %>%
    mutate(AVAL_MIN = AVAL_MIN %make_label% "Minimum AVAL Within PARAMCD")

  ADLB <- ADLB_SUPED2 %>%
    mutate(
      TRT01P = as.character(arm_mapping[match(TRT01P, names(arm_mapping))]),
      TRT01P = factor(TRT01P) %>% reorder(TRTORD) %make_label% "Planned Treatment for Period 01",
      TRT01A = as.character(arm_mapping[match(TRT01A, names(arm_mapping))]),
      TRT01A = factor(TRT01A) %>% reorder(TRTORD) %make_label% "Actual Treatment for Period 01",
      LOQFL = LOQFL %make_label% "Limit of Quantification",
      AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN) %make_label% "Analysis Visit Window Code",
      AVISITCDN = AVISITCDN %make_label% "Analysis Visit Window Code (N)",
      BASE2 = BASE2 %make_label% "Screening Value",
      CHG2 = CHG2 %make_label% "Absolute Change from Screening",
      PCHG2 = PCHG2 %make_label% "Percent Change from Screening"
    )

  ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB)
  ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
})

datanames <- c("ADSL", "ADLB")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]

shape_manual <- c("N" = 1, "Y" = 2, "NA" = 0)

color_manual <- c(
  "Drug X 100mg" = "#1e90ff",
  "Combination 100mg" = "#bb9990",
  "Placebo" = "#ffa07a"
)

arm_vars <- c("TRT01A", "TRT01P", "SEX", "RACE")

demog_vars_asl <- function(data) {
  date_vars_asl <- names(data)[vapply(data, function(x) inherits(x, c("Date", "POSIXct", "POSIXlt")), logical(1))]
  names(data)[!(names(data) %in% c("USUBJID", "STUDYID", date_vars_asl))]
}

anl_vars2 <- c("AVAL", "CHG", "PCHG", "AVALL2")
box_xaxis_vars <- c("TRT01A", "TRT01P", "AVISITCD", "STUDYID")
dm_vars <- c("SEX", "AGE", "RACE")

box_facet_vars <- c("TRT01A", "TRT01P", "AVISITCD")
cs_params <- choices_selected(choices = value_choices("ADLB", "PARAMCD", "PARAM"), selected = "ALT")

cs_arm_vars <- choices_selected(
  choices = variable_choices("ADSL", subset = arm_vars),
  selected = "TRT01A"
)


cs_anl_vars2 <- choices_selected(
  choices = variable_choices("ADLB", subset = anl_vars2),
  selected = "AVAL"
)

cs_dm_vars <- choices_selected(
  choices = variable_choices("ADSL", demog_vars_asl),
  selected = dm_vars
)

cs_box_facet_vars <- choices_selected(
  choices = variable_choices("ADLB", subset = box_facet_vars),
  selected = "AVISITCD"
)

cs_box_xaxis_vars <- choices_selected(
  choices = variable_choices("ADLB", subset = box_xaxis_vars),
  selected = "TRT01P"
)

app <- teal::init(
  data = data,
  filter = teal_slices(
    count_type = "all",
    teal_slice(dataname = "ADSL", varname = "SEX"),
    teal_slice(dataname = "ADSL", varname = "AGE")
  ),
  modules = tm_g_gh_boxplot(
    label = "Box Plot",
    dataname = "ADLB",
    param_var = "PARAMCD",
    param = cs_params,
    facet_var = cs_box_facet_vars,
    xaxis_var = cs_box_xaxis_vars,
    yaxis_var = cs_anl_vars2,
    plot_height = c(500, 200, 2000),
    trt_group = cs_arm_vars,
    color_manual = color_manual,
    shape_manual = shape_manual,
    rotate_xlab = TRUE,
    hline_arb = c(10, 30),
    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", "gray")
  )
)

shinyApp(app$ui, app$server)

sessionInfo()

No response

Relevant log output

No response

Code of Conduct

• I agree to follow this project's Code of Conduct.

Contribution Guidelines

• I agree to follow this project's Contribution Guidelines.

Security Policy

• I agree to follow this project's Security Policy.

[m7pr]

Confirming that I get errors as well

Listening on http://127.0.0.1:5004
[INFO] 2024-02-12 13:01:37.9908 pid:18668 token:[d89a8cdb] teal Initializing reporter_previewer_module
Warning: Error in teal.widgets::optionalSelectInput: is.null(selected) || length(selected) == 0 || all(selected %in%  .... is not TRUE
  3: runApp
  2: print.shiny.appobj
  1: <Anonymous>

[m7pr]

@vedhav where did you take this example from? Is this from teal gallery? I think there is a minor typo in the colour name, once spelled grey and once spelled gray

[vedhav]

I think I took it from a teal.gallery's longitudinal app. However, both of these should work. It's just catering to the American and British English and CSS users include people from both of these.
I'll change it to gray as it's most used.