tests/testthat/test-pretty_names.R

In parameters: Processing of Model Parameters

test_that("pretty_names", {
  data(mtcars)
  attr(mtcars$hp, "label") <- "Gross horsepower"
  mod <- lm(mpg ~ hp + factor(cyl), mtcars)

  p <- parameters::parameters(mod, pretty_names = "labels", include_reference = TRUE)
  expect_identical(
    attr(p, "pretty_labels"),
    c(
      `(Intercept)` = "(Intercept)", hp = "Gross horsepower", `factor(cyl)4` = "cyl [4]",
      `factor(cyl)6` = "cyl [6]", `factor(cyl)8` = "cyl [8]"
    )
  )

  p <- parameters::parameters(mod, pretty_names = "labels")
  expect_identical(
    attr(p, "pretty_labels"),
    c(
      `(Intercept)` = "(Intercept)", hp = "Gross horsepower", `factor(cyl)6` = "cyl [6]",
      `factor(cyl)8` = "cyl [8]"
    )
  )

  mtcars2 <- transform(mtcars, cyl = as.factor(cyl))
  attr(mtcars2$cyl, "label") <- "Cylinders"
  model <- lm(mpg ~ wt + cyl, data = mtcars2)
  p <- model_parameters(model, pretty_names = "labels", include_reference = TRUE)
  expect_identical(
    attr(p, "pretty_labels"),
    c(
      `(Intercept)` = "(Intercept)", wt = "wt", cyl4 = "Cylinders [4]",
      cyl6 = "Cylinders [6]", cyl8 = "Cylinders [8]"
    )
  )
})

skip_if_not_installed("withr")

# make sure we have the correct interaction mark for tests
withr::with_options(
  list(parameters_interaction = "*", parameters_warning_exponentiate = TRUE),
  test_that("pretty_labels", {
    set.seed(1024)
    N <- 5000
    X <- rbinom(N, 1, 0.5)
    M <- sample(c("a", "b", "c"), N, replace = TRUE)
    b <- runif(8, -1, 1)
    Y <- rbinom(N, 1, prob = plogis(
      b[1] + b[2] * X +
        b[3] * (M == "b") + b[4] * (M == "b") + b[5] * (M == "c") +
        b[6] * X * (M == "a") + b[7] * X + (M == "b") +
        b[8] * X * (M == "c")
    ))
    dat <- data.frame(Y, X, M, stringsAsFactors = FALSE)
    mod <- glm(Y ~ X * M, data = dat, family = binomial)

    p <- parameters(mod)
    expect_identical(
      attr(p, "pretty_labels"),
      c(
        `(Intercept)` = "(Intercept)", X = "X", Mb = "M [b]", Mc = "M [c]",
        `X:Mb` = "X * M [b]", `X:Mc` = "X * M [c]"
      )
    )
    expect_snapshot(print(p))
  })
)


withr::with_options(
  list(parameters_exponentiate = FALSE, parameters_warning_exponentiate = FALSE),
  {
    test_that("pretty_labels, pscl", {
      skip_if_not_installed("pscl")

      mydf <- pscl::bioChemists
      attr(mydf$art, "label") <- "MyCount"
      attr(mydf$fem, "label") <- "MyGender"
      attr(mydf$mar, "label") <- "MyMarried"

      model <- pscl::zeroinfl(art ~ fem + mar, data = mydf)
      expect_snapshot(print(model_parameters(model), pretty_names = "labels", zap_small = TRUE))

      # doesn't crash if pretty-labels is NULL
      mydf <- pscl::bioChemists
      mydf$mar <- as.character(mydf$mar)
      model <- pscl::zeroinfl(art ~ fem + mar, data = mydf)
      out <- model_parameters(model)
      expect_identical(dim(out), c(6L, 10L))
    })
  }
)