tests/testthat/test-check_heterogeneity_bias.R

test_that("check_heterogeneity_bias", {
  skip_if_not_installed("datawizard")
  data(iris)
  set.seed(123)
  iris$ID <- sample.int(4, nrow(iris), replace = TRUE) # fake-ID
  out <- check_heterogeneity_bias(iris, select = c("Sepal.Length", "Petal.Length"), by = "ID")
  expect_equal(out, c("Sepal.Length", "Petal.Length"), ignore_attr = TRUE)
  expect_output(print(out), "Possible heterogeneity bias due to following predictors: Sepal\\.Length, Petal\\.Length")

  out <- check_heterogeneity_bias(iris, select = ~ Sepal.Length + Petal.Length, by = ~ID)
  expect_equal(out, c("Sepal.Length", "Petal.Length"), ignore_attr = TRUE)
  expect_output(print(out), "Possible heterogeneity bias due to following predictors: Sepal\\.Length, Petal\\.Length")

  m <- lm(Sepal.Length ~ Petal.Length + Petal.Width + Species + ID, data = iris)
  expect_error(
    check_heterogeneity_bias(m, select = c("Sepal.Length", "Petal.Length"), by = "ID"),
    regex = "no mixed model"
  )

  skip_if_not_installed("lme4")
  m <- lme4::lmer(Sepal.Length ~ Petal.Length + Petal.Width + Species + (1 | ID), data = iris)
  out <- check_heterogeneity_bias(m, select = c("Sepal.Length", "Petal.Length"), by = "ID")
  expect_equal(out, c("Petal.Length", "Petal.Width", "Species"), ignore_attr = TRUE)
  expect_output(
    print(out),
    "Possible heterogeneity bias due to following predictors: Petal\\.Length, Petal\\.Width, Species"
  )
  out <- check_heterogeneity_bias(m, select = ~ Sepal.Length + Petal.Length, by = ~ID)
  expect_equal(out, c("Petal.Length", "Petal.Width", "Species"), ignore_attr = TRUE)
  expect_output(
    print(out),
    "Possible heterogeneity bias due to following predictors: Petal\\.Length, Petal\\.Width, Species"
  )
})

test_that("check_heterogeneity_bias", {
  skip_if_not_installed("datawizard", minimum_version = "0.12.3")
  data(efc, package = "datawizard")
  dat <- na.omit(efc)
  dat$e42dep <- factor(dat$e42dep)
  dat$c172code <- factor(dat$c172code)

  out <- check_heterogeneity_bias(
    dat,
    select = "c12hour",
    by = c("e42dep", "c172code"),
    nested = TRUE
  )
  expect_equal(out, "c12hour", ignore_attr = TRUE)
})

Try the performance package in your browser

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

performance documentation built on Oct. 19, 2024, 1:07 a.m.