From 3be7eb11e0943bd180199075a7d2d1a9374f790d Mon Sep 17 00:00:00 2001
From: Daniel Sjoberg <danield.sjoberg@gmail.com>
Date: Tue, 16 Feb 2021 14:15:10 -0500
Subject: [PATCH] #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                       |  2 +-
 NEWS.md                           |  2 ++
 R/add_global_p.R                  |  7 +------
 R/tbl_survfit.R                   |  4 ++--
 tests/testthat/test-tbl_survfit.R | 18 ++++++++++++++++++
 5 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 9a407e333c..d6e8d64a28 100644
--- a/DESCRIPTION
+++ b/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",
diff --git a/NEWS.md b/NEWS.md
index a9b1bf64eb..7ef29e0792 100644
--- a/NEWS.md
+++ b/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.
diff --git a/R/add_global_p.R b/R/add_global_p.R
index 001dd6797c..1e55b36d48 100644
--- a/R/add_global_p.R
+++ b/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)
   }
 
diff --git a/R/tbl_survfit.R b/R/tbl_survfit.R
index cf8d713b6b..00fd90ce1e 100644
--- a/R/tbl_survfit.R
+++ b/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 %>%
diff --git a/tests/testthat/test-tbl_survfit.R b/tests/testthat/test-tbl_survfit.R
index 2e88aa8348..964a8448ae 100644
--- a/tests/testthat/test-tbl_survfit.R
+++ b/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")
+  )
+
+})