Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

WIP variable_choices with choices as delayed_data #268

Closed
wants to merge 1 commit into from

Conversation

m7pr
Copy link
Contributor

@m7pr m7pr commented Oct 1, 2024

WIP - tries to provide fixes for insightsengineering/teal.goshawk#301

Testing (dirty) with below code. Dirty because I am assigning objects to .GlobalEnv

pkgload::load_all("../teal.widgets")
pkgload::load_all(".")
data1 <- 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")
    
    assign(x = "adlb_names", value =  names(ADLB)[26:193], envir = .GlobalEnv)
    
  }
)
datanames <- c("ADLB", "ADSL")

datanames(data1) <- datanames
join_keys(data1) <- default_cdisc_join_keys[datanames]


cs_facet_var <- choices_selected(
  variable_choices("ADSL", subset = function(data){
    na.omit(c("AVISITCD", "ARM", get("adlb_names", .GlobalEnv)))
  })
)

app <- init(
  data = data1,
  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)

@m7pr m7pr added the core label Oct 1, 2024
@@ -212,7 +214,7 @@ optionalSelectInput <- function(inputId, # nolint
shinyWidgets::pickerInput(
inputId = inputId,
label = label,
choices = raw_choices,
choices = if (inherits(raw_choices, "function")) raw_choices() else raw_choices,
Copy link
Contributor

@gogonzo gogonzo Oct 2, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

isn't raw_choices a function of data? I think so, which means that this change introduces a bug, as evaluation raw_choices() will throw an error

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this whole PR was wrong, I will write what was the fix on the original issue insightsengineering/teal.goshawk#301

@m7pr m7pr closed this Oct 3, 2024
@github-actions github-actions bot locked and limited conversation to collaborators Oct 3, 2024
Sign up for free to subscribe to this conversation on GitHub. Already have an account? Sign in.
Labels
Projects
None yet
Development

Successfully merging this pull request may close these issues.

2 participants