test_that("tidy_add_header_rows() works as expected", {
mod <- glm(
response ~ stage + grade * trt,
gtsummary::trial,
family = binomial,
contrasts = list(stage = contr.treatment, grade = contr.SAS, trt = contr.sum)
)
res <- mod |>
tidy_and_attach() |>
tidy_add_header_rows()
expect_equivalent(
res$label,
c(
"(Intercept)", "T Stage", "T2", "T3", "T4", "Grade", "I", "II",
"Chemotherapy Treatment", "Drug A", "Grade * Chemotherapy Treatment",
"I * Drug A", "II * Drug A"
)
)
expect_equivalent(
res$header_row,
c(
NA, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, FALSE,
TRUE, FALSE, FALSE
)
)
expect_equivalent(
res$var_nlevels,
c(NA, 4L, 4L, 4L, 4L, 3L, 3L, 3L, 2L, 2L, NA, NA, NA)
)
# show_single_row has an effect only on variables with one term (2 if a ref term)
res <- mod |>
tidy_and_attach() |>
tidy_identify_variables() |>
tidy_add_header_rows(show_single_row = everything(), quiet = TRUE)
expect_equivalent(
res$label,
c(
"(Intercept)", "T Stage", "T2", "T3", "T4", "Grade", "I", "II",
"Chemotherapy Treatment", "Grade * Chemotherapy Treatment", "I * Drug A",
"II * Drug A"
)
)
expect_equivalent(
res$header_row,
c(
NA, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, NA, TRUE,
FALSE, FALSE
)
)
# with reference rows
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_header_rows()
expect_equivalent(
res$label,
c(
"(Intercept)", "T Stage", "T1", "T2", "T3", "T4", "Grade",
"I", "II", "III", "Chemotherapy Treatment", "Drug A", "Drug B",
"Grade * Chemotherapy Treatment", "I * Drug A", "II * Drug A"
)
)
expect_equivalent(
res$header_row,
c(
NA, TRUE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE,
TRUE, FALSE, FALSE, TRUE, FALSE, FALSE
)
)
# no warning with an intercept only model
mod <- lm(mpg ~ 1, mtcars)
expect_warning(
mod |> tidy_and_attach() |> tidy_add_header_rows(),
NA
)
# header row for all categorical variable (even if no reference row)
# and if interaction with a categorical variable
# (except if )
mod <- lm(age ~ factor(response) * marker + trt, gtsummary::trial)
res <- mod |>
tidy_and_attach() |>
tidy_add_header_rows(show_single_row = "trt")
expect_equivalent(
res$header_row,
c(NA, TRUE, FALSE, NA, NA, TRUE, FALSE)
)
# show_single_row could be apply to an interaction variable
mod <- lm(age ~ factor(response) * marker, gtsummary::trial)
res <- mod |>
tidy_and_attach() |>
tidy_add_header_rows(show_single_row = "factor(response):marker")
expect_equivalent(
res$header_row,
c(NA, TRUE, FALSE, NA, NA)
)
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_header_rows(show_single_row = "factor(response):marker")
expect_equivalent(
res$header_row,
c(NA, TRUE, FALSE, FALSE, NA, NA)
)
expect_equivalent(
res$var_label,
c(
"(Intercept)", "factor(response)", "factor(response)", "factor(response)",
"Marker Level (ng/mL)", "factor(response) * Marker Level (ng/mL)"
)
)
# no standard name
mod <- lm(
hp ~ `miles per gallon`,
mtcars |> dplyr::rename(`miles per gallon` = mpg)
)
res <- mod |>
tidy_and_attach() |>
tidy_add_header_rows()
expect_equivalent(
res$header_row,
c(NA, NA)
)
mod <- lm(
hp ~ `cyl as factor`,
mtcars |> dplyr::mutate(`cyl as factor` = factor(cyl))
)
res <- mod |>
tidy_and_attach() |>
tidy_add_header_rows()
expect_equivalent(
res$header_row,
c(NA, TRUE, FALSE, FALSE)
)
})
test_that("test tidy_add_header_rows() checks", {
mod <- glm(response ~ stage + grade + trt, gtsummary::trial, family = binomial)
# expect an error if no model attached
expect_error(mod |> broom::tidy() |> tidy_add_header_rows())
# warning if applied twice
expect_message(
mod |>
tidy_and_attach() |>
tidy_add_header_rows() |>
tidy_add_header_rows()
)
})
test_that("tidy_add_header_rows() works with nnet::multinom", {
skip_if_not_installed("nnet")
skip_on_cran()
mod <- nnet::multinom(grade ~ stage + marker + age + trt, data = gtsummary::trial, trace = FALSE)
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_header_rows()
expect_equivalent(
res$header_row,
c(
NA, TRUE, FALSE, FALSE, FALSE, FALSE, NA, NA, TRUE, FALSE,
FALSE, NA, TRUE, FALSE, FALSE, FALSE, FALSE, NA, NA, TRUE, FALSE,
FALSE
)
)
expect_equivalent(
res$label,
c(
"(Intercept)", "T Stage", "T1", "T2", "T3", "T4",
"Marker Level (ng/mL)", "Age", "Chemotherapy Treatment",
"Drug A", "Drug B", "(Intercept)", "T Stage", "T1", "T2",
"T3", "T4", "Marker Level (ng/mL)", "Age",
"Chemotherapy Treatment", "Drug A", "Drug B"
)
)
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_header_rows(show_single_row = everything(), quiet = TRUE)
expect_equivalent(
res$header_row,
c(
NA, TRUE, FALSE, FALSE, FALSE, FALSE, NA, NA, NA, NA, TRUE,
FALSE, FALSE, FALSE, FALSE, NA, NA, NA
)
)
expect_equivalent(
res$label,
c(
"(Intercept)", "T Stage", "T1", "T2", "T3", "T4",
"Marker Level (ng/mL)", "Age", "Chemotherapy Treatment",
"(Intercept)", "T Stage", "T1", "T2", "T3", "T4",
"Marker Level (ng/mL)", "Age", "Chemotherapy Treatment"
)
)
})
test_that("test tidy_add_header_rows() bad single row request", {
mod <- lm(mpg ~ hp + factor(cyl) + factor(am), mtcars) |>
tidy_and_attach() |>
tidy_identify_variables()
expect_message(
tidy_add_header_rows(mod, show_single_row = "factor(cyl)")
)
expect_error(
tidy_add_header_rows(mod, show_single_row = "factor(cyl)", strict = TRUE)
)
})
test_that("tidy_add_header_rows() and mixed model", {
skip_on_cran()
skip_if_not_installed("lme4")
mod <- lme4::lmer(
age ~ stage + (stage | grade) + (1 | grade),
gtsummary::trial
)
res <- mod |>
tidy_and_attach(tidy_fun = broom.mixed::tidy) |>
tidy_add_header_rows()
expect_equal(
res |>
dplyr::filter(.data$header_row & .data$var_type == "ran_pars") |>
nrow(),
0L
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.