diff --git a/NEWS.md b/NEWS.md index 48744cb430..18df0d9d72 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. + ### Bug fixes * Fixed bug in `tm_t_coxreg` preventing table from being displayed when no covariates are selected. diff --git a/R/arm_ref_comp.R b/R/arm_ref_comp.R index 153345df38..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)) { - levels(arm) + levels(droplevels(arm)) } else { unique(arm) } diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index f1b9b96f2c..bf9468f78c 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( @@ -213,6 +221,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( diff --git a/tests/testthat/_snaps/tm_t_coxreg.md b/tests/testthat/_snaps/tm_t_coxreg.md index ed68dc0258..de69c3945d 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) } @@ -37,7 +38,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) } @@ -68,7 +70,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