301 delayed variable_choices for facet_var in tm_g_gh_boxplot

[m7pr]

Solution for #301

Working example

pkgload::load_all(".")
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) {
    na.omit(unique(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)

[github-actions]

Code Coverage Summary

Filename                                 Stmts    Miss  Cover    Missing
-------------------------------------  -------  ------  -------  ---------
R/tm_g_gh_boxplot.R                        354     354  0.00%    175-596
R/tm_g_gh_correlationplot.R                559     559  0.00%    227-895
R/tm_g_gh_density_distribution_plot.R      281     281  0.00%    135-466
R/tm_g_gh_lineplot.R                       565     565  0.00%    161-820
R/tm_g_gh_scatterplot.R                    249     249  0.00%    144-445
R/tm_g_gh_spaghettiplot.R                  319     319  0.00%    194-595
R/toggleable_slider.R                      154     154  0.00%    72-243
R/utils-arbitrary_lines.r                  125     125  0.00%    19-176
R/utils-data_constraints.r                 190     190  0.00%    2-257
R/utils-keep_range_slider_updated.r         29      29  0.00%    9-45
R/utils-maptrt.r                             9       9  0.00%    24-36
R/utils-templ_ui.r                          57      57  0.00%    2-86
R/utils.R                                   49      49  0.00%    12-112
R/zzz.R                                      2       2  0.00%    2-3
TOTAL                                     2942    2942  0.00%

Diff against main

Filename               Stmts    Miss  Cover
-------------------  -------  ------  --------
R/tm_g_gh_boxplot.R       -4      -4  +100.00%
R/utils-templ_ui.r        +9      +9  +100.00%
TOTAL                     +5      +5  +100.00%

Results for commit: defa814

Minimum allowed coverage is 80%

♻️ This comment has been updated with latest results