tests/testthat/test-obp-helpers.R

In tipr: Tipping Point Analyses

context("Observed bias plot helpers")

ps_mod <- glm(am ~ cyl + hp + I(hp^2), data = mtcars, family = "binomial")
outcome_mod <- lm(mpg ~ am + cyl + disp + wt + I(wt^2), data = mtcars)

test_that("Check drop list works", {
  expect_error(check_drop_list("a"), "`drop_list` must be a named list.")

  expect_error(check_drop_list(list("a")), "`drop_list` must be a named list.")

  expect_error(check_drop_list(list(a = 1)), "`drop_list` must be")

  expect_silent(check_drop_list(list(a = "a")))
})

test_that("We can get y from lm or glm formulas", {
  expect_equal(get_y(lm(mpg ~ cyl, data = mtcars)), "mpg")

  expect_equal(get_y(glm(mpg ~ cyl, data = mtcars)), "mpg")

})

test_that("We can get variables from lm or glm formulas", {
  expect_equal(parse_formula(lm(mpg ~ cyl, data = mtcars)), "cyl")

  expect_equal(parse_formula(glm(mpg ~ cyl, data = mtcars)), "cyl")

})

test_that("create_covariate_lists pulls the correct covariates", {
  c <- create_covariate_lists(ps_mod, outcome_mod)

  expect_equal(c$exposure, "am")
  expect_equal(c$ps_covariates, c("cyl", "hp", "I(hp^2)"))
  expect_equal(c$ps_covariates_clean, c("cyl", "hp"))
  expect_equal(c$outcome_covariates, c("am", "cyl", "disp", "wt", "I(wt^2)"))
  expect_equal(c$outcome_covariates_clean, c("cyl", "disp", "wt"))
})

test_that("drop_one_mod_tbl effectively creates a tbl for dropped covariate from both models", {
  t <- drop_one_mod_tbl("cyl", "cyl",
                        create_covariate_lists(ps_mod, outcome_mod))
  expect_equal(t$dropped, "cyl")
  expect_equal(t$new_ps[[1]], c("hp", "I(hp^2)"))
  expect_equal(t$new_outcome[[1]], c("am", "disp", "wt", "I(wt^2)"))

})

test_that("drop_one_mod_tbl effectively creates a tbl for dropped covariate from ps model", {
  t <- drop_one_mod_tbl("hp", "hp", create_covariate_lists(ps_mod, outcome_mod))
  expect_equal(t$dropped, "hp")
  expect_equal(t$new_ps[[1]], c("cyl"))
  expect_equal(t$new_outcome[[1]], c("am", "cyl", "disp", "wt", "I(wt^2)"))

})

test_that("drop_one_mod_tbl effectively creates a tbl for dropped covariate from outcome model", {
  t <- drop_one_mod_tbl("disp", "disp",
                        create_covariate_lists(ps_mod, outcome_mod))
  expect_equal(t$dropped, "disp")
  expect_equal(t$new_ps[[1]], c("cyl", "hp", "I(hp^2)"))
  expect_equal(t$new_outcome[[1]], c("am", "cyl", "wt", "I(wt^2)"))
})

test_that("drop_one_mod_tbl effectively creates a tbl for dropped group of covariates", {
  t <- drop_one_mod_tbl(c("disp", "cyl"), "disp and cyl",
                        create_covariate_lists(ps_mod, outcome_mod))
  expect_equal(t$dropped, "disp and cyl")
  expect_equal(t$new_ps[[1]], c("hp", "I(hp^2)"))
  expect_equal(t$new_outcome[[1]], c("am", "wt", "I(wt^2)"))
})

test_that("drop_one_mod works for dropping all covariates", {
  t <- drop_one_mod_tbl(c("hp", "cyl"), "hp and cyl",
                        create_covariate_lists(ps_mod, outcome_mod))
  expect_equal(t$new_ps[[1]], 1)
})

test_that("create_individual_covariate_list effectively creates a list of all covariates modelled", {
  c <- create_covariate_lists(ps_mod, outcome_mod)
  l <- create_individual_covariate_list(c)
  expect_silent(check_drop_list(l))
  expect_length(l, 4)
  expect_equal(names(l), unlist(l, use.names = FALSE))
})

test_that("drop_tbl creates the appropriate tbl", {
  c <- create_covariate_lists(ps_mod, outcome_mod)
  l <- create_individual_covariate_list(c)
  covs <- c(list("disp and cyl" = c("disp", "cyl")), l)
  t <- drop_tbl(covs, c)
  expect_equal(t[1, "type", drop = TRUE], c("disp and cyl" = "group"))
  expect_equivalent(t[-1, "type", drop = TRUE], rep("covariate", 4))
  expect_equal(t$new_ps[[1]], t$new_ps[[2]])
  expect_equal(t$new_ps[[4]], t$new_ps[[5]])
  expect_length(t$new_outcome[[3]], 5)
})

test_that("build_formula works", {
  b <- build_formula("am", c("mpg", "cyl", "I(cyl^2)"))
  expect_s3_class(b, "formula")
  expect_equal(as.character(b[[2]]), "am")
  expect_equal(as.character(b[[3]])[1], "+")
  expect_equal(as.character(b[[3]])[2], "mpg + cyl")
  expect_equal(as.character(b[[3]])[3], "I(cyl^2)")
})

test_that("clean_covariate works", {
  expect_equal(clean_covariate("I(hp^2)"), "hp")
  expect_equal(clean_covariate("rms::rcs(mpg)"), "mpg")
  expect_equal(clean_covariate("rms::rcs(mpg, 3)"), "mpg")
  expect_equal(clean_covariate("sqrt(mpg)"), "mpg")
  expect_equal(clean_covariate("log(mpg)"), "mpg")
  expect_equal(clean_covariate("sqrt(log(mpg))"), "mpg")
  expect_equal(clean_covariate("sqrt(log(mpg, 10))"), "mpg")
  expect_equal(clean_covariate("log(sqrt(mpg), 10))"), "mpg")
})