From b481a541681b36980ef77a943e4bbc4b95625b17 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 21 Sep 2023 14:48:07 -0400 Subject: [PATCH 1/4] Only select arms present in data by default --- R/arm_ref_comp.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/arm_ref_comp.R b/R/arm_ref_comp.R index 153345df38..cfbe128b9b 100644 --- a/R/arm_ref_comp.R +++ b/R/arm_ref_comp.R @@ -108,7 +108,7 @@ arm_ref_comp_observer <- function(session, teal::validate_has_elements(arm, "Treatment variable is empty.") arm_levels <- if (is.factor(arm)) { - levels(arm) + intersect(levels(arm), unique(arm)) } else { unique(arm) } From dab766758feec84f7c6b3b00ce6b076676fcd609 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 21 Sep 2023 17:42:18 -0400 Subject: [PATCH 2/4] drop filtered out levels in factor covariates in tm_t_coxreg --- R/tm_t_coxreg.R | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index f687712f34..4d7f83dffb 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -61,6 +61,14 @@ template_coxreg_u <- function(dataname, ) ) + data_pipe <- add_expr( + data_pipe, + substitute( + expr = dplyr::mutate(across(where(is.factor) & cov_var, droplevels)), + env = list(cov_var = cov_var) + ) + ) + data_pipe <- add_expr(data_pipe, quote(df_explicit_na(na_level = ""))) data_list <- add_expr( @@ -214,6 +222,14 @@ template_coxreg_m <- function(dataname, ) ) + data_pipe <- add_expr( + data_pipe, + substitute( + expr = dplyr::mutate(across(where(is.factor) & cov_var, droplevels)), + env = list(cov_var = cov_var) + ) + ) + data_pipe <- add_expr(data_pipe, quote(df_explicit_na(na_level = ""))) data_list <- add_expr( From 3cf1df357539869f5e7109f3508f06965af11f3a Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 21 Sep 2023 17:47:19 -0400 Subject: [PATCH 3/4] Update NEWS, snapshots --- NEWS.md | 7 +++++-- tests/testthat/_snaps/tm_t_coxreg.md | 9 ++++++--- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1e01aa4303..b5b6e69fe9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,9 +5,12 @@ * Fixed label indentation in `tm_t_abnormality_by_worst_grade`. * Added `total_label` argument to enable customization of the "All Patients" column/row label in the following modules: `tm_a_mmrm`, `tm_t_abnormality`, `tm_t_abnormality_by_worst_grade`, `tm_t_binary_outcome`, `tm_t_events`, `tm_t_events_by_grade`, `tm_t_events_patyear`, `tm_t_events_summary`, `tm_t_exposure`, `tm_t_mult_events`, `tm_t_shift_by_arm`, `tm_t_shift_by_arm_worst`, `tm_t_shift_by_grade`, `tm_t_smq`, `tm_t_summary`, `tm_t_summary_by`, and `tm_t_tte`. * Increased default width of `tm_g_forest_tte` plot to prevent overlapping text. -* Improve default annotation table sizing in `tm_g_km`. +* Improved default annotation table sizing in `tm_g_km`. * Refactored `tm_t_exposure` to display "total" row as last row in table instead of as a summary row. Added parameters `add_total_row` to set whether the total row should be displayed and `total_row_label` to set the total row label. -* Update `tm_t_events` to maintain indentation after pruning. +* Updated `tm_t_events` to maintain indentation after pruning. +* Updated default reference/comparison arm level selection to work when arm variable levels are filtered out. +* Updated `tm_t_coxreg` to drop factor covariate variable levels that are not present to avoid errors when filtering. + ### Miscellaneous * Updated `control_incidence_rate` parameter names in `tm_t_events_patyear` from `time_unit_input` and `time_unit_output` to `input_time_unit` and `num_pt_year`, respectively, after parameter names were changed in `tern`. diff --git a/tests/testthat/_snaps/tm_t_coxreg.md b/tests/testthat/_snaps/tm_t_coxreg.md index 6717c8840c..ec612d0c19 100644 --- a/tests/testthat/_snaps/tm_t_coxreg.md +++ b/tests/testthat/_snaps/tm_t_coxreg.md @@ -8,7 +8,8 @@ anl <- adrs %>% dplyr::filter(ARMCD %in% c("ARM A", "ARM B", "ARM C")) %>% dplyr::mutate(ARMCD = stats::relevel(ARMCD, ref = "ARM A")) %>% dplyr::mutate(ARMCD = droplevels(ARMCD)) %>% - dplyr::mutate(event = 1 - CNSR) %>% df_explicit_na(na_level = "") + dplyr::mutate(event = 1 - CNSR) %>% dplyr::mutate(across(where(is.factor) & + NULL, droplevels)) %>% df_explicit_na(na_level = "") control <- list(pval_method = "wald", ties = "efron", conf_level = 0.95, interaction = FALSE) } @@ -38,7 +39,8 @@ anl <- adrs %>% dplyr::filter(ARMCD %in% c("ARM A", "ARM B", "ARM C")) %>% dplyr::mutate(ARMCD = stats::relevel(ARMCD, ref = "ARM A")) %>% dplyr::mutate(ARMCD = droplevels(ARMCD)) %>% - dplyr::mutate(event = 1 - CNSR) %>% df_explicit_na(na_level = "") + dplyr::mutate(event = 1 - CNSR) %>% dplyr::mutate(across(where(is.factor) & + NULL, droplevels)) %>% df_explicit_na(na_level = "") control <- list(pval_method = "wald", ties = "efron", conf_level = 0.95, interaction = TRUE) } @@ -70,7 +72,8 @@ ref = "A: Drug X")) %>% dplyr::mutate(ARM = droplevels(ARM)) %>% dplyr::mutate(ARM = combine_levels(x = ARM, levels = c("B: Placebo", "C: Combination"))) %>% dplyr::mutate(event = 1 - - CNSR) %>% df_explicit_na(na_level = "") + CNSR) %>% dplyr::mutate(across(where(is.factor) & c("AGE", + "SEX"), droplevels)) %>% df_explicit_na(na_level = "") } $layout From 8901c09eb85a8a123821b3de7071d9f7782e7e94 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 22 Sep 2023 10:39:16 -0400 Subject: [PATCH 4/4] Minor refactor --- R/arm_ref_comp.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/arm_ref_comp.R b/R/arm_ref_comp.R index cfbe128b9b..d80da412a7 100644 --- a/R/arm_ref_comp.R +++ b/R/arm_ref_comp.R @@ -108,7 +108,7 @@ arm_ref_comp_observer <- function(session, teal::validate_has_elements(arm, "Treatment variable is empty.") arm_levels <- if (is.factor(arm)) { - intersect(levels(arm), unique(arm)) + levels(droplevels(arm)) } else { unique(arm) }