From 79364a9faf86564b9003428ddfb6decd92524141 Mon Sep 17 00:00:00 2001 From: harrism1 Date: Mon, 21 Oct 2024 16:32:31 -0400 Subject: [PATCH 1/6] init theme elements test suite --- .../_snaps/theme_elements_gtsummary.md | 14 ++ .../testthat/test-theme_elements_gtsummary.R | 146 ++++++++++++++++++ 2 files changed, 160 insertions(+) create mode 100644 tests/testthat/_snaps/theme_elements_gtsummary.md create mode 100644 tests/testthat/test-theme_elements_gtsummary.R diff --git a/tests/testthat/_snaps/theme_elements_gtsummary.md b/tests/testthat/_snaps/theme_elements_gtsummary.md new file mode 100644 index 000000000..9ca62de20 --- /dev/null +++ b/tests/testthat/_snaps/theme_elements_gtsummary.md @@ -0,0 +1,14 @@ +# pkgwide-str:ci.sep works + + Code + show_header_names(gts_5) + Output + Column Name Header level* N* n* p* + label "**Característica**" 200 + stat_1 "**Drug A** \nN = 98" Drug A 200 98 0.490 + stat_2 "**Drug B** \nN = 102" Drug B 200 102 0.510 + + Message + * These values may be dynamically placed into headers (and other locations). + i Review the `modify_header()` (`?gtsummary::modify()`) help for examples. + diff --git a/tests/testthat/test-theme_elements_gtsummary.R b/tests/testthat/test-theme_elements_gtsummary.R new file mode 100644 index 000000000..88467c9fe --- /dev/null +++ b/tests/testthat/test-theme_elements_gtsummary.R @@ -0,0 +1,146 @@ +# Package-wide Unit Tests------------------------------------------------------- +## pkgwide-fn:prependpvalue_fun------------------------------------------------- +test_that("pkgwide-fn:prependpvalue_fun works", { + + # Create a theme# + my_theme_1 <- + list( + # Prepend p value, with 3 place digits + "pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE) + ) + + # Set the theme + set_gtsummary_theme(my_theme_1) + + # Store the table# + gts_1 <- + trial |> + tbl_summary( + by = trt, + include = c(trt, age), + ) |> + add_p() + + # Test that the p-value has 3 digits# + expect_true( + inline_text(gts_1, variable = age, column = "p.value") |> + grepl(pattern = "p=0.\\d{3}", x = _) + ) + # Reset the theming# + reset_gtsummary_theme() +} +) + +## pkgwide-fn:pvalue_fun-------------------------------------------------------- +test_that("pkgwide-fn:pvalue_fun works", { + + # Create a theme# + my_theme_2 <- + list( + # Prepend p value, with 3 place digits + "pkgwide-fn:pvalue_fun" = label_style_pvalue(digits = 1, prefix = "Totally Awesome P Value = ", "OutDec" = ",") + ) + + # Set the theme + set_gtsummary_theme(my_theme_2) + + # Store the table# + gts_2 <- + trial |> + tbl_summary( + by = trt, + include = c(trt, age), + ) |> + add_p() + + # Test that the p-value has the correct digits and prefix# + expect_true( + inline_text.gtsummary(gts_2, variable = age, column = "p.value") |> + grepl(pattern = "Totally Awesome P Value = 0.\\d{1}", x = _) + ) + + + # Reset the theming# + reset_gtsummary_theme() +} +) + +## pkgwide-lgl:quiet------------------------------------------------------------ +test_that("pkgwide-lgl:quiet works", { + + # Create a theme# + my_theme_3 <- + list( + # set messaging to quiet + "pkgwide-lgl:quiet" = TRUE + ) + + # Set the theme + set_gtsummary_theme(my_theme_3) + + # Test that the lgl value can be found# + expect_equal( + get_theme_element("pkgwide-lgl:quiet"), TRUE + ) + # Reset the theming# + reset_gtsummary_theme() +} +) + +## pkgwide-str:ci.sep----------------------------------------------------------- +test_that("pkgwide-str:ci.sep works", { + + # Create a theme# + my_theme_4 <- + list( + # Set CI sep to be something *cute* + "pkgwide-str:ci.sep" = "~*~" + ) + + # Set the theme + set_gtsummary_theme(my_theme_4) + + # Create the table# + gts_4 <- + glm(response ~ age + stage, trial, family = binomial) |> + tbl_regression(x = _, exponentiate = TRUE) + + # Test that the CI has the correct pattern somewhere# + expect_true( + gts_4$table_body$ci |> grepl("~*~", x = _) |> any() + ) + # Reset the theming# + reset_gtsummary_theme() +} +) + +## pkgwide-str:language--------------------------------------------------------- +test_that("pkgwide-str:ci.sep works", { + + # Create a theme# + my_theme_5 <- + list( + # configurar el idioma en español# + "pkgwide-str:language" = "es" + ) + + # Set the theme + set_gtsummary_theme(my_theme_5) + + # Create the table# + gts_5 <- + trial |> + tbl_summary( + by = trt, + include = c(trt, age), + ) + + # Test that the CI has the correct pattern somewhere# + expect_snapshot( + show_header_names(gts_5) + ) + # Reset the theming# + reset_gtsummary_theme() +} +) + From cefe843ff9867543f92a3384e58afa39d3cf75d1 Mon Sep 17 00:00:00 2001 From: harrism1 Date: Mon, 25 Nov 2024 10:51:40 -0500 Subject: [PATCH 2/6] added unit tests for pkgwide theme elements --- .../_snaps/theme_elements_gtsummary.md | 17 +- .../testthat/test-theme_elements_gtsummary.R | 218 ++++++++++++------ 2 files changed, 157 insertions(+), 78 deletions(-) diff --git a/tests/testthat/_snaps/theme_elements_gtsummary.md b/tests/testthat/_snaps/theme_elements_gtsummary.md index 9ca62de20..98027c5c4 100644 --- a/tests/testthat/_snaps/theme_elements_gtsummary.md +++ b/tests/testthat/_snaps/theme_elements_gtsummary.md @@ -1,14 +1,27 @@ -# pkgwide-str:ci.sep works +# pkgwide-str:language works Code - show_header_names(gts_5) + show_header_names(gts_2) Output Column Name Header level* N* n* p* label "**Característica**" 200 stat_1 "**Drug A** \nN = 98" Drug A 200 98 0.490 stat_2 "**Drug B** \nN = 102" Drug B 200 102 0.510 + p.value "**p-valor**" 200 Message * These values may be dynamically placed into headers (and other locations). i Review the `modify_header()` (`?gtsummary::modify()`) help for examples. +# pkgwide-str:theme_name works + + Code + set_gtsummary_theme(my_theme_5) + Message + Setting theme "Super Cool Themey Theme" + +# pkgwide-fun:pre_conversion works + + Code + gts_6 + diff --git a/tests/testthat/test-theme_elements_gtsummary.R b/tests/testthat/test-theme_elements_gtsummary.R index 88467c9fe..b4b9fff36 100644 --- a/tests/testthat/test-theme_elements_gtsummary.R +++ b/tests/testthat/test-theme_elements_gtsummary.R @@ -2,50 +2,18 @@ ## pkgwide-fn:prependpvalue_fun------------------------------------------------- test_that("pkgwide-fn:prependpvalue_fun works", { - # Create a theme# - my_theme_1 <- - list( - # Prepend p value, with 3 place digits - "pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE) - ) - - # Set the theme - set_gtsummary_theme(my_theme_1) - - # Store the table# - gts_1 <- - trial |> - tbl_summary( - by = trt, - include = c(trt, age), - ) |> - add_p() - - # Test that the p-value has 3 digits# - expect_true( - inline_text(gts_1, variable = age, column = "p.value") |> - grepl(pattern = "p=0.\\d{3}", x = _) - ) - # Reset the theming# - reset_gtsummary_theme() -} -) - -## pkgwide-fn:pvalue_fun-------------------------------------------------------- -test_that("pkgwide-fn:pvalue_fun works", { - # Create a theme# - my_theme_2 <- + my_theme_1 <- list( # Prepend p value, with 3 place digits - "pkgwide-fn:pvalue_fun" = label_style_pvalue(digits = 1, prefix = "Totally Awesome P Value = ", "OutDec" = ",") + "pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE) ) # Set the theme - set_gtsummary_theme(my_theme_2) + set_gtsummary_theme(my_theme_1) # Store the table# - gts_2 <- + gts_1 <- trial |> tbl_summary( by = trt, @@ -53,94 +21,192 @@ test_that("pkgwide-fn:pvalue_fun works", { ) |> add_p() - # Test that the p-value has the correct digits and prefix# + # Test that the p-value has 3 digits# expect_true( - inline_text.gtsummary(gts_2, variable = age, column = "p.value") |> - grepl(pattern = "Totally Awesome P Value = 0.\\d{1}", x = _) + inline_text(gts_1, variable = age, column = "p.value") |> + grepl(pattern = "p=0.\\d{3}", x = _) ) - - # Reset the theming# reset_gtsummary_theme() } ) +## Other pkgwide Tests---------------------------------------------------------- +# Create a theme# +my_theme_2 <- + list( + # Prepend p value, with 3 place digits + "pkgwide-fn:pvalue_fun" = label_style_pvalue(digits = 1, prefix = "Totally Awesome P Value = ", "OutDec" = ","), + # set messaging to quiet + "pkgwide-lgl:quiet" = TRUE, + # configurar el idioma en español# + "pkgwide-str:language" = "es" + ) + +# Set the theme +set_gtsummary_theme(my_theme_2) + +# Store the table# +gts_2 <- + trial |> + tbl_summary( + by = trt, + statistic = age ~ "{mean} ({sd})", + include = c(trt, age), + ) |> + add_p() + +### pkgwide-fn:pvalue_fun-------------------------------------------------------- +test_that("pkgwide-fn:pvalue_fun works", { + + # Test that the p-value has the correct digits and prefix# + expect_true( + inline_text.gtsummary(gts_2, variable = age, column = "p.value") |> + grepl(pattern = "Totally Awesome P Value = 0.\\d{1}", x = _) + ) + +} +) + ## pkgwide-lgl:quiet------------------------------------------------------------ test_that("pkgwide-lgl:quiet works", { + # Test that the lgl value can be found# + expect_true( + get_theme_element("pkgwide-lgl:quiet") + ) +} +) + +## pkgwide-str:language--------------------------------------------------------- +test_that("pkgwide-str:language works", { + + # Test that the CI has the correct pattern somewhere# + expect_snapshot( + show_header_names(gts_2) + ) + +} +) + +# Reset the theme +reset_gtsummary_theme() + +## pkgwide-str:ci.sep----------------------------------------------------------- +test_that("pkgwide-str:ci.sep works", { + # Create a theme# my_theme_3 <- list( - # set messaging to quiet - "pkgwide-lgl:quiet" = TRUE + # Set CI sep to be something *cute* + "pkgwide-str:ci.sep" = "~*~", + # Have the print engine be kable + "pkgwide-str:print_engine" = "kable" ) # Set the theme set_gtsummary_theme(my_theme_3) - # Test that the lgl value can be found# - expect_equal( - get_theme_element("pkgwide-lgl:quiet"), TRUE + gts_3 <- + with_gtsummary_theme( + my_theme_3, + glm(response ~ age + stage, trial, family = binomial) |> + tbl_regression(x = _, exponentiate = TRUE), + ) + + # Test that the CI has the correct pattern somewhere# + expect_true( + gts_3$table_body$ci |> + grepl("~*~", x = _) |> + any() ) - # Reset the theming# + + # Reset the theme reset_gtsummary_theme() + } ) -## pkgwide-str:ci.sep----------------------------------------------------------- -test_that("pkgwide-str:ci.sep works", { +# Reset the theming# +reset_gtsummary_theme() + +## pkgwide-str:print_engine----------------------------------------------------- +test_that("pkgwide-str:print_engine works", { # Create a theme# my_theme_4 <- list( - # Set CI sep to be something *cute* - "pkgwide-str:ci.sep" = "~*~" + # Have the print engine be kable + "pkgwide-str:print_engine" = "kable" ) - # Set the theme + # set the theme set_gtsummary_theme(my_theme_4) - # Create the table# + # Set the theme to check that table is in kable format gts_4 <- - glm(response ~ age + stage, trial, family = binomial) |> - tbl_regression(x = _, exponentiate = TRUE) + with_gtsummary_theme( + my_theme_4, + trial |> + dplyr::select(death, trt) |> + tbl_summary(by = trt) + ) - # Test that the CI has the correct pattern somewhere# - expect_true( - gts_4$table_body$ci |> grepl("~*~", x = _) |> any() - ) - # Reset the theming# + # This only works when a theme is set explicitly + # And not when it is just temporarily set with 'with_gtsummary_theme' + # Is this intentional behavior? + expect_true(grepl("|:-", gts_4) |> any()) + + # Reset the theme reset_gtsummary_theme() } ) -## pkgwide-str:language--------------------------------------------------------- -test_that("pkgwide-str:ci.sep works", { +## pkgwide-str:theme_name------------------------------------------------------- +test_that("pkgwide-str:theme_name works", { # Create a theme# my_theme_5 <- list( - # configurar el idioma en español# - "pkgwide-str:language" = "es" + # Set a theme name + "pkgwide-str:theme_name" = "Super Cool Themey Theme" ) - # Set the theme - set_gtsummary_theme(my_theme_5) + expect_snapshot( + set_gtsummary_theme(my_theme_5) + ) - # Create the table# - gts_5 <- - trial |> - tbl_summary( - by = trt, - include = c(trt, age), + # Reset the theme + reset_gtsummary_theme() +} +) + + +## pkgwide-fun:pre_conversion--------------------------------------------------- +test_that("pkgwide-fun:pre_conversion works", { + + # Create a theme# + my_theme_6 <- + list( + # Set a fx to use in pre conversion + "pkgwide-fun:pre_conversion" = add_ci ) - # Test that the CI has the correct pattern somewhere# + # Set the theme + set_gtsummary_theme(my_theme_6) + gts_6 <- + trial |> + dplyr::select(death, trt) |> + tbl_summary(by = trt) + + # This only works when a theme is set explicitly + # And not when it is just temporarily set with 'with_gtsummary_theme' + # Is this intentional behavior? expect_snapshot( - show_header_names(gts_5) + gts_6 ) - # Reset the theming# + + # Reset the theme reset_gtsummary_theme() } ) - From 92d681373ec05cf41c57119a96e853b095463a5b Mon Sep 17 00:00:00 2001 From: harrism1 Date: Mon, 2 Dec 2024 20:19:19 -0500 Subject: [PATCH 3/6] added DS feedback --- man/tests.Rd | 114 +++++------ .../_snaps/theme_elements_gtsummary.md | 28 +-- .../testthat/test-theme_elements_gtsummary.R | 189 +++++++++--------- 3 files changed, 157 insertions(+), 174 deletions(-) diff --git a/man/tests.Rd b/man/tests.Rd index ee1b2cde6..e649d16a6 100644 --- a/man/tests.Rd +++ b/man/tests.Rd @@ -14,93 +14,93 @@ calculate a p-value from \code{t.test()} assuming equal variance, use \section{\code{tbl_summary() \%>\% add_p()}}{ \tabular{llll}{ \strong{alias} \tab \strong{description} \tab \strong{pseudo-code} \tab \strong{details} \cr - \code{'t.test'} \tab t-test \tab \code{t.test(variable ~ as.factor(by), data = data, conf.level = 0.95, ...)} \tab \cr - \code{'mood.test'} \tab Mood two-sample test of scale \tab \code{mood.test(variable ~ as.factor(by), data = data, ...)} \tab Not to be confused with the Brown-Mood test of medians \cr - \code{'oneway.test'} \tab One-way ANOVA \tab \code{oneway.test(variable ~ as.factor(by), data = data, ...)} \tab \cr - \code{'kruskal.test'} \tab Kruskal-Wallis test \tab \code{kruskal.test(data[[variable]], as.factor(data[[by]]))} \tab \cr - \code{'wilcox.test'} \tab Wilcoxon rank-sum test \tab \code{wilcox.test(as.numeric(variable) ~ as.factor(by), data = data, conf.int = TRUE, conf.level = conf.level, ...)} \tab \cr - \code{'chisq.test'} \tab chi-square test of independence \tab \code{chisq.test(x = data[[variable]], y = as.factor(data[[by]]), ...)} \tab \cr - \code{'chisq.test.no.correct'} \tab chi-square test of independence \tab \code{chisq.test(x = data[[variable]], y = as.factor(data[[by]]), correct = FALSE)} \tab \cr - \code{'fisher.test'} \tab Fisher's exact test \tab \code{fisher.test(data[[variable]], as.factor(data[[by]]), conf.level = 0.95, ...)} \tab \cr - \code{'mcnemar.test'} \tab McNemar's test \tab \verb{tidyr::pivot_wider(id_cols = group, ...); mcnemar.test(by_1, by_2, conf.level = 0.95, ...)} \tab \cr - \code{'mcnemar.test.wide'} \tab McNemar's test \tab \code{mcnemar.test(data[[variable]], data[[by]], conf.level = 0.95, ...)} \tab \cr - \code{'lme4'} \tab random intercept logistic regression \tab \verb{lme4::glmer(by ~ (1 \\UFF5C group), data, family = binomial) \%>\% anova(lme4::glmer(by ~ variable + (1 \\UFF5C group), data, family = binomial))} \tab \cr - \code{'paired.t.test'} \tab Paired t-test \tab \verb{tidyr::pivot_wider(id_cols = group, ...); t.test(by_1, by_2, paired = TRUE, conf.level = 0.95, ...)} \tab \cr - \code{'paired.wilcox.test'} \tab Paired Wilcoxon rank-sum test \tab \verb{tidyr::pivot_wider(id_cols = group, ...); wilcox.test(by_1, by_2, paired = TRUE, conf.int = TRUE, conf.level = 0.95, ...)} \tab \cr - \code{'prop.test'} \tab Test for equality of proportions \tab \code{prop.test(x, n, conf.level = 0.95, ...)} \tab \cr - \code{'ancova'} \tab ANCOVA \tab \code{lm(variable ~ by + adj.vars)} \tab \cr - \code{'emmeans'} \tab Estimated Marginal Means or LS-means \tab \code{lm(variable ~ by + adj.vars, data) \%>\% emmeans::emmeans(specs =~by) \%>\% emmeans::contrast(method = "pairwise") \%>\% summary(infer = TRUE, level = conf.level)} \tab When variable is binary, \code{glm(family = binomial)} and \code{emmeans(regrid = "response")} arguments are used. When \code{group} is specified, \code{lme4::lmer()} and \code{lme4::glmer()} are used with the group as a random intercept. \cr + \code{"t.test"} \tab t-test \tab \code{t.test(variable ~ as.factor(by), data = data, conf.level = 0.95, ...)} \tab \cr + \code{"mood.test"} \tab Mood two-sample test of scale \tab \code{mood.test(variable ~ as.factor(by), data = data, ...)} \tab Not to be confused with the Brown-Mood test of medians \cr + \code{"oneway.test"} \tab One-way ANOVA \tab \code{oneway.test(variable ~ as.factor(by), data = data, ...)} \tab \cr + \code{"kruskal.test"} \tab Kruskal-Wallis test \tab \code{kruskal.test(data[[variable]], as.factor(data[[by]]))} \tab \cr + \code{"wilcox.test"} \tab Wilcoxon rank-sum test \tab \code{wilcox.test(as.numeric(variable) ~ as.factor(by), data = data, conf.int = TRUE, conf.level = conf.level, ...)} \tab \cr + \code{"chisq.test"} \tab chi-square test of independence \tab \code{chisq.test(x = data[[variable]], y = as.factor(data[[by]]), ...)} \tab \cr + \code{"chisq.test.no.correct"} \tab chi-square test of independence \tab \code{chisq.test(x = data[[variable]], y = as.factor(data[[by]]), correct = FALSE)} \tab \cr + \code{"fisher.test"} \tab Fisher's exact test \tab \code{fisher.test(data[[variable]], as.factor(data[[by]]), conf.level = 0.95, ...)} \tab \cr + \code{"mcnemar.test"} \tab McNemar's test \tab \verb{tidyr::pivot_wider(id_cols = group, ...); mcnemar.test(by_1, by_2, conf.level = 0.95, ...)} \tab \cr + \code{"mcnemar.test.wide"} \tab McNemar's test \tab \code{mcnemar.test(data[[variable]], data[[by]], conf.level = 0.95, ...)} \tab \cr + \code{"lme4"} \tab random intercept logistic regression \tab \verb{lme4::glmer(by ~ (1 \\UFF5C group), data, family = binomial) \%>\% anova(lme4::glmer(by ~ variable + (1 \\UFF5C group), data, family = binomial))} \tab \cr + \code{"paired.t.test"} \tab Paired t-test \tab \verb{tidyr::pivot_wider(id_cols = group, ...); t.test(by_1, by_2, paired = TRUE, conf.level = 0.95, ...)} \tab \cr + \code{"paired.wilcox.test"} \tab Paired Wilcoxon rank-sum test \tab \verb{tidyr::pivot_wider(id_cols = group, ...); wilcox.test(by_1, by_2, paired = TRUE, conf.int = TRUE, conf.level = 0.95, ...)} \tab \cr + \code{"prop.test"} \tab Test for equality of proportions \tab \code{prop.test(x, n, conf.level = 0.95, ...)} \tab \cr + \code{"ancova"} \tab ANCOVA \tab \code{lm(variable ~ by + adj.vars)} \tab \cr + \code{"emmeans"} \tab Estimated Marginal Means or LS-means \tab \code{lm(variable ~ by + adj.vars, data) \%>\% emmeans::emmeans(specs =~by) \%>\% emmeans::contrast(method = "pairwise") \%>\% summary(infer = TRUE, level = conf.level)} \tab When variable is binary, \code{glm(family = binomial)} and \code{emmeans(regrid = "response")} arguments are used. When \code{group} is specified, \code{lme4::lmer()} and \code{lme4::glmer()} are used with the group as a random intercept. \cr } } \section{\code{tbl_svysummary() \%>\% add_p()}}{ \tabular{llll}{ \strong{alias} \tab \strong{description} \tab \strong{pseudo-code} \tab \strong{details} \cr - \code{'svy.t.test'} \tab t-test adapted to complex survey samples \tab \code{survey::svyttest(~variable + by, data)} \tab \cr - \code{'svy.wilcox.test'} \tab Wilcoxon rank-sum test for complex survey samples \tab \code{survey::svyranktest(~variable + by, data, test = 'wilcoxon')} \tab \cr - \code{'svy.kruskal.test'} \tab Kruskal-Wallis rank-sum test for complex survey samples \tab \code{survey::svyranktest(~variable + by, data, test = 'KruskalWallis')} \tab \cr - \code{'svy.vanderwaerden.test'} \tab van der Waerden's normal-scores test for complex survey samples \tab \code{survey::svyranktest(~variable + by, data, test = 'vanderWaerden')} \tab \cr - \code{'svy.median.test'} \tab Mood's test for the median for complex survey samples \tab \code{survey::svyranktest(~variable + by, data, test = 'median')} \tab \cr - \code{'svy.chisq.test'} \tab chi-squared test with Rao & Scott's second-order correction \tab \code{survey::svychisq(~variable + by, data, statistic = 'F')} \tab \cr - \code{'svy.adj.chisq.test'} \tab chi-squared test adjusted by a design effect estimate \tab \code{survey::svychisq(~variable + by, data, statistic = 'Chisq')} \tab \cr - \code{'svy.wald.test'} \tab Wald test of independence for complex survey samples \tab \code{survey::svychisq(~variable + by, data, statistic = 'Wald')} \tab \cr - \code{'svy.adj.wald.test'} \tab adjusted Wald test of independence for complex survey samples \tab \code{survey::svychisq(~variable + by, data, statistic = 'adjWald')} \tab \cr - \code{'svy.lincom.test'} \tab test of independence using the exact asymptotic distribution for complex survey samples \tab \code{survey::svychisq(~variable + by, data, statistic = 'lincom')} \tab \cr - \code{'svy.saddlepoint.test'} \tab test of independence using a saddlepoint approximation for complex survey samples \tab \code{survey::svychisq(~variable + by, data, statistic = 'saddlepoint')} \tab \cr - \code{'emmeans'} \tab Estimated Marginal Means or LS-means \tab \code{survey::svyglm(variable ~ by + adj.vars, data) \%>\% emmeans::emmeans(specs =~by) \%>\% emmeans::contrast(method = "pairwise") \%>\% summary(infer = TRUE, level = conf.level)} \tab When variable is binary, \code{survey::svyglm(family = binomial)} and \code{emmeans(regrid = "response")} arguments are used. \cr + \code{"svy.t.test"} \tab t-test adapted to complex survey samples \tab \code{survey::svyttest(~variable + by, data)} \tab \cr + \code{"svy.wilcox.test"} \tab Wilcoxon rank-sum test for complex survey samples \tab \code{survey::svyranktest(~variable + by, data, test = 'wilcoxon')} \tab \cr + \code{"svy.kruskal.test"} \tab Kruskal-Wallis rank-sum test for complex survey samples \tab \code{survey::svyranktest(~variable + by, data, test = 'KruskalWallis')} \tab \cr + \code{"svy.vanderwaerden.test"} \tab van der Waerden's normal-scores test for complex survey samples \tab \code{survey::svyranktest(~variable + by, data, test = 'vanderWaerden')} \tab \cr + \code{"svy.median.test"} \tab Mood's test for the median for complex survey samples \tab \code{survey::svyranktest(~variable + by, data, test = 'median')} \tab \cr + \code{"svy.chisq.test"} \tab chi-squared test with Rao & Scott's second-order correction \tab \code{survey::svychisq(~variable + by, data, statistic = 'F')} \tab \cr + \code{"svy.adj.chisq.test"} \tab chi-squared test adjusted by a design effect estimate \tab \code{survey::svychisq(~variable + by, data, statistic = 'Chisq')} \tab \cr + \code{"svy.wald.test"} \tab Wald test of independence for complex survey samples \tab \code{survey::svychisq(~variable + by, data, statistic = 'Wald')} \tab \cr + \code{"svy.adj.wald.test"} \tab adjusted Wald test of independence for complex survey samples \tab \code{survey::svychisq(~variable + by, data, statistic = 'adjWald')} \tab \cr + \code{"svy.lincom.test"} \tab test of independence using the exact asymptotic distribution for complex survey samples \tab \code{survey::svychisq(~variable + by, data, statistic = 'lincom')} \tab \cr + \code{"svy.saddlepoint.test"} \tab test of independence using a saddlepoint approximation for complex survey samples \tab \code{survey::svychisq(~variable + by, data, statistic = 'saddlepoint')} \tab \cr + \code{"emmeans"} \tab Estimated Marginal Means or LS-means \tab \code{survey::svyglm(variable ~ by + adj.vars, data) \%>\% emmeans::emmeans(specs =~by) \%>\% emmeans::contrast(method = "pairwise") \%>\% summary(infer = TRUE, level = conf.level)} \tab When variable is binary, \code{survey::svyglm(family = binomial)} and \code{emmeans(regrid = "response")} arguments are used. \cr } } \section{\code{tbl_survfit() \%>\% add_p()}}{ \tabular{lll}{ \strong{alias} \tab \strong{description} \tab \strong{pseudo-code} \cr - \code{'logrank'} \tab Log-rank test \tab \code{survival::survdiff(Surv(.) ~ variable, data, rho = 0)} \cr - \code{'tarone'} \tab Tarone-Ware test \tab \code{survival::survdiff(Surv(.) ~ variable, data, rho = 1.5)} \cr - \code{'petopeto_gehanwilcoxon'} \tab Peto & Peto modification of Gehan-Wilcoxon test \tab \code{survival::survdiff(Surv(.) ~ variable, data, rho = 1)} \cr - \code{'survdiff'} \tab G-rho family test \tab \code{survival::survdiff(Surv(.) ~ variable, data, ...)} \cr - \code{'coxph_lrt'} \tab Cox regression (LRT) \tab \code{survival::coxph(Surv(.) ~ variable, data, ...)} \cr - \code{'coxph_wald'} \tab Cox regression (Wald) \tab \code{survival::coxph(Surv(.) ~ variable, data, ...)} \cr - \code{'coxph_score'} \tab Cox regression (Score) \tab \code{survival::coxph(Surv(.) ~ variable, data, ...)} \cr + \code{"logrank"} \tab Log-rank test \tab \code{survival::survdiff(Surv(.) ~ variable, data, rho = 0)} \cr + \code{"tarone"} \tab Tarone-Ware test \tab \code{survival::survdiff(Surv(.) ~ variable, data, rho = 1.5)} \cr + \code{"petopeto_gehanwilcoxon"} \tab Peto & Peto modification of Gehan-Wilcoxon test \tab \code{survival::survdiff(Surv(.) ~ variable, data, rho = 1)} \cr + \code{"survdiff"} \tab G-rho family test \tab \code{survival::survdiff(Surv(.) ~ variable, data, ...)} \cr + \code{"coxph_lrt"} \tab Cox regression (LRT) \tab \code{survival::coxph(Surv(.) ~ variable, data, ...)} \cr + \code{"coxph_wald"} \tab Cox regression (Wald) \tab \code{survival::coxph(Surv(.) ~ variable, data, ...)} \cr + \code{"coxph_score"} \tab Cox regression (Score) \tab \code{survival::coxph(Surv(.) ~ variable, data, ...)} \cr } } \section{\code{tbl_continuous() \%>\% add_p()}}{ \tabular{lll}{ \strong{alias} \tab \strong{description} \tab \strong{pseudo-code} \cr - \code{'anova_2way'} \tab Two-way ANOVA \tab \code{lm(continuous_variable ~ by + variable)} \cr - \code{'t.test'} \tab t-test \tab \code{t.test(continuous_variable ~ as.factor(variable), data = data, conf.level = 0.95, ...)} \cr - \code{'oneway.test'} \tab One-way ANOVA \tab \code{oneway.test(continuous_variable ~ as.factor(variable), data = data)} \cr - \code{'kruskal.test'} \tab Kruskal-Wallis test \tab \code{kruskal.test(data[[continuous_variable]], as.factor(data[[variable]]))} \cr - \code{'wilcox.test'} \tab Wilcoxon rank-sum test \tab \code{wilcox.test(as.numeric(continuous_variable) ~ as.factor(variable), data = data, ...)} \cr - \code{'lme4'} \tab random intercept logistic regression \tab \verb{lme4::glmer(by ~ (1 \\UFF5C group), data, family = binomial) \%>\% anova(lme4::glmer(variable ~ continuous_variable + (1 \\UFF5C group), data, family = binomial))} \cr - \code{'ancova'} \tab ANCOVA \tab \code{lm(continuous_variable ~ variable + adj.vars)} \cr + \code{"anova_2way"} \tab Two-way ANOVA \tab \code{lm(continuous_variable ~ by + variable)} \cr + \code{"t.test"} \tab t-test \tab \code{t.test(continuous_variable ~ as.factor(variable), data = data, conf.level = 0.95, ...)} \cr + \code{"oneway.test"} \tab One-way ANOVA \tab \code{oneway.test(continuous_variable ~ as.factor(variable), data = data)} \cr + \code{"kruskal.test"} \tab Kruskal-Wallis test \tab \code{kruskal.test(data[[continuous_variable]], as.factor(data[[variable]]))} \cr + \code{"wilcox.test"} \tab Wilcoxon rank-sum test \tab \code{wilcox.test(as.numeric(continuous_variable) ~ as.factor(variable), data = data, ...)} \cr + \code{"lme4"} \tab random intercept logistic regression \tab \verb{lme4::glmer(by ~ (1 \\UFF5C group), data, family = binomial) \%>\% anova(lme4::glmer(variable ~ continuous_variable + (1 \\UFF5C group), data, family = binomial))} \cr + \code{"ancova"} \tab ANCOVA \tab \code{lm(continuous_variable ~ variable + adj.vars)} \cr } } \section{tbl_summary() \%>\% add_difference()}{ \tabular{lllll}{ \strong{alias} \tab \strong{description} \tab \strong{difference statistic} \tab \strong{pseudo-code} \tab \strong{details} \cr - \code{'t.test'} \tab t-test \tab mean difference \tab \code{t.test(variable ~ as.factor(by), data = data, conf.level = 0.95, ...)} \tab \cr - \code{'wilcox.test'} \tab Wilcoxon rank-sum test \tab \tab \code{wilcox.test(as.numeric(variable) ~ as.factor(by), data = data, conf.int = TRUE, conf.level = conf.level, ...)} \tab \cr - \code{'paired.t.test'} \tab Paired t-test \tab mean difference \tab \verb{tidyr::pivot_wider(id_cols = group, ...); t.test(by_1, by_2, paired = TRUE, conf.level = 0.95, ...)} \tab \cr - \code{'prop.test'} \tab Test for equality of proportions \tab rate difference \tab \code{prop.test(x, n, conf.level = 0.95, ...)} \tab \cr - \code{'ancova'} \tab ANCOVA \tab mean difference \tab \code{lm(variable ~ by + adj.vars)} \tab \cr - \code{'ancova_lme4'} \tab ANCOVA with random intercept \tab mean difference \tab \verb{lme4::lmer(variable ~ by + adj.vars + (1 \\UFF5C group), data)} \tab \cr - \code{'cohens_d'} \tab Cohen's D \tab standardized mean difference \tab \code{effectsize::cohens_d(variable ~ by, data, ci = conf.level, verbose = FALSE, ...)} \tab \cr - \code{'hedges_g'} \tab Hedge's G \tab standardized mean difference \tab \code{effectsize::hedges_g(variable ~ by, data, ci = conf.level, verbose = FALSE, ...)} \tab \cr - \code{'paired_cohens_d'} \tab Paired Cohen's D \tab standardized mean difference \tab \verb{tidyr::pivot_wider(id_cols = group, ...); effectsize::cohens_d(by_1, by_2, paired = TRUE, conf.level = 0.95, verbose = FALSE, ...)} \tab \cr - \code{'paired_hedges_g'} \tab Paired Hedge's G \tab standardized mean difference \tab \verb{tidyr::pivot_wider(id_cols = group, ...); effectsize::hedges_g(by_1, by_2, paired = TRUE, conf.level = 0.95, verbose = FALSE, ...)} \tab \cr - \code{'smd'} \tab Standardized Mean Difference \tab standardized mean difference \tab \code{smd::smd(x = data[[variable]], g = data[[by]], std.error = TRUE)} \tab \cr - \code{'emmeans'} \tab Estimated Marginal Means or LS-means \tab adjusted mean difference \tab \code{lm(variable ~ by + adj.vars, data) \%>\% emmeans::emmeans(specs =~by) \%>\% emmeans::contrast(method = "pairwise") \%>\% summary(infer = TRUE, level = conf.level)} \tab When variable is binary, \code{glm(family = binomial)} and \code{emmeans(regrid = "response")} arguments are used. When \code{group} is specified, \code{lme4::lmer()} and \code{lme4::glmer()} are used with the group as a random intercept. \cr + \code{"t.test"} \tab t-test \tab mean difference \tab \code{t.test(variable ~ as.factor(by), data = data, conf.level = 0.95, ...)} \tab \cr + \code{"wilcox.test"} \tab Wilcoxon rank-sum test \tab \tab \code{wilcox.test(as.numeric(variable) ~ as.factor(by), data = data, conf.int = TRUE, conf.level = conf.level, ...)} \tab \cr + \code{"paired.t.test"} \tab Paired t-test \tab mean difference \tab \verb{tidyr::pivot_wider(id_cols = group, ...); t.test(by_1, by_2, paired = TRUE, conf.level = 0.95, ...)} \tab \cr + \code{"prop.test"} \tab Test for equality of proportions \tab rate difference \tab \code{prop.test(x, n, conf.level = 0.95, ...)} \tab \cr + \code{"ancova"} \tab ANCOVA \tab mean difference \tab \code{lm(variable ~ by + adj.vars)} \tab \cr + \code{"ancova_lme4"} \tab ANCOVA with random intercept \tab mean difference \tab \verb{lme4::lmer(variable ~ by + adj.vars + (1 \\UFF5C group), data)} \tab \cr + \code{"cohens_d"} \tab Cohen's D \tab standardized mean difference \tab \code{effectsize::cohens_d(variable ~ by, data, ci = conf.level, verbose = FALSE, ...)} \tab \cr + \code{"hedges_g"} \tab Hedge's G \tab standardized mean difference \tab \code{effectsize::hedges_g(variable ~ by, data, ci = conf.level, verbose = FALSE, ...)} \tab \cr + \code{"paired_cohens_d"} \tab Paired Cohen's D \tab standardized mean difference \tab \verb{tidyr::pivot_wider(id_cols = group, ...); effectsize::cohens_d(by_1, by_2, paired = TRUE, conf.level = 0.95, verbose = FALSE, ...)} \tab \cr + \code{"paired_hedges_g"} \tab Paired Hedge's G \tab standardized mean difference \tab \verb{tidyr::pivot_wider(id_cols = group, ...); effectsize::hedges_g(by_1, by_2, paired = TRUE, conf.level = 0.95, verbose = FALSE, ...)} \tab \cr + \code{"smd"} \tab Standardized Mean Difference \tab standardized mean difference \tab \code{smd::smd(x = data[[variable]], g = data[[by]], std.error = TRUE)} \tab \cr + \code{"emmeans"} \tab Estimated Marginal Means or LS-means \tab adjusted mean difference \tab \code{lm(variable ~ by + adj.vars, data) \%>\% emmeans::emmeans(specs =~by) \%>\% emmeans::contrast(method = "pairwise") \%>\% summary(infer = TRUE, level = conf.level)} \tab When variable is binary, \code{glm(family = binomial)} and \code{emmeans(regrid = "response")} arguments are used. When \code{group} is specified, \code{lme4::lmer()} and \code{lme4::glmer()} are used with the group as a random intercept. \cr } } \section{tbl_svysummary() \%>\% add_difference()}{ \tabular{lllll}{ \strong{alias} \tab \strong{description} \tab \strong{difference statistic} \tab \strong{pseudo-code} \tab \strong{details} \cr - \code{'smd'} \tab Standardized Mean Difference \tab standardized mean difference \tab \code{smd::smd(x = variable, g = by, w = weights(data), std.error = TRUE)} \tab \cr - \code{'svy.t.test'} \tab t-test adapted to complex survey samples \tab \tab \code{survey::svyttest(~variable + by, data)} \tab \cr - \code{'emmeans'} \tab Estimated Marginal Means or LS-means \tab adjusted mean difference \tab \code{survey::svyglm(variable ~ by + adj.vars, data) \%>\% emmeans::emmeans(specs =~by) \%>\% emmeans::contrast(method = "pairwise") \%>\% summary(infer = TRUE, level = conf.level)} \tab When variable is binary, \code{survey::svyglm(family = binomial)} and \code{emmeans(regrid = "response")} arguments are used. \cr + \code{"smd"} \tab Standardized Mean Difference \tab standardized mean difference \tab \code{smd::smd(x = variable, g = by, w = weights(data), std.error = TRUE)} \tab \cr + \code{"svy.t.test"} \tab t-test adapted to complex survey samples \tab \tab \code{survey::svyttest(~variable + by, data)} \tab \cr + \code{"emmeans"} \tab Estimated Marginal Means or LS-means \tab adjusted mean difference \tab \code{survey::svyglm(variable ~ by + adj.vars, data) \%>\% emmeans::emmeans(specs =~by) \%>\% emmeans::contrast(method = "pairwise") \%>\% summary(infer = TRUE, level = conf.level)} \tab When variable is binary, \code{survey::svyglm(family = binomial)} and \code{emmeans(regrid = "response")} arguments are used. \cr } } diff --git a/tests/testthat/_snaps/theme_elements_gtsummary.md b/tests/testthat/_snaps/theme_elements_gtsummary.md index 98027c5c4..d9d8fe59b 100644 --- a/tests/testthat/_snaps/theme_elements_gtsummary.md +++ b/tests/testthat/_snaps/theme_elements_gtsummary.md @@ -1,27 +1,11 @@ -# pkgwide-str:language works - - Code - show_header_names(gts_2) - Output - Column Name Header level* N* n* p* - label "**Característica**" 200 - stat_1 "**Drug A** \nN = 98" Drug A 200 98 0.490 - stat_2 "**Drug B** \nN = 102" Drug B 200 102 0.510 - p.value "**p-valor**" 200 - - Message - * These values may be dynamically placed into headers (and other locations). - i Review the `modify_header()` (`?gtsummary::modify()`) help for examples. - -# pkgwide-str:theme_name works - - Code - set_gtsummary_theme(my_theme_5) - Message - Setting theme "Super Cool Themey Theme" - # pkgwide-fun:pre_conversion works Code gts_6 + Output + + + |**Characteristic** | **Drug A** N = 98 | **95% CI** | **Drug B** N = 102 | **95% CI** | + |:------------------|:------------------:|:----------:|:-------------------:|:----------:| + |Patient Died | 52 (53%) | 43%, 63% | 60 (59%) | 49%, 68% | diff --git a/tests/testthat/test-theme_elements_gtsummary.R b/tests/testthat/test-theme_elements_gtsummary.R index b4b9fff36..a1e22dcae 100644 --- a/tests/testthat/test-theme_elements_gtsummary.R +++ b/tests/testthat/test-theme_elements_gtsummary.R @@ -9,25 +9,24 @@ test_that("pkgwide-fn:prependpvalue_fun works", { "pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE) ) - # Set the theme - set_gtsummary_theme(my_theme_1) - - # Store the table# + # Create a summary table# gts_1 <- trial |> tbl_summary( by = trt, - include = c(trt, age), + include = c(trt, age) ) |> add_p() + # Apply the theme to the table and pull out the p-value# + gts_1_pvalue <- + with_gtsummary_theme( + x = my_theme_1, + expr = inline_text(x = gts_1, variable = age, column = "p.value") + ) + # Test that the p-value has 3 digits# - expect_true( - inline_text(gts_1, variable = age, column = "p.value") |> - grepl(pattern = "p=0.\\d{3}", x = _) - ) - # Reset the theming# - reset_gtsummary_theme() + expect_equal(gts_1_pvalue, "p=0.718") } ) @@ -35,35 +34,33 @@ test_that("pkgwide-fn:prependpvalue_fun works", { # Create a theme# my_theme_2 <- list( - # Prepend p value, with 3 place digits - "pkgwide-fn:pvalue_fun" = label_style_pvalue(digits = 1, prefix = "Totally Awesome P Value = ", "OutDec" = ","), + # Pvalue with 2 place digits and custom decimal mark + "pkgwide-fn:pvalue_fun" = label_style_pvalue(digits = 2, decimal.mark = "++"), # set messaging to quiet "pkgwide-lgl:quiet" = TRUE, # configurar el idioma en español# "pkgwide-str:language" = "es" ) -# Set the theme -set_gtsummary_theme(my_theme_2) -# Store the table# -gts_2 <- - trial |> - tbl_summary( - by = trt, - statistic = age ~ "{mean} ({sd})", - include = c(trt, age), - ) |> - add_p() +# Apply the theme to the table and pull out the p-vale# +gts_2_pvalue <- + with_gtsummary_theme( + x = my_theme_2, + expr = trial |> + tbl_summary( + by = trt, + include = c(trt, age), + ) |> + add_p() |> + inline_text.gtsummary(x = _, variable = age, column = "p.value") + ) -### pkgwide-fn:pvalue_fun-------------------------------------------------------- +### pkgwide-fn:pvalue_fun------------------------------------------------------- test_that("pkgwide-fn:pvalue_fun works", { - # Test that the p-value has the correct digits and prefix# - expect_true( - inline_text.gtsummary(gts_2, variable = age, column = "p.value") |> - grepl(pattern = "Totally Awesome P Value = 0.\\d{1}", x = _) - ) + # Test that the p-value has the decimal mark# + expect_equal(gts_2_pvalue, "0++72") } ) @@ -72,8 +69,11 @@ test_that("pkgwide-fn:pvalue_fun works", { test_that("pkgwide-lgl:quiet works", { # Test that the lgl value can be found# - expect_true( - get_theme_element("pkgwide-lgl:quiet") + expect_silent( + with_gtsummary_theme( + x = my_theme_2, + expr = get_theme_element("pkgwide-lgl:quiet") + ) ) } ) @@ -81,16 +81,23 @@ test_that("pkgwide-lgl:quiet works", { ## pkgwide-str:language--------------------------------------------------------- test_that("pkgwide-str:language works", { - # Test that the CI has the correct pattern somewhere# - expect_snapshot( - show_header_names(gts_2) - ) - + # Pull out the headers to see if the language changed# + vec_gts2_headers <- + with_gtsummary_theme( + x = my_theme_2, + expr = trial |> + tbl_summary( + by = trt, + include = c(trt, age) + ) |> + add_p() + )[["table_styling"]][["header"]][["label"]] + + # Test that some of the headers were translated to Spanish# + expect_contains(vec_gts2_headers, "**Característica**") } ) -# Reset the theme -reset_gtsummary_theme() ## pkgwide-str:ci.sep----------------------------------------------------------- test_that("pkgwide-str:ci.sep works", { @@ -98,67 +105,55 @@ test_that("pkgwide-str:ci.sep works", { # Create a theme# my_theme_3 <- list( - # Set CI sep to be something *cute* - "pkgwide-str:ci.sep" = "~*~", - # Have the print engine be kable - "pkgwide-str:print_engine" = "kable" + # Set CI sep to be something *cute*# + "pkgwide-str:ci.sep" = " ~*~" ) - # Set the theme - set_gtsummary_theme(my_theme_3) - - gts_3 <- + # Apply the theme to the table and grab the CI value for age# + gts_ci_value <- with_gtsummary_theme( - my_theme_3, - glm(response ~ age + stage, trial, family = binomial) |> - tbl_regression(x = _, exponentiate = TRUE), + x = my_theme_3, + expr = glm(response ~ age + stage, trial, family = binomial) |> + tbl_regression(x = _, exponentiate = TRUE) |> + inline_text.gtsummary(x = _, variable = age, column = "ci") ) - # Test that the CI has the correct pattern somewhere# - expect_true( - gts_3$table_body$ci |> - grepl("~*~", x = _) |> - any() + # Test that the CI has the correct pattern# + expect_equal( + gts_ci_value, "1.00 ~*~ 1.04" ) - - # Reset the theme - reset_gtsummary_theme() - } ) -# Reset the theming# -reset_gtsummary_theme() - ## pkgwide-str:print_engine----------------------------------------------------- test_that("pkgwide-str:print_engine works", { # Create a theme# my_theme_4 <- list( - # Have the print engine be kable + # Have the print engine be kable# "pkgwide-str:print_engine" = "kable" ) - # set the theme - set_gtsummary_theme(my_theme_4) - - # Set the theme to check that table is in kable format - gts_4 <- + # Set the theme to check that table is in kable format# + gts_4_w_theme <- with_gtsummary_theme( - my_theme_4, - trial |> + x = my_theme_4, + expr = trial |> dplyr::select(death, trt) |> - tbl_summary(by = trt) + tbl_summary(by = trt) |> + print() ) - # This only works when a theme is set explicitly - # And not when it is just temporarily set with 'with_gtsummary_theme' - # Is this intentional behavior? - expect_true(grepl("|:-", gts_4) |> any()) + # Create the same table with as_kable instead# + gts_4_w_kable <- + trial |> + dplyr::select(death, trt) |> + tbl_summary(by = trt) |> + as_kable() - # Reset the theme - reset_gtsummary_theme() + # Test that the print engine output matches the kable version of the table# + expect_equal(gts_4_w_theme, gts_4_w_kable) } ) @@ -168,16 +163,19 @@ test_that("pkgwide-str:theme_name works", { # Create a theme# my_theme_5 <- list( - # Set a theme name + # Set a theme name# "pkgwide-str:theme_name" = "Super Cool Themey Theme" ) - expect_snapshot( - set_gtsummary_theme(my_theme_5) - ) + # Grab the theme name# + gts_5_theme_name <- + with_gtsummary_theme( + x = my_theme_5, + expr = get_gtsummary_theme() + )[["pkgwide-str:theme_name"]] - # Reset the theme - reset_gtsummary_theme() + # Test that the theme name matches as expected# + expect_equal(gts_5_theme_name, "Super Cool Themey Theme") } ) @@ -188,25 +186,26 @@ test_that("pkgwide-fun:pre_conversion works", { # Create a theme# my_theme_6 <- list( - # Set a fx to use in pre conversion - "pkgwide-fun:pre_conversion" = add_ci + # Set a fx to use in pre conversion# + "pkgwide-fun:pre_conversion" = add_ci, + # Have the print engine be kable# + "pkgwide-str:print_engine" = "kable" ) - # Set the theme - set_gtsummary_theme(my_theme_6) + # Apply the theme to the table and print it to see pre conversions# gts_6 <- - trial |> - dplyr::select(death, trt) |> - tbl_summary(by = trt) + with_gtsummary_theme( + x = my_theme_6, + expr = trial |> + dplyr::select(death, trt) |> + tbl_summary(by = trt) |> + print() + ) - # This only works when a theme is set explicitly - # And not when it is just temporarily set with 'with_gtsummary_theme' - # Is this intentional behavior? + # Test that the table includes the CI column# expect_snapshot( gts_6 ) - # Reset the theme - reset_gtsummary_theme() } ) From 54dca0803de4eabbda47d013f9f62635691fd265 Mon Sep 17 00:00:00 2001 From: harrism1 Date: Mon, 2 Dec 2024 20:20:34 -0500 Subject: [PATCH 4/6] nitpick format changes --- tests/testthat/test-theme_elements_gtsummary.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/tests/testthat/test-theme_elements_gtsummary.R b/tests/testthat/test-theme_elements_gtsummary.R index a1e22dcae..b0e57328e 100644 --- a/tests/testthat/test-theme_elements_gtsummary.R +++ b/tests/testthat/test-theme_elements_gtsummary.R @@ -119,9 +119,7 @@ test_that("pkgwide-str:ci.sep works", { ) # Test that the CI has the correct pattern# - expect_equal( - gts_ci_value, "1.00 ~*~ 1.04" - ) + expect_equal(gts_ci_value, "1.00 ~*~ 1.04") } ) From 84401998eebb0b19c7ebc7541e01e7dd3a0e379e Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Thu, 26 Dec 2024 16:03:05 -0800 Subject: [PATCH 5/6] Update test-theme_elements_gtsummary.R --- .../testthat/test-theme_elements_gtsummary.R | 56 ++++++------------- 1 file changed, 18 insertions(+), 38 deletions(-) diff --git a/tests/testthat/test-theme_elements_gtsummary.R b/tests/testthat/test-theme_elements_gtsummary.R index b0e57328e..69066e240 100644 --- a/tests/testthat/test-theme_elements_gtsummary.R +++ b/tests/testthat/test-theme_elements_gtsummary.R @@ -1,32 +1,25 @@ # Package-wide Unit Tests------------------------------------------------------- ## pkgwide-fn:prependpvalue_fun------------------------------------------------- test_that("pkgwide-fn:prependpvalue_fun works", { - - # Create a theme# - my_theme_1 <- - list( - # Prepend p value, with 3 place digits - "pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE) - ) - - # Create a summary table# - gts_1 <- - trial |> - tbl_summary( - by = trt, - include = c(trt, age) - ) |> - add_p() - - # Apply the theme to the table and pull out the p-value# - gts_1_pvalue <- + # Test that the p-value has 3 digits + expect_equal( with_gtsummary_theme( - x = my_theme_1, - expr = inline_text(x = gts_1, variable = age, column = "p.value") - ) - - # Test that the p-value has 3 digits# - expect_equal(gts_1_pvalue, "p=0.718") + x = + list( + # Prepend p value, with 3 place digits + "pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE) + ), + expr = + trial |> + tbl_summary( + by = trt, + include = c(trt, age) + ) |> + add_p() |> + inline_text(variable = age, column = "p.value") + ), + "p=0.718" + ) } ) @@ -65,19 +58,6 @@ test_that("pkgwide-fn:pvalue_fun works", { } ) -## pkgwide-lgl:quiet------------------------------------------------------------ -test_that("pkgwide-lgl:quiet works", { - - # Test that the lgl value can be found# - expect_silent( - with_gtsummary_theme( - x = my_theme_2, - expr = get_theme_element("pkgwide-lgl:quiet") - ) - ) -} -) - ## pkgwide-str:language--------------------------------------------------------- test_that("pkgwide-str:language works", { From 455e10f5c1aa1bac2c32664ae0790cfc255c0006 Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Thu, 26 Dec 2024 16:42:35 -0800 Subject: [PATCH 6/6] theming unit test updates --- R/sysdata.rda | Bin 16578 -> 16542 bytes R/tbl_survfit.R | 11 +- data-raw/gtsummary_theme_elements.csv | 167 ++++++------ .../_snaps/theme_elements_gtsummary.md | 11 - .../testthat/test-theme_elements_gtsummary.R | 239 ++++++------------ 5 files changed, 161 insertions(+), 267 deletions(-) delete mode 100644 tests/testthat/_snaps/theme_elements_gtsummary.md diff --git a/R/sysdata.rda b/R/sysdata.rda index e4109dad6d3df738f827b1d88452deccdf6deb77..de620cd849740d8560cd7112914355af8be141a1 100644 GIT binary patch literal 16542 zcmV)AK*Ya7T4*^jL0KkKS-=-G2mm_lfB*mg|NsC0|NsC0|Nj5~|Nnpg|NsC0|Noo> zLI7X?fC=DC{Cc6;@~(T{_2J{dIZ#xC=I{Uj53}g>C?3o`1L%4_aMH>i!{2?^vGvwo zUi(YHJpk@ww(WYZd*1c$t>UCx7?#26u6F9{&<1t_hKpsEdvVn6>zJ&TG{u_RySrgw zyLVBA@3YAzdN$9jI@p+=*a6#PJ-~I>M|WCq+%*Il8ZX0e>@u3qO9 zb?$dFvCsnc^hrSaz!U*q0#OJE002yyGy*UaCMJf2$)g0*N$G+q;K*n;i7}%kGbYtP zQz`94)5y@oo=lo*dWVG%390F*ZAPA>)HFRospxc)Y^uRQ$PS313(*7 z)YCu!41+)b000000000Q000oAh=zzpDL)fRV@MlG;!PN84^gH=Lm&o#0MG`SdO!dT z00003KmY(V000J>2$Ujepc6oXr|FGHs1s=aR7ioC4gHIqROB;d#gwS7 zaO~Oy9=XrhMCLIB@Fs$ii2?+`ybv<55FGwxUC!o#=ReK+^8a;q5Pm#E@lP-4^q)gM zTpk}r3U#30>#<(NK%M#WVe7(af+`6oQtA-!Pqn}~r8*!^%uu_+>I0@91{C8Cq&emE zu#Y?g(=O4*0sF`osx=63``lJdf1etMHY&nz$FLri#Kza4Se9g{3O8OwklA`cW# zLK>vi@v0YX`J2{uMYpEuDLAKMOR&z%UAaIV7T-)LQKx7FwR}!cD-0EXi+qI)7{%Ie z>eeJtko8?1EgY=UAvxHkUO6Bg3uD>apdvylFKOCQRp{iD6he(4Jv;ub3>rbG1 zk!sJ`mxlP^cOlDTgS{~Hx`B3Vpel8mvQ-3dh=l?GEQkX#Do_AKA|6Y`;<{7=X%N`Z zVuqkfaROffKxIZf3?cR)g(=n&N1v~FzgzeT_uXcVQZG7M0NO|^>|&@jioztJdug83 zbj(%;G)4|J!f|wnou^a0LjdQ3`XC{%T?lF?3V6M8quudxERHCvl}{Sy5Fv9RfB;*) zqJyM@@#GwL8w%W$QYdw>31uIbYRN*5OMZ9Hr9BR(gV_ItbOdC8upm&7#32;$5M%(s zWI}-!g%qI@gb<-x6)9CF0f_~n2NW0#P-IbQ3KIb*5J+YMV3LwViHT*Ugj2@#4PRf` z%3`hWbLERYZ7!mxv+Ok8xVFC9GQR)snMR&o(j!|Br?7izi7u_|X%v2Lykh*ehc>JK z+4|mfWqCdse*W$Euc=tSg$F%bC6^YSmd^$;veBwyMAogQUOn9OH9-G>gX?yfaDGlVvy^*RVu4M|$6 zThieir_r`OQ(-ja@^4zp#E3%HI__P~d#eeJIa4l6v{LLZ!S!-*mR*YPEZxW>ZrkCe zmE>kYx@I;mJI!jxYk3We%U@j0$u_@w?k*`ub{gp2Tig{CcE`!@t?hy)Vw2SBwHY2G z+9M@MXNp#Hd*Z4(8GdD6fKHG_m*SsEc$@?yzAQtL#67|s2<_1B9Y05cm(&@phXEOA z4ax0H$tTXYG3gw!8L`6WksGIkn*_=*b}=FDiqa2!!rL0P@f})GMym(EGA>h%cBIS= zv#o-(QZRGeidaD;K@o%h9))q7Rnkeg1cZ_HZ6PJ_j=!b7 z%d|^Y=h*JGc~{0NFIJW<%SsQa%QsH-)Gb?(J^lj^A9ZOuzURg$ETjBdS$oMuG~jV5Z; z->O8nV#v9?b7*QFq$8O~E*duuMPMZaz9!~KLC&cdC0EOt@H2Fm$ieU8 zgFRFgUq`Jg#x}|C*VN+ARLDwDZtYwtu_Ap`HEC@cDhV}cNTwPq5z!(aX!!tk1a4>* z)=3k1Ysrl7%%N^vW9lCL$Q#ea;8_3yH3Nqyv z)|yP1F15OemcM|F@r}9*^1L@7ERvx>nY0Gt7{OE;&< ztDB~5hyrv00_AW}bwe`2jeyDTEe#8FU?PJ8oHEeYzSC{4b*W6jvWy`H%m*NB-KlVJ z*7nUef<;qV;;Lyj3?}0Z6iO;m)GBgqD0$Rc9T9*xK4D#S8-yQOO3}shqk6)skXJQ^ z<;gG}Lfv;~%sf{#kk@Pv6}YmQ%sXnU1#3vhkj3nR%Baa@cPqjZO6nD?JBci;%w5&Y zfZ^Gfey~dDP9ruDR&gLZERV&&m7Z-7uBjq2i5Dv)JK4fWjkw|MS;Kj@goYHWEgb5O&^u)ytED{t| z6etqNl8^#GkPOKrM6$pk)oKSlqQja0+9+T zDkwslMj(k|KqXkBk)a48W(lD|rf8@r22_S1rD38fWvC=nn5KZGB!UQtNMdEGDORbO zsFZ*tqJ*V_X^3bBCWpzNR}9in4yT0k|~O62&QU=2BvBmVv<^>iUOJ;f*K%bs3N73VwRyMC8io- zh#-P!q9R#>Xoi|1B8Fg^VWJ``Dhep1nWT!TA_9Vn3Z|wgqNyYhSM%-=51D~Jh=m3D zAFsg?ezS!;2&x4a7)VhN2h@7cZQcGs)phN;y?15O_=U_N=07TsOgo}H09=Lykv{GA znPyODX!`>^yOo!jqh39MNziQcskA4Ud~aoNN|MRxs49wx zF3C9@BDjemQ3~jZY%Mar;}|)^*&(Lo2V0m!HIvot9}enJC^OehU7=C(HDEc>|6u!QRxmkA;JGc;A`Ox56*k6o(5WHlEDPuIGicxVya&Gz*(k z$ts%pLtjkgxwnOYVX*T*Fz1dP~p8gEQ*4pQDhRG=+y+J1F!p{A=XGwdHETNrNXG{*I8 z-OP~!$BH_y)khauw*juk+;JA9PCDnz32{%JTQ&g`!VEOVgbT61>_s)BiDDZJ&T0%s z8!Zz7mK*AjPEEjqObk5~VRh(G?5X&v_=cV@qOQ z`K~d`cAZQ*31c-q)K%y-3TBHUFkzxk1d2(Cgdpyn!;cD@j%dm#vWDqVTP!$MCLk9D zg2V?#Hj?lpJTfb&m4U|LmN+eFOih6#g3duk6_p(F#mFK)<5h>%)qUr-7!#;QoLwCd^%r56!;Upl`(Eva zCKSdboKrd*93Kh3-5}M2HsaIHpT5tr0!M6HU!j~Ay z{grYd@+oUchfgjtoJSMD82@FVpo49aFRI)YIdC<|!n`jO#k}KuXgsQ97Y7lA_UZ%6 zh(XO+)p{O;9K_?XvJ0Phq;+2Qh-RrsoJ&kCcM6wTMC(1l2hzr2b;D2)JBp#-Ni20G z<|3-1Bd7~HX*|y}fuOfLj=;`v?gi4W(71*b3kJ}rsWuv1%lNxpxKQI?XDHQZIpsV9 z5QG>LuO<|&&s>tZzYhr<*N1^vfb(RRYg#lK;loal%Mj}8;d-1wKrHUZ90R>Q*hmP$ zd(|OmF>*$bCIi-jUv~bn^EX~Z_~WWIFO?Ng7^4v=vHUTO@DCT8&afUI$-RGucC23p ziNX|B6zt9!Atbutu%Lgpe$Z2+3wLWbc<#a;PIlh~x{S zE@$USH8Mg*T%@x@Fkk^F6kXTYri}7#A+adlH-IZ6EizWcLI@(kfNH3;1|X9_xAd-e z>ZC+xaxq+Lx~p$lnGVan;YWitu4X7U0b_S zU;{yTs6r4t0k$_*mmT(Tog-p~@t*DV*|VjMn&ASvomW8NwxvmvQBrDz zvaRNOi@4C-V{MwQk7XHk5%qgxCgbFo&yycA41xFyiZVXUqhxFCpXF~aFyys_r~irt78AFgPi?pH)m5%!7y4j)f|Xv`R^vDedtP60 z3tnVLYsS0cNtfyHw{fNkF^8eU>JAx0g3@eIvH4PuQ^6eGcDXtM+V&e)KeV$hcvw)O z3H-iGCv%o!&~v7`$l(e8e@oDO3o9WJ5^v@Fk$NyZ4bAn=jr6(r5+4qp(5kfz=P^(&-~5i)|iZJeo(H-9aLQ#7-?rrd9?RycXLDnS&>0ugdH~EQVm*Mh!2h|d7RoY zDR4|kttGU%)Q55tqG{QbEL=c@Q;bMyFRhlUhHYrCM%}HU(Upi8zE7CBkUWpJY)u;rkQ5U30;9?JcG$PZA5ascfK+|s9L9?c`_Z2(&Cli^qQDY!K}>2 z!WKvNXp)dYKNiG6A8yZ4bQD6`I~1NDj|2v0fwW7r;Y|_dN3NBafw^jJ%Z~!%Ir)yF z(r_XKM$p$7t{!4DrYRz3BvOjBVMSFGprEBOVA7E78Us|kxL~EKFdQ`=MPxux8KgrJ zL6T5dAm!so{`avV91=KxkSdFXCUlBXU-P11rS@Nt=zmt6KCeYG;*cWlk(Srz132m6u&7Ln$Nf#jZ$1Y&>yc1n3*WC#*0y*&rd&NzCkV;8yc;}doPaf+N6;mB?rq;6H{9F6gxA;EuakMYz zV_|QYZ=b}1joiu?7TAh&LrV`#+P?nJO9w{ktH{g-JvE+9*wC5kswAtum^DyUP*D+n z9cmAXW6zFIH!9|SUr)%3FK-!P@pBCQ+omDV$G;LGCbp=LxmOo!nU@8(!tr%8;~Xv` zjNPu|7T(t)yERCTehL#kS!r{3a)r{$OOrtuE=te5^X|-A>Lzzw!oio@8+KL0&FYyj zV@3LnwOZ9C2g0GqjL(to=v4xgP2~;ocwvrMVK({QiWAh-#|m}5>=b~xttL>E;$|X+ zp=B%Rlw8ZmvPXqo?a>$&7buV$6*aN0XwQaFWJ_iJM~gy3i`XudD38L{1p@i99bZn< zZq;H}Qj+1S0fq`m+`cllMXl@zhU0l2fGL`&JSK}+l{2Od;$TA5FjOrmQN)`p9z=U; zswk=%S-CTI5S6rX@pI}IOUGe8NqQNOl3tTu>^RTt%m%i8RncK}lZI?WPBVTnOKHmx zWir8yGGwfX$z<#KMtT+VQbqk~mF1R#zX20WR8z8;5n@!7g*p2bkckcAC@zG-+^S^F3L63_K$~N5lbR<-b28%p?Nxd}!!v*zv{3 z4D&Z4jN7rfi`SvA-Q6KbQsug~>1;EgI^!cNQTD6Lr&|&l@8T*;CCf?Zo3O*3ZV(do zgCW^d8m6aFri}=1ZgK7CHyR{H?pT#AY1XxYS5oX%MO7~~n6bSRZ$?A$g|HDs$NDytYP1*tV8! z{Nv`zzBus7-JcTU_2Bg^i!|9IxX+*^_7aAZJAm+vQ_K-LJ@6_jilT@>YxjXum~leJ z06Z```SYvMn+eP3HK7iLo&&Ap98B13czV1IS|*i>pdlCIl+~RQAwXH?r0yg547Mr4 zx;20nzLT4(q9KU^h(Om-91D@7G!{ogc&l9z&RacH(}fVsh7Y&I$IY;!Ni|hN5(gLp zWES<}T)s=dH2@i0`SI6BZp&d@<>+g&@18G`k^>+}0U=A#A+$ebC(DG;8`|sWHt!&A zU=c%9R2qkS-7rMtSYVQGh9gxIjmczvj`QbtSKDXi(8z3jOxZ4-*D(rjbEDz%-}V^t zyH~qU4q+dU*hoauI2XJ3Yu>t>ztQBIEOb>~k#_EeINS5^cIitNEJIMqql-bhg0uq0 z$V%#o87pg|b)I%0^?YzGWTIFXACDh=dJcICY>W)_kwnZTJ(&Qyv^NP_y5ON$iD8bc zag+M}H+XQvNs4oc(kE+fjgGbmWT_@bE0~r6B&8oscPuPm2cM{-WHXONX9^ZW>!}r{ zTf=ch?*pgN)p*~acZYaB4k&*Y6*k@1W!wma96m1)*U{*Gq(tTP8_lblKy4B*ohdR?wZ=AnGp8UcyiWzNtlkP6J5N@uQM%#cf7FQ???a}Or6^e{b&%+iB}i@(p2ZR}udXeE4_uJQ0s{n~o#1achJa%#3dR6mdF}4{+Hfz}7bdpCa$7#= z#zD1(O-Mx&gW#@8W!?2_uX5Cl$d%k=(!m1D;DFX^kot!JL&t{p4I1U{BQV(0pe!yb z{(BC!BGamjBqb2L?|KmL%1#Wz!8ALI$qY6 zv4%?BRCFj~0x~4;*7U*L6JR)%Qz6=#mDXev96H`W?||ZBWpM9|g(?Nc zV--{kw<=&k?%*VdCGZ~QI5LLdObo^-Vqi1E%yD2D280*@WWKo30$xS*MI=caR?~41 zGz2CcuZs%4->L2AU zPza#-EQTTJcP!x^QSO`>+Tcp7On&5a6Zu?0=DiN~DIDxiiYXFY0ds)+aRQJum#SPW zgC6o&b2mMmtu=WlHzHE%CF+O2@DHbCT$?pC#)On@50j2X4p~41P6ep$!C@T43uH0H z>3MO0>h19wg5l*T;}b&qLsOp`mBO@Z0*QBof_ySuo_|{Eiz6mr!=P=9a)5>*$)KeP zTR>*C1wz1=OT&OWCk`H(>Qw1t_!lZkjB{jl>nX~T2M`RgA$Q!`AZ|eq3D&j>R0QQ&bWp*aHKx?#>hBhAk|xR7o-SWC)p zSsoaGYk6T%sS-Wp4EY5BnD(^*_aUIS9Rx5Wyf5e0J*z^M93 zP;Fu8Za@h&Qg@hlSKdx%P6;b{N%XGGo7u92?DmLYprnJeW*Wo}@wu*qA`wJ1P-8sQhIk~ zOX93?#X8+ee4Lp!I2ZJNB2>)Gw9Zrxa!zihG+~Wt5*VbwmLUcRW>gG_l%5i$o-`EG zn|DQ-5n@-UX)CcZ2~MazhD6{M)NT=yWm7M@3WNmtX+q`{VxkL2vnx)Lpk583grH0wLCDolanfkg_Y!k2m)8As{!Ru=L*rVB~^MLyD%wxKx11u&U(UxVpf8t z$|)GMmTtKy_d*dgUX=L|@gBn6IMA;I^L?JZN8Vl&%)6Nyvu2;Pr zLD?38Apr3l<{;|SZ!;>B8LXgf3SVQTdz7bu+QX_UR^`Sm5#deVw?`D!9kO#^z<9<5 z(*_A{P+OrX$V_Q$h;s}{K)E*iro^DUV8M)_tRCf%aeb_*zokaN{05RPm+G2@;Y0M> z@LHXGF?pcEfF#-hvlC4!a98a}y8s;b5!d|sXS10H0~YLpQ$@d-!33$&h6m*WzV$cF z2nW1q=mE(NZYOcZ+3%9wU^@Pxn0a}mY%^-|M=`^idp0oATyrop&+kRtNrqhrmjG`+ zLu(GP;4lx5z1x1%X3;jq>~WhY(wua>R@i`)UQH5Z{-q=^q8~4Ynh6?`%r=baE9R3qCMc8xAaaFHf^uh=*801SMv0Xs zSYy)pojYS{xVQnnAu{xq&McT-W3U~=2E(j4l^_l{4%~=9+X?|iVMz?IKuHWmHX(rY z0I0m1dNm<(854Ivfm}dy8-N+{N=k9%;b30aU5S2`ea(*yd3ga{B4|W`WsLy7hBM>e zK0mJ;N_oystrBfZu_CQWq$&giAhf04lz@^s)NH^cTvUSMlNV*w9}pcjULl(C6E;1G zb70REQ;$g?sUoQ$B#9)XN@yAd4>V$91cbFFJ^tryN?;cV^Wx@%N4K13JJcD$M0LRF zVXraKbRBbzmAkqIK*Sm36OIOR?&qqB3dl7TDF<JiIAv^E`pw_deFc!oe+jU$g9 z$1Y=ZP6SSjBS7%dXbqpJ2?#)(1B1*8iYW*qnIqWbeB9gwZequjxK-GG+rE1sv+3ll zZxAeTwN%#-Zv~hvS?Y9rOS}v{U-Z=bejgVtwjsW51_h2; z_c}xhoMpgXI#95gcFw0gHeLr)_OiXk? zRx$7Q>RXiyFF`G)^)=%?bFi4&fgtkg@btDGDXV*30227&lkTS;?^iBw;}(*SUw;PYA*2 z!g)20I@Vh74wFum>ozTZ5iR8NCudU8)AfGBP>vH zBu!?KMu=!GU>WB_3C|a-Bz8mTdtsO+(TpHWx+rH-Zt&C=vE$_dqPE@|oQw1QFBMK$l1k}^jcYw#+NjRY+Q2aZX2 zbX^iadMTt)6{Bad)H2j$nIO8F3<0I}rDH-ZYilL@fIad}`s&s_Wqe;cka8lk9Vxtd zT!YAh(Z0IiCJ-JRYJ%?Ksev*iK*J2A7$g>ekw7}Ts5>+Als2A<8I&YLoeD@20l;9H zPA+)RIi@xCYt^J~@FoeJ5|1c*^)NtnC~vf{QzlGQlw%PZFb1#@(DhnU6YgpNxXEtC z6^!w-<8kM^o)ZC02ZOA8wUEdMs{&B3w6l3dD(-NYqJIPf>LlVK{~caW8ZDrF76bY z#eh)6NaNpNNYHj+ZzOA z=4DfkXI?QF2UG?oI9L;y=Ez_fqguzUuxN`xIAj5bFk%jaMm<5ytAIkUGyo42D(~th zE_73&2IWhrj*}qX%|jTFW|A{S3dj0NSkHl`h2^LzSEobHqq3oqLSTedGAR|f9dSyQ zFjn*>68<+L7!7a8KulyQ8H;uENurMlO^dkZ4{O9Yh;a-S1_r#l9V%j5B}X*&y)72x zVUA723~Z0f`Tc(+{`TVbYJ~YQl0k|NsSIGEB_o|BI6@ebVjPa?Rvw?bOxLA0e3E#1 zxFX_n2V-L72f4b*!VSQpcie77;zA1Z3Ify+VJ!ln4!#$H>>wYvF9(3k8q?%8nyk#`i?St-^YLO@Yc897r3*#&X<*HIL40VssYafxf^| zpl6oPFMJgddpCpw1~g)UoeJ?47iY>fBzZYSgsw@j72O(Cb56NY(P zU~~{G$;yIe&VXB1f5x|Y*-!qCr zGDgWH9&zKxZM9((5}XVhOpQ#(MOh?f9_PlL^A>Dp)H=Zys`fIp!x0li1_FTjQodlO zEJ7tJUZ+=sgTjCbLKC*r!fL9}5eX0xB~U~#k?cRV#o_6~Qs6h#EPAh(rt2vMfxr;S z5~51PBmj~EM3CT0cS$NRh?*#fe5E3CJsMV&ni7W+$=)(*mmh;(Q;N~NQ1QZsQ4uE^Q4Yc4` z81vzVyO?M*OR6X}nH)1Rz==D%R{No`yGM3Xvc{k)3wK*<4KNUz1Tu7pX$%Jtq~;kJ z3t1!qadKE$Sa>jj-$6i2(2bGjk$R$TAa60v+4SM6BI2%kfg+-yaieF0i6dV%f{n=5 z1~_n_L11&@L0Bf1+V3bO%E2^>>)9a4$f;?imI)hN2<6<#K30Y4yUP5~6n(y%TNsQZ zi2J$2m}Q`Z&|(52W+ESD+wvwGsC1~>z5M*+Gw1+9QJ zydooaC)Tl$5jKKM4a`1M1B!d4a8e7Th=CVY2?|3B$iR>&8bvGio#M1q2fKKUrY;PG zP)FUJ5bsX|5gu4DIUzp4X6e}`^?5p!(Km~Py2u-1hP{VG+J)z31Pbub)C`mTIk zfei;+qpX115I>#IB&yu?3}$1T0y+R_Y}q)F3<7&8AgMH!!%L>kJ(bl3P|oNV9D#o7 z+<^uOGn|#FRe?|r6G&|dZbuw*V-svynZk$&q}gz66}52|)+4hde6==;4TR^=cSEGm z^c=9nPD*ve@saAHX(eKZcngCNVZo(6Z92qK65gl^0f-KCjuu=)F<1K^FR3tJW$~^) zOdV0dB!s%bZwoA+oai7W1e2_xE zA*M`J-6{B3fpU8PFU;+ISJd-z6S5tECAy7%PC}D`fDrFRisTf({q6%;YjKE)93f*@lP#X*{0K5~$EB{yPU`!e) zjd^flmg*6DGzeN=g$)K>LiIpXLqPux=J1s0?*~eHVGnQuddtj!LIFzNY~&~g5e%ZfxgFz&Xltby z=pQ42vVCI$O0mu0BbBZ=aNMUD?T-taHuyKz)gBH}blmWWtcfu;$+#M`8&irQcomQk zJsp*(#X&HvA=aP;$raKjk%=!2IjHB4Q>?AyZjFu^8^Ng5a+8IUL_1~A0PB?|UJS|+ z*Ef4Cwva~)~nWM5KOAkr=sWK7yt`dE{-%RBDYVNlF4wP$c( zIV4a@0%atyPUeaVm8zKxgGt1oDhz$7+-)04=|^x@R%&_RaGH^G_Yp-@*)QeAx}ZJ-n`;Bp1u zDwB|^EJ(yRaxjFch!zpY-{;>uu?4^vYxF14mmQhOB$ul2p_a~6i7XBr=%6j*V+!OK zhEqru<{=x=y7)#|yOJ~(NK1;c%PxIBczMR-vw^tW6fQv6j^CT%-@0untrMJtcT00x zglk%$L{y9fT!*&+Xe3DpMkXQAh6;6&fEg4IFqfU~3yiAqJ*z<+j`ojT0*oY)=+jYP zanJ=2DiC!FdZ3a(foO$5%0UVvbmbBr{_uA0tC0#`9IIR3eXmRMPT2B3zun=iAe-UU zABU&lOGwWZPIo(aHkXhHb==;JkX4ZY!ZOg|r!|FPT%*Oye}`WI8mM#3yAa*rilWY8H@&?A~~1Aq8OXm-tdz>ra=8y4Iq<9 zZ_{!IRl>@7Yt zYx1+5^0cxpfEX0js_Hrg(4G79c~KiDmI_$9B&g6g4Hu&fC-S>kwA&9Gd;9!2OS^5-^79?Db>kyZK}|&>o1Q#4=m07RN3rB}Co9>THZkT1$uZcOHaZEQjA0lXkS2wye>)wn zn(&CE8?|bY!3S994*y(7bUV|4efWiQk0>G&Q(@bbm=eAU$_Bj9un<-P30R?8dC5do z1WXU=c%}#D;EcZ13)ojGvcXM}QlxcE1h;qL(`aE3&jqDK-$9v!HjU)&>U+ zXtZUJY(o`P6javYeH8qAT7Q2L(8K)EaivIx2+m5TQsnK&#my-ofaTrx2y7 zgW@3tDG=+jr#Gs&DC3*3nBUvjN~tl30=huE%jQAd_Aw=Ql!em8NLa!p8}+>a^e{-z=RJq37nv{psmrO-Rv4FRg)asjVt8lXmk zB?t(}!W)!{2@;6Ta#k~kIZkjiRHWM_CZGs#k2+M46hxSQyW0y@q5NDMvqJeds(Xg1 zZUW%Dh}|b+T0+~-Rgme|1lbTmr68^`9Y#_!t-Xu11fK$W*zXP=a3J?3*923FC{_^- zp`mCBQjuu#Ak(Ly!kWYH0n(tHfG3Rr<;0OVH-W6kInjkmhyx~pJiTpgu{PUd4g-MY zVhi?D_oNhECTPq6vW4)Ow~X>Fips$cXG;f@t#3d}&Iks`jJ|I4(0|=I?iZBqytU}VXiXwq1+w!sG{!}r_9Dcn+JT* zV2+3g5Z+Dhnm3FSEI0ptec zTLILj7+|B#2#v{6!z)D>70s}v!$3^FQDU_mhi-Drs6&`Erq=#(dG-G=);x$pQ$#4O z6_qs99{dP|-ZG-=HL34B27hEB9Vn=T6(}qM57YXe@Bau?3ea1d;DBC;e=F~!?tKEF zK8L+NFN^WODxQUW?LSRJ>W~{cfn7na3i#hA_ipvZOv@1Aq0yYc9k>r>q(ndWJh_l) z4kHjCunYmfh(sheGknxP*x|%;nhGhOIAVOmcuYQbpHiHqe>)CS!WM?)kOzbV=juLA^T*)6EeEQ-6&WyrO(Y=pAerqK7=@qJ6-+~DfQq>{tP7o zOAu5gh|0@qx&9^f5|DrDmhJrnC9obcLm(QHP^oeT5JQr%Pl4yVg5imI*xKZa_Fq4) zDo^10A(RbC$)Xy?2hqU+HGr(zU^;mSR0reP`Z<#^ICuU}b&eqrZNRtTtfp7N5%nk{ zUuPtEC=$PZb(#sW%bXL*m_EHICob+34*b_7s@L#QmGFGrU)y zrdz*pahaZh<2{q~yhhOmjA+q77YQpD;6+juK~xXYkP4his2Usekuz<)3(1X@J^kcyy3pVjM~!??HigY^fucKqQa3;2cKvd7b5n8!V7#XBhEn8J39AKo+SWkpU8bFoWO= z0;ppus89fe1gHzRMG;KOn&5$*S2qdD1JoLhzg80wKofbYVq77A*4fFPY}u7++T?PM zm{15sAhrwgO-)g`1i4uE+n{=$iP@Ll$>^f35T>%~<<5r!k;p0*6moR^M-o=2O#InX zt>hj;7}6IT5VPKFBNM#%0WHb#xOoBJuCs>`)lyrD@F ziNbGYL?|`^ZH!P};VY5$Sds8|HV19i!y9cjJ(-&UXteNL031a-UE9RlZ#4ET_QEzI zn1UopksyjLm@=$T_G{22@?p7n?Zib6Dv5?^(5GBy+9!lUA=1hnjS_3qVCIiy$JyIl zlgc4X29D4NWR&gqLvaM$0I2B&Q5*neON0?s*gfUzsq+}yY0P?_(Rj}uu+LfLW&xPY z#Ze@Rf=k{rK^6emD_?Lb2S1 zd7Kk;MpsNocA2J25eU+r;Iiy;h=(dDW78c|}ib!e(U|3w4s8~TY96iK+HNlWG44@090tNsfXFy`+456`$SC%Ds! zej!Lkl?$Z>@O}~x;OG0S%q{!T*ps%ym7AIf@F|H-8W44Jt!{9?cb>0#+*=WS zKF(Lcf&EiYNdLR@s^iZ2kJo(o@Oyb!HSGyWs=z~;+VsP;M?r+lOuoDAG^^u;7yy0> zg3L{NC*}9*v-ED<#E%fs^Ndt6y$Hjv9WINF0iyw+8U^Avnu?o*i5Dd!SZ%m8MAhto zW*p^&Fb|FupH*`;$oJrE9-(Y~FFnd^}C-Jt>}H7PrQZvt1*R*tx&%n z%1u%h!DPMM!XxoBBy^avq#U9S>3P&Udag5AF(?RQb$-^k#cBAJo0rG>U>)X=nSt=Z z-#((xQf9oMCB_@t;EAK0)pks7q%3qqnkL8De(qY8gkwtw-MeiYh)|N`Z;6mXpc~Nk z;i_~D6R_xRTbllqavgD>!bd5$T{fB|8XM6Yzx5!YsU>;_x_ZYXHJtB=NcpKi(XHsJ zswlGq*?%=MT+v|-Ps-0vfwCss2oU$hAPLB%kpk(ZeYL#lqqk6|Es2ps!hWq`&3rcC z;B1O03>5-#V+z?j8FAdvrC5S_L=!34nZtmR`6Nvh7K7e;D$u%y|5hJUv*5ULFBVCQ z6C8T)L`@AW`@}@o;qcN|bpmzTfpM@FmQffHTFQ^hU&s%sN_}V6xe;JR4CrJaJUN7v zKj-E7TSTf(5Fl~^l@V}|mel&YY>!qVtb!sk=_HY$D};>-hMGW27@I9OHYqXRX8 z@1oFIl#L2Tmfn@U=Ty2Kmh0kA5pF$Mg$j#ONbJj*Riop9ve zg#(PZ)+T2#+=4{esGxh$4*P6X;Ii6iVMb(W&^4gKscW>x|W=wDu zzz9a*!3QC3uFnxJG;GR^2V=>p28PSeBdgoC!X)uymi;UVfY<48N!An)WkFR`UNuOb z&0LC`Go9soAD^G*e_0=In828UUubQrT}#ly*6G>Y9nLHO5NkgU;21rIf!8~d@9OTn zq7q-~YMvtv=ZUpOwDkO^BVrg<c5dxH`<53}ktRTs>zjMtx%srNQ={4rV?d2=6 zN5AG=g5%M@%`O1&Jt8!{5fYg%JqH~NY9S{l1q0sHYo3@w3YgUdkCx3vaQYS4O{ETx z#H4tx!dJ*h-6V`m3yZegP3nksE6RyR#2cuq&Qn`pTV7`~ zP?FG6N)~5~i2>jeLl|Q8tskq=ke;zKu_6j;e-B zFW`|@;8f9s&Pn!tK9ARqd;Knto7JPoI-Gu&N!*l1Vq8S-Q%igX$IId>ii)o=Vj?II z_V>fdz~ty{u`{wu@tfC%c=R_(<>>MEV3y7#Y)brUaBue0A^ zvgAL`+OQvvR5ieG`_kU-sK5ojZKytG9C&5llxlg)%rXO{mxO#kc-S=C8yg>N!lq=Z zSrpS^a61gCSXfNLR(_IS4TGt0Wn`7O#wh|9sb=$6e|D?cCaRhb$HP+$OtCgb3Ike| zSt8ifWBw-t2+PAGLtuw}Zq(i@(=sdCT+G2njA0Anv|_cl`B*@IA1OTFkJajSo7q{$ z`)9CdcfHX=bb)~v8xFcs&&i2E-`+R4C9`?m-{1B#`5p(|$Ac6iH|2m5Zj!FI2LR71 z3OA3?^CfE_OPDtLS*YniB^F<1A*rA^)Pn%sxjW@Hih&xWV5Yd{Js_LqzycV?M@4jh1e1ef87a8c}xSZLpDV<)>FCt|32d9o3@~V6~Gw+p?WzVk~me zFhgSlfevp6)Rrgecu;>XW(ElGf!>^Kx+5>m|Fy&r%RtXSwC?^vo-w30;#%%NwsD&| zR8)|!TViLRW8qfvcN$N(J(mGv0G$67ga!D>0H&|v_weJJ)@cer_+SUD1hBOUy${Qe zsZeiF#PiRk{69icl%1sFKL*8NV#{bpB7prsPl)u>{!fy>OYl1$-`;oo{uI!Nnh_u> VsPi5*6-WQY+>uTcBrpZd0sw6|JOTg! literal 16578 zcmV)IK)k;~T4*^jL0KkKS#zkn(*QdGfB*mg|NsC0|NsC0|Nj5~|Nnpg|NsC0|Noo> zLI7X?fC=DDJbIBIX|uV`96SfTfYkt-zyJWS00(mcqD8izW{Sb}!S65!-p;$$)4)|I zYf9bNw)@^Y+~Cv}n2TZ5ow{p)3vFmL0!u5qr&R9L>s4ie8(S`nbYkpkK^(QBnq(MK z(Y62sTXeagt9{2_tjz|owwX(5R6Q4Ds>tVLI^DG;*Iae8Y>jtec4z=np3IAngnT0=mg4nQ_;0g3TLBJQ`Ffqo}rFm3=yH~4IZbd={-#}2dSWXfRP}Y0s;U=glUO@L8DC* z6A~LrevMB_JxrdOo>Nie^%`hs^)eYFCI+69Y5hu_&-7+`3HyM)SeW2us86arf3#?8Y`km3B!+P2Rss{2&g2TOQ=J*eU1Uj zQ=SCw#S6SHpgLjhLY!gLhcv#X5$1q;W!gBvKXC%}MxhQLbBzUepwv|xON-?G%?q@Z zeMbrNi_)lF4EgD~4HGmO6UpUJ0R0aPEacn9)fuNmp+Fehrg)rJN`P%Bn;Hxd)B#Q)OWRNxQ54Kk1L;8u6DuTdueEfxw%;b+ zcN#TFeTgUoXdtgdHWG&nzC^qa4y;oLXm7@X7MA2i+ZUfQG#2Ls2+W z#p{(G@1v1qa7A3IddrwW9pr!j7521Ha}Zul!-m6Ht%);=hbjS9N`F1})X}Eh|Jl>B z&cBJy?LM`+fifUo2sosoBAv7tKrmSlphcxcC`6$IC{~3^RY`zi0ck&;BmRV60K@i+~Mz6W<TMMSC?)}!A=L;+N5tV(9V8}GG zbs;tIJuSn!m@;YI`6EyH_yZT_usGUpd>@I|Dl4h+$@sP&cJhU5a3JHgG1+No>1f|X zI)?$CkwiU6%do`>uS;YjpTWDfF!#v7t2QbeFAV)rdmtk7bv0X6nLY zR#eNRcA8rY@O@mIgDYaY%QtdNZQFb`QoNkdZk)#oh|MJqYI@l_nTepOyjogj-Z#XiY+oCG7j zE->VAhqyz59l9OJ)%18NeL>A`90oGd8z-`6l6>o8dPgiqc;RQ5ji-c~36x;$Vqxxz z(hq#X-HloC9dc1dyMy1FE>n$mq|OI+g}5sUMh<(COpFin>WR0HUXN6j#|CA7isB@2*$a?1hm>tlB|4i{F) z9{&4>jJ0VxzR#e5I$NBc3}4rD51pig&B!S|%8v4(!EV4YQ1bC1!xz(|VNS281ZGjE zT6Qvdc!K~;$RIE}JsM&x>=;Z{$h&JsK>ewfAcn{HsH4I=gI>&WjXRG(@36>__GU}m z*>-6atxq-a#}#mPd}1I>Xc#Q`wd)XO6HPFw>N0itmKw~U@pGDRLp^|%14}~Lz}v`t z3@&$3y&I(G)z%gUF}37j*3D+SOVKfBA`i_q=5=p_uA{M&t`6FlWnBN%Jmu##XATCKz&?b6A zVhEZeb9uvuQ}eCn4yT^i)Tb-i`ip*i+PSq%q5z!$K)F~bJ#funO#zeMY#1%00TdV- za%H8S`=-}f*HW9or5HjDFdTuV?bX4#rIgCq1K0omr!3hI(0 zD3I}R$mxo-F_XFuD6JZEVo7!yD335v6e6OkJn{#OK%@?=`Saj?c6|ND`x4|qsP)k5 zDf$WYGUQMnIVs9ccsM|jDlb$_P}0F6MNvY5EQu)qBnbe_l0-`^0v&dsb$sLk0GmLN z!XO8#lx7BC2!@2E2$X0Ugb6}v7$7MSqN1XNDWqZumLvjIiYXcpf+k>^6dGoVf{m20FsIlmIqM<1$ zssc(VilK&rLMSSvq=F_XV3?60DkzBvXd)$&sDPT9B1s}xVk%;WB1%Z6DX1cusu&uX zsAY;tYMLktXod)Afuf*_mPv|QgqW6?X@($z38ILJW(lGiXo!kgf@y|`h^VM2qLOBk zDx`=C3MeX?n4*fLgh5}-xIjKs3G?KrFW~vq5f|ZGPHX@|i-aU72m{>rz7I$94zrlg zt=sSVzsx9@&hzZj35RS)d<&4kk|*1~(=5si^iR|o-MLwJv}?<-DLM_FwKjzF4{C59 zg1(p484dSLE^+ z2jI{l3_r;8K9>#MsG-ubBg?P?5hHl3QqdUH^YSbD=${|$dpQG+4Z+*gx{s2<4U+FV`Rh#CdUspOSSd||Jma@^a(z%bZ%f9*M@S*WBM#Sdfq z!ss=lfr_Bbd6F;hm_;HVOhMkEAgLB~b9c^?-0-aEPYyO?E(dhNrAc*VnavG1rZp)Yt1UC@pG;dAZs;_|^=#eDkpjnpIoyBl%DT9G*GAA}O% zpER~?0w;tRX^jXMUw`UFHKT!I8w}1`3`QG~mhik7U8@k)KxQ{95iSe9pGO?9y5PPN zh(RF5q}Yw^O%M{LF+i+A;7G>&f|+ASMuJDZ0ZQj?8SD#2Ce6hCg1~RooRc}=>r=Qz zB*elHcnjRw1o zQzw~*5+_npB2EzaveZV2-zElPus~^-u2dER%8v40|-`rIW76) zPMmYfRGG6m!M#G*v$Yy%NFbVmk<@|!U|^6a9`Ze(p7GFbB01&-rB%zrywTlA>|u@+ z!#*8(plB8VG?RvrQManvxMmap$05j08-QeD4tO*5{KdIOOh%`b*qZ`L1)PG6D=InV zi;zTqCaVM5m&!w_0%4#6TTac0cZg1%QfeoOMn@UYPU8#=!It3;VIiYf5UZ41jn`J~ zSE-198slpB$ymU1_~zV_@5T3gJtHWd8cO5crg}q{E|+8BQaC;0%9} zp`e3pk}s;<7C7)V$ilprielbyz7!sfG7E!%!uxdr*De7EE!4SrJdkpejx10>`Ju_Q z^ce&(f~aI$PB7hggh?6gmkO zm^~o6RoWL2!l7W=4+Q2gEdvtM%H|;_z4#-#X164iuSql zw{A4(qNX)36%|kzqY)@E>;aAPk2}fQtQ}v;zl`Jk9dVqJ5vyWGW(CMW3R#?rcgw=rR2b8yIRkWM+y632lO!`4bjfo9z<>!r zqTPMQnsiCA4HHJ=cmlFHYLc{ML3B#w9C;bsY#Vrz)#If<^Tx%n(n#~-fRSj&s!^x& z$Xwf`v=;|ML=1)|gK+Ad_|zeVQ3qdo6afH`3%RfzL)=DcAF*6-y>z@#U?4FHhUchV zA#I3v3CdhMc>v7NThfUO?#OOASf~=Kw>)o)p0vAze!BO1v49T~QIQOSpmk$)X>r_V z3D7p08r36CO+*$h)ke=l@yCF{n864GZCct47lP{7aLWS%!(S~rE4$3y;p;VAi#8(S zBg*bHdruMKKPDzq_@mF3lw@3njg7ag_djCm4s%#Yb(QzA)m5IID%x4p$03241 zOqE$TDbQF51XwbMCc!?7$nvFB2y=kqlqvWswwc9SyK;Ou8tWlBe9N9>c|Ok0`Xs(3 zFz#{xY;a`mGf8m3$D~L-uPAZ7U7};-n^l`nGm~CS(5#_41MK!0Gpe$dbB;@LxZs4} zvDxlC1$B%7OZ$GzJ=fg;CTA=u3!auwIw%2jR|rzZ@CuG{kA^@2LBlsB*e#&|`2#2n z1}qELxG|1ouWC$dP(5%#pmzO#aj1wRh#;VdnOT_pCHs2^3SJ*m^L(Fk^Cy;iHpJU( zG|D9cfxK@SQNn8F1rNz&>L^IK_OKxQli9r0l*}V1SRf_trI4>aM975+sDcF=)?pJ) z!H^ACPj*G@-B+(%f^DnKDomRevsogdGDvnMe1&|>%0{rFMpIbiw8mJll?LpLNM=qj zd;(zz`VF@9Xv-vsB1$4dx$zIzdw;6(F2CaJxVE*1yFG8l{IQ!Epg+KfMid}V0j9vS ztyq{sZlGag9(9JNqfKU{y@E5K;ZIs8#5RTjM%l!ITsds>Cx@U2%F&NnW z5nYlxsJb>XZF=wF$Mj{Vu@D#Ti48lhrW4lU>B}7=2lbk(!wHxXKzI!$4tgw-8SDe` znryr#P+-Q9*%BH{^s?1Z&8-#a+qJYhGO+_3zBF(%p~EN~ONkXE`Qkk%gsRjC+&kYO zK>-Q`Q=x1Oi^84ddvJt5G)vN%z9&mP62SQvVUe5hGfho;*>rV>5pfN z(Y+w!@blmnz{XvnjGDSot!O~r6M`9ohbAQa6~9bKjk1_rV(j5#pNU+KRZL}cxV2#* z{yDJeB-Byb`Tg%z9Xkr3za0OB!cEESIOropDgz6+Y4QzskdBH{msM1mv88YgCPUZ# zN2+#DhezL1p8WF9HK>j&r;q0&+GUD4*HabDMwXPS|8=Q;^ZM+{Yyn(*K@vg;U&`-@ zRhO~tKV69GsrJpG_h5j`&^C#7JL#f3vFA$6K-{%9<->t-ocptb7W-)lOUr#dIg_m^ z+&4kt?{mZ;i3JcuK?n#4L$SEw2Qs^~oLk&d#AciH3-(As{p-w0APdtPx=N6gh{xR7)hf+o2{PM?(Z6!8VZ-?FIVrtV`0)l%2u% z0`eE_eu{&# z5-j;$Qa;t+H8!(CLP=|;*@EJE_ZXN;n2U!lrFR4O_?K#NFTbg{dDiA(-|*OQ-obu- z%&FFv$cl7>M*~RRJobi-_I<@yQJ1WCTRj_*AuHQdNf$W))j?H3L`C?u=R7HiHRz-R znHIA$dp?9&J>*4ag~~HG&PqeAiEKzj<4kg(kGiXet(TPjr-J;wOxTA7!cm(Gyu-Dv zxU9|53AcWPuWm|P*tff|bFDJmpney(vr5m%`B=SQiVkO4`qKB}HShiOmvg^Pn>=8Q z*b@!OFRo*=J->@Vh%r$+)LTUZ0C8Y|*UjOfHBC%FqsjgML0okE`DQK~0>oA|SVOtnGLGusP`)YMDr_AMlO3_2ObGcI^2l|FN08xIeY z!LPkzlgo*PnMk-@I8$SnV3h$K*!6BfhW3Ga*3HPcEDl#W1~7@tZ^|iUIwB0BRxssC zk&6)|nQlRtg}Gr2=XuMa9x?s)jJ8&jbXGh`CYBQJ^M&4VBe3b6ELNi#*N9qc-er zV)MEh{vFa54C(6e^>{nprN_c|d_L7==(<%fV5;^Cq>@aOnu)#)36@|1F6S}~+9Ooc z?KIDw1>NQ)oaW)eh~487m5nNvFKOxAhM20Q*0TyHVQtumK2Wj(D471vnRc#@Z&4+L z$)ofBhUu1c>T>a4`wAw}`23I_cGyeL7@r#@ea{OFL{$;W3>o@7HltC?n5|V_dCqIu ztj21;B7#xWVd?oNDWgZ1d~mnyO>3wFucSrtK|wb?zdev$(qNG=ehBwp$vWFI;wy9uB-wb`KC$3Wb` zB8^0vACvg(7va1(0v;FvL?%csYq@piBgBcS<;@$nHI@fL{`}w^SHxU(Au&y`vOp`+$)y{b$W3eN#=DKDh)Qiwz zFHv7=RP#nNN!EGTgU#zewUUWoTz%O6q2zPOQ)FOgq>3hCDeSlkN)4lwmbN4kXhg); ztT1o&eg8Se%?uHEjD&BV6EuMaN|Iz^xrtyBN@MOj_(NlmAE(+eE;0|V0&XE%9i<|) z#b|6S?}N(nyGswYL%uuV;BcM$Jfzm~JMRocALH`7^J_n?`v{5A>o>iTmnagD7sTEhKeGE{&zc3rVxpeuJs`k{C>~KOyMrP zJJ`2?c~R;Im~YAIT)*!@SFke#(dEA-0VFgMd=~l=&RGUXVlTj7bIXI6d3Beef$k0) zYwW)~$*qD^hT$pfRFur6=N7>SoRG)@0|cO*;BPnvfMY5O#sFV=@9zCAIScj$$*r)Q zmd~(bAlkyFq#_Xl`{b^R_x)7p*shVW60L?z%n&PIXaiMl+2)&|lOFEO290v~5twXg z&=waJe`SYFBG0PR8yp~~<#XZNl$&_Pf@O9WcrY+}dHeZi7=a4zOHTTV=Lj}8aZvAi z%4anA8AAA)^hA(m?sTY3ykR(6wT14$l!j`St&!@QA;<2^vM@U?8sp=ps2kKwtX;4I z#oc<8g;)B-;k1MTnGROjM%phn)9uAg@dLsxQv-k$IPi=lj)@0J;#No)bykOFMAAqO z;KU2Ir>X^%xlnccaWt1Xw|E))Y)$6N4T^o{tBJf?gy}RyF*gN5aH57ngTVr>%94bj zB1PbU<~TR?IwLj&B)Jl(g$EoAmCJ`$3V`mg5fZ~mAX4XI2ah4{gH7> zfUw43s)35dOUORL0vkYzuwKGAuMME=Vqk+40iE_^ivY+pAix79`eQ^1c~|6$NRl`$ zrs5!I2uwW>qYA$NpK;J4)j(bf;8}w^6DWM}m`E0xs>C=#F6fXLBgut0wn!G=fSCHQ zKCWz_B7?xOn1^?u&6CnS^NllT2^8pyy=8IDngNcoOeo15%uj+T5?p|}fPI*ONEip0 zxLF20w6NuFdp!*`d1yBxQtBn<50}|K<&ko1)YBRgQM5ixawu`i03vWLM`{ZQ=vIvC8|vIj}r6I%Iv=#ZmBkf$#Ul_6+|ab6kwpFgTylpVh4v9|u z;5GxiC!is-O7Yr*aOTejFGl-85=0kv!aMA{UfM(IV$dLJKzFuC27)B3&FH7 ztJO$>gebVNX_iJ&AuzfEVelZv3F%xyU`)U@R<4SGR58xkk{O%4xFMDa!3MWPz$sg* zBP(G*ouDNwXBWyAr-m0&a%E8Pvb>OC07~^0U_7cE!CE#1s;@*BW(6;33~OgO&sb25 zO3+l`v&APi z3S zN!ZEGzRnCW%&1{t3nBz&CYn^_SM5l<037!b*8e3l*~){E#k(Ms(QoDQAeA~0!2bX% z?^ArRfP2P{a2$~4;&&V^pD8WY1Fh^Cho_oG!#1xZa-5vA*|CO_;hBM+e{5coOfu(0 zxdFWVn^<(6;{f_w-M8&FZ4+!>-wCpfDaS*_ZHNg){3GtA@TGmU^WFX(ojRk z3?S-yMCT73eE!H{2Tgt)7k$7N#Dfm(&`8vlVYFvKUjZ|UVu?U92PjnMCnk4V-&b+O z(K4jV40>NPqik(g7XUZFCSH=+!IKNjb_2Lz*mRC1NCSogvmy{qA%y^vu%w1qAS8w& zn-ExC@FXS6KN3SIg5+<^KuZ7?CeRGAN=k9*;b30)U5S2`ewN3EJbXZ|ku)Mevc`a4 zLmBYzpAYHA(w-+LR*5#H*O6AF(iH*%5L#00%0NjR$~Isd=2*Cb#bz$UxE;WBS$IZk zz(zQFX70h$bV{k{y2=$PRG>;qN<^lCpiuIROkj|fq{qYM`X^feSVxX7Xfmmh_0>FvP@HAc(XA#9hsv1sUwpz6z ztcA$8G9!;3&W=XtoCuv5MuFj^&>KHU5*ULh5{In|MwU?uZz&^(SM0G%PT>6A|^CKZ`6mYkY5K0kxW$Q#3GAYrF zfFc?jdK;0-4hOPfBf#Aar@U-75?Er_yYC^K2segwfEZE~M7Ubnd?f=0=J@M5HXuTb zCnVaouzTsD5IYb}C9%V~U9N!SdSPQ%Q*aYKhtlSx4ucFmirLJns^7qx(GphCmJ2QL zBFe)+&A^a(Ohq|@>&?)IB*h_-ayAT%InB+3N|j05FtY|U4-RYz%Y6|kfz*NaQJxv} z2sFfC+Y}=i8DfKhB5O2?G($mi0M9xYPI$bvgwDWz*Y@Gx>IEdWLk9&$B7crjGKnGzsjhEfU%1)wBQ4n33|IXFrh zk6R32k|DtgND=|IUYL$I6lfh`g5&qTjy@WgAUc#c+E=NQCMrrXh-8cb ztORqtR+NPOEkG9;E!d*5o;G}W@uZ)L8PMYem=T$>G2}?A7pFZnUL&!|Fci>tx=)6( z8fe7}<2lR_FxX#QHIaLV61>$~nx;^0h+-yOr{D3v14YRyQ3+qx#5t!-La@X`;sd^p zt&#o*{5dNhD{jelu%zBB0*E<&(XpM&%5l8!mewqVL_-8*xO2Oc(eIYVuD(xI&4 zU6=@*PIcNtS;V&3*dr%1Dx7mWQHa1gpfNGR!imgtWH1cTtz*})Xp2EOWC4dD#2+7E z*wfY=%D4n7^FRRJjk@@Z9vWGK8k;V$H_U;v4CEl8nn=wMNw4t{Gb5wE>bICIwF-7m#bOwCKF|q%?E~Hw-Hv zo~YYLq|)q~1~NlzN5b6U(xVvs6b;)!pt2Od17`qCCV&Nc76O(h2av<9%RN7&z~c;# z1P$WjIc`E4$LqE+Ity^X-(V=vGrG?1_$ngyZwLkqXvTy%ZXqpRKP1klXSg_3a>xUB z4``HeG6a-Q62Q^`Om-54C>4W_rk5U#?v$N@G&BrAzz;SG1Jn;Jr9&%_C6I#``S2tNcKuIqJ1U?e5+EW;JCB z;p)Oua68Hy9=G=T_t{8TJ$NIGniAB70BHk8lErr8rQQt9lXT0zZxfN~QnaJZ5Oxx~ zsY8W`k_OR)Agcq7F%B>h`P_B8W738mUx6QDbAok&MD7-57` z-ey=hIf&r_1qG#poF4{*Z8#PNJlJ8b{u&I@>WU3!M-0rcB2Na@zUXXj(cqMHzGZZ#9QuwY4@47Bp{emS<|kPu*sN4A&dm2W-$-bn+X<-Ol9k+3yZ2d#Dd}N zbOMqW>v$+gfi+-Llky9d6&c)NFX#5co^lQ2#^AdsXm ztc(c)fuvHuH*BpH0q))-X^Vp)EEA@1;o6q`)nG_NCb*Z|@k0SAIzyC&h8zAuRG z3IT`?WR6QN0hp`(zn7^nUw!f1eKHm<6UARN#wJ(58RyTde?DY8?|zzY+n;&p!SUzz3N$R@~X0ze>;2^k16 zwgUlx8k``|Al4KZ#A-JXTpJ)2fZf^#HFDi~P=<-MY62lmm$3CxA5+AGPr*HkV~YLc zy(h14n`gqoUod4ilO_`m?{fXR*8dYkb^cx>WYRmbOS>bx%F`wayF4N!gL-YT>NA=Q zx7;yqw?raQ931|{=9!0ygT#FE4-!3k6Cq&X)iv7K=ZVi+Xmp{>6hGCMX(So0?g)G*KGz23J;{avo}fb25FxY&>mV8q(L_TrQR#LwMmhRA#dX?)MWdGqOgDofcH$hc zBbjeNAb?1$;4z8;0~ne@U#3TF$MCU^G2%XcEO6fQoq)4RVz-LnXsavVGv!tsMW$gIn z4bhXrWnq+ICP|pIRl`FVrx!c}tW=qJGbl$`-Sg7K#f>`+w#>$si3W4JQp#a-9ckZW zUs6{f(k>NbOxjlZSd+EOJMPwDP|Ps3XK-LWlSrtPf`w$UPR$e(rD~)@Ak{dO1!Pnw za-wW-GYD9LdMXk|_gk8bR>x{PSrzm&D9YTdsurfKgsjG36>fg~=9L9Rm;{EI<*jEvmNkgd1zD>)D)LnRL#@^h1`b_UG*tB3Zle}Lw>dpl`#UsID4Gi=XM~u z0eT=}$78dGqgM%|S5z8Z5EsZTa>ZX=Y;4NKl?W!Q61ta4p++6H zQwU>$g$5Bq4P!uB@Ygh|3|UfH1=lemMd9d~m)iWS=X|X!i=YMtHEOz!fpjN+{N7YX z$>oBUE{Q5M4Z}s~!wLOALl&E1<{XdE*}E)+J99o*f>3ke*)GkahTz|fO)edil-Sv{ zwveKNo+)kJ19UlOXMY1_7mMNXdjQ;O;e@8(FU&PP8)@aQB#AD1e4x^zbID`Fz;3)` zYA7kFq#7~Y(WE$gap<`~QxgPD#;)IM$!ww+Q4tHmBdq*iRanm19h=T<7>EEW1Si?L z&tr+Zr|rm&KuKBe--Pok0u(|M8IS~I3ijvICrx-nQVrU*NaR7%a|d&*BeWg4z&_+c zxyPar38}E`%1jAg1!V(X0I(2N0tr~5T6mI(stA}L^LSfnsNU@u`S(oSI;8c2}V zr^rpcuhwUDIY@NE=7irtnS<#kMvEc~#}Oz93d%!~4j4>iHo=X1-#7kTKbg_y{x@oN zx8B2>>u9O@N0?CZqHGFk)*B#H^N{Ue`to$56r5RnXc&sU&u zF^B@(-EBi3Z$p>bV=B9lk0glqunZ1?An3e;TQ_JN=p-~8=v{G`t0{J0flg@q``K=4amYpX{t@N zH8xBQSIG-7yQlx;QB*XST_*$(G=-}O&7s-03z-pG@E(^E~(snhZExg594xb2X#_KbH zIY?9Anvc=@`~Ijcw=e2?bS6?@ihjO*B4-3ptRfpjLeLbYBGKhRr$;%3HMYNG4wXVz z0FRl0&d}O8yij#<9+YE7gaNLhx_w7wLsdi`0l;yw1^X%a7Xv_ebK~_9Y118d$ zRH_JdDOh*<7Ssf^+kk0^%V-oL7_>#wi>vXG-UbDw6Y%eD;)6JD?#gjYMM7$W!cFux z>`M44rC_-lsv^OQx=_6F~*>H0FpjpaS++gSDyo>LN<`R=SlNt zUD%o#>^z{8AT;2H8sjgG4&d*-MHh@>pCcIpY#tLqf;u1=AfrVdO_XE^hX?>WXfQZM zL3gP-EbHyzoN##vW^SZ1#4e0gJ~d8YAlca%1JZ`%TLILj7;;haf=6`Ft$KunuuC0; zP*4cJ@(GfWG<}2q6T@Kqaz_lR{epFOzFAc)QuAp|nX@wJJ&9+86(^-v$Ibrg9;pGX z&I;!Z5LerMFW$4=7gCalTTs+e@DCOP{}hOa{%50-4FSYt2v`n4-b5l28yNirKh)g7 zav4e~lOSMyGgz1UKSxG*b1>>1zm-mM>h8d6N__DzBoA19yU&I=B`x5;gzg1!*pdM5 z0D5`T&%X0~xp6=O@F@T_`g`y_IEGVpNUIxQjvOTdu)%;Zh&8rG5ML*B!heckdLOt; z;W4YAO_GISkt}@$yWOKUdB?yREfqW3&SSQ2!F2J|oT61f$BK^;&%PJ?$`oV|{>AgfW3JOdt@_y088l(i+w>I0Xf3eRyiS9M9SI+&b6#>|WXuVqtM783 zzyu$yVrUc4rAZKEQpz7dX~`-h+T&m6eMf_N0R3O=s&qoUP?5#pl)UL4&si<>4y~EG zM?0gv!b{|W$iT=EMg< z!nc^PDQbIzN0|^2I^LiC9zCq3Ha{>fP2CSqkC~vD3NuZD*5D043w!4%T z>Ii#*12jRO7G`UcBqKK1{&0rDccKYHZLx`rWIzD`MUWiG75hNIxfiq+5L?~CJV+X+ z!UGem2xl>Nd`&JR{h|aKAdo#0kPD=tBm_(WgdW(iDuyzug#ZXZN`Sq>Q543hq6irk zaqb)-J(-;AbKfu&0X4NI1q2oLrmo5C*?Lk_q7~xNkOLY+5|~!!sYwcm5k!+-?(jbY z#&`VYM&VGbQM;w=_{mjANdCI4>pLQ35)nsg2<6!{?RRHz_Sk{O zY-7eqhWMg#0Ah+cQ6eIPtV=~xSP9T`=jRzA&yQwVf+#wKfGdDtV7M0c1|hZ;p_FO? z9}q{K5W0qm39$*nH}k|yNdN?bjF~v-W4oZPj42{fHw}0q6dJ%<@kIyi3a(FSflijG z0PMQhV{N9#uQOOJ7M<&W0^uWnBkRt6D_h@eBVs9tB1D-I2%_nOD#Z^~a1uD!Gao&d z2%&PKUygI>%Q9*c@5VG9OT*KIJ$g(!Mc(ZAC#|>bj7We@o4_>@O?#nWf>;1a41l&K z=n%BHLMpn)#JuW!rZ(Dgp2xgiGuGA_>pdL6GZ~nwB#}@_d`4&@z#9c??gc>S@0)lt z+z*sPRzQW~Jrp?zZ63!ZEw&*9rz>FC^>Qvw@O zXA?65!7R|TE?)0nh>JNkO16j7lnzQC<$g?f0qZ>M;?_`b`K9uda=JOl)m7HkigTib!e(U|3PJ^yC+^H3IWRxJ&ETZ>E;~j$Naww9(aG(`ZoTicI#=1tv^DO4i?)V+i)=8{8roi zNgM|uws58zYd7+@`}!p$K#2$Ydz%}}|IhW+-(!_pAEVvK_^*E)v$}uPv$o;veCOf3 zcyvDoMfF<(P-?Ic@wt7F)*!vIR%Tln6X<+@D-8QH)2I!5kE)b{#Tt6H$&Ut!sIr|syV&6@(fQQ3P z!*055G)OczqBnoGK|@kX^bKX9iU~#Qt~4(yP&8|LDyoVs!2Vz3?;U-G$UR5l=iz(T zns!+S(D+3k35cX|0^y^1y1L}C&Fl$y-uLxUJrC8632Q78V!dxXR2)OKTdKa zNi+!jfrz~H%!7z-t+tHhB?9yJWd$JN^aJy|9qWf8@no2>F~_X*M9|XDwnR;SZzhtv zs1vT#3x$BRvWUQn)>M9){Sf@>Q}mxr$cq9fXG0+c3Bi&-*Zx28%Xv(gAU@&&kqKyw zmQ?*-4llO}PB94)aE?aK6~Q7yZ9M}YDCA&RHIn&dO#`o>c{8a$s~tanCCH!KL;M~G zJ0K13I5xR3up~|(1^U7xanB_KspM^;b(!9{Bh91*ZOQMa;?@ zIH&w^+6YG$LX^;@K!sKBecEMuqw;ZSrY5E_2yK}D-!X#+o? zNRU0iUT@gFs%{I$g_wM1U>qTQYz=xYBSR;SkwR$qk(h2W%t2CY$NJ<8;K(s07~RLV zW+&d?1O#R^2x*jti$!WXsw<94jg!<&u#mNeyj0^Ks1xT?iwG^E3xq=oP?tO5M>WM1 z;RG^@3uhN>+EUa$79ig!4S`i*h%e*3a-!ma=2>cF>xUNnC>$lmu`@Y_GU|flX4A$IH zph>23T{LEhXyZ2pRKyGr7_o54p@Lq5i?EQOYY~uBTKF`S-W)b27U`V_o$5WL*WU?^ zw$GfIt6p-HH39Q}FW3BU#>TolD@sWRte2bGQJsU<2ZvtAvF`p+QsA)@VPHjWf{J(` zg5sT2NF7Wyz>#Y<#ixfh~xFtR6KUs|0};lk|6jsmy=2;3MT;v=^nm@c9i z)y6<^bFUyQF_7mQ&n&mdvIjdqPaWVZ^zn(6ln`YhRa9POC|%23T3QEJ()+)2Z`S^j zFAFJwDFUvctxDouf(ExrzU=5>J^=o^&~CwlxCj=^2I0!VSnOgVeCm|&m~T8Ssx_yt z=(!sZ!nYu}Up=BMwJ!YUQ!Hfi5-|?(g#H26WYA+Hx^6*QpRMh9vO)FlJXT&$uaSGt zpD2WxkVMdR2hgO4KQaezoqpip;y5s*2HPT6D$srWx=Zy*lmUJq=5tKSY?XVBDW7Zb z<+C+eAl%MR!hsm$7gWlV55;}Xzz`mPOTcun_Zj0!uLM5MQo9s)#s_Z7xhezR3JU3x0EoJ)| z9yPzeRu2(PlKp%cXw(WJbB~c(QR@7n~3JNZUoUX$Uo77!1NA zQy$@QbF-BSDQ*Cwf?@(0Kr!DC>Q{{tjfgiN{+#kx7Q#t4mAbR+Qrxuoc2IVH#_Im%X z5cqo?e_yvhns&Lpj>DYfMqt`R=q8U03~yJzRTULoV8ldFAn>mTQ;W{d*1_E4md0=$ z8RyR4r>mahyBak>-9u8-?Zs_ia>S$H@G}^_RiD4tZ!L17@@mOwY+CbRQoxx+45DdP zKkTW=!#4^N(+zsv3RxjYFQlZTe84>JO) zP|U}LK;m6E7sZof>RY$Mo8WmrR}uUmgyI!|NqQ=}{A<%Nq$u8RTh@`TfhJJf$tIhU z07>k;%0o{$aMOPD-#DH^nu>!4um*nIoKq8D@Gb+a2ZXmh)4xWS;m_LnCW}w8iM9FQ zD2}OmZ_vw)MRnBZexLB&+V%CPAVW^9y-pnZGx89c91tNue{QJkmR@!9ywo6h_n*E} zYl$>)v`>P&-ZaBOvHIsM)%1;JMT%#ovjJ9Rk9IhDBed|*ED+ehWziXaulepSwun7c9TWR_o~QwT0D%9-kXeOlxPfHmHe#r$8C|l(%s`8P z*M-lLbI%s_!2n;FfC^{%|C0_(*IP(Z2kHPG;1aQF39cWV9_>N3Lj&lZr_TDal%(sY z829y+LbA245xGEr#iyFR9~mdmk^i+U}-NM9PT;RY!>OK~*3B7ji{7P>^$| FyVEgnaVh`+ diff --git a/R/tbl_survfit.R b/R/tbl_survfit.R index 2ec70b6d7..4a897cbbc 100644 --- a/R/tbl_survfit.R +++ b/R/tbl_survfit.R @@ -206,11 +206,12 @@ tbl_survfit.list <- function(x, ) } if (missing(statistic)) { - get_theme_element( - "tbl_survfit-arg:statistic", - default = - paste0("{estimate} ({conf.low}", get_theme_element("pkgwide-str:ci.sep", default = ", "), "{conf.high})") - ) + statistic <- + get_theme_element( + "tbl_survfit-arg:statistic", + default = + paste0("{estimate} ({conf.low}", get_theme_element("pkgwide-str:ci.sep", default = ", "), "{conf.high})") + ) } check_string(statistic) if (is_string(label)) label <- inject(everything() ~ !!label) diff --git a/data-raw/gtsummary_theme_elements.csv b/data-raw/gtsummary_theme_elements.csv index 0a99846fd..f28538676 100644 --- a/data-raw/gtsummary_theme_elements.csv +++ b/data-raw/gtsummary_theme_elements.csv @@ -1,84 +1,83 @@ -deprecated,fn,name,argument,desc,example -FALSE,add_global_p,add_global_p-str:type,FALSE,set argument default for `add_global_p.tbl_regression(type=)` and `add_global_p.tbl_uvregression(type=)`,"""II""" -FALSE,add_global_p,add_global_p-str:type,FALSE,"set argument default for `add_global_p.tbl_regression(type=)` and `add_global_p.tbl_uvregression(type=)`; default is `""III""`","""II""" -FALSE,add_p.tbl_cross,add_p.tbl_cross-arg:pvalue_fun,TRUE,, -FALSE,add_p.tbl_cross,add_p.tbl_cross-arg:source_note ,TRUE,, -FALSE,add_p.tbl_cross,add_p.tbl_cross-arg:test,TRUE,, -FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical,FALSE,default test for categorical/dichotomous variables,"""chisq.test""" -FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical.group_by2,FALSE,default test for categorical/dichotomous grouped/correlated variables with a 2-level by variable,"""lme4""" -FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical.low_count,FALSE,default test for categorical/dichotomous variables with minimum expected count <5,"""fisher.test""" -FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous,FALSE,default test for continuous variables with a 3- or more level by variable,"""aov""" -FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous.group_by2,FALSE,default test for continuous grouped/correlated variables with a 2-level by variable,"""lme4""" -FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous_by2,FALSE,default test for continuous variables with a 2-level by variable,"""t.test""" -TRUE,add_p.tbl_summary,add_p.tbl_summary-arg:pvalue_fun,TRUE,, -FALSE,add_p.tbl_summary,add_p.tbl_summary-arg:test,TRUE,, -FALSE,add_p.tbl_svysummary,add_p.tbl_svysummary-attr:test.categorical,FALSE,default test for categorical/dichotomous variables,"""svy.chisq.test""" -FALSE,add_p.tbl_svysummary,add_p.tbl_svysummary-attr:test.continuous,FALSE,default test for continuous variables,"""svy.wilcox.test""" -FALSE,add_p.tbl_svysummary,add_p.tbl_svysummary-arg:pvalue_fun,TRUE,, -FALSE,add_p.tbl_svysummary,add_p.tbl_svysummary-arg:test,TRUE,, -FALSE,add_q,add_q-arg:method,TRUE,, -FALSE,add_q,add_q-arg:pvalue_fun,TRUE,, -FALSE,add_stat_label,add_stat_label-arg:location,TRUE,, -FALSE,as_flex_table,as_flex_table-lst:addl_cmds,FALSE,"named list of expressions of {flextable} package commands inserted in the `as_flex_table()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_flex_table(x, return_calls = TRUE)` and check the names.","list(autofit = list(rlang::expr(flextable::font(fontname = ""Bodoni 72"", part = ""all"")), rlang::expr(flextable::fontsize(size = 8, part = ""all""))))" -FALSE,as_gt,as_gt-lst:addl_cmds,FALSE,"named list of expressions of {gt} package commands inserted in the `as_gt()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_gt(x, return_calls = TRUE)` and check the names.",list(tab_spanner = rlang::expr(gt::tab_options(table.font.size = 'small'))) -FALSE,as_hux_table,as_hux_table.gtsummary-lst:addl_cmds,FALSE,"named list of expressions of {huxtable} package commands inserted in the `as_hux_table()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_hux_table(x, return_calls = TRUE)` and check the names.", -FALSE,as_kable,as_kable-arg:dots,TRUE,"named list of arguments passed to `knitr::kable()`, which also applies to calls from `as_kable_extra()`","list(booktabs = TRUE, longtable = TRUE, linesep = """")" -FALSE,as_kable_extra,as_kable_extra-lst:addl_cmds,FALSE,"named list of expressions of {kableExtra} package commands inserted in the `as_kable_extra()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_kable_extra(x, return_calls = TRUE)` and check the names.", -FALSE,Package-wide,pkgwide-fn:prependpvalue_fun,FALSE,"function to style p-values throughout package that include a ""p"" prefix, e.g. ""p<0.001"" or ""p=0.12""; this is common in the `inline_text()` functions; default is `function(x) style_pvalue(x, prepend_p = TRUE)`","function(x) style_pvalue(x, digits = 2, prepend_p = TRUE)" -FALSE,Package-wide,pkgwide-fn:pvalue_fun,FALSE,function to style p-values throughout package; default is `style_pvalue`,"function(x) style_pvalue(x, digits = 2)" -FALSE,Package-wide,pkgwide-lgl:quiet,FALSE,logical indicating whether to suppress messages or not; default is `FALSE`, -FALSE,Package-wide,pkgwide-str:ci.sep,FALSE,"string indicating separator between upper and lower bounds of confidence intervals. Default is `"", ""`",""" to """ -FALSE,Package-wide,pkgwide-str:language,FALSE,"string indicating language; default is `""en""`","""es""" -FALSE,Package-wide,pkgwide-str:print_engine,FALSE,"string indicating the default print engine; default is `""gt""`","""flextable""" -FALSE,Package-wide,pkgwide-str:theme_name,FALSE,optional name of theme; name is printed when theme loaded,"""My Personal Theme""" -FALSE,Package-wide,pkgwide-fun:pre_conversion,FALSE,"function that is executed on the gtsummary object before it is converted with `as_gt()`, `as_flex_table()`, etc. Must be a function that can be run on every and any gtsummary object",bold_levels -FALSE,style_number,style_number-arg:big.mark,TRUE,, -FALSE,style_number,style_number-arg:decimal.mark,TRUE,, -FALSE,tbl_regression,tbl_regression-fn:addnl-fn-to-run,FALSE,a function that will be executed after at the end of each `tbl_regression()` call,bold_labels -TRUE,tbl_regression,tbl_regression-chr:tidy_columns,FALSE,"character vector of columns from `tidy_fun=` tibble to print. 'estimate' column will always be printed. Select among columns 'conf.low', 'conf.high', 'std.error', 'statistic', or 'p.value'.","c(""std.error"", ""p.value"")" -FALSE,tbl_regression,tbl_regression-lst:tidy_plus_plus,FALSE,"Additional `tidy_plus_plus()` arguments. Cannot be one of `model=`, `tidy_fun=`, `exponentiate=`, `variable_labels=`, `show_single_row=`, `intercept=`, `include=`, `conf.level=`, `conf.int=`, or `strict=` as these are controlled by `tbl_regression()`. The default value for the additional arguments is `list(conf.int = TRUE, add_header_rows = TRUE, add_estimate_to_reference_rows = FALSE)`.","list(conf.int = TRUE, add_header_rows = TRUE, add_estimate_to_reference_rows = TRUE)" -FALSE,tbl_regression,tbl_regression-str:coef_header,FALSE,"string setting the default term for the beta coefficient column header; default is `""Beta""`","ifelse(exponentiate == TRUE, ""exp(coef)"", ""coef"")" -FALSE,tbl_regression,tbl_regression-str:ref_row_text,FALSE,string indicating the text to print on reference rows (default is an em-dash),"""Reference""" -FALSE,tbl_regression,tbl_regression-arg:conf.level,TRUE,, -FALSE,tbl_regression,tbl_regression-arg:conf.int,TRUE,, -FALSE,tbl_regression,tbl_regression-arg:estimate_fun ,TRUE,, -TRUE,tbl_regression,tbl_regression-arg:pvalue_fun ,TRUE,, -FALSE,tbl_regression,tbl_regression-arg:add_estimate_to_reference_rows,TRUE,, -FALSE,tbl_regression,tbl_regression-arg:tidy_fun ,TRUE,, -FALSE,tbl_stack,tbl_stack-str:group_header,FALSE,"string indicating the group column header used in `as_tibble()`, `as_flex_table()`, etc. where row headers are not supported; default is `""**Group**""`","""**Group Status**""" -FALSE,tbl_summary,tbl_summary-fn:addnl-fn-to-run,FALSE,a function that will be executed after at the end of each `tbl_summary()` call,bold_labels -FALSE,tbl_summary,tbl_summary-fn:N_fun,FALSE,function to style integers. Currently questioning...THIS MAY BE REMOVED IN A FUTURE RELEASE. Use `style_number-arg:big.mark` and `style_number-arg:decimal.mark` instead.,"function(x) sprintf(""%.0f"", x)" -FALSE,tbl_summary,tbl_summary-fn:percent_fun,FALSE,function to style percentages; default is `style_percent`,function(x) style_percent(x) -FALSE,tbl_summary,tbl_summary-str:default_con_type,FALSE,"string indicating the default summary type for continuous variables; default is `""continuous""`; update to `""continuous2""` for multi-line summaries of continuous variables","""continuous2""" -FALSE,tbl_summary,tbl_summary-str:missing_stat,FALSE,"string indicating the statistic(s) to present on the missing row. The default is `""{N_miss}""`. Select among `c(""N_miss"", ""N_obs"", ""p_miss"", ""N_nonmiss"", ""p_nonmiss"")`","""{N_miss} ({p_miss}%)""" -FALSE,tbl_summary,tbl_summary-str:header-noby,FALSE,string indicating the statistic header when there is no by variable present,"""N={N}""" -FALSE,tbl_summary,tbl_summary-str:header-withby,FALSE,string indicating the statistic header when there is a by variable present,"""**{level}** \nN={n}""" -FALSE,tbl_summary,tbl_summary-arg:digits,TRUE,, -TRUE,tbl_summary,tbl_summary-arg:label,TRUE,, -FALSE,tbl_summary,tbl_summary-arg:missing,TRUE,, -FALSE,tbl_summary,tbl_summary-arg:missing_text,TRUE,, -FALSE,tbl_summary,tbl_summary-arg:percent,TRUE,, -FALSE,tbl_summary,tbl_summary-arg:sort,TRUE,, -FALSE,tbl_summary,tbl_summary-arg:statistic,TRUE,, -FALSE,tbl_summary,tbl_summary-arg:type,TRUE,, -FALSE,tbl_summary,tbl_summary-arg:value,TRUE,, -FALSE,tbl_survfit,tbl_survfit-arg:statistic,TRUE,, -FALSE,tbl_svysummary,tbl_svysummary-fn:addnl-fn-to-run,FALSE,a function that will be executed after at the end of each `tbl_svysummary()` call,bold_labels -FALSE,tbl_svysummary,tbl_svysummary-str:header-noby,FALSE,string indicating the statistic header when there is no by variable present,"""N={N}""" -FALSE,tbl_svysummary,tbl_svysummary-str:header-withby,FALSE,string indicating the statistic header when there is a by variable present,"""**{level}** \nN={n}""" -FALSE,tbl_svysummary,tbl_svysummary-arg:digits,TRUE,, -FALSE,tbl_svysummary,tbl_svysummary-arg:label,TRUE,, -FALSE,tbl_svysummary,tbl_svysummary-arg:missing,TRUE,, -FALSE,tbl_svysummary,tbl_svysummary-arg:missing_text,TRUE,, -FALSE,tbl_svysummary,tbl_svysummary-arg:percent,TRUE,, -FALSE,tbl_svysummary,tbl_svysummary-arg:sort,TRUE,, -FALSE,tbl_svysummary,tbl_svysummary-arg:statistic,TRUE,, -FALSE,tbl_svysummary,tbl_svysummary-arg:type,TRUE,, -FALSE,tbl_svysummary,tbl_svysummary-arg:value,TRUE,, -FALSE,add_difference,add_difference-fn:addnl-fn-to-run,FALSE,a function that will be executed after at the end of each `add_difference()` call,bold_labels -FALSE,tbl_custom_summary,tbl_custom_summary-arg:digits,TRUE,, -FALSE,tbl_custom_summary,tbl_custom_summary-arg:label,TRUE,, -FALSE,tbl_custom_summary,tbl_custom_summary-arg:missing,TRUE,, -FALSE,tbl_custom_summary,tbl_custom_summary-arg:missing_text,TRUE,, -FALSE,tbl_custom_summary,tbl_custom_summary-arg:type,TRUE,, -FALSE,tbl_custom_summary,tbl_custom_summary-arg:value,TRUE,, +deprecated,fn,name,argument,desc,example +FALSE,add_global_p,add_global_p-str:type,FALSE,set argument default for `add_global_p.tbl_regression(type=)` and `add_global_p.tbl_uvregression(type=)`,"""II""" +FALSE,add_global_p,add_global_p-str:type,FALSE,"set argument default for `add_global_p.tbl_regression(type=)` and `add_global_p.tbl_uvregression(type=)`; default is `""III""`","""II""" +FALSE,add_p.tbl_cross,add_p.tbl_cross-arg:pvalue_fun,TRUE,, +FALSE,add_p.tbl_cross,add_p.tbl_cross-arg:source_note ,TRUE,, +FALSE,add_p.tbl_cross,add_p.tbl_cross-arg:test,TRUE,, +FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical,FALSE,default test for categorical/dichotomous variables,"""chisq.test""" +FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical.group_by2,FALSE,default test for categorical/dichotomous grouped/correlated variables with a 2-level by variable,"""lme4""" +FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical.low_count,FALSE,default test for categorical/dichotomous variables with minimum expected count <5,"""fisher.test""" +FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous,FALSE,default test for continuous variables with a 3- or more level by variable,"""aov""" +FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous.group_by2,FALSE,default test for continuous grouped/correlated variables with a 2-level by variable,"""lme4""" +FALSE,add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous_by2,FALSE,default test for continuous variables with a 2-level by variable,"""t.test""" +TRUE,add_p.tbl_summary,add_p.tbl_summary-arg:pvalue_fun,TRUE,, +FALSE,add_p.tbl_summary,add_p.tbl_summary-arg:test,TRUE,, +FALSE,add_p.tbl_svysummary,add_p.tbl_svysummary-attr:test.categorical,FALSE,default test for categorical/dichotomous variables,"""svy.chisq.test""" +FALSE,add_p.tbl_svysummary,add_p.tbl_svysummary-attr:test.continuous,FALSE,default test for continuous variables,"""svy.wilcox.test""" +FALSE,add_p.tbl_svysummary,add_p.tbl_svysummary-arg:pvalue_fun,TRUE,, +FALSE,add_p.tbl_svysummary,add_p.tbl_svysummary-arg:test,TRUE,, +FALSE,add_q,add_q-arg:method,TRUE,, +FALSE,add_q,add_q-arg:pvalue_fun,TRUE,, +FALSE,add_stat_label,add_stat_label-arg:location,TRUE,, +FALSE,as_flex_table,as_flex_table-lst:addl_cmds,FALSE,"named list of expressions of {flextable} package commands inserted in the `as_flex_table()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_flex_table(x, return_calls = TRUE)` and check the names.","list(autofit = list(rlang::expr(flextable::font(fontname = ""Bodoni 72"", part = ""all"")), rlang::expr(flextable::fontsize(size = 8, part = ""all""))))" +FALSE,as_gt,as_gt-lst:addl_cmds,FALSE,"named list of expressions of {gt} package commands inserted in the `as_gt()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_gt(x, return_calls = TRUE)` and check the names.",list(tab_spanner = rlang::expr(gt::tab_options(table.font.size = 'small'))) +FALSE,as_hux_table,as_hux_table.gtsummary-lst:addl_cmds,FALSE,"named list of expressions of {huxtable} package commands inserted in the `as_hux_table()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_hux_table(x, return_calls = TRUE)` and check the names.", +FALSE,as_kable,as_kable-arg:dots,TRUE,"named list of arguments passed to `knitr::kable()`, which also applies to calls from `as_kable_extra()`","list(booktabs = TRUE, longtable = TRUE, linesep = """")" +FALSE,as_kable_extra,as_kable_extra-lst:addl_cmds,FALSE,"named list of expressions of {kableExtra} package commands inserted in the `as_kable_extra()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_kable_extra(x, return_calls = TRUE)` and check the names.", +FALSE,Package-wide,pkgwide-fn:prependpvalue_fun,FALSE,"function to style p-values throughout package that include a ""p"" prefix, e.g. ""p<0.001"" or ""p=0.12""; this is common in the `inline_text()` functions; default is `function(x) style_pvalue(x, prepend_p = TRUE)`","function(x) style_pvalue(x, digits = 2, prepend_p = TRUE)" +FALSE,Package-wide,pkgwide-fn:pvalue_fun,FALSE,function to style p-values throughout package; default is `style_pvalue`,"function(x) style_pvalue(x, digits = 2)" +FALSE,Package-wide,pkgwide-str:ci.sep,FALSE,"string indicating separator between upper and lower bounds of confidence intervals. Default is `"", ""`",""" to """ +FALSE,Package-wide,pkgwide-str:language,FALSE,"string indicating language; default is `""en""`","""es""" +FALSE,Package-wide,pkgwide-str:print_engine,FALSE,"string indicating the default print engine; default is `""gt""`","""flextable""" +FALSE,Package-wide,pkgwide-str:theme_name,FALSE,optional name of theme; name is printed when theme loaded,"""My Personal Theme""" +FALSE,Package-wide,pkgwide-fun:pre_conversion,FALSE,"function that is executed on the gtsummary object before it is converted with `as_gt()`, `as_flex_table()`, etc. Must be a function that can be run on every and any gtsummary object",bold_levels +FALSE,style_number,style_number-arg:big.mark,TRUE,, +FALSE,style_number,style_number-arg:decimal.mark,TRUE,, +FALSE,tbl_regression,tbl_regression-fn:addnl-fn-to-run,FALSE,a function that will be executed after at the end of each `tbl_regression()` call,bold_labels +TRUE,tbl_regression,tbl_regression-chr:tidy_columns,FALSE,"character vector of columns from `tidy_fun=` tibble to print. 'estimate' column will always be printed. Select among columns 'conf.low', 'conf.high', 'std.error', 'statistic', or 'p.value'.","c(""std.error"", ""p.value"")" +FALSE,tbl_regression,tbl_regression-lst:tidy_plus_plus,FALSE,"Additional `tidy_plus_plus()` arguments. Cannot be one of `model=`, `tidy_fun=`, `exponentiate=`, `variable_labels=`, `show_single_row=`, `intercept=`, `include=`, `conf.level=`, `conf.int=`, or `strict=` as these are controlled by `tbl_regression()`. The default value for the additional arguments is `list(conf.int = TRUE, add_header_rows = TRUE, add_estimate_to_reference_rows = FALSE)`.","list(conf.int = TRUE, add_header_rows = TRUE, add_estimate_to_reference_rows = TRUE)" +FALSE,tbl_regression,tbl_regression-str:coef_header,FALSE,"string setting the default term for the beta coefficient column header; default is `""Beta""`","ifelse(exponentiate == TRUE, ""exp(coef)"", ""coef"")" +FALSE,tbl_regression,tbl_regression-str:ref_row_text,FALSE,string indicating the text to print on reference rows (default is an em-dash),"""Reference""" +FALSE,tbl_regression,tbl_regression-arg:conf.level,TRUE,, +FALSE,tbl_regression,tbl_regression-arg:conf.int,TRUE,, +FALSE,tbl_regression,tbl_regression-arg:estimate_fun ,TRUE,, +TRUE,tbl_regression,tbl_regression-arg:pvalue_fun ,TRUE,, +FALSE,tbl_regression,tbl_regression-arg:add_estimate_to_reference_rows,TRUE,, +FALSE,tbl_regression,tbl_regression-arg:tidy_fun ,TRUE,, +FALSE,tbl_stack,tbl_stack-str:group_header,FALSE,"string indicating the group column header used in `as_tibble()`, `as_flex_table()`, etc. where row headers are not supported; default is `""**Group**""`","""**Group Status**""" +FALSE,tbl_summary,tbl_summary-fn:addnl-fn-to-run,FALSE,a function that will be executed after at the end of each `tbl_summary()` call,bold_labels +FALSE,tbl_summary,tbl_summary-fn:N_fun,FALSE,function to style integers. Currently questioning...THIS MAY BE REMOVED IN A FUTURE RELEASE. Use `style_number-arg:big.mark` and `style_number-arg:decimal.mark` instead.,"function(x) sprintf(""%.0f"", x)" +FALSE,tbl_summary,tbl_summary-fn:percent_fun,FALSE,function to style percentages; default is `style_percent`,function(x) style_percent(x) +FALSE,tbl_summary,tbl_summary-str:default_con_type,FALSE,"string indicating the default summary type for continuous variables; default is `""continuous""`; update to `""continuous2""` for multi-line summaries of continuous variables","""continuous2""" +FALSE,tbl_summary,tbl_summary-str:missing_stat,FALSE,"string indicating the statistic(s) to present on the missing row. The default is `""{N_miss}""`. Select among `c(""N_miss"", ""N_obs"", ""p_miss"", ""N_nonmiss"", ""p_nonmiss"")`","""{N_miss} ({p_miss}%)""" +FALSE,tbl_summary,tbl_summary-str:header-noby,FALSE,string indicating the statistic header when there is no by variable present,"""N={N}""" +FALSE,tbl_summary,tbl_summary-str:header-withby,FALSE,string indicating the statistic header when there is a by variable present,"""**{level}** \nN={n}""" +FALSE,tbl_summary,tbl_summary-arg:digits,TRUE,, +TRUE,tbl_summary,tbl_summary-arg:label,TRUE,, +FALSE,tbl_summary,tbl_summary-arg:missing,TRUE,, +FALSE,tbl_summary,tbl_summary-arg:missing_text,TRUE,, +FALSE,tbl_summary,tbl_summary-arg:percent,TRUE,, +FALSE,tbl_summary,tbl_summary-arg:sort,TRUE,, +FALSE,tbl_summary,tbl_summary-arg:statistic,TRUE,, +FALSE,tbl_summary,tbl_summary-arg:type,TRUE,, +FALSE,tbl_summary,tbl_summary-arg:value,TRUE,, +FALSE,tbl_survfit,tbl_survfit-arg:statistic,TRUE,, +FALSE,tbl_svysummary,tbl_svysummary-fn:addnl-fn-to-run,FALSE,a function that will be executed after at the end of each `tbl_svysummary()` call,bold_labels +FALSE,tbl_svysummary,tbl_svysummary-str:header-noby,FALSE,string indicating the statistic header when there is no by variable present,"""N={N}""" +FALSE,tbl_svysummary,tbl_svysummary-str:header-withby,FALSE,string indicating the statistic header when there is a by variable present,"""**{level}** \nN={n}""" +FALSE,tbl_svysummary,tbl_svysummary-arg:digits,TRUE,, +FALSE,tbl_svysummary,tbl_svysummary-arg:label,TRUE,, +FALSE,tbl_svysummary,tbl_svysummary-arg:missing,TRUE,, +FALSE,tbl_svysummary,tbl_svysummary-arg:missing_text,TRUE,, +FALSE,tbl_svysummary,tbl_svysummary-arg:percent,TRUE,, +FALSE,tbl_svysummary,tbl_svysummary-arg:sort,TRUE,, +FALSE,tbl_svysummary,tbl_svysummary-arg:statistic,TRUE,, +FALSE,tbl_svysummary,tbl_svysummary-arg:type,TRUE,, +FALSE,tbl_svysummary,tbl_svysummary-arg:value,TRUE,, +FALSE,add_difference,add_difference-fn:addnl-fn-to-run,FALSE,a function that will be executed after at the end of each `add_difference()` call,bold_labels +FALSE,tbl_custom_summary,tbl_custom_summary-arg:digits,TRUE,, +FALSE,tbl_custom_summary,tbl_custom_summary-arg:label,TRUE,, +FALSE,tbl_custom_summary,tbl_custom_summary-arg:missing,TRUE,, +FALSE,tbl_custom_summary,tbl_custom_summary-arg:missing_text,TRUE,, +FALSE,tbl_custom_summary,tbl_custom_summary-arg:type,TRUE,, +FALSE,tbl_custom_summary,tbl_custom_summary-arg:value,TRUE,, \ No newline at end of file diff --git a/tests/testthat/_snaps/theme_elements_gtsummary.md b/tests/testthat/_snaps/theme_elements_gtsummary.md deleted file mode 100644 index d9d8fe59b..000000000 --- a/tests/testthat/_snaps/theme_elements_gtsummary.md +++ /dev/null @@ -1,11 +0,0 @@ -# pkgwide-fun:pre_conversion works - - Code - gts_6 - Output - - - |**Characteristic** | **Drug A** N = 98 | **95% CI** | **Drug B** N = 102 | **95% CI** | - |:------------------|:------------------:|:----------:|:-------------------:|:----------:| - |Patient Died | 52 (53%) | 43%, 63% | 60 (59%) | 49%, 68% | - diff --git a/tests/testthat/test-theme_elements_gtsummary.R b/tests/testthat/test-theme_elements_gtsummary.R index 69066e240..d196af1a4 100644 --- a/tests/testthat/test-theme_elements_gtsummary.R +++ b/tests/testthat/test-theme_elements_gtsummary.R @@ -1,189 +1,94 @@ -# Package-wide Unit Tests------------------------------------------------------- -## pkgwide-fn:prependpvalue_fun------------------------------------------------- -test_that("pkgwide-fn:prependpvalue_fun works", { - # Test that the p-value has 3 digits +skip_on_cran() +skip_if_not(is_pkg_installed("survival")) + +# pkgwide-fn:prependpvalue_fun ------------------------------------------------- +test_that("pkgwide-fn:prependpvalue_fun", { + # works in `inline_text.tbl_summary()` expect_equal( with_gtsummary_theme( - x = - list( - # Prepend p value, with 3 place digits - "pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE) - ), + x = list("pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE)), expr = trial |> - tbl_summary( - by = trt, - include = c(trt, age) - ) |> + tbl_summary(by = trt, include = age) |> add_p() |> inline_text(variable = age, column = "p.value") ), "p=0.718" ) -} -) -## Other pkgwide Tests---------------------------------------------------------- -# Create a theme# -my_theme_2 <- - list( - # Pvalue with 2 place digits and custom decimal mark - "pkgwide-fn:pvalue_fun" = label_style_pvalue(digits = 2, decimal.mark = "++"), - # set messaging to quiet - "pkgwide-lgl:quiet" = TRUE, - # configurar el idioma en español# - "pkgwide-str:language" = "es" + # works in `inline_text.tbl_cross()` + expect_equal( + with_gtsummary_theme( + x = list("pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE)), + expr = + trial |> + tbl_cross(col = trt, row = grade) |> + add_p() |> + inline_text(col_level = "p.value") + ), + "p=0.871" ) - -# Apply the theme to the table and pull out the p-vale# -gts_2_pvalue <- - with_gtsummary_theme( - x = my_theme_2, - expr = trial |> - tbl_summary( - by = trt, - include = c(trt, age), - ) |> - add_p() |> - inline_text.gtsummary(x = _, variable = age, column = "p.value") + # works in `inline_text.tbl_regression()` + expect_equal( + with_gtsummary_theme( + x = list("pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE)), + expr = + lm(marker ~ age, trial) |> + tbl_regression() |> + inline_text(variable = age, pattern = "{p.value}") + ), + "p=0.965" ) -### pkgwide-fn:pvalue_fun------------------------------------------------------- -test_that("pkgwide-fn:pvalue_fun works", { - - # Test that the p-value has the decimal mark# - expect_equal(gts_2_pvalue, "0++72") - -} -) - -## pkgwide-str:language--------------------------------------------------------- -test_that("pkgwide-str:language works", { - - # Pull out the headers to see if the language changed# - vec_gts2_headers <- + # works in `inline_text.tbl_survfit()` + expect_equal( with_gtsummary_theme( - x = my_theme_2, - expr = trial |> - tbl_summary( - by = trt, - include = c(trt, age) - ) |> - add_p() - )[["table_styling"]][["header"]][["label"]] - - # Test that some of the headers were translated to Spanish# - expect_contains(vec_gts2_headers, "**Característica**") -} -) - + x = list("pkgwide-fn:prependpvalue_fun" = label_style_pvalue(digits = 3, prepend_p = TRUE)), + tbl_survfit( + survival::survfit(survival::Surv(ttdeath, death) ~ trt, trial), + times = c(12, 24), + label = ~"Treatment", + label_header = "**{time} Month**" + ) |> + add_p() |> + inline_text(column = p.value) + ), + "p=0.239" + ) +}) -## pkgwide-str:ci.sep----------------------------------------------------------- +# pkgwide-str:ci.sep ----------------------------------------------------------- test_that("pkgwide-str:ci.sep works", { - - # Create a theme# - my_theme_3 <- - list( - # Set CI sep to be something *cute*# - "pkgwide-str:ci.sep" = " ~*~" - ) - - # Apply the theme to the table and grab the CI value for age# - gts_ci_value <- - with_gtsummary_theme( - x = my_theme_3, - expr = glm(response ~ age + stage, trial, family = binomial) |> - tbl_regression(x = _, exponentiate = TRUE) |> - inline_text.gtsummary(x = _, variable = age, column = "ci") - ) - - # Test that the CI has the correct pattern# - expect_equal(gts_ci_value, "1.00 ~*~ 1.04") -} -) - -## pkgwide-str:print_engine----------------------------------------------------- -test_that("pkgwide-str:print_engine works", { - - # Create a theme# - my_theme_4 <- - list( - # Have the print engine be kable# - "pkgwide-str:print_engine" = "kable" - ) - - # Set the theme to check that table is in kable format# - gts_4_w_theme <- - with_gtsummary_theme( - x = my_theme_4, - expr = trial |> - dplyr::select(death, trt) |> - tbl_summary(by = trt) |> - print() - ) - - # Create the same table with as_kable instead# - gts_4_w_kable <- - trial |> - dplyr::select(death, trt) |> - tbl_summary(by = trt) |> - as_kable() - - # Test that the print engine output matches the kable version of the table# - expect_equal(gts_4_w_theme, gts_4_w_kable) -} -) - -## pkgwide-str:theme_name------------------------------------------------------- -test_that("pkgwide-str:theme_name works", { - - # Create a theme# - my_theme_5 <- - list( - # Set a theme name# - "pkgwide-str:theme_name" = "Super Cool Themey Theme" - ) - - # Grab the theme name# - gts_5_theme_name <- + # works with add_difference() + expect_equal( with_gtsummary_theme( - x = my_theme_5, - expr = get_gtsummary_theme() - )[["pkgwide-str:theme_name"]] - - # Test that the theme name matches as expected# - expect_equal(gts_5_theme_name, "Super Cool Themey Theme") -} -) - - -## pkgwide-fun:pre_conversion--------------------------------------------------- -test_that("pkgwide-fun:pre_conversion works", { - - # Create a theme# - my_theme_6 <- - list( - # Set a fx to use in pre conversion# - "pkgwide-fun:pre_conversion" = add_ci, - # Have the print engine be kable# - "pkgwide-str:print_engine" = "kable" - ) + x = list("pkgwide-str:ci.sep" = " --- "), + expr = + trial |> + tbl_summary(by = trt, include = age, missing = "no") |> + add_difference() |> + as_tibble(col_labels = FALSE) |> + dplyr::pull(conf.low) + ), + "-4.6 --- 3.7" + ) - # Apply the theme to the table and print it to see pre conversions# - gts_6 <- + # works with `tbl_survfit()` + expect_equal( with_gtsummary_theme( - x = my_theme_6, - expr = trial |> - dplyr::select(death, trt) |> - tbl_summary(by = trt) |> - print() - ) - - # Test that the table includes the CI column# - expect_snapshot( - gts_6 + x = list("pkgwide-str:ci.sep" = " --- "), + tbl_survfit( + survival::survfit(survival::Surv(ttdeath, death) ~ trt, trial), + times = 12, + label = ~"Treatment", + label_header = "**{time} Month**" + ) |> + as_tibble(col_labels = FALSE) |> + dplyr::pull(stat_1) |> + dplyr::last() + ), + "86% (80% --- 93%)" ) +}) -} -)