tests/testthat/test-set_contrasts.R

In contrastable: Consistent Contrast Coding for Factors

test_that("set contrast equivalent to manual contrast codes", {
  tst_df <-
    set_contrasts(mtcars,
                  gear ~ helmert_code,
                  cyl ~ contr.sum,
                  verbose = FALSE)

  comparison_df <- mtcars
  comparison_df$gear <- factor(comparison_df$gear)
  comparison_df$cyl <- factor(comparison_df$cyl)

  contrasts(comparison_df$cyl) <-
    use_contrasts(comparison_df$cyl, contr.sum)
  contrasts(comparison_df$gear) <-
    use_contrasts(comparison_df$gear, helmert_code)

  columns_equivalent <-
    vapply(
      names(tst_df),
      function(x) {
        all(tst_df[[x]] == comparison_df[[x]]) &
          class(tst_df[[x]]) == class(comparison_df[[x]])
      },
      TRUE
    )

  expect_true(all(columns_equivalent))
})

test_that("Ignoring dropped levels in orthogonal polynomial contrasts", {
  expect_warning(set_contrasts(mtcars,
                               carb ~ contr.poly - 4:6,
                               verbose = FALSE),
                 regexp = r"(Cannot use ... with set_contrasts.)"
  )
  testdf <- suppressWarnings(set_contrasts(mtcars,
                                           carb ~ contr.poly - 4:6,
                                           verbose = FALSE))

  expect_warning(set_contrasts(mtcars,
                               gear ~ contr.sum - 2:3,
                               verbose = FALSE),
                 regexp = "only be used with polynomial contrasts"
  )


  expect_equal(contrasts(testdf$carb), contr.poly(6), ignore_attr = TRUE)
})

test_that("Contrasts print when asked for", {
  expect_snapshot_output(
    invisible(
      set_contrasts(mtcars,
                    gear ~ helmert_code,
                    print_contrasts = TRUE,
                    verbose = FALSE)
    )
  )
})


test_that("Namespaced call works", {
  result <- contrastable::set_contrasts(mtcars,
                                        carb ~ contr.sum,
                                        verbose = FALSE)
  expect_true(!is.null(result))
})