Fix tm_t_coxreg errors when applying filters

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.

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)
       }

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(

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