tests/testthat/test-clm.R

test_that("colorizing works", {
  ordinal_ologit <- ordinal::clm(rating ~ temp * contact,
                                 data = ordinal::wine,
                                 link = "logit"
  )
  
  greek_col <- c("#1B9E77", "#D95F02", "#7570B3", "#E7298A", "#66A61E", 
                 "#E6AB02", "#A6761D", "#666666")
  
  expect_snapshot_output(
    extract_eq(
      ordinal_ologit,
      wrap = TRUE, 
      terms_per_line = 2,
      var_colors = c(temp = "blue"),
      greek_colors = greek_col,
      subscript_colors = rev(greek_col)
    )
  )
})

test_that("Renaming Variables works", {
  df <- data.frame(
    outcome = factor(rep(LETTERS[1:3], 100),
                     levels = LETTERS[1:3],
                     ordered = TRUE
    ),
    categorical = rep(letters[1:5], 20),
    continuous = rnorm(300, 100, 1)
  )
  expect_warning(
    m3 <- ordinal::clm(outcome ~ categorical*continuous,
                       data = df, 
                       link = "logit"
    )
  )
  expect_snapshot_output(
    extract_eq(
      m3,
      swap_var_names = c("categorical" = "cat"),
      swap_subscript_names = c(
        "a" = "Hey look! A new subscript",
        "d" = "Don't look at me though"
      ),
      wrap = TRUE,
      terms_per_line = 2
    )
  )
})

test_that("Math extraction works", {
  df <- data.frame(
    outcome = factor(rep(LETTERS[1:3], 100),
                     levels = LETTERS[1:3],
                     ordered = TRUE
    ),
    continuous = rnorm(300, 100, 1)
  )
  
  expect_warning(
    model_logit <- ordinal::clm(
      outcome ~ poly(continuous, 3) + exp(continuous) + log(continuous),
      data = df, 
      link = "logit"
    )
  )
  expect_warning(
    model_probit <- ordinal::clm(
      outcome ~ poly(continuous, 3) + exp(continuous) + log(continuous),
      data = df,
      link = "probit"
    )
  )
  
  expect_snapshot_output(extract_eq(model_logit))
  expect_snapshot_output(extract_eq(model_probit))
})

test_that("Collapsing clm factors works", {
  df <- data.frame(
    outcome = factor(rep(LETTERS[1:3], 100),
                     levels = LETTERS[1:3],
                     ordered = TRUE
    ),
    categorical = rep(letters[1:5], 20),
    continuous = rnorm(300, 100, 1)
  )
  expect_warning(
    model_logit <- ordinal::clm(outcome ~ categorical*continuous,
                                data = df, link = "logit"
    )
  )
  expect_warning(
    model_probit <- ordinal::clm(outcome ~ categorical*continuous,
                                 data = df, link = "probit"
    )
  )
  # no collapsing
  expect_snapshot(extract_eq(model_logit))
  expect_snapshot(extract_eq(model_probit))
  
  # collapsing
  expect_snapshot(extract_eq(model_logit, index_factors = TRUE))
  expect_snapshot(extract_eq(model_probit, index_factors = TRUE))
})

test_that("Ordered models with clm work", {
  set.seed(1234)
  df <- data.frame(
    outcome = factor(rep(LETTERS[1:3], 100),
      levels = LETTERS[1:3],
      ordered = TRUE
    ),
    continuous_1 = rnorm(300, 1, 1),
    continuous_2 = rnorm(300, 5, 5)
  )

  model_logit <- ordinal::clm(outcome ~ continuous_1 + continuous_2,
    data = df, link = "logit"
  )
  model_probit <- ordinal::clm(outcome ~ continuous_1 + continuous_2,
    data = df, link = "probit"
  )

  expect_snapshot_output(extract_eq(model_logit, wrap = FALSE))
  expect_snapshot_output(extract_eq(model_logit, wrap = TRUE, terms_per_line = 2))
  expect_snapshot_output(extract_eq(model_probit, wrap = FALSE))
  expect_snapshot_output(extract_eq(model_probit, wrap = TRUE, terms_per_line = 2))

  # Coefficients instead of letters
  expect_snapshot_output(extract_eq(model_logit, use_coefs = TRUE))
})

test_that("Unsupported CLMs create a message", {
  set.seed(1234)
  df <- data.frame(
    outcome = factor(rep(LETTERS[1:3], 100),
      levels = LETTERS[1:3],
      ordered = TRUE
    ),
    continuous_1 = rnorm(300, 1, 1),
    continuous_2 = rnorm(300, 5, 5)
  )

  model <- ordinal::clm(outcome ~ continuous_1 + continuous_2,
    data = df, link = "cauchit"
  )

  expect_message(extract_eq(model))
})

Try the equatiomatic package in your browser

Any scripts or data that you put into this service are public.

equatiomatic documentation built on May 29, 2024, 1:19 a.m.