test_that("tidy_add_term_labels() works for basic models", {
mod <- lm(Petal.Length ~ Petal.Width, iris)
expect_error(
mod |> tidy_and_attach() |> tidy_add_term_labels(),
NA
)
df <- gtsummary::trial
mod <- glm(response ~ age + grade + trt, df, family = binomial)
res <- mod |>
tidy_and_attach() |>
tidy_add_term_labels()
expect_equivalent(
res$label,
c("(Intercept)", "Age", "II", "III", "Drug B")
)
df <- gtsummary::trial
mod <- glm(response ~ age + grade + trt, df, family = binomial)
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_term_labels()
expect_equivalent(
res$label,
c("(Intercept)", "Age", "I", "II", "III", "Drug A", "Drug B")
)
# if labels provided in `labels`, taken into account
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_term_labels(
labels = list(
"(Intercept)" = "the intercept",
"trtDrug A" = "the reference term",
gradeIII = "third grade"
)
)
expect_equivalent(
res$label,
c(
"the intercept", "Age", "I", "II", "third grade", "the reference term",
"Drug B"
)
)
# no error if providing labels not corresponding to an existing variable
# but display a message
expect_error(
mod |>
tidy_and_attach() |>
tidy_add_term_labels(
labels = list(aaa = "aaa", bbb = "bbb", ccc = 44)
),
NA
)
expect_message(
mod |>
tidy_and_attach() |>
tidy_add_term_labels(
labels = list(aaa = "aaa", bbb = "bbb", ccc = 44)
)
)
expect_error(
mod |>
tidy_and_attach() |>
tidy_add_term_labels(
labels = list(aaa = "aaa", bbb = "bbb", ccc = 44),
strict = TRUE
)
)
# model with an interaction term only
mod <- lm(age ~ factor(response):marker, gtsummary::trial)
res <- mod |>
tidy_and_attach() |>
tidy_add_term_labels()
expect_equivalent(
res$label,
c("(Intercept)", "0 * Marker Level (ng/mL)", "1 * Marker Level (ng/mL)")
)
})
test_that("test tidy_add_term_labels() 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_term_labels())
# could be apply twice (no error)
expect_error(
mod |> tidy_and_attach() |> tidy_add_term_labels() |> tidy_add_term_labels(),
NA
)
# cannot be applied after tidy_add_header_rows
expect_error(
mod |> tidy_and_attach() |> tidy_add_header_rows() |> tidy_add_term_labels()
)
})
test_that("tidy_add_term_labels() correctly manages interaction terms", {
df <- gtsummary::trial
mod <- glm(response ~ age * grade * trt, df, family = binomial)
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_term_labels()
expect_equivalent(
res$label,
c(
"(Intercept)", "Age", "I", "II", "III", "Drug A", "Drug B",
"Age * II", "Age * III", "Age * Drug B", "II * Drug B", "III * Drug B",
"Age * II * Drug B", "Age * III * Drug B"
)
)
# custom separator and custom labels for certain interaction terms
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_term_labels(
interaction_sep = ":::",
labels = c(
"age:gradeII" = "custom interaction label",
"gradeII:trtDrug B" = "a second custom label"
)
)
expect_equivalent(
res$label,
c(
"(Intercept)", "Age", "I", "II", "III", "Drug A", "Drug B",
"custom interaction label", "Age:::III", "Age:::Drug B", "a second custom label",
"III:::Drug B", "Age:::II:::Drug B", "Age:::III:::Drug B"
)
)
# case with sum contrasts
mod <- lm(
marker ~ stage:ttdeath + stage,
data = gtsummary::trial,
contrasts = list(stage = "contr.sum")
)
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_term_labels()
expect_equivalent(
res$label,
c(
"(Intercept)", "T1", "T2", "T3", "T4", "T1 * Months to Death/Censor",
"T2 * Months to Death/Censor", "T3 * Months to Death/Censor",
"T4 * Months to Death/Censor"
)
)
# complex case: model with no intercept and sum contrasts
mod <- lm(
Petal.Length ~ Species * Petal.Width - 1,
data = iris,
contrasts = list(Species = contr.sum)
)
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_term_labels()
expect_equivalent(
res$label,
c(
"setosa", "versicolor", "virginica", "Petal.Width",
"setosa * Petal.Width", "versicolor * Petal.Width"
)
)
})
test_that("tidy_add_term_labels() works with poly or helmert contrasts", {
mod <- glm(
response ~ stage + grade + trt,
gtsummary::trial,
family = binomial,
contrasts = list(stage = contr.sum, grade = contr.helmert, trt = contr.SAS)
)
# should not produce an error
expect_error(
mod |> tidy_and_attach() |> tidy_add_term_labels(),
NA
)
})
test_that("tidy_add_term_labels() works with sdif contrasts", {
skip_if_not_installed("MASS")
mod <- glm(
response ~ stage + grade,
gtsummary::trial,
family = binomial,
contrasts = list(stage = MASS::contr.sdif, grade = MASS::contr.sdif)
)
# should not produce an error
expect_error(
res <- mod |> tidy_and_attach() |> tidy_add_term_labels(),
NA
)
expect_equivalent(
res$label,
c(
`(Intercept)` = "(Intercept)", `stageT2-T1` = "T2 - T1",
`stageT3-T2` = "T3 - T2", `stageT4-T3` = "T4 - T3",
`gradeII-I` = "II - I", `gradeIII-II` = "III - II"
)
)
# should not produce an error
expect_error(
res <- mod |>
tidy_and_attach(exponentiate = TRUE) |>
tidy_add_term_labels(),
NA
)
expect_equivalent(
res$label,
c(
`(Intercept)` = "(Intercept)", `stageT2-T1` = "T2 / T1",
`stageT3-T2` = "T3 / T2", `stageT4-T3` = "T4 / T3",
`gradeII-I` = "II / I", `gradeIII-II` = "III / II"
)
)
})
test_that("tidy_add_term_labels() works with variables having non standard name", {
skip_on_cran()
df <- gtsummary::trial |> dplyr::rename(
`grade of kids...` = grade,
`?? treatment ++ response ...` = response
)
mod <- lm(age ~ marker * `grade of kids...` + factor(`?? treatment ++ response ...`), df)
res <- mod |>
tidy_and_attach() |>
tidy_add_reference_rows() |>
tidy_add_term_labels()
expect_equivalent(
res$label,
c(
"(Intercept)", "Marker Level (ng/mL)", "I", "II", "III", "0",
"1", "Marker Level (ng/mL) * II", "Marker Level (ng/mL) * III"
)
)
expect_equivalent(
res$variable,
c(
"(Intercept)", "marker", "grade of kids...", "grade of kids...", "grade of kids...",
"factor(`?? treatment ++ response ...`)", "factor(`?? treatment ++ response ...`)",
"marker:grade of kids...", "marker:grade of kids..."
)
)
res <- gtsummary::trial |>
dplyr::select(response, `age at dx` = age, `drug type` = trt) |>
lm(
response ~ `age at dx` + `drug type`,
data = _
) |>
tidy_and_attach() |>
tidy_add_variable_labels(list(`age at dx` = "AGGGGGGGE")) |>
tidy_add_term_labels()
expect_equivalent(
res$label,
c("(Intercept)", "AGGGGGGGE", "Drug B")
)
})
test_that("tidy_add_term_labels() works with stats::poly()", {
skip_on_cran()
df <- iris |> labelled::set_variable_labels(Petal.Length = "Length of petal")
mod <- lm(Sepal.Length ~ poly(Sepal.Width, 3) + poly(Petal.Length, 2), df)
res <- mod |>
tidy_and_attach() |>
tidy_add_term_labels()
expect_equivalent(
res$label,
c(
"(Intercept)", "Sepal.Width", "Sepal.Width²", "Sepal.Width³",
"Petal.Length", "Petal.Length²"
)
)
})
skip_on_cran()
test_that("tidy_add_term_labels() works with lme4::lmer", {
skip_on_cran()
skip_if_not_installed("lme4")
mod <- lme4::lmer(Reaction ~ Days + (Days | Subject), lme4::sleepstudy)
expect_error(mod |> tidy_and_attach(tidy_fun = broom.mixed::tidy) |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with lme4::glmer", {
skip_on_cran()
skip_if_not_installed("lme4")
mod <- lme4::glmer(cbind(incidence, size - incidence) ~ period + (1 | herd),
family = binomial, data = lme4::cbpp
)
expect_error(mod |> tidy_and_attach(tidy_fun = broom.mixed::tidy) |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with survival::coxph", {
skip_on_cran()
df <- survival::lung |> dplyr::mutate(sex = factor(sex))
mod <- survival::coxph(survival::Surv(time, status) ~ ph.ecog + age + sex, data = df)
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with survival::survreg", {
skip_on_cran()
mod <- survival::survreg(
survival::Surv(futime, fustat) ~ ecog.ps + rx,
survival::ovarian,
dist = "exponential"
)
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with nnet::multinom", {
skip_on_cran()
mod <- nnet::multinom(grade ~ stage + marker + age, data = gtsummary::trial, trace = FALSE)
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with survey::svyglm", {
skip_on_cran()
skip_if_not_installed("survey")
df <- survey::svydesign(~1, weights = ~1, data = gtsummary::trial)
mod <- survey::svyglm(response ~ age + grade * trt, df, family = quasibinomial)
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with ordinal::clm", {
skip_on_cran()
mod <- ordinal::clm(rating ~ temp * contact, data = ordinal::wine)
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with ordinal::clmm", {
skip_on_cran()
mod <- ordinal::clmm(rating ~ temp * contact + (1 | judge), data = ordinal::wine)
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with MASS::polr", {
skip_on_cran()
mod <- MASS::polr(Sat ~ Infl + Type + Cont, weights = Freq, data = MASS::housing)
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with geepack::geeglm", {
skip_on_cran()
skip_if(packageVersion("geepack") < "1.3")
df <- geepack::dietox
df$Cu <- as.factor(df$Cu)
mf <- formula(Weight ~ Cu * Time)
suppressWarnings(
mod <- geepack::geeglm(mf, data = df, id = Pig, family = poisson("identity"), corstr = "ar1")
)
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with gam::gam", {
skip_on_cran()
skip_if_not_installed("gam")
data(kyphosis, package = "gam")
mod <- gam::gam(Kyphosis ~ gam::s(Age, 4) + Number, family = binomial, data = kyphosis)
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
mod <- suppressWarnings(gam::gam(
Ozone^(1 / 3) ~ gam::lo(Solar.R) + gam::lo(Wind, Temp),
data = datasets::airquality, na = gam::na.gam.replace
))
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
})
test_that("tidy_add_term_labels() works with lavaan::lavaan", {
skip_on_cran()
skip_if_not_installed("lavaan")
df <- lavaan::HolzingerSwineford1939
df$grade <- factor(df$grade, ordered = TRUE)
HS.model <- "visual =~ x1 + x2 + x3
textual =~ x4 + x5 + x6 + grade
speed =~ x7 + x8 + x9 "
mod <- lavaan::lavaan(HS.model,
data = df,
auto.var = TRUE, auto.fix.first = TRUE,
auto.cov.lv.x = TRUE
)
expect_error(mod |> tidy_and_attach() |> tidy_add_term_labels(), NA)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.