nikolas-burkoff
commented
2 years ago Reprex below @gogonzo
Separately @npaszty https://github.com/insightsengineering/coredev-tasks/issues/285
library(scda)
library(teal.goshawk)
# original ARM value = dose value
arm_mapping <- list(
"A: Drug X" = "150mg QD",
"B: Placebo" = "Placebo",
"C: Combination" = "Combination"
)
color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C")
# assign LOQ flag symbols: circles for "N" and triangles for "Y", squares for "NA"
shape_manual <- c("N" = 1, "Y" = 2, "NA" = 0)
ADSL <- synthetic_cdisc_data("latest")$adsl
set.seed(1)
ADLB <- synthetic_cdisc_data("latest")$adlb
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",
trimws(
substr(
AVISIT,
start = 6,
stop = stringr::str_locate(AVISIT, "DAY") - 1
)
)
),
TRUE ~ NA_character_
)) %>%
dplyr::mutate(AVISITCDN = dplyr::case_when(
AVISITCD == "SCR" ~ -2,
AVISITCD == "BL" ~ 0,
grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
TRUE ~ NA_real_
)) %>%
# use ARMCD values to order treatment in visualization legend
dplyr::mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
ifelse(grepl("B", ARMCD), 2,
ifelse(grepl("A", ARMCD), 3, NA)
)
)) %>%
dplyr::mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
dplyr::mutate(ARM = factor(ARM) %>%
reorder(TRTORD)) %>%
dplyr::mutate(
ANRHI = dplyr::case_when(
PARAMCD == "ALT" ~ 60,
PARAMCD == "CRP" ~ 70,
PARAMCD == "IGA" ~ 80,
TRUE ~ NA_real_
),
ANRLO = dplyr::case_when(
PARAMCD == "ALT" ~ 20,
PARAMCD == "CRP" ~ 30,
PARAMCD == "IGA" ~ 40,
TRUE ~ NA_real_
)
) %>%
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[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
# add LLOQ and ULOQ variables
ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB)
ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
app <- init(
data = cdisc_data(
cdisc_dataset("ADSL", ADSL, code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl"),
cdisc_dataset(
"ADLB",
ADLB,
code = "set.seed(1)
ADLB <- synthetic_cdisc_data('latest')$adlb
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',
trimws(
substr(
AVISIT,
start = 6,
stop = stringr::str_locate(AVISIT, 'DAY') - 1
)
)
),
TRUE ~ NA_character_)) %>%
dplyr::mutate(AVISITCDN = dplyr::case_when(
AVISITCD == 'SCR' ~ -2,
AVISITCD == 'BL' ~ 0,
grepl('W', AVISITCD) ~ as.numeric(gsub('[^0-9]*', '', AVISITCD)),
TRUE ~ NA_real_)) %>%
# use ARMCD values to order treatment in visualization legend
dplyr::mutate(TRTORD = ifelse(grepl('C', ARMCD), 1,
ifelse(grepl('B', ARMCD), 2,
ifelse(grepl('A', ARMCD), 3, NA)))) %>%
dplyr::mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
dplyr::mutate(ARM = factor(ARM) %>%
reorder(TRTORD)) %>%
dplyr::mutate(
ANRHI = dplyr::case_when(
PARAMCD == 'ALT' ~ 60,
PARAMCD == 'CRP' ~ 70,
PARAMCD == 'IGA' ~ 80,
TRUE ~ NA_real_
),
ANRLO = dplyr::case_when(
PARAMCD == 'ALT' ~ 20,
PARAMCD == 'CRP' ~ 30,
PARAMCD == 'IGA' ~ 40,
TRUE ~ NA_real_
)) %>%
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[['ANRHI']], 'label') <- 'Analysis Normal Range Upper Limit'
attr(ADLB[['ANRLO']], 'label') <- 'Analysis Normal Range Lower Limit'
# add LLOQ and ULOQ variables
ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB)
ADLB <- left_join(ADLB, ADLB_LOQS, by = 'PARAM')",
vars = list(arm_mapping = arm_mapping)
),
check = TRUE
),
modules = modules(
tm_g_gh_correlationplot(
label = "Correlation Plot",
dataname = "ADLB",
param_var = "PARAMCD",
xaxis_param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
yaxis_param = choices_selected(c("ALT", "CRP", "IGA"), "CRP"),
xaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "BASE"),
yaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "AVAL"),
trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
color_manual = c(
"Drug X 100mg" = "#000000",
"Placebo" = "#3498DB",
"Combination 100mg" = "#E74C3C"
),
shape_manual = c("N" = 1, "Y" = 2, "NA" = 0),
plot_height = c(500, 200, 2000),
facet_ncol = 2,
visit_facet = TRUE,
reg_line = FALSE,
loq_legend = TRUE,
font_size = c(12, 8, 20),
dot_size = c(1, 1, 12),
reg_text_size = c(3, 3, 10),
hline_vars = c("ULOQN", "LLOQN"),
hline_vars_colors = c("purple", "gray"),
hline_vars_labels = c("Upper Limit of Quantitation", "Lower Limit of Quantitation"),
vline_vars = c("ULOQN", "LLOQN"),
vline_vars_colors = c("brown", "gold"),
vline_vars_labels = c("Upper Limit of Quantitation", "Lower Limit of Quantitation")
)
)
)
shinyApp(app$ui, app$server)
gogonzo
kpagacz
when adding LLOQ vertical line, the legend doesn't update. same with SRC. when adding LLOQ horizontal line, the legend updates and the vertical line also appears now. see app.R here: /home/bceuser/npaszty/lupus_data_mart/sandbox