insightsengineering / tern

Table, Listings, and Graphs (TLG) library for common outputs used in clinical trials
https://insightsengineering.github.io/tern/
Other
76 stars 21 forks source link

Map helper function for LBT13/14 #258

Open anajens opened 2 years ago

anajens commented 2 years ago

Variant 5 in each template LBT13/LBT14 needs to use trim_levels_to_map with a metadata map that has the appropriate grade reference ranges. For example, in the "HIGH" direction some parameters like ALKPHSI have levels 1-4 defined. Other parameters have only a subset of levels e.g. GLUCSI has levels 3,4 only and LYMPHSI has levels 2-3 only.

source("https://raw.github.roche.com/NEST/nest_on_bee/master/bee_nest_utils.R")
bee_use_nest(release = "2021_10_13")

library(tern)
library(dplyr)

# STREAM data -----------------------

safety_path <- "/opt/bee/analyses/stream2/master/2.11/stream2/doc/examples/molecule/project/safety/task01/outdata_vad/"
adlb_filename <- 'adlb.sas7bdat'
adlb <- haven::read_sas(paste0(safety_path, adlb_filename))

adsl_filename <- "adsl.sas7bdat"
adsl <- haven::read_sas(paste0(safety_path, adsl_filename))

# STATIC OUTPUT for LBT14 Variant 5 ------------------

adsl_f <- adsl %>% 
  filter(SAFFL == "Y") %>%
  df_explicit_na()

# Just choose a few params for simplicity.

adlb_f <- adlb %>% 
  filter(PARAMCD %in% c("ALKPHSI", "GLUCSI", "LYMPHSI")) %>% 
  filter(WGRHIFL == "Y" & SAFFL == "Y") %>%
  df_explicit_na()

# Create new grouping variables ATOXGR_GP, BTOXGR_GP
adlb_out <- adlb_f %>% mutate(
  ATOXGR_GP = case_when(
    ATOXGR %in% c(0, -1, -2, -3, -4) ~ "Not High",
    ATOXGR == 1 ~ "1",
    ATOXGR == 2 ~ "2",
    ATOXGR == 3 ~ "3",
    ATOXGR == 4 ~ "4",
    ATOXGR == "<Missing>" ~ "Missing"
  )
) %>% mutate(
  BTOXGR_GP = case_when(
    BTOXGR %in% c(0, -1, -2, -3, -4) ~ "Not High",
    BTOXGR == 1 ~ "1",
    BTOXGR == 2 ~ "2",
    BTOXGR == 3 ~ "3",
    BTOXGR == 4 ~ "4",
    BTOXGR == "<Missing>" ~ "Missing"
  )
)

adlb_out <- adlb_out %>% mutate(
  AVISIT = forcats::fct_reorder(AVISIT, AVISITN),
  ATOXGR_GP = factor(ATOXGR_GP, levels = c("Not High", "1", "2", "3", "4", "Missing")),
  BTOXGR_GP = factor(BTOXGR_GP, levels = c("Not High", "1", "2", "3", "4", "Missing"))
)

adlb_out <- adlb_out %>%
  var_relabel(
    PARAMCD = "Parameter Code",
    AVISIT = "Visit",
    ATOXGR_GP = "NCI-CTCAE Grade at Visit",
    BTOXGR_GP = "Baseline NCI-CTCAE Grade"
  )

pth <- "/opt/bee/analyses/stream2/master/current/stream2/app/metadata/__atoxgr_allhigh_ref.sas7bdat"
ref <- haven::read_sas(pth)

# Construct the map according to the "ref" dataset
map_alkph <- data.frame(
  PARAMCD = rep("ALKPHSI", 36),
  BTOXGR_GP = c(
    rep(c("Not High", "1", "2", "3", "4", "Missing"), 6)
  ),
  ATOXGR_GP = c(
    rep(c("Not High", "1", "2", "3", "4", "Missing"), each = 6)
  )
)

map_gluc <- data.frame(
  PARAMCD = rep("GLUCSI", 16),
  BTOXGR_GP = c(
    rep(c("Not High", "3", "4", "Missing"), 4)
  ),
  ATOXGR_GP = c(
    rep(c("Not High", "3", "4", "Missing"), each = 4)
  )
)

map_lymph <- data.frame(
  PARAMCD = rep("LYMPHSI", 16),
  BTOXGR_GP = c(
    rep(c("Not High", "2", "3", "Missing"), 4)
  ),
  ATOXGR_GP = c(
    rep(c("Not High", "2", "3", "Missing"), each = 4)
  )
)

map <- rbind(
  map_alkph,
  map_gluc,
  map_lymph
)

result2 <- basic_table() %>%
  split_cols_by("ACTARM") %>%
  add_colcounts() %>%
  split_rows_by(
    "PARAMCD", split_fun = trim_levels_to_map(map), label_pos = "topleft", split_label = obj_label(adlb_out$PARAMCD)
  ) %>%
  split_rows_by(
    "BTOXGR_GP", label_pos = "topleft", split_label = obj_label(adlb_out$BTOXGR_GP)
  ) %>%
  summarize_num_patients(var = "USUBJID", .stats = c("unique_count")) %>%
  count_occurrences("ATOXGR_GP", denom = "n", drop = F) %>% #note drop = F here because we want to "Fill in"
  append_varlabels(adlb_out, "ATOXGR_GP", indent = 2L) %>%
  build_table(df = adlb_out, alt_counts_df = adsl_f)

Viewer(result2)
yli110-stat697 commented 2 years ago

for metadata creation, please refer to https://github.com/insightsengineering/tern/blob/main/R/d_pkparam.R

6iris6 commented 2 years ago

Hi @shajoezhu , does above Rosemary's PR look good to you? I don't think it has been merged.