Re-adding data pre-processing

Author: ddsjoberg

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gtsummary
 Title: Presentation-Ready Data Summary and Analytic Result Tables
-Version: 2.1.0.9011
+Version: 2.1.0.9012
 Authors@R: c(
     person("Daniel D.", "Sjoberg", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0862-2018")),

NEWS.md

@@ -1,5 +1,7 @@
 # gtsummary (development version)
 
+* Data pre-processing has now been re-introduced for calculations in `add_p()` and `add_difference()`. Data pre-processing steps  were removed in the v2.0 release; however, in some cases---particularly `add_difference()` for dichotomous variables---the reduced functionality was affecting the user experience. See `?tests` for details on data pre-processing. (#2165)
+
 * The `add_variable_group_header()` function has been generalized to work with gtsummary tables, where previously only `'tbl_summary'` were accepted. (#2197)
 
 * The footnote placed on the p-value column by `add_significance_stars()` no longer replaces any existing footnote. Rather the footnote is added to any existing footnote. (#2184)

R/add_p.R

@@ -252,7 +252,8 @@ calculate_and_add_test_results <- function(x, include, group = NULL, test.args,
                 test.args = test.args[[variable]],
                 adj.vars = adj.vars,
                 conf.level = conf.level,
-                continuous_variable = continuous_variable
+                continuous_variable = continuous_variable,
+                tbl = x
               )
             )
           )

R/sysdata.rda

@@ -1,11 +1,21 @@
+.data_pre_processing <- function(data, numeric = character(), factor = character()) {
+  for (v in numeric) {
+    data[[v]] <- as.numeric(data[[v]])
+  }
+  for (v in factor) {
+    data[[v]] <- as.factor(data[[v]])
+  }
+  data
+}
+
 # add_p.tbl_summary ------------------------------------------------------------
 add_p_test_t.test <- function(data, variable, by, test.args, conf.level = 0.95, ...) {
   check_pkg_installed("cardx")
   check_empty(c("group", "adj.vars"), ...)
 
   rlang::inject(
     cardx::ard_stats_t_test(
-      data = data,
+      data = .data_pre_processing(data, factor = by),
       variable = all_of(variable),
       by = all_of(by),
       conf.level = conf.level,
@@ -20,7 +30,7 @@ add_p_test_wilcox.test <- function(data, variable, by, test.args, conf.level = 0
 
   rlang::inject(
     cardx::ard_stats_wilcox_test(
-      data = data,
+      data = .data_pre_processing(data, factor = by, numeric = variable),
       variable = all_of(variable),
       by = all_of(by),
       conf.int = TRUE,
@@ -75,7 +85,7 @@ add_p_test_chisq.test <- function(data, variable, by, test.args, ...) {
 
   rlang::inject(
     cardx::ard_stats_chisq_test(
-      data = data,
+      data = .data_pre_processing(data, factor = by),
       variable = all_of(variable),
       by = all_of(by),
       !!!test.args
@@ -103,7 +113,7 @@ add_p_test_mood.test <- function(data, variable, by, test.args, ...) {
 
   rlang::inject(
     cardx::ard_stats_mood_test(
-      data = data,
+      data = .data_pre_processing(data, factor = by),
       variable = all_of(variable),
       by = all_of(by),
       !!!test.args
@@ -117,7 +127,7 @@ add_p_test_kruskal.test <- function(data, variable, by, ...) {
   check_empty(c("group", "adj.vars", "test.args"), ...)
 
   cardx::ard_stats_kruskal_test(
-    data = data,
+    data = .data_pre_processing(data, factor = by),
     variable = all_of(variable),
     by = all_of(by)
   )
@@ -129,7 +139,7 @@ add_p_test_fisher.test <- function(data, variable, by, test.args, conf.level = 0
 
   rlang::inject(
     cardx::ard_stats_fisher_test(
-      data = data,
+      data = .data_pre_processing(data, factor = by),
       variable = all_of(variable),
       by = all_of(by),
       conf.level = conf.level,
@@ -152,7 +162,8 @@ add_p_test_aov <- function(data, variable, by, ...) {
     i = "The same functionality is covered in {.val oneway.test} with argument `var.equal = TRUE`."
   ))
 
-  add_p_test_oneway.test(data = data, variable = variable, by = by, test.args = list(var.equal = TRUE))
+  add_p_test_oneway.test(data = .data_pre_processing(data, factor = by),
+                         variable = variable, by = by, test.args = list(var.equal = TRUE))
 }
 
 add_p_test_oneway.test <- function(data, variable, by, test.args, ...) {
@@ -162,25 +173,12 @@ add_p_test_oneway.test <- function(data, variable, by, test.args, ...) {
   rlang::inject(
     cardx::ard_stats_oneway_test(
       formula = cardx::reformulate2(termlabels = by, response = variable),
-      data = data,
+      data = .data_pre_processing(data, factor = by),
       !!!test.args
     )
   )
 }
 
-add_p_test_mood.test <- function(data, variable, by, ...) {
-  check_pkg_installed("cardx")
-  check_empty(c("group", "adj.vars", "test.args"), ...)
-
-  rlang::inject(
-    cardx::ard_stats_mood_test(
-      data = data,
-      variable = all_of(variable),
-      by = all_of(by)
-    )
-  )
-}
-
 add_p_test_lme4 <- function(data, variable, by, group, ...) {
   check_pkg_installed("cardx")
   check_pkg_installed("lme4", ref = "cardx")
@@ -247,10 +245,16 @@ add_p_tbl_summary_paired.wilcox.test <- function(data, variable, by, group, test
   )
 }
 
-add_p_test_prop.test <- function(data, variable, by, test.args, conf.level = 0.95, ...) {
+add_p_test_prop.test <- function(data, variable, by, test.args, conf.level = 0.95, tbl, ...) {
   check_pkg_installed("cardx")
   check_empty(c("adj.vars", "group"), ...)
 
+  # convert variable to lgl using the `value` argument
+  if (identical(tbl$inputs$type[[variable]], "dichotomous") &&
+      !is_empty(tbl$inputs$value[[variable]])) {
+    data[[variable]] <- data[[variable]] == tbl$inputs$value[[variable]]
+  }
+
   rlang::inject(
     cardx::ard_stats_prop_test(
       data = data,

R/utils-add_p_tests.R

@@ -1,19 +1,19 @@
 class,add_p,add_difference,diff_statistic,test_package,test_name,test_fun,fun_to_run,accept_dots,pseudo_code,description,details
-tbl_summary,TRUE,TRUE,mean difference,stats,t.test,stats::t.test,gtsummary:::add_p_test_t.test,TRUE,"t.test(variable ~ by, data = data, conf.level = 0.95, ...)",t-test,
-tbl_summary,TRUE,FALSE,,stats,aov,stats::aov,gtsummary:::add_p_test_aov,FALSE,"aov(variable ~ by, data = data) %>% summary()",One-way ANOVA,
-tbl_summary,TRUE,FALSE,,stats,mood.test,stats::mood.test,gtsummary:::add_p_test_mood.test,TRUE,"mood.test(variable ~ by, data = data, ...) ",Mood two-sample test of scale,Not to be confused with the Brown-Mood test of medians
-tbl_summary,TRUE,FALSE,,stats,oneway.test,stats::oneway.test,gtsummary:::add_p_test_oneway.test,TRUE,"oneway.test(variable ~ by, data = data, ...) ",One-way ANOVA,
-tbl_summary,TRUE,FALSE,,stats,kruskal.test,stats::kruskal.test,gtsummary:::add_p_test_kruskal.test,FALSE,"kruskal.test(x = data[[variable]], g = data[[by]])",Kruskal-Wallis test,
-tbl_summary,TRUE,TRUE,,stats,wilcox.test,stats::wilcox.test,gtsummary:::add_p_test_wilcox.test,TRUE,"wilcox.test(variable ~ by, data = data, conf.int = TRUE, conf.level = conf.level,  ...)",Wilcoxon rank-sum test,
-tbl_summary,TRUE,FALSE,,stats,chisq.test,stats::chisq.test,gtsummary:::add_p_test_chisq.test,TRUE,"chisq.test(x = data[[variable]], y = data[[by]], ...)",chi-square test of independence,
-tbl_summary,TRUE,FALSE,,stats,chisq.test.no.correct,,gtsummary:::add_p_test_chisq.test.no.correct,FALSE,"chisq.test(x = data[[variable]], y = data[[by]], correct = FALSE)",chi-square test of independence,
-tbl_summary,TRUE,FALSE,,stats,fisher.test,stats::fisher.test,gtsummary:::add_p_test_fisher.test,TRUE,"fisher.test(x = data[[variable]], y = data[[by]], conf.level = 0.95, ...)",Fisher's exact test,
+tbl_summary,TRUE,TRUE,mean difference,stats,t.test,stats::t.test,gtsummary:::add_p_test_t.test,TRUE,"t.test(variable ~ as.factor(by), data = data, conf.level = 0.95, ...)",t-test,
+tbl_summary,TRUE,FALSE,,stats,aov,stats::aov,gtsummary:::add_p_test_aov,FALSE,"aov(variable ~ as.factor(by), data = data) %>% summary()",One-way ANOVA,
+tbl_summary,TRUE,FALSE,,stats,mood.test,stats::mood.test,gtsummary:::add_p_test_mood.test,TRUE,"mood.test(variable ~ as.factor(by), data = data, ...)",Mood two-sample test of scale,Not to be confused with the Brown-Mood test of medians
+tbl_summary,TRUE,FALSE,,stats,oneway.test,stats::oneway.test,gtsummary:::add_p_test_oneway.test,TRUE,"oneway.test(variable ~ as.factor(by), data = data, ...)",One-way ANOVA,
+tbl_summary,TRUE,FALSE,,stats,kruskal.test,stats::kruskal.test,gtsummary:::add_p_test_kruskal.test,FALSE,"	kruskal.test(data[[variable]], as.factor(data[[by]]))",Kruskal-Wallis test,
+tbl_summary,TRUE,TRUE,,stats,wilcox.test,stats::wilcox.test,gtsummary:::add_p_test_wilcox.test,TRUE,"wilcox.test(as.numeric(variable) ~ as.factor(by), data = data, conf.int = TRUE, conf.level = conf.level,  ...)",Wilcoxon rank-sum test,
+tbl_summary,TRUE,FALSE,,stats,chisq.test,stats::chisq.test,gtsummary:::add_p_test_chisq.test,TRUE,"	chisq.test(x = data[[variable]], y = as.factor(data[[by]]), ...)",chi-square test of independence,
+tbl_summary,TRUE,FALSE,,stats,chisq.test.no.correct,,gtsummary:::add_p_test_chisq.test.no.correct,FALSE,"chisq.test(x = data[[variable]], y = as.factor(data[[by]]), correct = FALSE)",chi-square test of independence,
+tbl_summary,TRUE,FALSE,,stats,fisher.test,stats::fisher.test,gtsummary:::add_p_test_fisher.test,TRUE,"fisher.test(data[[variable]], as.factor(data[[by]]), conf.level = 0.95, ...)",Fisher's exact test,
 tbl_summary,TRUE,FALSE,,stats,mcnemar.test,stats::mcnemar.test,gtsummary:::add_p_test_mcnemar.test,TRUE,"tidyr::pivot_wider(id_cols = group, ...); mcnemar.test(by_1, by_2, conf.level = 0.95, ...)",McNemar's test,
 tbl_summary,TRUE,FALSE,,stats,mcnemar.test.wide,,gtsummary:::add_p_test_mcnemar.test_wide,TRUE,"mcnemar.test(data[[variable]], data[[by]], conf.level = 0.95, ...)",McNemar's test,
 tbl_summary,TRUE,FALSE,,lme4,lme4,lme4::glmer,gtsummary:::add_p_test_lme4,FALSE,"lme4::glmer(by ~ (1 \UFF5C group), data, family = binomial) %>% anova(lme4::glmer(by ~ variable + (1 \UFF5C group), data, family = binomial))",random intercept logistic regression,
 tbl_summary,TRUE,TRUE,mean difference,stats,paired.t.test,,gtsummary:::add_p_tbl_summary_paired.t.test,TRUE,"tidyr::pivot_wider(id_cols = group, ...); t.test(by_1, by_2, paired = TRUE, conf.level = 0.95, ...)",Paired t-test,
 tbl_summary,TRUE,FALSE,,stats,paired.wilcox.test,,gtsummary:::add_p_tbl_summary_paired.wilcox.test,TRUE,"tidyr::pivot_wider(id_cols = group, ...); wilcox.test(by_1, by_2, paired = TRUE, conf.int = TRUE, conf.level = 0.95, ...)",Paired Wilcoxon rank-sum test,
-tbl_summary,TRUE,TRUE,rate difference,stats,prop.test,stats::prop.test,gtsummary:::add_p_test_prop.test,TRUE,"prop.test(x, n, conf.level = 0.95, ...)",Test for equality of proportions,
+tbl_summary,TRUE,TRUE,rate difference,stats,prop.test,stats::prop.test,gtsummary:::add_p_test_prop.test,TRUE,"prop.test(x, n, conf.level = 0.95, ...)",Test for equality of proportions,"For dichotomous comparisons, the 'variable' is first converted to a logical."
 tbl_summary,TRUE,TRUE,mean difference,stats,ancova,,gtsummary:::add_p_test_ancova,FALSE,lm(variable ~ by + adj.vars),ANCOVA,
 tbl_summary,FALSE,TRUE,mean difference,stats,ancova_lme4,,gtsummary:::add_p_test_ancova_lme4,FALSE,"lme4::lmer(variable ~ by + adj.vars + (1 \UFF5C group), data)",ANCOVA with random intercept,
 tbl_summary,FALSE,TRUE,standardized mean difference,effectsize,cohens_d,effectsize::cohens_d,gtsummary:::add_p_test_cohens_d,TRUE,"effectsize::cohens_d(variable ~ by, data, ci = conf.level, verbose = FALSE, ...)",Cohen's D,

data-raw/gtsummary_tests.csv

@@ -634,3 +634,64 @@ test_that("ordering in add_difference.tbl_summary() with paired tests", {
       as.data.frame()
   )
 })
+
+test_that("addressing GH #2165: Non-logical dichotomous comparisons using prop.test()", {
+  # check the results are correct by matching ARDs
+  expect_equal(
+    trial |>
+      dplyr::mutate(response = factor(response, levels = c(0, 1), labels = c("no", "yes"))) |>
+      tbl_summary(
+        by = trt,
+        include = response
+      ) |>
+      add_difference() |>
+      gather_ard() |>
+      getElement("add_difference") |>
+      getElement("response") |>
+      dplyr::select(-"fmt_fn"),
+    trial |>
+      dplyr::mutate(response = response == 1) |>
+      cardx::ard_stats_prop_test(by = trt, variable = response) |>
+      dplyr::select(-"fmt_fn")
+  )
+
+  # check when the value presented is the opposite (FALSE)
+  expect_equal(
+    trial |>
+      dplyr::mutate(response = as.logical(response)) |>
+      tbl_summary(
+        by = trt,
+        include = response,
+        value = list(response = FALSE)
+      ) |>
+      add_difference() |>
+      gather_ard() |>
+      getElement("add_difference") |>
+      getElement("response") |>
+      dplyr::select(-"fmt_fn"),
+    trial |>
+      dplyr::mutate(response = response == 0) |>
+      cardx::ard_stats_prop_test(by = trt, variable = response) |>
+      dplyr::select(-"fmt_fn")
+  )
+
+  # check results when variable has >2 levels
+  expect_equal(
+    trial |>
+      tbl_summary(
+        by = trt,
+        include = grade,
+        value = list(grade = "I")
+      ) |>
+      add_difference() |>
+      gather_ard() |>
+      getElement("add_difference") |>
+      getElement("grade") |>
+      dplyr::select(-"fmt_fn"),
+    trial |>
+      dplyr::mutate(grade = grade == "I") |>
+      cardx::ard_stats_prop_test(by = trt, variable = grade) |>
+      dplyr::select(-"fmt_fn")
+  )
+})
+