insightsengineering / insightsengineering/teal.goshawk

[Feature Request]: improve tm_g_gh_boxplot colour validation

Open
#232 1 comment 0 reactions 0 assignees View on GitHub
core enhancement
Dominant language
R
Stars
3
Forks
3
Avg merge
2d 6h
Merged PRs (30d)
11

Description

### 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
![image](https://github.com/insightsengineering/teal.goshawk/assets/133694481/c595bb88-ae54-4bec-9611-5b41e9b0a949)

```{R}
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

- [X] I agree to follow this project's Code of Conduct.

### Contribution Guidelines

- [X] I agree to follow this project's Contribution Guidelines.

### Security Policy

- [X] I agree to follow this project's Security Policy.

Contributor guide

Open the contributing guide

Assessment

This issue has not been assessed yet.

Get new issues in your inbox

A short digest of beginner-friendly GitHub issues.