[Feature Request]: improve tm_g_gh_boxplot colour validation

[m7pr]

Feature description

Currently you can specify a random "character" in tm_g_gh_boxplot's hline_arb_color parameter, which is documented as a character vector of at most length of hline_arb. naming the color for the arbitrary horizontal lines.

If we know those should be colour names we should provide a validation on a startup, stating what might be possible colour names, instead of a message that you should just do an eye verification

library(dplyr)
library(nestcolor)
library(teal.goshawk)

# original ARM value = dose value
arm_mapping <- list(
  "A: Drug X" = "150mg QD",
  "B: Placebo" = "Placebo",
  "C: Combination" = "Combination"
)

set.seed(1)
ADSL <- goshawk::rADSL
ADLB <- goshawk::rADLB
var_labels <- lapply(ADLB, function(x) attributes(x)$label)
ADLB <- ADLB %>%
  dplyr::mutate(
    AVISITCD = dplyr::case_when(
      AVISIT == "SCREENING" ~ "SCR",
      AVISIT == "BASELINE" ~ "BL",
      grepl("WEEK", AVISIT) ~ paste("W", stringr::str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
      TRUE ~ as.character(NA)
    ),
    AVISITCDN = dplyr::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 = dplyr::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
  ) %>%
  dplyr::rowwise() %>%
  dplyr::group_by(PARAMCD) %>%
  dplyr::mutate(LBSTRESC = ifelse(
    USUBJID %in% sample(USUBJID, 1, replace = TRUE),
    paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC
  )) %>%
  dplyr::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 <- goshawk:::h_identify_loq_values(ADLB)
ADLB <- dplyr::left_join(ADLB, ALB_LOQS, by = "PARAM")

app <- teal::init(
  data = teal.data::cdisc_data(
    adsl <- teal.data::cdisc_dataset("ADSL", ADSL, code = "ADSL <- goshawk::rADSL"),
    teal.data::cdisc_dataset(
      "ADLB",
      ADLB,
      code = "
        set.seed(1)
        ADLB <- goshawk::rADLB
        var_labels <- lapply(ADLB, function(x) attributes(x)$label)
        ADLB <- ADLB %>%
          dplyr::mutate(AVISITCD = dplyr::case_when(
            AVISIT == 'SCREENING' ~ 'SCR',
            AVISIT == 'BASELINE' ~ 'BL',
            grepl('WEEK', AVISIT) ~ paste('W', stringr::str_extract(AVISIT, '(?<=(WEEK ))[0-9]+')),
            TRUE ~ as.character(NA)),
            AVISITCDN = dplyr::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 = dplyr::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) %>%
          dplyr::rowwise() %>%
          dplyr::group_by(PARAMCD) %>%
          dplyr::mutate(LBSTRESC = ifelse(
            USUBJID %in% sample(USUBJID, 1, replace = TRUE),
            paste('<', round(runif(1, min = 25, max = 30))), LBSTRESC)) %>%
          dplyr::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 <- goshawk:::h_identify_loq_values(ADLB)
        ADLB <- left_join(ADLB, ALB_LOQS, by = 'PARAM')",
      vars = list(ADSL = adsl, arm_mapping = arm_mapping)
    ),
    check = FALSE # to shorten the example check = FALSE, in real scenarios use check = TRUE
  ),
  modules = teal::modules(
    teal.goshawk::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 = choices_selected(c("ACTARM", "ARM", "AVISITCD", "SEX"), "AVISITCD"),
      trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
      loq_legend = TRUE,
      rotate_xlab = FALSE,
      hline_arb = c(60, 55),
      hline_arb_color = c("grey", "asd"),
      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"),
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

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.

[npaszty]

happy to have validation text nice and clear so users know what action to take to address the issue.