--- title: AET04 subtitle: Adverse Events by Highest NCI CTCAE Grade --- ------------------------------------------------------------------------ {{< include ../../_utils/envir_hook.qmd >}} ```{r setup, echo = FALSE, warning = FALSE, message = FALSE} library(dplyr) library(tern) adsl <- random.cdisc.data::cadsl adae <- random.cdisc.data::cadae # Ensure character variables are converted to factors and empty strings and NAs are explicit missing levels. adsl <- df_explicit_na(adsl) %>% filter(TRT01A != "<Missing>") adae <- df_explicit_na(adae) %>% var_relabel( AEBODSYS = "MedDRA System Organ Class", AEDECOD = "MedDRA Preferred Term" ) %>% filter( ANL01FL == "Y", AETOXGR != "<Missing>" ) # Pre-Processing grade_groups <- list( "Grade 1-2" = c("1", "2"), "Grade 3-4" = c("3", "4"), "Grade 5" = "5" ) adae$TOTAL_VAR <- "- Any adverse events - " # Helper function to avoid filtering also the first part of the table, where general information is given. my_row_condition <- function(row_fnc_condition) { function(table_row) { if (indent_mod(table_row) == 0) { return(TRUE) } else { row_fnc_condition(table_row) } } } # Helper function to calculate sum from first nested row score_all_sum <- function(tt) { cleaf <- collect_leaves(tt)[[1]] if (NROW(cleaf) == 0) { stop("score_all_sum score function used at subtable [", obj_name(tt), "] that has no content.") } sum(sapply(row_values(cleaf), function(cv) cv[1])) } # Raw table used by variant 8/10 raw_table <- basic_table(show_colcounts = TRUE) %>% split_cols_by("ACTARM") %>% split_rows_by( var = "TOTAL_VAR", label_pos = "hidden", child_labels = "visible", indent_mod = -1L ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 7L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups, .indent_mods = 6L ) %>% split_rows_by( "AEBODSYS", child_labels = "visible", nested = FALSE, split_fun = drop_split_levels, split_label = var_labels(adae)[["AEBODSYS"]], label_pos = "topleft" ) %>% split_rows_by( "AEDECOD", child_labels = "visible", split_fun = add_overall_level("- Overall -", trim = TRUE), split_label = var_labels(adae)[["AEDECOD"]], label_pos = "topleft" ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 6L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups, .indent_mods = 5L ) %>% append_topleft(" Grade") %>% build_table(adae, alt_counts_df = adsl) %>% prune_table() %>% sort_at_path( path = "AEBODSYS", scorefun = score_all_sum, decreasing = TRUE ) %>% sort_at_path( path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_all_sum, decreasing = TRUE ) ``` ```{r include = FALSE} webr_code_labels <- c("setup") ``` {{< include ../../_utils/webr_no_include.qmd >}} ## Output ::::::::::: panel-tabset ## Standard Table ::: {.panel-tabset .nav-justified group="webr"} ## {{< fa regular file-lines sm fw >}} Preview ```{r variant1, test = list(result_v1 = "result")} lyt <- basic_table(show_colcounts = TRUE) %>% split_cols_by("ACTARM") %>% split_rows_by( var = "TOTAL_VAR", label_pos = "hidden", child_labels = "visible", indent_mod = -1L ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 7L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups, .indent_mods = 6L ) %>% split_rows_by( "AEBODSYS", child_labels = "visible", nested = FALSE, split_fun = drop_split_levels, split_label = var_labels(adae)[["AEBODSYS"]], label_pos = "topleft" ) %>% split_rows_by( "AEDECOD", child_labels = "visible", split_fun = add_overall_level("- Overall -", trim = TRUE), split_label = var_labels(adae)[["AEDECOD"]], label_pos = "topleft" ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 6L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups, .indent_mods = 5L ) %>% append_topleft(" Grade") result <- lyt %>% build_table(adae, alt_counts_df = adsl) %>% prune_table() %>% sort_at_path( path = "AEBODSYS", scorefun = score_all_sum, decreasing = TRUE ) %>% sort_at_path( path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_all_sum, decreasing = TRUE ) result ``` ```{r include = FALSE} webr_code_labels <- c("variant1") ``` {{< include ../../_utils/webr.qmd >}} ::: ## Table with Fill-In <br/> of Treatment Groups ::: {.panel-tabset .nav-justified group="webr"} ## {{< fa regular file-lines sm fw >}} Preview ```{r variant2, test = list(result_v2 = "result")} adae2 <- adae %>% filter(ACTARM == "A: Drug X") lyt <- basic_table(show_colcounts = TRUE) %>% split_cols_by("ACTARM") %>% split_rows_by( var = "TOTAL_VAR", label_pos = "hidden", child_labels = "visible", indent_mod = -1L ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 7L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups, .indent_mods = 6L ) %>% split_rows_by( "AEBODSYS", child_labels = "visible", nested = FALSE, split_fun = drop_split_levels, split_label = var_labels(adae)[["AEBODSYS"]], label_pos = "topleft" ) %>% split_rows_by( "AEDECOD", child_labels = "visible", split_fun = add_overall_level("- Overall -", trim = TRUE), split_label = var_labels(adae)[["AEDECOD"]], label_pos = "topleft" ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 6L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups, .indent_mods = 5L ) %>% append_topleft(" Grade") result <- lyt %>% build_table(adae2, alt_counts_df = adsl) %>% prune_table() %>% sort_at_path( path = "AEBODSYS", scorefun = score_all_sum, decreasing = TRUE ) %>% sort_at_path( path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_all_sum, decreasing = TRUE ) result ``` ```{r include = FALSE} webr_code_labels <- c("variant2") ``` {{< include ../../_utils/webr.qmd >}} ::: ## Table with Fill-In <br/> of Grades ::: {.panel-tabset .nav-justified group="webr"} ## {{< fa regular file-lines sm fw >}} Preview ```{r variant3, test = list(result_v3 = "result")} lyt <- basic_table(show_colcounts = TRUE) %>% split_cols_by("ACTARM") %>% split_rows_by( var = "TOTAL_VAR", label_pos = "hidden", child_labels = "visible", indent_mod = -1L ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 7L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups, .indent_mods = 6L ) %>% split_rows_by( "AEBODSYS", child_labels = "visible", nested = FALSE, split_fun = drop_split_levels, split_label = var_labels(adae)[["AEBODSYS"]], label_pos = "topleft" ) %>% split_rows_by( "AEDECOD", child_labels = "visible", split_fun = add_overall_level("- Overall -", trim = TRUE), split_label = var_labels(adae)[["AEDECOD"]], label_pos = "topleft" ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 6L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups, .indent_mods = 5L ) %>% append_topleft(" Grade") result <- lyt %>% build_table(adae, alt_counts_df = adsl) %>% sort_at_path( path = "AEBODSYS", scorefun = score_all_sum, decreasing = TRUE ) %>% sort_at_path( path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_all_sum, decreasing = TRUE ) result ``` ```{r include = FALSE} webr_code_labels <- c("variant3") ``` {{< include ../../_utils/webr.qmd >}} ::: ## Table with Collapsing <br/> of Grades ::: {.panel-tabset .nav-justified group="webr"} ## {{< fa regular file-lines sm fw >}} Preview ```{r variant4, test = list(result_v4 = "result")} grade_groups_1 <- list( "Grade 1-2" = c("1", "2"), "Grade 3-5" = c("3", "4", "5") ) lyt <- basic_table(show_colcounts = TRUE) %>% split_cols_by("ACTARM") %>% split_rows_by( var = "TOTAL_VAR", label_pos = "hidden", child_labels = "visible", indent_mod = -1L ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 7L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups_1, .indent_mods = 6L ) %>% split_rows_by( "AEBODSYS", child_labels = "visible", nested = FALSE, split_fun = drop_split_levels, split_label = var_labels(adae)[["AEBODSYS"]], label_pos = "topleft" ) %>% split_rows_by( "AEDECOD", child_labels = "visible", split_fun = add_overall_level("- Overall -", trim = TRUE), split_label = var_labels(adae)[["AEDECOD"]], label_pos = "topleft" ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 6L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups_1, .indent_mods = 5L ) %>% append_topleft(" Grade") result <- lyt %>% build_table(adae, alt_counts_df = adsl) %>% prune_table() %>% sort_at_path( path = "AEBODSYS", scorefun = score_all_sum, decreasing = TRUE ) %>% sort_at_path( path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_all_sum, decreasing = TRUE ) result ``` ```{r include = FALSE} webr_code_labels <- c("variant4") ``` {{< include ../../_utils/webr.qmd >}} ::: ## Table Using Worst Grade <br/> Flags from ADAE ```{r variant5} #| code-fold: show # No Worst Grade Flags found in the ADAE data set. ``` ## Table with an Incidence Rate <br/> $\geq$ 40%, Totals Restricted ::: {.panel-tabset .nav-justified group="webr"} ## {{< fa regular file-lines sm fw >}} Preview ```{r variant6, test = list(result_v6 = "result")} # Simple wrapper to return subset ADAE to a threshold of xx%. get_adae_trimmed <- function(adsl, adae, cutoff_rate) { n_per_arm <- adsl %>% dplyr::count(ACTARM) anl_terms <- adae %>% dplyr::group_by(ACTARM, AEBODSYS, AEDECOD) %>% dplyr::count( unique_terms = n_distinct(USUBJID) ) %>% dplyr::select(-n) %>% dplyr::ungroup() anl_terms <- dplyr::left_join( anl_terms, n_per_arm, by = "ACTARM" ) %>% dplyr::mutate( ae_rate = unique_terms / n ) %>% dplyr::filter(ae_rate >= cutoff_rate) %>% dplyr::select(AEDECOD) %>% unique() anl <- dplyr::left_join( anl_terms, adae, by = "AEDECOD" ) anl } adae6 <- get_adae_trimmed(adsl, adae, cutoff_rate = 0.4) lyt <- basic_table(show_colcounts = TRUE) %>% split_cols_by("ACTARM") %>% split_rows_by( var = "TOTAL_VAR", label_pos = "hidden", child_labels = "visible", indent_mod = -1L ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 7L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups, .indent_mods = 6L ) %>% split_rows_by( "AEBODSYS", child_labels = "visible", nested = FALSE, split_fun = drop_split_levels, split_label = var_labels(adae)[["AEBODSYS"]], label_pos = "topleft" ) %>% split_rows_by( "AEDECOD", child_labels = "visible", split_fun = add_overall_level("- Overall -", trim = TRUE), split_label = var_labels(adae)[["AEDECOD"]], label_pos = "topleft" ) %>% summarize_num_patients( var = "USUBJID", .stats = "unique", .labels = "- Any Grade -", .indent_mods = 6L ) %>% count_occurrences_by_grade( var = "AETOXGR", grade_groups = grade_groups, .indent_mods = 5L ) %>% append_topleft(" Grade") result <- lyt %>% build_table(adae6, alt_counts_df = adsl) %>% prune_table() %>% sort_at_path( path = "AEBODSYS", scorefun = score_all_sum, decreasing = TRUE ) %>% sort_at_path( path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_all_sum, decreasing = TRUE ) result ``` ```{r include = FALSE} webr_code_labels <- c("variant6") ``` {{< include ../../_utils/webr.qmd >}} ::: ## Table with an Incidence Rate <br/> $\geq$ X%, Totals Unrestricted Variant 7 was not created. With this variant, the SOC level is not trimmed (even if there are no terms left). ## Table with an Incidence <br/> Rate $\geq$ 58 Patients ::: {.panel-tabset .nav-justified group="webr"} ## {{< fa regular file-lines sm fw >}} Preview ```{r variant8, test = list(result_v8 = "result")} cutoff <- 58L row_condition <- has_count_in_any_col(atleast = cutoff, col_names = levels(adsl$ACTARM)) result <- prune_table(raw_table, keep_content_rows(my_row_condition(row_condition))) result ``` ```{r include = FALSE} webr_code_labels <- c("variant8") ``` {{< include ../../_utils/webr.qmd >}} ::: ## Table with a Difference in <br/> Incidence Rate $\geq$ 10% ::: {.panel-tabset .nav-justified group="webr"} ## {{< fa regular file-lines sm fw >}} Preview ```{r variant9, test = list(result_v9 = "result")} cutoff <- 0.1 row_condition <- has_fractions_difference(atleast = cutoff, col_names = levels(adsl$ACTARM)) result <- prune_table(raw_table, keep_content_rows(my_row_condition(row_condition))) result ``` ```{r include = FALSE} webr_code_labels <- c("variant9") ``` {{< include ../../_utils/webr.qmd >}} ::: ## Table with an Incidence Rate <br/> $\geq$ 5%, SOCs \< 5% Removed Variant 10 was not done With this variant, SOC levels above the threshold are still in the table even if there are no terms left. ## Table with an Incidence Rate $\geq$ 40%, <br/> All SOCs w/o Preferred Terms Removed ::: {.panel-tabset .nav-justified group="webr"} ## {{< fa regular file-lines sm fw >}} Preview ```{r variant11, test = list(result_v11 = "result")} cutoff <- 0.4 row_condition <- has_fraction_in_any_col(atleast = cutoff, col_names = levels(adsl$ACTARM)) result <- prune_table(raw_table, keep_content_rows(my_row_condition(row_condition))) result ``` ```{r include = FALSE} webr_code_labels <- c("variant11") ``` {{< include ../../_utils/webr.qmd >}} ::: ## Data Setup ```{r setup} #| code-fold: show ``` ::::::::::: {{< include ../../_utils/save_results.qmd >}} ## `teal` App ::: {.panel-tabset .nav-justified} ## {{< fa regular file-lines fa-sm fa-fw >}} Preview ```{r teal, opts.label = c("skip_if_testing", "app")} library(teal.modules.clinical) ## Data reproducible code data <- teal_data() data <- within(data, { ADSL <- random.cdisc.data::cadsl ADAE <- random.cdisc.data::cadae }) datanames <- c("ADSL", "ADAE") datanames(data) <- datanames join_keys(data) <- default_cdisc_join_keys[datanames] ## Reusable Configuration For Modules ADAE <- data[["ADAE"]] ## Setup App app <- init( data = data, modules = modules( tm_t_events_by_grade( label = "Adverse Events by Grade Table", dataname = "ADAE", arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"), llt = choices_selected( choices = variable_choices(ADAE, c("AETERM", "AEDECOD")), selected = c("AEDECOD") ), hlt = choices_selected( choices = variable_choices(ADAE, c("AEBODSYS", "AESOC")), selected = "AEBODSYS" ), grade = choices_selected( choices = variable_choices(ADAE, c("AETOXGR", "AESEV")), selected = "AETOXGR" ) ) ) ) shinyApp(app$ui, app$server) ``` {{< include ../../_utils/shinylive.qmd >}} ::: {{< include ../../repro.qmd >}} 