Skip to content

Commit

Permalink
Paired test ordering (#1560)
Browse files Browse the repository at this point in the history
* ordering fix for paired test

* increment version number

* Update NEWS.md

* cleanup

* Update test-vetted_models-clogit.R

* Update DESCRIPTION

* Update add_difference.md
  • Loading branch information
ddsjoberg authored Oct 8, 2023
1 parent 73e99dd commit bbbc198
Show file tree
Hide file tree
Showing 14 changed files with 120 additions and 66 deletions.
6 changes: 3 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: gtsummary
Title: Presentation-Ready Data Summary and Analytic Result
Tables
Version: 1.7.2.9000
Version: 1.7.2.9001
Authors@R:
c(person(given = "Daniel D.",
family = "Sjoberg",
Expand Down Expand Up @@ -75,12 +75,12 @@ Depends:
R (>= 3.4)
Imports:
broom (>= 1.0.1),
broom.helpers (>= 1.13.0),
broom.helpers (>= 1.14.0),
cli (>= 3.1.1),
dplyr (>= 1.1.1),
forcats (>= 1.0.0),
glue (>= 1.6.2),
gt (>= 0.9.0),
gt (>= 0.10.0),
knitr (>= 1.37),
lifecycle (>= 1.0.1),
purrr (>= 1.0.1),
Expand Down
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
# gtsummary (development version)

* Fix in `add_difference()` for pair t-tests. Previously, the sign of the reported difference depended on which group appeared first in the source data. Function has been updated to consistently report the difference as the first group mean minus the second group mean. (#1557)

# gtsummary 1.7.2

* Removed messaging about the former auto-removal of the `tbl_summary(group)` variable from the table: a change that occurred 3+ years ago in gtsummary v1.3.1
Expand Down
4 changes: 2 additions & 2 deletions R/utils-add_p_tests.R
Original file line number Diff line number Diff line change
Expand Up @@ -141,7 +141,7 @@ add_p_tbl_summary_paired.t.test <- function(data, variable, by, group,

# reshaping data
data_wide <-
tidyr::pivot_wider(data,
tidyr::pivot_wider(dplyr::arrange(data, .data[[by]]),
id_cols = all_of(group),
names_from = all_of(by),
values_from = all_of(variable)
Expand Down Expand Up @@ -245,7 +245,7 @@ add_p_tbl_summary_paired.wilcox.test <- function(data, variable, by, group,

# reshaping data
data_wide <-
tidyr::pivot_wider(data,
tidyr::pivot_wider(dplyr::arrange(data, .data[[by]]),
id_cols = all_of(group),
names_from = all_of(by),
values_from = all_of(variable)
Expand Down
30 changes: 30 additions & 0 deletions tests/testthat/_snaps/add_difference.md
Original file line number Diff line number Diff line change
Expand Up @@ -135,3 +135,33 @@
1 -0.42 -4.5, 3.7 0.8
2 -4.7% -18%, 8.4% 0.5

# ordering in add_difference() with paired tests

Code
mtcars %>% mutate(.by = am, id = row_number(), am = factor(am, levels = c(0, 1))) %>%
tbl_summary(by = am, include = mpg) %>% add_difference(test = ~
"paired.t.test", group = id) %>% as_kable()
Message
Note for variable 'mpg': Some observations included in the calculation of summary statistics were omitted from the p-value calculation due to unbalanced missingness within group.
Output
|**Characteristic** | **0**, N = 19 | **1**, N = 13 | **Difference** | **95% CI** | **p-value** |
|:------------------|:-----------------:|:-----------------:|:--------------:|:----------:|:-----------:|
|mpg | 17.3 (15.0, 19.2) | 22.8 (21.0, 30.4) | -7.0 | -10, -3.6 | <0.001 |

---

Code
mtcars %>% mutate(.by = am, id = row_number(), am = factor(am, levels = c(1, 0))) %>%
tbl_summary(by = am, include = mpg) %>% add_difference(test = ~
"paired.t.test", group = id) %>% as_kable()
Message
Note for variable 'mpg': Some observations included in the calculation of summary statistics were omitted from the p-value calculation due to unbalanced missingness within group.
Output
|**Characteristic** | **1**, N = 13 | **0**, N = 19 | **Difference** | **95% CI** | **p-value** |
|:------------------|:-----------------:|:-----------------:|:--------------:|:----------:|:-----------:|
|mpg | 22.8 (21.0, 30.4) | 17.3 (15.0, 19.2) | 7.0 | 3.6, 10 | <0.001 |

62 changes: 31 additions & 31 deletions tests/testthat/_snaps/as_gt.md

Large diffs are not rendered by default.

32 changes: 32 additions & 0 deletions tests/testthat/test-add_difference.R
Original file line number Diff line number Diff line change
Expand Up @@ -342,3 +342,35 @@ test_that("add_difference() with emmeans()", {
NA
)
})


test_that("ordering in add_difference() with paired tests", {
expect_snapshot(
mtcars %>%
mutate(
.by = am,
id = row_number(),
am = factor(am, levels = c(0, 1))
) %>%
tbl_summary(
by = am,
include = mpg
) %>%
add_difference(test = ~"paired.t.test", group = id) %>%
as_kable()
)
expect_snapshot(
mtcars %>%
mutate(
.by = am,
id = row_number(),
am = factor(am, levels = c(1, 0))
) %>%
tbl_summary(
by = am,
include = mpg
) %>%
add_difference(test = ~"paired.t.test", group = id) %>%
as_kable()
)
})
1 change: 0 additions & 1 deletion tests/testthat/test-vetted_models-clogit.R
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,6 @@ skip_on_cran()
skip_if(!isTRUE(as.logical(Sys.getenv("CI"))))
skip_if_not(broom.helpers::.assert_package("car", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("survival", pkg_search = "gtsummary", boolean = TRUE))
library(dplyr)
library(survival)

# clogit() ---------------------------------------------------------------------
Expand Down
14 changes: 6 additions & 8 deletions tests/testthat/test-vetted_models-coxph.R
Original file line number Diff line number Diff line change
Expand Up @@ -25,14 +25,12 @@ skip_on_cran()
skip_if(!isTRUE(as.logical(Sys.getenv("CI"))))
skip_if_not(broom.helpers::.assert_package("car", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("survival", pkg_search = "gtsummary", boolean = TRUE))
library(dplyr)
library(survival)

# coxph() ----------------------------------------------------------------------
test_that("vetted_models coxph()", {
# building models to check
mod_coxph_lin <- coxph(Surv(ttdeath, death) ~ age + trt + grade, data = trial)
mod_coxph_int <- coxph(Surv(ttdeath, death) ~ age + trt * grade, data = trial)
mod_coxph_lin <- survival::coxph(survival::Surv(ttdeath, death) ~ age + trt + grade, data = trial)
mod_coxph_int <- survival::coxph(survival::Surv(ttdeath, death) ~ age + trt * grade, data = trial)
# 1. Runs as expected with standard use
# - without errors, warnings, messages
expect_error(
Expand Down Expand Up @@ -157,8 +155,8 @@ test_that("vetted_models coxph()", {
expect_error(
trial %>%
tbl_uvregression(
y = Surv(ttdeath, death),
method = coxph
y = survival::Surv(ttdeath, death),
method = survival::coxph
) %>%
add_global_p() %>%
add_q(),
Expand All @@ -167,8 +165,8 @@ test_that("vetted_models coxph()", {
expect_warning(
trial %>%
tbl_uvregression(
y = Surv(ttdeath, death),
method = coxph
y = survival::Surv(ttdeath, death),
method = survival::coxph
) %>%
add_nevent() %>%
add_global_p() %>%
Expand Down
1 change: 0 additions & 1 deletion tests/testthat/test-vetted_models-geeglm.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ skip_if(!isTRUE(as.logical(Sys.getenv("CI"))))
skip_if_not(broom.helpers::.assert_package("car", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("geepack", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("survival", pkg_search = "gtsummary", boolean = TRUE))
library(dplyr)

# geeglm() --------------------------------------------------------------------
test_that("vetted_models geeglm()", {
Expand Down
1 change: 0 additions & 1 deletion tests/testthat/test-vetted_models-glm.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ skip_on_cran()
skip_if(!isTRUE(as.logical(Sys.getenv("CI"))))
skip_if_not(broom.helpers::.assert_package("car", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("survival", pkg_search = "gtsummary", boolean = TRUE))
library(dplyr)

# glm() ------------------------------------------------------------------------
test_that("vetted_models glm()", {
Expand Down
1 change: 0 additions & 1 deletion tests/testthat/test-vetted_models-glmer.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ skip_if(!isTRUE(as.logical(Sys.getenv("CI"))))
skip_if_not(broom.helpers::.assert_package("car", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("lme4", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("survival", pkg_search = "gtsummary", boolean = TRUE))
library(dplyr)

# glmer() --------------------------------------------------------------------
test_that("vetted_models glmer()", {
Expand Down
1 change: 0 additions & 1 deletion tests/testthat/test-vetted_models-lm.R
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,6 @@ skip_on_cran()
testthat::skip_if(!isTRUE(as.logical(Sys.getenv("CI"))))
skip_if_not(broom.helpers::.assert_package("car", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("survival", pkg_search = "gtsummary", boolean = TRUE))
library(dplyr)

# lm() ------------------------------------------------------------------------
test_that("vetted_models lm()", {
Expand Down
1 change: 0 additions & 1 deletion tests/testthat/test-vetted_models-lmer.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ skip_if(!isTRUE(as.logical(Sys.getenv("CI"))))
skip_if_not(broom.helpers::.assert_package("car", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("survival", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("lme4", pkg_search = "gtsummary", boolean = TRUE))
library(dplyr)

# lmer() -----------------------------------------------------------------------
test_that("vetted_models lmer()", {
Expand Down
30 changes: 14 additions & 16 deletions tests/testthat/test-vetted_models-survreg.R
Original file line number Diff line number Diff line change
Expand Up @@ -35,15 +35,13 @@ skip_if(!isTRUE(as.logical(Sys.getenv("CI"))))
skip_if_not(broom.helpers::.assert_package("car", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("lme4", pkg_search = "gtsummary", boolean = TRUE))
skip_if_not(broom.helpers::.assert_package("survival", pkg_search = "gtsummary", boolean = TRUE))
library(dplyr)
library(survival)


# survreg() --------------------------------------------------------------------
test_that("vetted_models survreg()", {
# building models to check
mod_survreg_lin <- survreg(Surv(ttdeath, death) ~ age + trt + grade, data = trial)
mod_survreg_int <- survreg(Surv(ttdeath, death) ~ age + trt * grade, data = trial)
mod_survreg_lin <- survival::survreg(survival::Surv(ttdeath, death) ~ age + trt + grade, data = trial)
mod_survreg_int <- survival::survreg(survival::Surv(ttdeath, death) ~ age + trt * grade, data = trial)
# 1. Runs as expected with standard use
# - without errors, warnings, messages
expect_error(
Expand Down Expand Up @@ -82,15 +80,15 @@ test_that("vetted_models survreg()", {
# - labels are correct
expect_equal(
tbl_survreg_lin$table_body %>%
filter(row_type == "label") %>%
pull(label),
dplyr::filter(row_type == "label") %>%
dplyr::pull(label),
c("Age", "Chemotherapy Treatment", "Grade"),
ignore_attr = TRUE
)
expect_equal(
tbl_survreg_int$table_body %>%
filter(row_type == "label") %>%
pull(label),
dplyr::filter(row_type == "label") %>%
dplyr::pull(label),
c("Age", "Chemotherapy Treatment", "Grade", "Chemotherapy Treatment * Grade"),
ignore_attr = TRUE
)
Expand All @@ -99,8 +97,8 @@ test_that("vetted_models survreg()", {
# - interaction labels are correct
expect_equal(
tbl_survreg_int$table_body %>%
filter(var_type == "interaction") %>%
pull(label),
dplyr::filter(var_type == "interaction") %>%
dplyr::pull(label),
c("Chemotherapy Treatment * Grade", "Drug B * II", "Drug B * III"),
ignore_attr = TRUE
)
Expand All @@ -127,7 +125,7 @@ test_that("vetted_models survreg()", {
# - numbers in table are correct
expect_equal(
tbl_survreg_lin2$table_body %>%
pull(p.value) %>%
dplyr::pull(p.value) %>%
na.omit() %>%
as.vector(),
car::Anova(mod_survreg_lin, type = "III") %>%
Expand All @@ -137,16 +135,16 @@ test_that("vetted_models survreg()", {
)
expect_equal(
tbl_survreg_int2$table_body %>%
pull(p.value) %>%
dplyr::pull(p.value) %>%
na.omit() %>%
as.vector(),
car::Anova(mod_survreg_int, type = "III") %>%
as.data.frame() %>%
pull(`Pr(>Chisq)`),
dplyr::pull(`Pr(>Chisq)`),
ignore_attr = TRUE
)
expect_equal(
tbl_survreg_lin3$table_body %>% filter(variable == "trt") %>% pull(p.value),
tbl_survreg_lin3$table_body %>% dplyr::filter(variable == "trt") %>% pull(p.value),
car::Anova(mod_survreg_lin, type = "III") %>%
as.data.frame() %>%
tibble::rownames_to_column() %>%
Expand All @@ -160,8 +158,8 @@ test_that("vetted_models survreg()", {
expect_error(
trial %>%
tbl_uvregression(
y = Surv(ttdeath, death),
method = survreg
y = survival::Surv(ttdeath, death),
method = survival::survreg
) %>%
add_global_p() %>%
add_q(),
Expand Down

0 comments on commit bbbc198

Please sign in to comment.