Nothing
skip_on_cran()
skip_if_not(is_pkg_installed("survival"))
# inline_text.tbl_summary tests ------------------------------------------------
test_inline1 <- trial |> tbl_summary()
test_inline2 <- trial |> tbl_summary(by = trt)
test_inline2b <- trial |>
tbl_summary(by = trt) |>
add_overall() |>
add_p()
test_inline3 <-
trial |>
tbl_summary(by = trt, include = age, missing = "no") |>
add_difference()
test_that("inline_text.tbl_summary", {
expect_equal(
trial |>
select(age) |>
tbl_summary() |>
inline_text(variable = "age", column = "stat_0"),
"47 (38, 57)"
)
expect_equal(
inline_text(test_inline1, variable = "age"),
"47 (38, 57)"
)
expect_equal(
inline_text(test_inline1, variable = "stage", level = "T1"),
"53 (27%)"
)
expect_equal(
inline_text(test_inline1, variable = "stage", level = "T1", pattern = "{p}%"),
"27%"
)
expect_equal(
inline_text(test_inline1, variable = "age", pattern = "The median is {median}"),
"The median is 47"
)
expect_equal(
inline_text(test_inline2, variable = "age", column = "Drug B"),
"48 (39, 56)"
)
expect_equal(
inline_text(test_inline3, pattern = "{estimate} (95% CI {conf.low}, {conf.high})", variable = "age"),
"-0.44 (95% CI -4.6, 3.7)"
)
expect_equal(
inline_text(test_inline2, variable = "stage", level = "T1", column = "Drug B"),
"25 (25%)"
)
expect_equal(
inline_text(test_inline2b, variable = "stage", column = "p.value"),
"p=0.9"
)
# add_overall checks
expect_equal(
inline_text(test_inline2b, variable = "age", column = "stat_1", pattern = "{median}"),
"46"
)
expect_equal(
inline_text(test_inline2b, variable = "age", column = "stat_0", pattern = "{median}"),
"47"
)
expect_equal(
inline_text(test_inline2b, variable = "stage", level = "T1", column = "stat_0", pattern = "{n}"),
"53"
)
expect_equal(
inline_text(test_inline2b, variable = "stage", level = "T1", column = "stat_1", pattern = "{n}"),
"28"
)
# can still select first level after remove row type
expect_equal(
trial %>%
select(grade, trt) %>%
tbl_summary(by = trt, missing = "no") %>%
remove_row_type() %>%
inline_text(variable = grade, level = "I", column = "stat_1"),
"35 (36%)"
)
# ensure inline_text(column) argument works with factor levels
expect_equal(
trial |>
dplyr::mutate(trt = factor(trt)) |>
tbl_summary(by = trt, include = age) |>
inline_text(variable = "age", column = "Drug A", pattern = "{median}"),
"46"
)
})
test_that("inline_text.tbl_summary() messaging", {
# dplyr made a slight change to their messaging in v1.1.4 and that is captured here
# just adding this because some validated envs don't have the most recent version
skip_if(packageVersion("dplyr") < package_version("1.1.4"))
expect_snapshot(
error = TRUE,
inline_text(test_inline2, variable = "age", column = "Pla5cebo")
)
expect_snapshot(
error = TRUE,
inline_text(test_inline2, variable = "stage", level = "Tsdfgsdfg1", column = "Drug B")
)
expect_snapshot(
error = TRUE,
inline_text(test_inline2, variable = "st55age", level = "T1", column = "Drug B")
)
})
# inline_text.regression tests -------------------------------------------------
test_inline3 <- lm(marker ~ age + stage, trial) |> tbl_regression()
test_inline4 <- glm(response ~ trt + age + stage, trial, family = binomial) |>
tbl_regression(exponentiate = TRUE)
test_that("inline_text.tbl_regression()", {
expect_equal(
inline_text(test_inline3, variable = "age"),
"0.00 (95% CI -0.01, 0.01; p=0.9)"
)
expect_equal(
inline_text(test_inline4, variable = "stage", level = "T2"),
"0.58 (95% CI 0.24, 1.36; p=0.2)"
)
})
test_that("inline_text.tbl_regression() messaging", {
# dplyr made a slight change to their messaging in v1.1.4 and that is captured here
# just adding this because some validated envs don't have the most recent version
skip_if(packageVersion("dplyr") < package_version("1.1.4"))
expect_snapshot(
error = TRUE,
inline_text(test_inline3, variable = "stage", level = "Tsdfgsdfg1")
)
expect_snapshot(
error = TRUE,
inline_text(test_inline3, variable = "st55age")
)
})
# inline_text.tbl_survfit() tests ---------------------------------------------
fit1 <- survival::survfit(survival::Surv(ttdeath, death) ~ trt, trial)
fit2 <- survival::survfit(survival::Surv(ttdeath, death) ~ 1, trial)
tbl1 <-
tbl_survfit(
fit1,
times = c(12, 24),
label_header = "**{time} Month**"
) %>%
add_p()
tbl2 <-
tbl_survfit(
fit2,
probs = 0.5
)
test_that("inline_text.tbl_survfit()", {
expect_equal(
inline_text(tbl1, time = 24, level = "Drug A"),
"47% (38%, 58%)"
)
expect_equal(
inline_text(tbl1, time = 24, level = "Drug A", pattern = "{estimate}"),
"47%"
)
expect_silent(
tbl1_pvalue <- inline_text(tbl1, column = p.value)
)
expect_equal(tbl1_pvalue, "p=0.2")
expect_silent(
tbl1_pattern <-
inline_text(
tbl1,
time = 24,
level = "Drug A",
pattern = "{estimate}",
estimate_fun = label_style_percent(digits = 3, suffix = "%")
)
)
expect_equal(tbl1_pattern, "46.939%")
expect_equal(
inline_text(tbl2, prob = 0.5),
"22 (21, —)"
)
})
test_that("inline_text.tbl_survfit() messaging", {
expect_snapshot(
error = TRUE,
inline_text(tbl1, time = 24, column = "stat_2", level = "Drug A")
)
expect_snapshot(
error = TRUE,
inline_text(tbl1, time = 10000, level = "Drug A")
)
expect_snapshot(
error = TRUE,
inline_text(tbl2, prob = 0.2, level = "Drug A")
)
})
# inline_text.tbl_continuous() tests ------------------------------------------------
test_that("inline_text.tbl_continuous()", {
expect_equal(
trial |>
tbl_continuous(
variable = age,
by = trt,
include = grade
) |>
inline_text(variable = grade, level = "I", column = "stat_1"),
"46 (36, 60)"
)
})
# inline_text.tbl_cross() tests ------------------------------------------------
test_that("inline_text.tbl_cross()", {
tbl_cross <-
tbl_cross(trial, row = trt, col = response) %>%
add_p()
expect_equal(
inline_text(tbl_cross, row_level = "Drug A", col_level = "1"),
"28"
)
expect_equal(
inline_text(tbl_cross, row_level = "Total", col_level = "1"),
"61"
)
expect_equal(
inline_text(tbl_cross, col_level = "p.value"),
"p=0.7"
)
})
test_that("inline_text.tbl_cross() messaging", {
tbl_cross <-
tbl_cross(trial, row = trt, col = response) %>%
add_p()
expect_snapshot(
error = TRUE,
inline_text(tbl_cross, row_level = "Drug A")
)
expect_snapshot(
error = TRUE,
inline_text(tbl_cross)
)
})
# skip_if_not(broom.helpers::.assert_package("survey", pkg_search = "gtsummary", boolean = TRUE))
#
# # inline_text.tbl_svysummary tests --------------
# test_inline1 <- trial %>%
# survey::svydesign(data = ., ids = ~1, weights = ~1) %>%
# tbl_svysummary()
# test_inline2 <- trial %>%
# survey::svydesign(data = ., ids = ~1, weights = ~1) %>%
# tbl_svysummary(by = trt)
# test_inline2b <- trial %>%
# survey::svydesign(data = ., ids = ~1, weights = ~1) %>%
# tbl_svysummary(by = trt) %>%
# add_p()
# test_that("inline_text.tbl_svysummary: no by", {
# expect_error(
# inline_text(test_inline1, variable = "age"),
# NA
# )
# expect_error(
# inline_text(test_inline1, variable = "stage", level = "T1"),
# NA
# )
#
# expect_equal(
# inline_text(test_inline1, variable = "stage", level = "T1", pattern = "{p}%"),
# "27%"
# )
# expect_equal(
# inline_text(test_inline1, variable = "age", pattern = "The median is {median}"),
# "The median is 47"
# )
# })
# test_that("inline_text.tbl_svysummary: with by", {
# expect_error(
# inline_text(test_inline2, variable = "age", column = "Drug B"),
# NA
# )
# expect_error(
# inline_text(test_inline2, variable = "stage", level = "T1", column = "Drug B"),
# NA
# )
# expect_error(
# inline_text(test_inline2b, variable = "stage", column = "p.value"),
# NA
# )
# })
# test_that("inline_text.tbl_svysummary: with by - expect errors", {
# expect_error(
# inline_text(test_inline2, variable = "age", column = "Pla5cebo"),
# NULL
# )
# expect_error(
# inline_text(test_inline2, variable = "stage", level = "Tsdfgsdfg1", column = "Drug B"),
# NULL
# )
#
# expect_error(
# inline_text(test_inline2, variable = "st55age", level = "T1", column = "Drug B"),
# NULL
# )
# })
# test_that("inline_text.tbl_svysummary: no errors with empty string selection", {
# skip_if_not(broom.helpers::.assert_package("survey", pkg_search = "gtsummary", boolean = TRUE))
# expect_error(
# trial %>%
# select(grade) %>%
# mutate(grade = ifelse(grade == "I", "", as.character(grade))) %>%
# survey::svydesign(data = ., ids = ~1, weights = ~1) %>%
# tbl_svysummary() %>%
# inline_text(variable = grade, level = "III"),
# NA
# )
# })
test_that("check for messaging about duplicate variables", {
t1 <- lm(age ~ marker, trial) %>% tbl_regression()
expect_snapshot(
tbl_stack(list(t1, t1)) %>%
inline_text(variable = marker, column = estimate)
)
})
test_that("inline_text.gtsummary() messaging", {
tbl <-
.create_gtsummary_object(table_body = head(mtcars)) |>
modify_column_unhide(everything())
expect_error(
inline_text(tbl, variable = "mpg"),
'data frame does not have the required'
)
tbl <-
head(mtcars) %>%
dplyr::mutate(variable = "one") %>%
.create_gtsummary_object() |>
modify_column_unhide(everything())
expect_error(
inline_text(tbl, variable = "one", column = "mpg", level = "21"),
"The gtsummary table does not have the required "
)
})
# testing mixed class inline text with patterns
test_that("works with mixed class stacking", {
expect_equal(
trial %>%
mutate(
var_duration = Sys.Date() - Sys.Date()
) %>%
tbl_summary(
include = c(age, var_duration),
type = ~"continuous"
) %>%
inline_text(variable = var_duration, pattern = "{median}"),
"0.0000 days"
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.