#764 fct order bug fix in survfit (#765)

* #764 fct order bug fix in survfit

* Update test-tbl_survfit.R

* Update add_global_p.R

* updated news and bumped version number

Co-authored-by: michaelcurry1123 <30420015+michaelcurry1123@users.noreply.github.com>
Co-authored-by: Curry <currym1@mskcc.org>

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: gtsummary
 Title: Presentation-Ready Data Summary and Analytic Result
     Tables
-Version: 1.3.6.9013
+Version: 1.3.6.9014
 Authors@R: 
     c(person(given = "Daniel D.",
              family = "Sjoberg",

NEWS.md

@@ -1,5 +1,7 @@
 # gtsummary (development version)
 
+* Preserve ordering for factor variables in tbl_survfit(). (#764)
+
 * Removed {usethis} package dependency and replaced with {cli}. (#768)
 
 * Added variable-specific formatting to `add_difference(estimate_fun=)` allowing a single table to show, for example, mean and rate differences that are formatted/rounded differently.

R/add_global_p.R

@@ -80,12 +80,7 @@ add_global_p.tbl_regression <- function(x, include = everything(), type = NULL,
   # if no terms are provided, stop and return x
   if (length(include) == 0) {
     if (quiet == FALSE)
-      paste("No terms were selected, and no global p-values were added to the table.",
-            "The default behaviour is to add global p-values for categorical and ",
-            "interaction terms. To obtain p-values for other terms,",
-            "update the `include=` argument.") %>%
-      stringr::str_wrap() %>%
-      message()
+      inform("No terms were selected, and no global p-values were added to the table.")
     return(x)
   }
 

R/tbl_survfit.R

@@ -400,6 +400,8 @@ survfit_time <- function(x, variable, times, label_header, conf.level,
   # adding time 0 to data frame
   tidy <-
     tidy %>%
+    # making strata a fct to preserve ordering
+    mutate_at(vars(!!!strata), ~factor(., levels = unique(.))) %>%
     # if CI is missing, and SE is 0, making the CIs the estimate
     mutate_at(vars(.data$conf.high, .data$conf.low),
               ~ifelse(is.na(.) & .data$std.error == 0, .data$estimate, .)) %>%
@@ -414,8 +416,6 @@ survfit_time <- function(x, variable, times, label_header, conf.level,
     ) %>%
     ungroup()
 
-
-
   # getting requested estimates
   df_stat <-
     tidy %>%

tests/testthat/test-tbl_survfit.R

@@ -169,3 +169,21 @@ test_that("no errors/warnings with competing events", {
                summod2$meta_data$df_stats[[1]]$estimate)
 })
 
+test_that("Factor ordering preserved", {
+  trial2 <- mutate(trial, trt = ifelse(trt == "Drug A",1,0),
+                  trt = factor(trt, levels = c(0,1),labels = c("Drug B", "Drug A")))
+  mod1 <- survfit(Surv(ttdeath, death)~trt, trial2)
+
+  tbl1 <- tbl_survfit(mod1, times = 12)
+  tbl2 <- tbl_survfit(mod1, probs = 0.2)
+
+  expect_equal(
+    tbl1$table_body$label,
+    c("trt", "Drug B", "Drug A")
+  )
+  expect_equal(
+    tbl2$table_body$label,
+    c("trt", "Drug B", "Drug A")
+  )
+
+})