tests/testthat/test-mixOmics.R

In butcher: Model Butcher

test_that("pls + predict() works", {
  skip_on_cran()
  skip_if_not_installed("mixOmics")
  suppressPackageStartupMessages(do.call(library, list(package = "mixOmics")))
  fit <- pls(matrix(rnorm(2e2), ncol = 2), rnorm(1e2), mode = "classic")
  x <- axe_call(fit)
  expect_equal(x$call, rlang::expr(dummy_call()))
  x <- axe_data(fit)
  expect_identical(x$input.X, character(0L))
  x <- axe_fitted(fit)
  expect_equal(x$names$sample, matrix(NA))
  x <- butcher(fit)
  new_data <- matrix(1:2, ncol = 2) %>% `colnames<-`(c("X1", "X2"))
  expect_equal(
    predict(x, new_data) %>% purrr::discard_at("call"),
    predict(fit, new_data) %>% purrr::discard_at("call")
  )
})

test_that("spls + predict() works", {
  skip_on_cran()
  skip_if_not_installed("mixOmics")
  suppressPackageStartupMessages(do.call(library, list(package = "mixOmics")))
  fit <- spls(matrix(rnorm(2e2), ncol = 2), rnorm(1e2))
  x <- axe_call(fit)
  expect_equal(x$call, rlang::expr(dummy_call()))
  x <- axe_data(fit)
  expect_identical(x$input.X, character(0L))
  x <- axe_fitted(fit)
  expect_equal(x$names$sample, matrix(NA))
  x <- butcher(fit)
  new_data <- matrix(1:2, ncol = 2) %>% `colnames<-`(c("X1", "X2"))
  expect_equal(predict(x, new_data) %>% purrr::discard_at("call"),
               predict(fit, new_data) %>% purrr::discard_at("call"))
})

test_that("plsda + predict() works", {
  skip_on_cran()
  skip_if_not_installed("mixOmics")
  suppressPackageStartupMessages(do.call(library, list(package = "mixOmics")))
  fit <- plsda(matrix(rnorm(2e2), ncol = 2), sample(c("a", "b"), 1e2, replace = TRUE))
  x <- axe_call(fit)
  expect_equal(x$call, rlang::expr(dummy_call()))
  x <- axe_data(fit)
  expect_identical(x$input.X, character(0L))
  x <- axe_fitted(fit)
  expect_equal(x$names$sample, matrix(NA))
  x <- butcher(fit)
  new_data <- matrix(1:2, ncol = 2) %>% `colnames<-`(c("X1", "X2"))
  expect_equal(predict(x, new_data) %>% purrr::discard_at("call"),
               predict(fit, new_data) %>% purrr::discard_at("call"))
})